* internal linker

  * reorganized aasm layer

compiler/aasm.pas

@@ -1,1098 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit implements an abstract asmoutput class for all processor types
-
-    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.
-
- ****************************************************************************
-}
-{# @abstract(This unit implements an abstract asm output class for all processor types)
-  This unit implements an abstract assembler output class for all processors, these
-  are then overriden for each assembler writer to actually write the data in these
-  classes to an assembler file.
-}
-
-unit aasm;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-       cutils,cclasses,
-       globtype,globals,systems;
-
-    type
-       tait = (
-          ait_none,
-          ait_direct,
-          ait_string,
-          ait_label,
-          ait_comment,
-          ait_instruction,
-          ait_datablock,
-          ait_symbol,
-          ait_symbol_end, { needed to calc the size of a symbol }
-          ait_const_32bit,
-          ait_const_16bit,
-          ait_const_8bit,
-          ait_const_symbol,
-          ait_real_80bit,
-          ait_real_64bit,
-          ait_real_32bit,
-          ait_comp_64bit,
-          ait_align,
-          ait_section,
-          { the following is only used by the win32 version of the compiler }
-          { and only the GNU AS Win32 is able to write it                   }
-          ait_const_rva,
-          ait_stabn,
-          ait_stabs,
-          ait_force_line,
-          ait_stab_function_name,
-          ait_cut, { used to split into tiny assembler files }
-          ait_regalloc, { for register,temp allocation debugging }
-          ait_tempalloc,
-          ait_marker,
-{$ifdef alpha}
-          { the follow is for the DEC Alpha }
-          ait_frame,
-          ait_ent,
-{$endif alpha}
-{$ifdef m68k}
-          ait_labeled_instruction,
-{$endif m68k}
-{$ifdef ia64}
-          ait_bundle,
-          ait_stop,
-{$endif ia64}
-{$ifdef SPARC}
-          ait_labeled_instruction,
-{$endif SPARC}
-          { never used, makes insertation of new ait_ easier to type }
-          { lazy guy !!!! ;-) (FK) }
-          ait_dummy);
-
-
-{ ait_* types which don't result in executable code or which don't influence   }
-{ the way the program runs/behaves, but which may be encountered by the        }
-{ optimizer (= if it's sometimes added to the exprasm list). Update if you add }
-{ a new ait type!                                                              }
-    const
-      SkipInstr = [ait_comment, ait_symbol,ait_force_line,ait_section
-{$ifdef GDB}
-                   ,ait_stabs, ait_stabn, ait_stab_function_name
-{$endif GDB}
-                   ,ait_regalloc, ait_tempalloc, ait_symbol_end
-  ];
-
-
-  { asm symbol functions }
-    type
-       TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
-
-       TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION);
-
-       tasmsymbol = class(TNamedIndexItem)
-         defbind,
-         bind      : TAsmsymbind;
-         typ       : TAsmsymtype;
-         { the next fields are filled in the binary writer }
-         section : tsection;
-         idx     : longint;
-         address,
-         size    : longint;
-         { this need to be incremented with every symbol loading into the
-           paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
-         refs    : longint;
-         {# Alternate symbol which can be used for 'renaming' needed for
-           inlining }
-         altsymbol : tasmsymbol;
-         {# TRUE if the symbol is local for a procedure/function }
-         proclocal : boolean;
-         {# Is the symbol in the used list }
-         inusedlist : boolean;
-         { assembler pass label is set, used for detecting multiple labels }
-         pass : byte;
-         constructor create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
-         procedure reset;
-         function  is_used:boolean;
-         procedure setaddress(_pass:byte;sec:tsection;offset,len:longint);
-         procedure GenerateAltSymbol;
-       end;
-
-       tasmlabel = class(tasmsymbol)
-         { this is set by the tai_label.Init }
-         is_set,
-         { is the label only there for getting an address (e.g. for i/o }
-         { checks -> true) or is it a jump target (false)               }
-         is_addr : boolean;
-         labelnr : longint;
-         constructor create;
-         constructor createdata;
-         constructor createaddr;
-         function getname:string;override;
-       end;
-
-
-       { the short name makes typing easier }
-       tai = class(tlinkedlistitem)
-          { pointer to record with optimizer info about this tai object }
-          optinfo  : pointer;
-          fileinfo : tfileposinfo;
-          typ      : tait;
-          constructor Create;
-       end;
-
-       tai_string = class(tai)
-          str : pchar;
-          { extra len so the string can contain an \0 }
-          len : longint;
-          constructor Create(const _str : string);
-          constructor Create_pchar(_str : pchar);
-          constructor Create_length_pchar(_str : pchar;length : longint);
-          destructor Destroy;override;
-       end;
-
-       { generates a common label }
-       tai_symbol = class(tai)
-          is_global : boolean;
-          sym : tasmsymbol;
-          size : longint;
-          constructor Create(_sym:tasmsymbol;siz:longint);
-          constructor Createname(const _name : string;siz:longint);
-          constructor Createname_global(const _name : string;siz:longint);
-          constructor Createdataname(const _name : string;siz:longint);
-          constructor Createdataname_global(const _name : string;siz:longint);
-       end;
-
-       tai_symbol_end = class(tai)
-          sym : tasmsymbol;
-          constructor Create(_sym:tasmsymbol);
-          constructor Createname(const _name : string);
-       end;
-
-       tai_label = class(tai)
-          is_global : boolean;
-          l : tasmlabel;
-          constructor Create(_l : tasmlabel);
-       end;
-
-       tai_direct = class(tai)
-          str : pchar;
-          constructor Create(_str : pchar);
-          destructor Destroy; override;
-       end;
-
-       { to insert a comment into the generated assembler file }
-       tai_asm_comment = class(tai)
-          str : pchar;
-          constructor Create(_str : pchar);
-          destructor Destroy; override;
-       end;
-
-
-       { Insert a section/segment directive }
-       tai_section = class(tai)
-          sec : tsection;
-          constructor Create(s : tsection);
-       end;
-
-
-       { generates an uninitializised data block }
-       tai_datablock = class(tai)
-          is_global : boolean;
-          sym  : tasmsymbol;
-          size : longint;
-          constructor Create(const _name : string;_size : longint);
-          constructor Create_global(const _name : string;_size : longint);
-       end;
-
-
-       { generates a long integer (32 bit) }
-       tai_const = class(tai)
-          value : longint;
-          constructor Create_32bit(_value : longint);
-          constructor Create_16bit(_value : word);
-          constructor Create_8bit(_value : byte);
-       end;
-
-       tai_const_symbol = class(tai)
-          sym    : tasmsymbol;
-          offset : longint;
-          constructor Create(_sym:tasmsymbol);
-          constructor Create_offset(_sym:tasmsymbol;ofs:longint);
-          constructor Create_rva(_sym:tasmsymbol);
-          constructor Createname(const name:string);
-          constructor Createname_offset(const name:string;ofs:longint);
-          constructor Createname_rva(const name:string);
-       end;
-
-       { generates a single (32 bit real) }
-       tai_real_32bit = class(tai)
-          value : ts32real;
-          constructor Create(_value : ts32real);
-       end;
-
-       { generates a double (64 bit real) }
-       tai_real_64bit = class(tai)
-          value : ts64real;
-          constructor Create(_value : ts64real);
-       end;
-
-       { generates an extended (80 bit real) }
-       tai_real_80bit = class(tai)
-          value : ts80real;
-          constructor Create(_value : ts80real);
-       end;
-
-       { generates an comp (integer over 64 bits) }
-       tai_comp_64bit = class(tai)
-          value : ts64comp;
-          constructor Create(_value : ts64comp);
-       end;
-
-       { insert a cut to split into several smaller files }
-
-       tcutplace=(cut_normal,cut_begin,cut_end);
-
-       tai_cut = class(tai)
-          place : tcutplace;
-          constructor Create;
-          constructor Create_begin;
-          constructor Create_end;
-       end;
-
-       TMarker = (NoPropInfoStart, NoPropInfoEnd,
-         AsmBlockStart, AsmBlockEnd,
-         InlineStart,InlineEnd
-       );
-
-       tai_marker = class(tai)
-         Kind: TMarker;
-         Constructor Create(_Kind: TMarker);
-       end;
-
-       taitempalloc = class(tai)
-          allocation : boolean;
-          temppos,
-          tempsize   : longint;
-          constructor alloc(pos,size:longint);
-          constructor dealloc(pos,size:longint);
-       end;
-
-{ for each processor define the best precision }
-{ bestreal is defined in globals }
-{$ifdef i386}
-const
-       ait_bestreal = ait_real_80bit;
-type
-       tai_bestreal = tai_real_80bit;
-{$endif i386}
-{$ifdef m68k}
-const
-       ait_bestreal = ait_real_32bit;
-type
-       tai_bestreal = tai_real_32bit;
-{$endif m68k}
-
-       taasmoutput = class(tlinkedlist)
-         function getlasttaifilepos : pfileposinfo;
-       end;
-
-    const
-    { maximum of aasmoutput lists there will be }
-      maxoutputlists = 10;
-
-    var
-    { temporary lists }
-      exprasmlist,
-    { default lists }
-      datasegment,codesegment,bsssegment,
-      debuglist,withdebuglist,consts,
-      importssection,exportssection,
-      resourcesection,rttilist,
-      resourcestringlist         : taasmoutput;
-    { asm symbol list }
-      asmsymbollist : tdictionary;
-      usedasmsymbollist : tsinglelist;
-
-    const
-      nextaltnr   : longint = 1;
-      nextlabelnr : longint = 1;
-      countlabelref : boolean = true;
-
-    {# create a new assembler label }
-    procedure getlabel(var l : tasmlabel);
-    { make l as a new label and flag is_addr }
-    procedure getaddrlabel(var l : tasmlabel);
-    { make l as a new label and flag is_data }
-    procedure getdatalabel(var l : tasmlabel);
-    {# return a label number }
-    procedure getlabelnr(var l : longint);
-
-    function  newasmsymbol(const s : string) : tasmsymbol;
-    function  newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol;
-    function  getasmsymbol(const s : string) : tasmsymbol;
-    function  renameasmsymbol(const sold, snew : string):tasmsymbol;
-
-    procedure CreateUsedAsmSymbolList;
-    procedure DestroyUsedAsmSymbolList;
-    procedure UsedAsmSymbolListInsert(p:tasmsymbol);
-    procedure UsedAsmSymbolListReset;
-    procedure UsedAsmSymbolListResetAltSym;
-    procedure UsedAsmSymbolListCheckUndefined;
-
-
-implementation
-
-uses
-{$ifdef delphi}
-  sysutils,
-{$else}
-  strings,
-{$endif}
-  fmodule,verbose;
-
-{****************************************************************************
-                             TAI
- ****************************************************************************}
-
-    constructor tai.Create;
-      begin
-        optinfo := nil;
-        fileinfo:=aktfilepos;
-      end;
-
-{****************************************************************************
-                             TAI_SECTION
- ****************************************************************************}
-
-    constructor tai_section.Create(s : tsection);
-      begin
-         inherited Create;
-         typ:=ait_section;
-         sec:=s;
-      end;
-
-
-{****************************************************************************
-                             TAI_DATABLOCK
- ****************************************************************************}
-
-    constructor tai_datablock.Create(const _name : string;_size : longint);
-
-      begin
-         inherited Create;
-         typ:=ait_datablock;
-         sym:=newasmsymboltype(_name,AB_LOCAL,AT_DATA);
-         { keep things aligned }
-         if _size<=0 then
-           _size:=4;
-         size:=_size;
-         is_global:=false;
-      end;
-
-
-    constructor tai_datablock.Create_global(const _name : string;_size : longint);
-      begin
-         inherited Create;
-         typ:=ait_datablock;
-         sym:=newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
-         { keep things aligned }
-         if _size<=0 then
-           _size:=4;
-         size:=_size;
-         is_global:=true;
-      end;
-
-
-{****************************************************************************
-                               TAI_SYMBOL
- ****************************************************************************}
-
-    constructor tai_symbol.Create(_sym:tasmsymbol;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=_sym;
-         size:=siz;
-         is_global:=(sym.defbind=AB_GLOBAL);
-      end;
-
-    constructor tai_symbol.Createname(const _name : string;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=newasmsymboltype(_name,AB_LOCAL,AT_FUNCTION);
-         size:=siz;
-         is_global:=false;
-      end;
-
-    constructor tai_symbol.Createname_global(const _name : string;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=newasmsymboltype(_name,AB_GLOBAL,AT_FUNCTION);
-         size:=siz;
-         is_global:=true;
-      end;
-
-    constructor tai_symbol.Createdataname(const _name : string;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=newasmsymboltype(_name,AB_LOCAL,AT_DATA);
-         size:=siz;
-         is_global:=false;
-      end;
-
-    constructor tai_symbol.Createdataname_global(const _name : string;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
-         size:=siz;
-         is_global:=true;
-      end;
-
-
-{****************************************************************************
-                               TAI_SYMBOL
- ****************************************************************************}
-
-    constructor tai_symbol_end.Create(_sym:tasmsymbol);
-      begin
-         inherited Create;
-         typ:=ait_symbol_end;
-         sym:=_sym;
-      end;
-
-    constructor tai_symbol_end.Createname(const _name : string);
-      begin
-         inherited Create;
-         typ:=ait_symbol_end;
-         sym:=newasmsymboltype(_name,AB_GLOBAL,AT_NONE);
-      end;
-
-
-{****************************************************************************
-                               TAI_CONST
- ****************************************************************************}
-
-    constructor tai_const.Create_32bit(_value : longint);
-
-      begin
-         inherited Create;
-         typ:=ait_const_32bit;
-         value:=_value;
-      end;
-
-    constructor tai_const.Create_16bit(_value : word);
-
-      begin
-         inherited Create;
-         typ:=ait_const_16bit;
-         value:=_value;
-      end;
-
-    constructor tai_const.Create_8bit(_value : byte);
-
-      begin
-         inherited Create;
-         typ:=ait_const_8bit;
-         value:=_value;
-      end;
-
-
-{****************************************************************************
-                               TAI_CONST_SYMBOL_OFFSET
- ****************************************************************************}
-
-    constructor tai_const_symbol.Create(_sym:tasmsymbol);
-      begin
-         inherited Create;
-         typ:=ait_const_symbol;
-         sym:=_sym;
-         offset:=0;
-         { update sym info }
-         inc(sym.refs);
-      end;
-
-    constructor tai_const_symbol.Create_offset(_sym:tasmsymbol;ofs:longint);
-      begin
-         inherited Create;
-         typ:=ait_const_symbol;
-         sym:=_sym;
-         offset:=ofs;
-         { update sym info }
-         inc(sym.refs);
-      end;
-
-    constructor tai_const_symbol.Create_rva(_sym:tasmsymbol);
-      begin
-         inherited Create;
-         typ:=ait_const_rva;
-         sym:=_sym;
-         offset:=0;
-         { update sym info }
-         inc(sym.refs);
-      end;
-
-    constructor tai_const_symbol.Createname(const name:string);
-      begin
-         inherited Create;
-         typ:=ait_const_symbol;
-         sym:=newasmsymbol(name);
-         offset:=0;
-         { update sym info }
-         inc(sym.refs);
-      end;
-
-    constructor tai_const_symbol.Createname_offset(const name:string;ofs:longint);
-      begin
-         inherited Create;
-         typ:=ait_const_symbol;
-         sym:=newasmsymbol(name);
-         offset:=ofs;
-         { update sym info }
-         inc(sym.refs);
-      end;
-
-    constructor tai_const_symbol.Createname_rva(const name:string);
-      begin
-         inherited Create;
-         typ:=ait_const_rva;
-         sym:=newasmsymbol(name);
-         offset:=0;
-         { update sym info }
-         inc(sym.refs);
-      end;
-
-
-{****************************************************************************
-                               TAI_real_32bit
- ****************************************************************************}
-
-    constructor tai_real_32bit.Create(_value : ts32real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_32bit;
-         value:=_value;
-      end;
-
-{****************************************************************************
-                               TAI_real_64bit
- ****************************************************************************}
-
-    constructor tai_real_64bit.Create(_value : ts64real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_64bit;
-         value:=_value;
-      end;
-
-{****************************************************************************
-                               TAI_real_80bit
- ****************************************************************************}
-
-    constructor tai_real_80bit.Create(_value : ts80real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_80bit;
-         value:=_value;
-      end;
-
-{****************************************************************************
-                               Tai_comp_64bit
- ****************************************************************************}
-
-    constructor tai_comp_64bit.Create(_value : ts64comp);
-
-      begin
-         inherited Create;
-         typ:=ait_comp_64bit;
-         value:=_value;
-      end;
-
-
-{****************************************************************************
-                               TAI_STRING
- ****************************************************************************}
-
-     constructor tai_string.Create(const _str : string);
-
-       begin
-          inherited Create;
-          typ:=ait_string;
-          getmem(str,length(_str)+1);
-          strpcopy(str,_str);
-          len:=length(_str);
-       end;
-
-     constructor tai_string.Create_pchar(_str : pchar);
-
-       begin
-          inherited Create;
-          typ:=ait_string;
-          str:=_str;
-          len:=strlen(_str);
-       end;
-
-    constructor tai_string.Create_length_pchar(_str : pchar;length : longint);
-
-       begin
-          inherited Create;
-          typ:=ait_string;
-          str:=_str;
-          len:=length;
-       end;
-
-    destructor tai_string.destroy;
-
-      begin
-         { you can have #0 inside the strings so }
-         if str<>nil then
-           freemem(str,len+1);
-         inherited Destroy;
-      end;
-
-
-{****************************************************************************
-                               TAI_LABEL
- ****************************************************************************}
-
-    constructor tai_label.create(_l : tasmlabel);
-      begin
-        inherited Create;
-        typ:=ait_label;
-        l:=_l;
-        l.is_set:=true;
-        is_global:=(l.defbind=AB_GLOBAL);
-      end;
-
-
-{****************************************************************************
-                              TAI_DIRECT
- ****************************************************************************}
-
-     constructor tai_direct.Create(_str : pchar);
-
-       begin
-          inherited Create;
-          typ:=ait_direct;
-          str:=_str;
-       end;
-
-    destructor tai_direct.destroy;
-
-      begin
-         strdispose(str);
-         inherited Destroy;
-      end;
-
-{****************************************************************************
-          TAI_ASM_COMMENT  comment to be inserted in the assembler file
- ****************************************************************************}
-
-     constructor tai_asm_comment.Create(_str : pchar);
-
-       begin
-          inherited Create;
-          typ:=ait_comment;
-          str:=_str;
-       end;
-
-    destructor tai_asm_comment.destroy;
-
-      begin
-         strdispose(str);
-         inherited Destroy;
-      end;
-
-{****************************************************************************
-                              TAI_CUT
- ****************************************************************************}
-
-     constructor tai_cut.Create;
-       begin
-          inherited Create;
-          typ:=ait_cut;
-          place:=cut_normal;
-       end;
-
-
-     constructor tai_cut.Create_begin;
-       begin
-          inherited Create;
-          typ:=ait_cut;
-          place:=cut_begin;
-       end;
-
-
-     constructor tai_cut.Create_end;
-       begin
-          inherited Create;
-          typ:=ait_cut;
-          place:=cut_end;
-       end;
-
-
-{****************************************************************************
-                             Tai_Marker
- ****************************************************************************}
-
-     Constructor Tai_Marker.Create(_Kind: TMarker);
-     Begin
-       Inherited Create;
-       typ := ait_marker;
-       Kind := _Kind;
-     End;
-
-{*****************************************************************************
-                                TaiTempAlloc
-*****************************************************************************}
-
-    constructor taitempalloc.alloc(pos,size:longint);
-      begin
-        inherited Create;
-        typ:=ait_tempalloc;
-        allocation:=true;
-        temppos:=pos;
-        tempsize:=size;
-      end;
-
-
-    constructor taitempalloc.dealloc(pos,size:longint);
-      begin
-        inherited Create;
-        typ:=ait_tempalloc;
-        allocation:=false;
-        temppos:=pos;
-        tempsize:=size;
-      end;
-
-
-
-{*****************************************************************************
-                                  AsmSymbol
-*****************************************************************************}
-
-    constructor tasmsymbol.create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
-      begin;
-        inherited createname(s);
-        reset;
-        defbind:=_bind;
-        typ:=_typ;
-        inusedlist:=false;
-        pass:=255;
-        { mainly used to remove unused labels from the codesegment }
-        refs:=0;
-      end;
-
-    procedure tasmsymbol.GenerateAltSymbol;
-      begin
-        if not assigned(altsymbol) then
-         begin
-           altsymbol:=tasmsymbol.create(name+'_'+tostr(nextaltnr),defbind,typ);
-           { also copy the amount of references }
-           altsymbol.refs:=refs;
-           inc(nextaltnr);
-         end;
-      end;
-
-    procedure tasmsymbol.reset;
-      begin
-        { reset section info }
-        section:=sec_none;
-        address:=0;
-        size:=0;
-        idx:=-1;
-        pass:=255;
-        bind:=AB_EXTERNAL;
-        proclocal:=false;
-      end;
-
-    function tasmsymbol.is_used:boolean;
-      begin
-        is_used:=(refs>0);
-      end;
-
-    procedure tasmsymbol.setaddress(_pass:byte;sec:tsection;offset,len:longint);
-      begin
-        if (_pass=pass) then
-         begin
-           Message1(asmw_e_duplicate_label,name);
-           exit;
-         end;
-        pass:=_pass;
-        section:=sec;
-        address:=offset;
-        size:=len;
-        { when the bind was reset to External, set it back to the default
-          bind it got when defined }
-        if (bind=AB_EXTERNAL) and (defbind<>AB_NONE) then
-         bind:=defbind;
-      end;
-
-
-{*****************************************************************************
-                                  AsmLabel
-*****************************************************************************}
-
-    constructor tasmlabel.create;
-      begin;
-        labelnr:=nextlabelnr;
-        inc(nextlabelnr);
-        inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION);
-        proclocal:=true;
-        is_set:=false;
-        is_addr := false;
-      end;
-
-
-    constructor tasmlabel.createdata;
-      begin;
-        labelnr:=nextlabelnr;
-        inc(nextlabelnr);
-        if (cs_create_smart in aktmoduleswitches) or
-           target_asm.labelprefix_only_inside_procedure then
-          inherited create('_$'+current_module.modulename^+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
-        else
-          inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
-        is_set:=false;
-        is_addr := false;
-        { write it always }
-        refs:=1;
-      end;
-
-    constructor tasmlabel.createaddr;
-      begin;
-        create;
-        is_addr := true;
-      end;
-
-    function tasmlabel.getname:string;
-      begin
-        getname:=inherited getname;
-        inc(refs);
-      end;
-
-
-{*****************************************************************************
-                              AsmSymbolList helpers
-*****************************************************************************}
-
-    function newasmsymbol(const s : string) : tasmsymbol;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(asmsymbollist.search(s));
-        if not assigned(hp) then
-         begin
-           { Not found, insert it as an External }
-           hp:=tasmsymbol.create(s,AB_EXTERNAL,AT_FUNCTION);
-           asmsymbollist.insert(hp);
-         end;
-        newasmsymbol:=hp;
-      end;
-
-
-    function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : tasmsymbol;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(asmsymbollist.search(s));
-        if assigned(hp) then
-         hp.defbind:=_bind
-        else
-         begin
-           { Not found, insert it as an External }
-           hp:=tasmsymbol.create(s,_bind,_typ);
-           asmsymbollist.insert(hp);
-         end;
-        newasmsymboltype:=hp;
-      end;
-
-
-    function getasmsymbol(const s : string) : tasmsymbol;
-      begin
-        getasmsymbol:=tasmsymbol(asmsymbollist.search(s));
-      end;
-
-
-    { renames an asmsymbol }
-    function renameasmsymbol(const sold, snew : string):tasmsymbol;
-      begin
-        renameasmsymbol:=tasmsymbol(asmsymbollist.rename(sold,snew));
-      end;
-
-
-{*****************************************************************************
-                              Used AsmSymbolList
-*****************************************************************************}
-
-    procedure CreateUsedAsmSymbolList;
-      begin
-        if assigned(usedasmsymbollist) then
-         internalerror(78455782);
-        usedasmsymbollist:=TSingleList.create;
-      end;
-
-
-    procedure DestroyUsedAsmSymbolList;
-      begin
-        usedasmsymbollist.destroy;
-        usedasmsymbollist:=nil;
-      end;
-
-
-    procedure UsedAsmSymbolListInsert(p:tasmsymbol);
-      begin
-        if not p.inusedlist then
-         usedasmsymbollist.insert(p);
-        p.inusedlist:=true;
-      end;
-
-
-    procedure UsedAsmSymbolListReset;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(usedasmsymbollist.first);
-        while assigned(hp) do
-         begin
-           with hp do
-            begin
-              reset;
-              inusedlist:=false;
-            end;
-           hp:=tasmsymbol(hp.listnext);
-         end;
-      end;
-
-
-    procedure UsedAsmSymbolListResetAltSym;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(usedasmsymbollist.first);
-        while assigned(hp) do
-         begin
-           with hp do
-            begin
-              altsymbol:=nil;
-              inusedlist:=false;
-            end;
-           hp:=tasmsymbol(hp.listnext);
-         end;
-      end;
-
-
-    procedure UsedAsmSymbolListCheckUndefined;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(usedasmsymbollist.first);
-        while assigned(hp) do
-         begin
-           with hp do
-            begin
-              if (refs>0) and
-                 (section=Sec_none) and
-                 not(bind in [AB_EXTERNAL,AB_COMMON]) then
-               Message1(asmw_e_undefined_label,name);
-            end;
-           hp:=tasmsymbol(hp.listnext);
-         end;
-      end;
-
-
-{*****************************************************************************
-                              Label Helpers
-*****************************************************************************}
-
-    procedure getlabel(var l : tasmlabel);
-      begin
-        l:=tasmlabel.create;
-        asmsymbollist.insert(l);
-      end;
-
-
-    procedure getdatalabel(var l : tasmlabel);
-      begin
-        l:=tasmlabel.createdata;
-        asmsymbollist.insert(l);
-      end;
-
-    procedure getaddrlabel(var l : tasmlabel);
-      begin
-        l:=tasmlabel.createaddr;
-        asmsymbollist.insert(l);
-      end;
-
-    procedure getlabelnr(var l : longint);
-      begin
-         l:=nextlabelnr;
-         inc(nextlabelnr);
-      end;
-
-
-{*****************************************************************************
-                                 TAAsmOutput
-*****************************************************************************}
-
-    function taasmoutput.getlasttaifilepos : pfileposinfo;
-      begin
-         if assigned(last) then
-           getlasttaifilepos:=@tai(last).fileinfo
-         else
-           getlasttaifilepos:=nil;
-      end;
-
-end.
-{
-  $Log$
-  Revision 1.27  2002-05-18 13:34:04  peter
-    * readded missing revisions
-
-  Revision 1.25  2002/05/14 19:34:38  peter
-    * removed old logs and updated copyright year
-
-  Revision 1.24  2002/05/14 17:28:08  peter
-    * synchronized cpubase between powerpc and i386
-    * moved more tables from cpubase to cpuasm
-    * tai_align_abstract moved to tainst, cpuasm must define
-      the tai_align class now, which may be empty
-
-  Revision 1.23  2002/04/15 18:54:34  carl
-  - removed tcpuflags
-
-  Revision 1.22  2002/04/07 13:18:19  carl
-  + more documentation
-
-  Revision 1.21  2002/04/07 10:17:40  carl
-  - remove packenumfixed (requires version 1.0.2 or later to compile now!)
-  + changing some comments so its commented automatically
-
-  Revision 1.20  2002/03/24 19:04:31  carl
-  + patch for SPARC from Mazen NEIFER
-
-}

compiler/aasmbase.pas

@@ -0,0 +1,788 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements an abstract asmoutput class for all processor types
+
+    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.
+
+ ****************************************************************************
+}
+{# @abstract(This unit implements an abstract asm output class for all processor types)
+  This unit implements an abstract assembler output class for all processors, these
+  are then overriden for each assembler writer to actually write the data in these
+  classes to an assembler file.
+}
+
+unit aasmbase;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       cutils,cclasses,
+       globtype,globals,systems;
+
+  { asm symbol functions }
+    type
+       TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
+
+       TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION);
+
+       TAsmRelocationType = (RELOC_ABSOLUTE,RELOC_RELATIVE,RELOC_RVA);
+
+       TAsmSectionSizes = array[TSection] of longint;
+
+       TAsmSymbol = class(TNamedIndexItem)
+         defbind,
+         currbind  : TAsmsymbind;
+         typ       : TAsmsymtype;
+         { the next fields are filled in the binary writer }
+         section : TSection;
+         address,
+         size    : longint;
+         { this need to be incremented with every symbol loading into the
+           paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
+         refs    : longint;
+         {# Alternate symbol which can be used for 'renaming' needed for
+           inlining }
+         altsymbol : tasmsymbol;
+         objectdata : pointer;
+         {# TRUE if the symbol is local for a procedure/function }
+         proclocal : boolean;
+         {# Is the symbol in the used list }
+         inusedlist : boolean;
+         { assembler pass label is set, used for detecting multiple labels }
+         pass : byte;
+         constructor create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+         procedure reset;
+         function  is_used:boolean;
+         procedure setaddress(_pass:byte;sec:TSection;offset,len:longint);
+         procedure GenerateAltSymbol;
+       end;
+
+       TAsmLabel = class(TAsmSymbol)
+         { this is set by the tai_label.Init }
+         is_set,
+         { is the label only there for getting an address (e.g. for i/o }
+         { checks -> true) or is it a jump target (false)               }
+         is_addr : boolean;
+         labelnr : longint;
+         constructor create;
+         constructor createdata;
+         constructor createaddr;
+         function getname:string;override;
+       end;
+
+       TAsmRelocation = class(TLinkedListItem)
+          address,
+          orgsize  : longint;  { original size of the symbol to relocate, required for COFF }
+          symbol   : tasmsymbol;
+          section  : TSection; { only used if symbol=nil }
+          typ      : TAsmRelocationType;
+          constructor CreateSymbol(Aaddress:longint;s:Tasmsymbol;Atyp:TAsmRelocationType);
+          constructor CreateSymbolSize(Aaddress:longint;s:Tasmsymbol;Aorgsize:longint;Atyp:TAsmRelocationType);
+          constructor CreateSection(Aaddress:longint;sec:TSection;Atyp:TAsmRelocationType);
+       end;
+
+       TAsmSection = class(TLinkedListItem)
+         name      : string[32];
+         secsymidx : longint;   { index for the section in symtab }
+         addralign : longint;   { alignment of the section }
+         flags     : cardinal;  { section flags }
+         { size of the data and in the file }
+         dataalignbytes : longint;
+         data      : TDynamicArray;
+         datasize  : longint;
+         datapos   : longint;
+         { size and position in memory, set by seTSectionsize }
+         memsize,
+         mempos    : longint;
+         { relocation }
+         relocations : TLinkedList;
+         constructor create(const Aname:string;Aalign:longint;alloconly:boolean);
+         destructor  destroy;override;
+         function  write(var d;l:longint):longint;
+         function  writestr(const s:string):longint;
+         procedure writealign(l:longint);
+         function  aligneddatasize:longint;
+         procedure alignsection;
+         procedure alloc(l:longint);
+         procedure addsymreloc(ofs:longint;p:tasmsymbol;relative:TAsmRelocationType);
+         procedure addsectionreloc(ofs:longint;sec:TSection;relative:TAsmRelocationType);
+       end;
+
+       TAsmObjectData = class(TLinkedListItem)
+         name      : string[80];
+         currsec   : TSection;
+         sects     : array[TSection] of TAsmSection;
+         symbols   : tindexarray;
+         constructor create(const n:string);
+         destructor  destroy;override;
+         procedure createsection(sec:TSection);virtual;
+         procedure defaulTSection(sec:TSection);
+         function  sectionsize(s:TSection):longint;
+         function  currsectionsize:longint;
+         procedure seTSectionsizes(var s:TAsmSectionSizes);virtual;
+         procedure alloc(len:longint);
+         procedure allocalign(len:longint);
+         procedure writebytes(var data;len:longint);
+         procedure writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);virtual;abstract;
+         procedure writesymbol(p:tasmsymbol);virtual;abstract;
+         procedure writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
+         procedure writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
+         procedure fixuprelocs;virtual;
+       end;
+
+       TAsmObjectAlloc = class
+         currsec : TSection;
+         secsize : TAsmSectionSizes;
+         constructor create;
+         destructor  destroy;override;
+         procedure seTSection(sec:TSection);
+         function  sectionsize:longint;
+         procedure sectionalloc(l:longint);
+         procedure sectionalign(l:longint);
+         procedure staballoc(p:pchar);
+         procedure reseTSections;
+       end;
+       TAsmObjectDataclass = class of TAsmObjectAlloc;
+
+
+    var
+      { asm symbol list }
+      asmsymbollist : tdictionary;
+      usedasmsymbollist : tsinglelist;
+
+      objectdata : TAsmObjectData;
+
+    const
+      nextaltnr   : longint = 1;
+      nextlabelnr : longint = 1;
+
+    {# create a new assembler label }
+    procedure getlabel(var l : tasmlabel);
+    { make l as a new label and flag is_addr }
+    procedure getaddrlabel(var l : tasmlabel);
+    { make l as a new label and flag is_data }
+    procedure getdatalabel(var l : tasmlabel);
+    {# return a label number }
+    procedure getlabelnr(var l : longint);
+
+    function  newasmsymbol(const s : string) : tasmsymbol;
+    function  newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol;
+    function  getasmsymbol(const s : string) : tasmsymbol;
+    function  renameasmsymbol(const sold, snew : string):tasmsymbol;
+
+    procedure CreateUsedAsmSymbolList;
+    procedure DestroyUsedAsmSymbolList;
+    procedure UsedAsmSymbolListInsert(p:tasmsymbol);
+    procedure UsedAsmSymbolListReset;
+    procedure UsedAsmSymbolListResetAltSym;
+    procedure UsedAsmSymbolListCheckUndefined;
+
+
+implementation
+
+    uses
+{$ifdef delphi}
+      sysutils,
+{$else}
+      strings,
+{$endif}
+      fmodule,verbose;
+
+    const
+      symbolsgrow = 100;
+
+
+{*****************************************************************************
+                                 TAsmSymbol
+*****************************************************************************}
+
+    constructor tasmsymbol.create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+      begin;
+        inherited createname(s);
+        reset;
+        defbind:=_bind;
+        typ:=_typ;
+        inusedlist:=false;
+        pass:=255;
+        { mainly used to remove unused labels from the codesegment }
+        refs:=0;
+      end;
+
+    procedure tasmsymbol.GenerateAltSymbol;
+      begin
+        if not assigned(altsymbol) then
+         begin
+           altsymbol:=tasmsymbol.create(name+'_'+tostr(nextaltnr),defbind,typ);
+           { also copy the amount of references }
+           altsymbol.refs:=refs;
+           inc(nextaltnr);
+         end;
+      end;
+
+    procedure tasmsymbol.reset;
+      begin
+        { reset section info }
+        section:=sec_none;
+        address:=0;
+        size:=0;
+        indexnr:=-1;
+        pass:=255;
+        currbind:=AB_EXTERNAL;
+        proclocal:=false;
+      end;
+
+    function tasmsymbol.is_used:boolean;
+      begin
+        is_used:=(refs>0);
+      end;
+
+    procedure tasmsymbol.setaddress(_pass:byte;sec:TSection;offset,len:longint);
+      begin
+        if (_pass=pass) then
+         begin
+           Message1(asmw_e_duplicate_label,name);
+           exit;
+         end;
+        pass:=_pass;
+        section:=sec;
+        address:=offset;
+        size:=len;
+        { when the bind was reset to External, set it back to the default
+          bind it got when defined }
+        if (currbind=AB_EXTERNAL) and (defbind<>AB_NONE) then
+         currbind:=defbind;
+      end;
+
+
+{*****************************************************************************
+                                 TAsmLabel
+*****************************************************************************}
+
+    constructor tasmlabel.create;
+      begin;
+        labelnr:=nextlabelnr;
+        inc(nextlabelnr);
+        inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION);
+        proclocal:=true;
+        is_set:=false;
+        is_addr := false;
+      end;
+
+
+    constructor tasmlabel.createdata;
+      begin;
+        labelnr:=nextlabelnr;
+        inc(nextlabelnr);
+        if (cs_create_smart in aktmoduleswitches) or
+           target_asm.labelprefix_only_inside_procedure then
+          inherited create('_$'+current_module.modulename^+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
+        else
+          inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
+        is_set:=false;
+        is_addr := false;
+        { write it always }
+        refs:=1;
+      end;
+
+    constructor tasmlabel.createaddr;
+      begin;
+        create;
+        is_addr := true;
+      end;
+
+    function tasmlabel.getname:string;
+      begin
+        getname:=inherited getname;
+        inc(refs);
+      end;
+
+
+{****************************************************************************
+                                TAsmObjectAlloc
+****************************************************************************}
+
+    constructor TAsmObjectAlloc.create;
+      begin
+      end;
+
+
+    destructor TAsmObjectAlloc.destroy;
+      begin
+      end;
+
+
+    procedure TAsmObjectAlloc.seTSection(sec:TSection);
+      begin
+        currsec:=sec;
+      end;
+
+
+    procedure TAsmObjectAlloc.reseTSections;
+      begin
+        FillChar(secsize,sizeof(secsize),0);
+      end;
+
+
+    procedure TAsmObjectAlloc.sectionalloc(l:longint);
+      begin
+        inc(secsize[currsec],l);
+      end;
+
+
+    procedure TAsmObjectAlloc.sectionalign(l:longint);
+      begin
+        if (secsize[currsec] mod l)<>0 then
+          inc(secsize[currsec],l-(secsize[currsec] mod l));
+      end;
+
+
+    procedure TAsmObjectAlloc.staballoc(p:pchar);
+      begin
+        inc(secsize[sec_stab]);
+        if assigned(p) and (p[0]<>#0) then
+          inc(secsize[sec_stabstr],strlen(p)+1);
+      end;
+
+
+    function TAsmObjectAlloc.sectionsize:longint;
+      begin
+        sectionsize:=secsize[currsec];
+      end;
+
+
+{****************************************************************************
+                              TAsmRelocation
+****************************************************************************}
+
+    constructor TAsmRelocation.CreateSymbol(Aaddress:longint;s:Tasmsymbol;Atyp:TAsmRelocationType);
+      begin
+        Address:=Aaddress;
+        Symbol:=s;
+        OrgSize:=0;
+        Section:=Sec_none;
+        Typ:=Atyp;
+      end;
+
+
+    constructor TAsmRelocation.CreateSymbolSize(Aaddress:longint;s:Tasmsymbol;Aorgsize:longint;Atyp:TAsmRelocationType);
+      begin
+        Address:=Aaddress;
+        Symbol:=s;
+        OrgSize:=Aorgsize;
+        Section:=Sec_none;
+        Typ:=Atyp;
+      end;
+
+
+    constructor TAsmRelocation.CreateSection(Aaddress:longint;sec:TSection;Atyp:TAsmRelocationType);
+      begin
+        Address:=Aaddress;
+        Symbol:=nil;
+        OrgSize:=0;
+        Section:=sec;
+        Typ:=Atyp;
+      end;
+
+
+{****************************************************************************
+                              TAsmSection
+****************************************************************************}
+
+    constructor TAsmSection.create(const Aname:string;Aalign:longint;alloconly:boolean);
+      begin
+        inherited create;
+        name:=Aname;
+        secsymidx:=0;
+        addralign:=Aalign;
+        { data }
+        datasize:=0;
+        datapos:=0;
+        if alloconly then
+         data:=nil
+        else
+         Data:=TDynamicArray.Create(8192);
+        { position }
+        mempos:=0;
+        memsize:=0;
+        { relocation }
+        relocations:=TLinkedList.Create;
+      end;
+
+
+    destructor TAsmSection.destroy;
+      begin
+        if assigned(Data) then
+          Data.Free;
+      end;
+
+
+    function TAsmSection.write(var d;l:longint):longint;
+      begin
+        write:=datasize;
+        if not assigned(Data) then
+         Internalerror(3334441);
+        Data.write(d,l);
+        inc(datasize,l);
+      end;
+
+
+    function TAsmSection.writestr(const s:string):longint;
+      begin
+        writestr:=datasize;
+        if not assigned(Data) then
+         Internalerror(3334441);
+        Data.write(s[1],length(s));
+        inc(datasize,length(s));
+      end;
+
+
+    procedure TAsmSection.writealign(l:longint);
+      var
+        i : longint;
+        empty : array[0..63] of char;
+      begin
+        { no alignment needed for 0 or 1 }
+        if l<=1 then
+         exit;
+        i:=datasize mod l;
+        if i>0 then
+         begin
+           if assigned(data) then
+            begin
+              fillchar(empty,sizeof(empty),0);
+              Data.write(empty,l-i);
+            end;
+           inc(datasize,l-i);
+         end;
+      end;
+
+
+    function TAsmSection.aligneddatasize:longint;
+      begin
+        aligneddatasize:=align(datasize,addralign);
+      end;
+
+
+    procedure TAsmSection.alignsection;
+      begin
+        writealign(addralign);
+      end;
+
+
+    procedure TAsmSection.alloc(l:longint);
+      begin
+        if assigned(Data) then
+         Internalerror(3334442);
+        inc(datasize,l);
+      end;
+
+
+    procedure TAsmSection.addsymreloc(ofs:longint;p:tasmsymbol;relative:TAsmRelocationType);
+      var
+        r : TAsmRelocation;
+      begin
+        r:=TAsmRelocation.Create;
+        r.address:=ofs;
+        r.orgsize:=0;
+        r.symbol:=p;
+        r.section:=sec_none;
+        r.typ:=relative;
+        relocations.concat(r);
+      end;
+
+
+    procedure TAsmSection.addsectionreloc(ofs:longint;sec:TSection;relative:TAsmRelocationType);
+      var
+        r : TAsmRelocation;
+      begin
+        r:=TAsmRelocation.Create;
+        r.address:=ofs;
+        r.symbol:=nil;
+        r.orgsize:=0;
+        r.section:=sec;
+        r.typ:=relative;
+        relocations.concat(r);
+      end;
+
+
+{****************************************************************************
+                                TAsmObjectData
+****************************************************************************}
+
+    constructor TAsmObjectData.create(const n:string);
+      begin
+        inherited create;
+        name:=n;
+        { sections }
+        FillChar(Sects,sizeof(Sects),0);
+        { symbols }
+        symbols:=tindexarray.create(symbolsgrow);
+        symbols.noclear:=true;
+      end;
+
+
+    destructor TAsmObjectData.destroy;
+      var
+        sec : TSection;
+      begin
+        { free memory }
+        for sec:=low(TSection) to high(TSection) do
+         if assigned(sects[sec]) then
+          sects[sec].free;
+        symbols.free;
+      end;
+
+
+    procedure TAsmObjectData.createsection(sec:TSection);
+      begin
+        sects[sec]:=TAsmSection.create(target_asm.secnames[sec],1,(sec=sec_bss));
+      end;
+
+
+    function TAsmObjectData.sectionsize(s:TSection):longint;
+      begin
+        if assigned(sects[s]) then
+         sectionsize:=sects[s].datasize
+        else
+         sectionsize:=0;
+      end;
+
+
+    function TAsmObjectData.currsectionsize:longint;
+      begin
+        if assigned(sects[currsec]) then
+         currsectionsize:=sects[currsec].datasize
+        else
+         currsectionsize:=0;
+      end;
+
+
+    procedure TAsmObjectData.seTSectionsizes(var s:TAsmSectionSizes);
+      begin
+      end;
+
+
+    procedure TAsmObjectData.defaulTSection(sec:TSection);
+      begin
+        currsec:=sec;
+      end;
+
+
+    procedure TAsmObjectData.writebytes(var data;len:longint);
+      begin
+        if not assigned(sects[currsec]) then
+         createsection(currsec);
+        sects[currsec].write(data,len);
+      end;
+
+
+    procedure TAsmObjectData.alloc(len:longint);
+      begin
+        if not assigned(sects[currsec]) then
+         createsection(currsec);
+        sects[currsec].alloc(len);
+      end;
+
+
+    procedure TAsmObjectData.allocalign(len:longint);
+      var
+        modulo : longint;
+      begin
+        if not assigned(sects[currsec]) then
+         createsection(currsec);
+        modulo:=sects[currsec].datasize mod len;
+        if modulo > 0 then
+          sects[currsec].alloc(len-modulo);
+      end;
+
+
+    procedure TAsmObjectData.fixuprelocs;
+      begin
+        { no relocation support by default }
+      end;
+
+
+{*****************************************************************************
+                              AsmSymbolList helpers
+*****************************************************************************}
+
+    function newasmsymbol(const s : string) : tasmsymbol;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(asmsymbollist.search(s));
+        if not assigned(hp) then
+         begin
+           { Not found, insert it as an External }
+           hp:=tasmsymbol.create(s,AB_EXTERNAL,AT_FUNCTION);
+           asmsymbollist.insert(hp);
+         end;
+        newasmsymbol:=hp;
+      end;
+
+
+    function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : tasmsymbol;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(asmsymbollist.search(s));
+        if assigned(hp) then
+         hp.defbind:=_bind
+        else
+         begin
+           { Not found, insert it as an External }
+           hp:=tasmsymbol.create(s,_bind,_typ);
+           asmsymbollist.insert(hp);
+         end;
+        newasmsymboltype:=hp;
+      end;
+
+
+    function getasmsymbol(const s : string) : tasmsymbol;
+      begin
+        getasmsymbol:=tasmsymbol(asmsymbollist.search(s));
+      end;
+
+
+    { renames an asmsymbol }
+    function renameasmsymbol(const sold, snew : string):tasmsymbol;
+      begin
+        renameasmsymbol:=tasmsymbol(asmsymbollist.rename(sold,snew));
+      end;
+
+
+{*****************************************************************************
+                              Used AsmSymbolList
+*****************************************************************************}
+
+    procedure CreateUsedAsmSymbolList;
+      begin
+        if assigned(usedasmsymbollist) then
+         internalerror(78455782);
+        usedasmsymbollist:=TSingleList.create;
+      end;
+
+
+    procedure DestroyUsedAsmSymbolList;
+      begin
+        usedasmsymbollist.destroy;
+        usedasmsymbollist:=nil;
+      end;
+
+
+    procedure UsedAsmSymbolListInsert(p:tasmsymbol);
+      begin
+        if not p.inusedlist then
+         usedasmsymbollist.insert(p);
+        p.inusedlist:=true;
+      end;
+
+
+    procedure UsedAsmSymbolListReset;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(usedasmsymbollist.first);
+        while assigned(hp) do
+         begin
+           with hp do
+            begin
+              reset;
+              inusedlist:=false;
+            end;
+           hp:=tasmsymbol(hp.listnext);
+         end;
+      end;
+
+
+    procedure UsedAsmSymbolListResetAltSym;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(usedasmsymbollist.first);
+        while assigned(hp) do
+         begin
+           with hp do
+            begin
+              altsymbol:=nil;
+              inusedlist:=false;
+            end;
+           hp:=tasmsymbol(hp.listnext);
+         end;
+      end;
+
+
+    procedure UsedAsmSymbolListCheckUndefined;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(usedasmsymbollist.first);
+        while assigned(hp) do
+         begin
+           with hp do
+            begin
+              if (refs>0) and
+                 (section=Sec_none) and
+                 not(currbind in [AB_EXTERNAL,AB_COMMON]) then
+               Message1(asmw_e_undefined_label,name);
+            end;
+           hp:=tasmsymbol(hp.listnext);
+         end;
+      end;
+
+
+{*****************************************************************************
+                              Label Helpers
+*****************************************************************************}
+
+    procedure getlabel(var l : tasmlabel);
+      begin
+        l:=tasmlabel.create;
+        asmsymbollist.insert(l);
+      end;
+
+
+    procedure getdatalabel(var l : tasmlabel);
+      begin
+        l:=tasmlabel.createdata;
+        asmsymbollist.insert(l);
+      end;
+
+    procedure getaddrlabel(var l : tasmlabel);
+      begin
+        l:=tasmlabel.createaddr;
+        asmsymbollist.insert(l);
+      end;
+
+    procedure getlabelnr(var l : longint);
+      begin
+         l:=nextlabelnr;
+         inc(nextlabelnr);
+      end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-07-01 18:46:20  peter
+    * internal linker
+    * reorganized aasm layer
+
+}

compiler/aggas.pas

@@ -31,7 +31,8 @@ interface
     uses
       cclasses,
       globals,
-      aasm,assemble;
+      aasmbase,aasmtai,aasmcpu,
+      assemble;
 
 
 
@@ -64,7 +65,7 @@ implementation
       dos,
 {$endif Delphi}
       cutils,globtype,systems,
-      fmodule,finput,verbose,cpubase,cpuasm, tainst
+      fmodule,finput,verbose,cpubase
 {$ifdef GDB}
   {$ifdef delphi}
       ,sysutils
@@ -87,7 +88,7 @@ var
       funcname     : pchar;
       stabslastfileinfo : tfileposinfo;
 {$endif}
-      lastsec      : tsection; { last section type written }
+      lasTSec      : TSection; { last section type written }
       lastfileinfo : tfileposinfo;
       infile,
       lastinfile   : tinputfile;
@@ -204,7 +205,7 @@ var
        (#9'.long'#9,#9'.short'#9,#9'.byte'#9);
 
 
-    function ait_section2str(s:tsection):string;
+    function ait_section2str(s:TSection):string;
     begin
        ait_section2str:=target_asm.secnames[s];
 {$ifdef GDB}
@@ -217,7 +218,7 @@ var
          else       n_line:=n_dataline;
       end;
 {$endif GDB}
-      LastSec:=s;
+      LasTSec:=s;
     end;
 
 {****************************************************************************}
@@ -293,8 +294,10 @@ var
       allocstr : array[boolean] of string[10]=(' released',' allocated');
       nolinetai =[ait_label,
                   ait_regalloc,ait_tempalloc,
-                  ait_stabn,ait_stabs,ait_section,
-                  ait_cut,ait_marker,ait_align,ait_stab_function_name];
+{$ifdef GDB}
+                  ait_stabn,ait_stabs,ait_stab_function_name,
+{$endif GDB}
+                  ait_cut,ait_marker,ait_align,ait_section];
     type
       t80bitarray = array[0..9] of byte;
       t64bitarray = array[0..7] of byte;
@@ -392,15 +395,15 @@ var
            ait_regalloc :
              begin
                if (cs_asm_regalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Register '+std_reg2str[tairegalloc(hp).reg]+
-                   allocstr[tairegalloc(hp).allocation]);
+                 AsmWriteLn(target_asm.comment+'Register '+std_reg2str[tai_regalloc(hp).reg]+
+                   allocstr[tai_regalloc(hp).allocation]);
              end;
 
            ait_tempalloc :
              begin
                if (cs_asm_tempalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Temp '+tostr(taitempalloc(hp).temppos)+','+
-                   tostr(taitempalloc(hp).tempsize)+allocstr[taitempalloc(hp).allocation]);
+                 AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
+                   tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]);
              end;
 
            ait_align :
@@ -687,7 +690,7 @@ var
                   while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
                    begin
                      if tai(hp.next).typ=ait_section then
-                       lastsec:=tai_section(hp.next).sec;
+                       lasTSec:=tai_section(hp.next).sec;
                      hp:=tai(hp.next);
                    end;
 {$ifdef GDB}
@@ -697,8 +700,8 @@ var
                   funcname:=nil;
                   WriteFileLineInfo(hp.fileinfo);
 {$endif GDB}
-                  if lastsec<>sec_none then
-                    AsmWriteLn(ait_section2str(lastsec));
+                  if lasTSec<>sec_none then
+                    AsmWriteLn(ait_section2str(lasTSec));
                   AsmStartSize:=AsmSize;
                 end;
              end;
@@ -734,7 +737,7 @@ var
        Comment(v_info,'Start writing gas-styled assembler output for '+current_module.mainsource^);
 {$endif}
 
-      LastSec:=sec_none;
+      LasTSec:=sec_none;
 {$ifdef GDB}
       FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
 {$endif GDB}
@@ -765,7 +768,6 @@ var
       AsmStartSize:=AsmSize;
       symendcount:=0;
 
-      countlabelref:=false;
       If (cs_debuginfo in aktmoduleswitches) then
         WriteTree(debuglist);
       WriteTree(codesegment);
@@ -783,7 +785,6 @@ var
       {$ifdef GDB}
       WriteFileEndInfo;
       {$ENDIF}
-      countlabelref:=true;
 
       AsmLn;
 {$ifdef EXTDEBUG}
@@ -795,7 +796,11 @@ var
 end.
 {
   $Log$
-  Revision 1.5  2002-05-18 13:34:05  peter
+  Revision 1.6  2002-07-01 18:46:20  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.5  2002/05/18 13:34:05  peter
     * readded missing revisions
 
   Revision 1.4  2002/05/16 19:46:34  carl

compiler/aopt.pas

@@ -26,7 +26,7 @@ Unit aopt;
 
 Interface
 
-Uses Aasm, cobjects, aoptobj, aoptcpud, aoptcpub {aoptcs, aoptpeep} ;
+Uses Aasmbase,aasmtai,aasmcpu, cobjects, aoptobj, aoptcpud, aoptcpub {aoptcs, aoptpeep} ;
 
 Type
   PAsmOptimizer = ^TAsmOptimizer;
@@ -51,7 +51,7 @@ procedure Optimize(AsmL:Paasmoutput);
 
 Implementation
 
-uses cpuinfo, globtype, globals, tainst;
+uses cpuinfo, globtype, globals;
 
 Constructor TAsmOptimizer.Init(_AsmL: PAasmOutput);
 Begin
@@ -241,7 +241,11 @@ End.
 
 {
  $Log$
- Revision 1.4  2002-05-18 13:34:05  peter
+ Revision 1.5  2002-07-01 18:46:21  peter
+   * internal linker
+   * reorganized aasm layer
+
+ Revision 1.4  2002/05/18 13:34:05  peter
    * readded missing revisions
 
  Revision 1.3  2002/05/16 19:46:34  carl

compiler/aoptobj.pas

@@ -305,10 +305,10 @@ Begin
     While Assigned(p) And
           (p.typ=ait_RegAlloc) Do
       Begin
-        if Tairegalloc(p).allocation then
-          UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
+        if tai_regalloc(p).allocation then
+          UsedRegs := UsedRegs + [tai_regalloc(p).Reg]
         else
-          UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
+          UsedRegs := UsedRegs - [tai_regalloc(p).Reg];
         p := Tai(p.next);
       End;
   Until Not(Assigned(p)) Or
@@ -769,9 +769,9 @@ Begin
             Not(Tai_Label(StartPai).l.Is_Used))) Do
       StartPai := Tai(StartPai.Next);
     If Assigned(StartPai) And
-       (StartPai.typ = ait_regAlloc) and (TairegAlloc(StartPai).allocation) Then
+       (StartPai.typ = ait_regAlloc) and (tai_regalloc(StartPai).allocation) Then
       Begin
-        if TairegAlloc(StartPai).Reg = Reg then
+        if tai_regalloc(StartPai).Reg = Reg then
          begin
            FindRegAlloc:=true;
            exit;
@@ -787,7 +787,11 @@ End.
 
 {
  $Log$
- Revision 1.4  2002-05-18 13:34:05  peter
+ Revision 1.5  2002-07-01 18:46:21  peter
+   * internal linker
+   * reorganized aasm layer
+
+ Revision 1.4  2002/05/18 13:34:05  peter
    * readded missing revisions
 
  Revision 1.3  2002/05/16 19:46:35  carl

compiler/assemble.pas

@@ -43,9 +43,12 @@ interface
       strings,
       dos,
 {$endif Delphi}
-      systems,globtype,globals,aasm,ogbase;
+      systems,globtype,globals,aasmbase,aasmtai,ogbase;
 
     const
+       { maximum of aasmoutput lists there will be }
+       maxoutputlists = 10;
+       { buffer size for writing the .s file }
        AsmOutSize=32768;
 
     type
@@ -128,7 +131,7 @@ interface
         procedure MakeObject;override;
       protected
         { object alloc and output }
-        objectalloc  : tobjectalloc;
+        objectalloc  : TAsmObjectAlloc;
         objectoutput : tobjectoutput;
       private
         { the aasmoutput lists that need to be processed }
@@ -187,7 +190,7 @@ Implementation
       finput,
       gdb,
 {$endif GDB}
-      cpubase,cpuasm
+      cpubase,aasmcpu
       ;
 
     var
@@ -590,7 +593,8 @@ Implementation
       begin
         inherited create(smart);
         objectoutput:=nil;
-        objectalloc:=tobjectalloc.create;
+        objectdata:=nil;
+        objectalloc:=TAsmObjectAlloc.create;
         SmartAsm:=smart;
         currpass:=0;
       end;
@@ -605,6 +609,7 @@ Implementation
 {$ifdef MEMDEBUG}
          d := tmemdebug.create('agbin');
 {$endif}
+        objectdata.free;
         objectoutput.free;
         objectalloc.free;
 {$ifdef MEMDEBUG}
@@ -621,7 +626,7 @@ Implementation
         code : integer;
         hp : pchar;
         reloc : boolean;
-        sec : tsection;
+        sec : TSection;
         ps : tasmsymbol;
         s : string;
       begin
@@ -759,7 +764,7 @@ Implementation
 
     procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint);
       var
-         sec : tsection;
+         sec : TSection;
       begin
         if currpass=1 then
           begin
@@ -852,13 +857,13 @@ Implementation
     procedure TInternalAssembler.EndFileLineInfo;
       var
         hp : tasmsymbol;
-        store_sec : tsection;
+        store_sec : TSection;
       begin
           if not ((cs_debuginfo in aktmoduleswitches) or
              (cs_gdb_lineinfo in aktglobalswitches)) then
            exit;
         store_sec:=objectalloc.currsec;
-        objectalloc.setsection(sec_code);
+        objectalloc.seTSection(sec_code);
         hp:=newasmsymboltype('Letext',AB_LOCAL,AT_FUNCTION);
         if currpass=1 then
           begin
@@ -868,7 +873,7 @@ Implementation
         else
           objectdata.writesymbol(hp);
         EmitStabs('"",'+tostr(n_sourcefile)+',0,0,Letext');
-        objectalloc.setsection(store_sec);
+        objectalloc.seTSection(store_sec);
       end;
 {$endif GDB}
 
@@ -950,7 +955,7 @@ Implementation
              ait_const_symbol :
                objectalloc.sectionalloc(4);
              ait_section:
-               objectalloc.setsection(Tai_section(hp).sec);
+               objectalloc.seTSection(Tai_section(hp).sec);
              ait_symbol :
                Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
              ait_label :
@@ -1016,7 +1021,7 @@ Implementation
                        Tai_datablock(hp).sym.setaddress(currpass,sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
                        { force to be common/external, must be after setaddress as that would
                          set it to AS_GLOBAL }
-                       Tai_datablock(hp).sym.bind:=AB_COMMON;
+                       Tai_datablock(hp).sym.currbind:=AB_COMMON;
                      end
                     else
                      begin
@@ -1064,7 +1069,7 @@ Implementation
                end;
              ait_section:
                begin
-                 objectalloc.setsection(Tai_section(hp).sec);
+                 objectalloc.seTSection(Tai_section(hp).sec);
 {$ifdef GDB}
                  case Tai_section(hp).sec of
                   sec_code : n_line:=n_textline;
@@ -1186,7 +1191,7 @@ Implementation
                end;
              ait_section :
                begin
-                 objectdata.defaultsection(Tai_section(hp).sec);
+                 objectdata.defaulTSection(Tai_section(hp).sec);
 {$ifdef GDB}
                  case Tai_section(hp).sec of
                   sec_code : n_line:=n_textline;
@@ -1244,10 +1249,10 @@ Implementation
                objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
              ait_const_rva :
                objectdata.writereloc(Tai_const_symbol(hp).offset,4,
-                 Tai_const_symbol(hp).sym,relative_rva);
+                 Tai_const_symbol(hp).sym,RELOC_RVA);
              ait_const_symbol :
                objectdata.writereloc(Tai_const_symbol(hp).offset,4,
-                 Tai_const_symbol(hp).sym,relative_false);
+                 Tai_const_symbol(hp).sym,RELOC_ABSOLUTE);
              ait_label :
                begin
                  objectdata.writesymbol(Tai_label(hp).l);
@@ -1258,7 +1263,7 @@ Implementation
 {$ifdef i386}
 {$ifndef NOAG386BIN}
              ait_instruction :
-               Taicpu(hp).Pass2;
+               Taicpu(hp).Pass2(objectdata);
 {$endif NOAG386BIN}
 {$endif i386}
 {$ifdef GDB}
@@ -1290,19 +1295,18 @@ Implementation
       label
         doexit;
       begin
-        objectalloc.resetsections;
-        objectalloc.setsection(sec_code);
+        objectalloc.reseTSections;
+        objectalloc.seTSection(sec_code);
 
-        objectoutput.initwriting(ObjFile);
-        objectdata:=objectoutput.data;
-        objectdata.defaultsection(sec_code);
-      { reset the asmsymbol list }
+        objectdata:=objectoutput.newobjectdata(Objfile);
+        objectdata.defaulTSection(sec_code);
+        { reset the asmsymbol list }
         CreateUsedAsmsymbolList;
 
 {$ifdef MULTIPASS}
       { Pass 0 }
         currpass:=0;
-        objectalloc.setsection(sec_code);
+        objectalloc.seTSection(sec_code);
         { start with list 1 }
         currlistidx:=1;
         currlist:=list[currlistidx];
@@ -1319,8 +1323,8 @@ Implementation
 
       { Pass 1 }
         currpass:=1;
-        objectalloc.resetsections;
-        objectalloc.setsection(sec_code);
+        objectalloc.reseTSections;
+        objectalloc.seTSection(sec_code);
 {$ifdef GDB}
         StartFileLineInfo;
 {$endif GDB}
@@ -1340,7 +1344,7 @@ Implementation
         UsedAsmSymbolListCheckUndefined;
 
         { set section sizes }
-        objectdata.setsectionsizes(objectalloc.secsize);
+        objectdata.seTSectionsizes(objectalloc.secsize);
         { leave if errors have occured }
         if errorcount>0 then
          goto doexit;
@@ -1363,13 +1367,15 @@ Implementation
         EndFileLineInfo;
 {$endif GDB}
 
-        { leave if errors have occured }
-        if errorcount>0 then
-         goto doexit;
-
-        { write last objectfile }
-        objectoutput.donewriting;
-        objectdata:=nil;
+        { don't write the .o file if errors have occured }
+        if errorcount=0 then
+         begin
+           { write objectfile }
+           objectoutput.startobjectfile(ObjFile);
+           objectoutput.writeobjectfile(objectdata);
+           objectdata.free;
+           objectdata:=nil;
+         end;
 
       doexit:
         { reset the used symbols back, must be after the .o has been
@@ -1382,17 +1388,16 @@ Implementation
     procedure TInternalAssembler.writetreesmart;
       var
         hp : Tai;
-        startsec : tsection;
+        starTSec : TSection;
         place: tcutplace;
       begin
-        objectalloc.resetsections;
-        objectalloc.setsection(sec_code);
+        objectalloc.reseTSections;
+        objectalloc.seTSection(sec_code);
 
         NextSmartName(cut_normal);
-        objectoutput.initwriting(ObjFile);
-        objectdata:=objectoutput.data;
-        objectdata.defaultsection(sec_code);
-        startsec:=sec_code;
+        objectdata:=objectoutput.newobjectdata(Objfile);
+        objectdata.defaulTSection(sec_code);
+        starTSec:=sec_code;
 
         { start with list 1 }
         currlistidx:=1;
@@ -1406,8 +1411,8 @@ Implementation
 {$ifdef MULTIPASS}
          { Pass 0 }
            currpass:=0;
-           objectalloc.resetsections;
-           objectalloc.setsection(startsec);
+           objectalloc.reseTSections;
+           objectalloc.seTSection(starTSec);
            TreePass0(hp);
            { leave if errors have occured }
            if errorcount>0 then
@@ -1416,8 +1421,8 @@ Implementation
 
          { Pass 1 }
            currpass:=1;
-           objectalloc.resetsections;
-           objectalloc.setsection(startsec);
+           objectalloc.reseTSections;
+           objectalloc.seTSection(starTSec);
 {$ifdef GDB}
            StartFileLineInfo;
 {$endif GDB}
@@ -1429,14 +1434,15 @@ Implementation
            UsedAsmSymbolListCheckUndefined;
 
            { set section sizes }
-           objectdata.setsectionsizes(objectalloc.secsize);
+           objectdata.seTSectionsizes(objectalloc.secsize);
            { leave if errors have occured }
            if errorcount>0 then
             exit;
 
          { Pass 2 }
            currpass:=2;
-           objectdata.defaultsection(startsec);
+           objectoutput.startobjectfile(Objfile);
+           objectdata.defaulTSection(starTSec);
 {$ifdef GDB}
            StartFileLineInfo;
 {$endif GDB}
@@ -1448,8 +1454,9 @@ Implementation
            if errorcount>0 then
             exit;
 
-           { if not end then write the current objectfile }
-           objectoutput.donewriting;
+           { write the current objectfile }
+           objectoutput.writeobjectfile(objectdata);
+           objectdata.free;
            objectdata:=nil;
 
            { reset the used symbols back, must be after the .o has been
@@ -1461,8 +1468,8 @@ Implementation
            if not MaybeNextList(hp) then
             break;
            { save section for next loop }
-           { this leads to a problem if startsec is sec_none !! PM }
-           startsec:=objectalloc.currsec;
+           { this leads to a problem if starTSec is sec_none !! PM }
+           starTSec:=objectalloc.currsec;
 
            { we will start a new objectfile so reset everything }
            { The place can still change in the next while loop, so don't init }
@@ -1477,19 +1484,19 @@ Implementation
                  (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
             begin
               if Tai(hp).typ=ait_section then
-               startsec:=Tai_section(hp).sec
+               starTSec:=Tai_section(hp).sec
               else if (Tai(hp).typ=ait_cut) then
                place := Tai_cut(hp).place;
               hp:=Tai(hp.next);
             end;
 
+           { start next objectfile }
            NextSmartName(place);
-           objectoutput.initwriting(ObjFile);
-           objectdata:=objectoutput.data;
+           objectdata:=objectoutput.newobjectdata(Objfile);
 
-           { there is a problem if startsec is sec_none !! PM }
-           if startsec=sec_none then
-             startsec:=sec_code;
+           { there is a problem if starTSec is sec_none !! PM }
+           if starTSec=sec_none then
+             starTSec:=sec_code;
 
            if not MaybeNextList(hp) then
              break;
@@ -1588,7 +1595,11 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.36  2002-05-18 13:34:05  peter
+  Revision 1.37  2002-07-01 18:46:21  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.36  2002/05/18 13:34:05  peter
     * readded missing revisions
 
   Revision 1.35  2002/05/16 19:46:35  carl

compiler/cclasses.pas

@@ -65,6 +65,7 @@ interface
           FCount : integer;
           FFirst,
           FLast  : TLinkedListItem;
+          FNoClear : boolean;
        public
           constructor Create;
           destructor  Destroy;override;
@@ -93,6 +94,7 @@ interface
           property First:TLinkedListItem read FFirst;
           property Last:TLinkedListItem read FLast;
           property Count:Integer read FCount;
+          property NoClear:boolean write FNoClear;
        end;
 
 {********************************************
@@ -413,12 +415,14 @@ end;
         FFirst:=nil;
         Flast:=nil;
         FCount:=0;
+        FNoClear:=False;
       end;
 
 
     destructor TLinkedList.destroy;
       begin
-        Clear;
+        if not FNoClear then
+         Clear;
       end;
 
 
@@ -1729,7 +1733,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.14  2002-06-17 13:56:14  jonas
+  Revision 1.15  2002-07-01 18:46:21  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.14  2002/06/17 13:56:14  jonas
     * tdictionary.rename() returns nil if the original object wasn't found
       (reported by Sergey Korshunoff <[email protected]>)
 

compiler/cg64f32.pas

@@ -32,7 +32,7 @@ unit cg64f32;
   interface
 
     uses
-       aasm,
+       aasmbase,aasmtai,aasmcpu,
        cpuinfo, cpubase,
        cginfo, cgobj,
        node,symtype;
@@ -587,7 +587,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  2002-07-01 16:23:52  peter
+  Revision 1.16  2002-07-01 18:46:21  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.15  2002/07/01 16:23:52  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/cgbase.pas

@@ -34,7 +34,7 @@ unit cgbase;
       { symtable }
       symconst,symtype,symdef,symsym,
       { aasm }
-      aasm,cpubase,cpuinfo,cginfo
+      cpubase,cpuinfo,cginfo,aasmbase,aasmtai
       ;
 
 
@@ -525,7 +525,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2002-05-20 13:30:40  carl
+  Revision 1.18  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.17  2002/05/20 13:30:40  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/cgobj.pas

@@ -32,8 +32,8 @@ unit cgobj;
   interface
 
     uses
-       cclasses,aasm,symtable,
-       cpuasm,cpubase,cpuinfo,
+       cclasses,aasmbase,aasmtai,aasmcpu,symtable,
+       cpubase,cpuinfo,
        cginfo,
        symconst,symbase,symtype,node;
 
@@ -386,7 +386,7 @@ unit cgobj;
 
     uses
        globals,globtype,options,systems,cgbase,
-       verbose,types,tgobj,symdef,tainst,rgobj;
+       verbose,types,tgobj,symdef,rgobj;
 
     const
       max_scratch_regs = high(scratch_regs) - low(scratch_regs) + 1;
@@ -409,13 +409,13 @@ unit cgobj;
     procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
 
       begin
-         list.concat(tairegalloc.alloc(r));
+         list.concat(tai_regalloc.alloc(r));
       end;
 
     procedure tcg.a_reg_dealloc(list : taasmoutput;r : tregister);
 
       begin
-         list.concat(tairegalloc.dealloc(r));
+         list.concat(tai_regalloc.dealloc(r));
       end;
 
     procedure tcg.a_label(list : taasmoutput;l : tasmlabel);
@@ -1150,7 +1150,7 @@ unit cgobj;
       begin
          if assigned(procinfo^._class) then
            begin
-              list.concat(Tairegalloc.Alloc(SELF_POINTER_REG));
+              list.concat(tai_regalloc.Alloc(SELF_POINTER_REG));
               if lexlevel>normal_function_level then
                 begin
                    reference_reset_base(hp,procinfo^.framepointer,procinfo^.framepointer_offset);
@@ -1332,7 +1332,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.29  2002-07-01 16:23:52  peter
+  Revision 1.30  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.29  2002/07/01 16:23:52  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/compiler.pas

@@ -121,7 +121,7 @@ function Compile(const cmd:string):longint;
 implementation
 
 uses
-  cpuasm;
+  aasmcpu;
 
 var
   CompilerInitedAfterArgs,
@@ -337,7 +337,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.29  2002-05-18 13:34:06  peter
+  Revision 1.30  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.29  2002/05/18 13:34:06  peter
     * readded missing revisions
 
   Revision 1.28  2002/05/16 19:46:35  carl

compiler/cresstr.pas

@@ -60,7 +60,9 @@ var
 implementation
 
 uses
-   cutils,globals,aasm,verbose,fmodule;
+   cutils,globals,
+   verbose,fmodule,
+   aasmbase,aasmtai;
 
 
 { ---------------------------------------------------------------------
@@ -292,7 +294,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.13  2002-05-18 13:34:06  peter
+  Revision 1.14  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.13  2002/05/18 13:34:06  peter
     * readded missing revisions
 
   Revision 1.12  2002/05/16 19:46:35  carl

compiler/cutils.pas

@@ -58,9 +58,11 @@ interface
     function lower(const s : string) : string;
     function trimbspace(const s:string):string;
     function trimspace(const s:string):string;
+    function space (b : longint): string;
+    function PadSpace(const s:string;len:longint):string;
     function GetToken(var s:string;endchar:char):string;
     procedure uppervar(var s : string);
-    function hexstr(val : cardinal;cnt : byte) : string;
+    function hexstr(val : cardinal;cnt : longint) : string;
     function tostru(i:cardinal) : string;
     function tostr(i : longint) : string;
     function int64tostr(i : int64) : string;
@@ -327,64 +329,101 @@ uses
       end;
 
 
-    function hexstr(val : cardinal;cnt : byte) : string;
+    function hexstr(val : cardinal;cnt : longint) : string;
       const
         HexTbl : array[0..15] of char='0123456789ABCDEF';
       var
-        i : longint;
+        i,j : longint;
       begin
-        hexstr[0]:=char(cnt);
-        for i:=cnt downto 1 do
+        { calculate required length }
+        i:=0;
+        j:=val;
+        while (j>0) do
+         begin
+           inc(i);
+           j:=j shr 4;
+         end;
+        { generate fillers }
+        j:=0;
+        while (i+j<cnt) do
          begin
-           hexstr[i]:=hextbl[val and $f];
+           inc(j);
+           hexstr[j]:='0';
+         end;
+        { generate hex }
+        inc(j,i);
+        hexstr[0]:=chr(j);
+        while (val>0) do
+         begin
+           hexstr[j]:=hextbl[val and $f];
+           dec(j);
            val:=val shr 4;
          end;
       end;
 
 
-   function tostru(i:cardinal):string;
-   {
-     return string of value i, but for cardinals
-   }
+    function tostru(i:cardinal):string;
+    {
+      return string of value i, but for cardinals
+    }
+       var
+         hs : string;
+       begin
+         str(i,hs);
+         tostru:=hs;
+       end;
+
+
+    function trimbspace(const s:string):string;
+    {
+      return s with all leading spaces and tabs removed
+    }
       var
-        hs : string;
+        i,j : longint;
       begin
-        str(i,hs);
-        tostru:=hs;
+        j:=1;
+        i:=length(s);
+        while (j<i) and (s[j] in [#9,' ']) do
+         inc(j);
+        trimbspace:=Copy(s,j,i-j+1);
       end;
 
 
-   function trimbspace(const s:string):string;
-   {
-     return s with all leading spaces and tabs removed
-   }
-     var
-       i,j : longint;
-     begin
-       j:=1;
-       i:=length(s);
-       while (j<i) and (s[j] in [#9,' ']) do
-        inc(j);
-       trimbspace:=Copy(s,j,i-j+1);
-     end;
 
+    function trimspace(const s:string):string;
+    {
+      return s with all leading and ending spaces and tabs removed
+    }
+      var
+        i,j : longint;
+      begin
+        i:=length(s);
+        while (i>0) and (s[i] in [#9,' ']) do
+         dec(i);
+        j:=1;
+        while (j<i) and (s[j] in [#9,' ']) do
+         inc(j);
+        trimspace:=Copy(s,j,i-j+1);
+      end;
 
 
-   function trimspace(const s:string):string;
-   {
-     return s with all leading and ending spaces and tabs removed
-   }
-     var
-       i,j : longint;
-     begin
-       i:=length(s);
-       while (i>0) and (s[i] in [#9,' ']) do
-        dec(i);
-       j:=1;
-       while (j<i) and (s[j] in [#9,' ']) do
-        inc(j);
-       trimspace:=Copy(s,j,i-j+1);
-     end;
+    function space (b : longint): string;
+      begin
+        space[0] := chr(b);
+        FillChar (Space[1],b,' ');
+      end;
+
+
+    function PadSpace(const s:string;len:longint):string;
+    {
+      return s with spaces add to the end
+    }
+      begin
+         if length(s)<len then
+          PadSpace:=s+Space(len-length(s))
+         else
+          PadSpace:=s;
+      end;
 
 
     function GetToken(var s:string;endchar:char):string;
@@ -765,7 +804,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.17  2002-05-18 13:34:07  peter
+  Revision 1.18  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.17  2002/05/18 13:34:07  peter
     * readded missing revisions
 
   Revision 1.16  2002/05/16 19:46:36  carl

compiler/export.pas

@@ -30,7 +30,7 @@ uses
   cutils,cclasses,
   systems,
   symtype,
-  aasm;
+  aasmbase;
 
 const
    { export options }
@@ -39,7 +39,7 @@ const
    eo_name     = $4;
 
 type
-   texported_item = class(tlinkedlistitem)
+   texported_item = class(TLinkedListItem)
       sym : tsym;
       index : longint;
       name : pstring;
@@ -180,7 +180,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.19  2002-05-18 13:34:07  peter
+  Revision 1.20  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.19  2002/05/18 13:34:07  peter
     * readded missing revisions
 
   Revision 1.18  2002/05/16 19:46:36  carl

compiler/finput.pas

@@ -126,6 +126,7 @@ interface
           ppufilename,              { fullname of the ppufile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
+          mapfilename,              { fullname of the mapfile }
           exefilename,              { fullname of the exefile }
           mainsource   : pstring;   { name of the main sourcefile }
           constructor create(const s:string);
@@ -604,6 +605,7 @@ uses
          stringdispose(ppufilename);
          stringdispose(staticlibfilename);
          stringdispose(sharedlibfilename);
+         stringdispose(mapfilename);
          stringdispose(exefilename);
          stringdispose(outputpath);
          stringdispose(path);
@@ -640,6 +642,7 @@ uses
          else
           p:=path^;
          exefilename:=stringdup(p+n+target_info.exeext);
+         mapfilename:=stringdup(p+n+'.map');
       end;
 
 
@@ -654,6 +657,7 @@ uses
         staticlibfilename:=nil;
         sharedlibfilename:=nil;
         exefilename:=nil;
+        mapfilename:=nil;
         outputpath:=nil;
         path:=nil;
         { status }
@@ -682,6 +686,7 @@ uses
         stringdispose(staticlibfilename);
         stringdispose(sharedlibfilename);
         stringdispose(exefilename);
+        stringdispose(mapfilename);
         stringdispose(outputpath);
         stringdispose(path);
         stringdispose(modulename);
@@ -693,7 +698,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.15  2002-05-18 13:34:07  peter
+  Revision 1.16  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.15  2002/05/18 13:34:07  peter
     * readded missing revisions
 
   Revision 1.14  2002/05/16 19:46:36  carl

compiler/gdb.pas

@@ -33,7 +33,7 @@ uses
   strings,
 {$endif}
   globtype,cpubase,
-  globals,aasm;
+  globals,aasmtai;
 
 {stab constants }
 Const
@@ -304,7 +304,11 @@ end.
 
 {
   $Log$
-  Revision 1.13  2002-05-18 13:34:08  peter
+  Revision 1.14  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.13  2002/05/18 13:34:08  peter
     * readded missing revisions
 
   Revision 1.12  2002/05/16 19:46:36  carl

compiler/globals.pas

@@ -24,6 +24,9 @@ unit globals;
 
 {$i fpcdefs.inc}
 
+{ Use the internal linker by default }
+{ define INTERNALLINKER}
+
 interface
 
     uses
@@ -1416,7 +1419,7 @@ implementation
         initmodeswitches:=fpcmodeswitches;
         initlocalswitches:=[cs_check_io,cs_typed_const_writable];
         initmoduleswitches:=[cs_extsyntax,cs_browser];
-        initglobalswitches:=[cs_check_unit_name,cs_link_static];
+        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);
 {$ifdef i386}
@@ -1466,7 +1469,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.59  2002-07-01 16:23:52  peter
+  Revision 1.60  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.59  2002/07/01 16:23:52  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/globtype.pas

@@ -126,7 +126,7 @@ interface
          cs_asm_regalloc,cs_asm_tempalloc,cs_asm_nodes,
          { linking }
          cs_link_extern,cs_link_static,cs_link_smart,cs_link_shared,cs_link_deffile,
-         cs_link_strip,cs_link_staticflag,cs_link_on_target
+         cs_link_strip,cs_link_staticflag,cs_link_on_target,cs_link_internal,cs_link_map
        );
        tglobalswitches = set of tglobalswitch;
 
@@ -255,7 +255,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  2002-05-18 13:34:08  peter
+  Revision 1.27  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.26  2002/05/18 13:34:08  peter
     * readded missing revisions
 
   Revision 1.25  2002/05/16 19:46:36  carl

compiler/i386/aasmcpu.pas

@@ -0,0 +1,1795 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
+
+    Contains the abstract assembler implementation for the i386
+
+    * Portions of this code was inspired by the NASM sources
+      The Netwide Assembler is Copyright (c) 1996 Simon Tatham and
+      Julian Hall. All rights reserved.
+
+    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 aasmcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      cclasses,globals,verbose,
+      cpuinfo,cpubase,
+      aasmbase,aasmtai;
+
+    const
+    { Operand types }
+      OT_NONE      = $00000000;
+
+      OT_BITS8     = $00000001;  { size, and other attributes, of the operand  }
+      OT_BITS16    = $00000002;
+      OT_BITS32    = $00000004;
+      OT_BITS64    = $00000008;  { FPU only  }
+      OT_BITS80    = $00000010;
+      OT_FAR       = $00000020;  { this means 16:16 or 16:32, like in CALL/JMP }
+      OT_NEAR      = $00000040;
+      OT_SHORT     = $00000080;
+
+      OT_SIZE_MASK = $000000FF;  { all the size attributes  }
+      OT_NON_SIZE  = longint(not OT_SIZE_MASK);
+
+      OT_SIGNED    = $00000100;  { the operand need to be signed -128-127 }
+
+      OT_TO        = $00000200;  { operand is followed by a colon  }
+                                 { reverse effect in FADD, FSUB &c  }
+      OT_COLON     = $00000400;
+
+      OT_REGISTER  = $00001000;
+      OT_IMMEDIATE = $00002000;
+      OT_IMM8      = $00002001;
+      OT_IMM16     = $00002002;
+      OT_IMM32     = $00002004;
+      OT_IMM64     = $00002008;
+      OT_IMM80     = $00002010;
+      OT_REGMEM    = $00200000;  { for r/m, ie EA, operands  }
+      OT_REGNORM   = $00201000;  { 'normal' reg, qualifies as EA  }
+      OT_REG8      = $00201001;
+      OT_REG16     = $00201002;
+      OT_REG32     = $00201004;
+      OT_MMXREG    = $00201008;  { MMX registers  }
+      OT_XMMREG    = $00201010;  { Katmai registers  }
+      OT_MEMORY    = $00204000;  { register number in 'basereg'  }
+      OT_MEM8      = $00204001;
+      OT_MEM16     = $00204002;
+      OT_MEM32     = $00204004;
+      OT_MEM64     = $00204008;
+      OT_MEM80     = $00204010;
+      OT_FPUREG    = $01000000;  { floating point stack registers  }
+      OT_FPU0      = $01000800;  { FPU stack register zero  }
+      OT_REG_SMASK = $00070000;  { special register operands: these may be treated differently  }
+                                 { a mask for the following  }
+      OT_REG_ACCUM = $00211000;  { accumulator: AL, AX or EAX  }
+      OT_REG_AL    = $00211001;    { REG_ACCUM | BITSxx  }
+      OT_REG_AX    = $00211002;    { ditto  }
+      OT_REG_EAX   = $00211004;    { and again  }
+      OT_REG_COUNT = $00221000;  { counter: CL, CX or ECX  }
+      OT_REG_CL    = $00221001;    { REG_COUNT | BITSxx  }
+      OT_REG_CX    = $00221002;    { ditto  }
+      OT_REG_ECX   = $00221004;    { another one  }
+      OT_REG_DX    = $00241002;
+
+      OT_REG_SREG  = $00081002;  { any segment register  }
+      OT_REG_CS    = $01081002;  { CS  }
+      OT_REG_DESS  = $02081002;  { DS, ES, SS (non-CS 86 registers)  }
+      OT_REG_FSGS  = $04081002;  { FS, GS (386 extended registers)  }
+
+      OT_REG_CDT   = $00101004;  { CRn, DRn and TRn  }
+      OT_REG_CREG  = $08101004;  { CRn  }
+      OT_REG_CR4   = $08101404;  { CR4 (Pentium only)  }
+      OT_REG_DREG  = $10101004;  { DRn  }
+      OT_REG_TREG  = $20101004;  { TRn  }
+
+      OT_MEM_OFFS  = $00604000;  { special type of EA  }
+                                 { simple [address] offset  }
+      OT_ONENESS   = $00800000;  { special type of immediate operand  }
+                                 { so UNITY == IMMEDIATE | ONENESS  }
+      OT_UNITY     = $00802000;  { for shift/rotate instructions  }
+
+      { Size of the instruction table converted by nasmconv.pas }
+      instabentries = {$i i386nop.inc}
+      maxinfolen    = 8;
+
+    type
+      TOperandOrder = (op_intel,op_att);
+
+      tinsentry=packed record
+        opcode  : tasmop;
+        ops     : byte;
+        optypes : array[0..2] of longint;
+        code    : array[0..maxinfolen] of char;
+        flags   : longint;
+      end;
+      pinsentry=^tinsentry;
+
+      { alignment for operator }
+      tai_align = class(tai_align_abstract)
+         reg       : tregister;
+         constructor create(b:byte);
+         constructor create_op(b: byte; _op: byte);
+         function getfillbuf:pchar;override;
+      end;
+
+      taicpu = class(taicpu_abstract)
+         opsize    : topsize;
+         constructor op_none(op : tasmop;_size : topsize);
+
+         constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister);
+         constructor op_const(op : tasmop;_size : topsize;_op1 : aword);
+         constructor op_ref(op : tasmop;_size : topsize;const _op1 : treference);
+
+         constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
+         constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference);
+         constructor op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aword);
+
+         constructor op_const_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister);
+         constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aword);
+         constructor op_const_ref(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference);
+
+         constructor op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister);
+
+         constructor op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
+         constructor op_const_reg_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;_op3 : tregister);
+         constructor op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference;_op3 : tregister);
+         constructor op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister; const _op3 : treference);
+         constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;const _op3 : treference);
+
+         { this is for Jmp instructions }
+         constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
+
+         constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
+         constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
+         constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+         constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
+
+         procedure changeopsize(siz:topsize);
+
+         function  GetString:string;
+         procedure CheckNonCommutativeOpcodes;
+      private
+         FOperandOrder : TOperandOrder;
+         procedure init(_size : topsize); { this need to be called by all constructor }
+    {$ifndef NOAG386BIN}
+      public
+         { the next will reset all instructions that can change in pass 2 }
+         procedure ResetPass1;
+         procedure ResetPass2;
+         function  CheckIfValid:boolean;
+         function  Pass1(offset:longint):longint;virtual;
+         procedure Pass2(sec:TAsmObjectdata);virtual;
+         procedure SetOperandOrder(order:TOperandOrder);
+      private
+         { next fields are filled in pass1, so pass2 is faster }
+         insentry  : PInsEntry;
+         insoffset,
+         inssize   : longint;
+         LastInsOffset : longint; { need to be public to be reset }
+         function  InsEnd:longint;
+         procedure create_ot;
+         function  Matches(p:PInsEntry):longint;
+         function  calcsize(p:PInsEntry):longint;
+         procedure gencode(sec:TAsmObjectData);
+         function  NeedAddrPrefix(opidx:byte):boolean;
+         procedure Swatoperands;
+    {$endif NOAG386BIN}
+      end;
+
+
+    procedure InitAsm;
+    procedure DoneAsm;
+
+
+implementation
+
+     uses
+       cutils,
+       ag386att;
+
+{*****************************************************************************
+                              Instruction table
+*****************************************************************************}
+
+    const
+     {Instruction flags }
+       IF_NONE   = $00000000;
+       IF_SM     = $00000001;        { size match first two operands  }
+       IF_SM2    = $00000002;
+       IF_SB     = $00000004;  { unsized operands can't be non-byte  }
+       IF_SW     = $00000008;  { unsized operands can't be non-word  }
+       IF_SD     = $00000010;  { unsized operands can't be nondword  }
+       IF_AR0    = $00000020;  { SB, SW, SD applies to argument 0  }
+       IF_AR1    = $00000040;  { SB, SW, SD applies to argument 1  }
+       IF_AR2    = $00000060;  { SB, SW, SD applies to argument 2  }
+       IF_ARMASK = $00000060;  { mask for unsized argument spec  }
+       IF_PRIV   = $00000100;  { it's a privileged instruction  }
+       IF_SMM    = $00000200;  { it's only valid in SMM  }
+       IF_PROT   = $00000400;  { it's protected mode only  }
+       IF_UNDOC  = $00001000;  { it's an undocumented instruction  }
+       IF_FPU    = $00002000;  { it's an FPU instruction  }
+       IF_MMX    = $00004000;  { it's an MMX instruction  }
+       IF_3DNOW  = $00008000;  { it's a 3DNow! instruction  }
+       IF_SSE    = $00010000;  { it's a SSE (KNI, MMX2) instruction  }
+       IF_PMASK  = longint($FF000000);  { the mask for processor types  }
+       IF_PFMASK = longint($F001FF00);  { the mask for disassembly "prefer"  }
+       IF_8086   = $00000000;  { 8086 instruction  }
+       IF_186    = $01000000;  { 186+ instruction  }
+       IF_286    = $02000000;  { 286+ instruction  }
+       IF_386    = $03000000;  { 386+ instruction  }
+       IF_486    = $04000000;  { 486+ instruction  }
+       IF_PENT   = $05000000;  { Pentium instruction  }
+       IF_P6     = $06000000;  { P6 instruction  }
+       IF_KATMAI = $07000000;  { Katmai instructions  }
+       IF_CYRIX  = $10000000;  { Cyrix-specific instruction  }
+       IF_AMD    = $20000000;  { AMD-specific instruction  }
+       { added flags }
+       IF_PRE    = $40000000;  { it's a prefix instruction }
+       IF_PASS2  = longint($80000000);  { if the instruction can change in a second pass }
+
+     type
+       TInsTabCache=array[TasmOp] of longint;
+       PInsTabCache=^TInsTabCache;
+
+     const
+       InsTab:array[0..instabentries-1] of TInsEntry={$i i386tab.inc}
+
+     var
+       InsTabCache : PInsTabCache;
+
+     const
+       { Intel style operands ! }
+       opsize_2_type:array[0..2,topsize] of longint=(
+         (OT_NONE,
+          OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS16,OT_BITS32,OT_BITS32,
+          OT_BITS16,OT_BITS32,OT_BITS64,
+          OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
+          OT_NEAR,OT_FAR,OT_SHORT
+         ),
+         (OT_NONE,
+          OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS8,OT_BITS8,OT_BITS16,
+          OT_BITS16,OT_BITS32,OT_BITS64,
+          OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
+          OT_NEAR,OT_FAR,OT_SHORT
+         ),
+         (OT_NONE,
+          OT_BITS8,OT_BITS16,OT_BITS32,OT_NONE,OT_NONE,OT_NONE,
+          OT_BITS16,OT_BITS32,OT_BITS64,
+          OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
+          OT_NEAR,OT_FAR,OT_SHORT
+         )
+       );
+
+       { Convert reg to operand type }
+       reg2type : array[firstreg..lastreg] of longint = (OT_NONE,
+         OT_REG_EAX,OT_REG_ECX,OT_REG32,OT_REG32,OT_REG32,OT_REG32,OT_REG32,OT_REG32,
+         OT_REG_AX,OT_REG_CX,OT_REG_DX,OT_REG16,OT_REG16,OT_REG16,OT_REG16,OT_REG16,
+         OT_REG_AL,OT_REG_CL,OT_REG8,OT_REG8,OT_REG8,OT_REG8,OT_REG8,OT_REG8,
+         OT_REG_CS,OT_REG_DESS,OT_REG_DESS,OT_REG_DESS,OT_REG_FSGS,OT_REG_FSGS,
+         OT_FPU0,OT_FPU0,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,
+         OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,
+         OT_REG_CREG,OT_REG_CREG,OT_REG_CREG,OT_REG_CR4,
+         OT_REG_TREG,OT_REG_TREG,OT_REG_TREG,OT_REG_TREG,OT_REG_TREG,
+         OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,
+         OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG
+       );
+
+
+{****************************************************************************
+                              TAI_ALIGN
+ ****************************************************************************}
+
+    constructor tai_align.create(b: byte);
+      begin
+        inherited create(b);
+        reg := R_ECX;
+      end;
+
+
+    constructor tai_align.create_op(b: byte; _op: byte);
+      begin
+        inherited create_op(b,_op);
+        reg := R_NO;
+      end;
+
+
+    function tai_align.getfillbuf:pchar;
+      const
+        alignarray:array[0..5] of string[8]=(
+          #$8D#$B4#$26#$00#$00#$00#$00,
+          #$8D#$B6#$00#$00#$00#$00,
+          #$8D#$74#$26#$00,
+          #$8D#$76#$00,
+          #$89#$F6,
+          #$90
+        );
+      var
+        bufptr : pchar;
+        j : longint;
+      begin
+        if not use_op then
+         begin
+           bufptr:=@buf;
+           while (fillsize>0) do
+            begin
+              for j:=0 to 5 do
+               if (fillsize>=length(alignarray[j])) then
+                break;
+              move(alignarray[j][1],bufptr^,length(alignarray[j]));
+              inc(bufptr,length(alignarray[j]));
+              dec(fillsize,length(alignarray[j]));
+            end;
+         end;
+        getfillbuf:=pchar(@buf);
+      end;
+
+
+{*****************************************************************************
+                                 Taicpu Constructors
+*****************************************************************************}
+
+    procedure taicpu.changeopsize(siz:topsize);
+      begin
+        opsize:=siz;
+      end;
+
+
+    procedure taicpu.init(_size : topsize);
+      begin
+         { default order is att }
+         FOperandOrder:=op_att;
+         segprefix:=R_NO;
+         opsize:=_size;
+{$ifndef NOAG386BIN}
+         insentry:=nil;
+         LastInsOffset:=-1;
+         InsOffset:=0;
+         InsSize:=0;
+{$endif}
+      end;
+
+
+    constructor taicpu.op_none(op : tasmop;_size : topsize);
+      begin
+         inherited create(op);
+         init(_size);
+      end;
+
+
+    constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadreg(0,_op1);
+      end;
+
+
+    constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : aword);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadconst(0,_op1);
+      end;
+
+
+    constructor taicpu.op_ref(op : tasmop;_size : topsize;const _op1 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadref(0,_op1);
+      end;
+
+
+    constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aword);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadconst(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadconst(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aword);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadconst(0,_op1);
+         loadconst(1,_op2);
+      end;
+
+
+    constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadconst(0,_op1);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadref(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadreg(2,_op3);
+      end;
+
+
+    constructor taicpu.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;_op3 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadconst(0,_op1);
+         loadreg(1,_op2);
+         loadreg(2,_op3);
+      end;
+
+
+    constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;const _op3 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+         loadref(2,_op3);
+      end;
+
+
+    constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference;_op3 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadconst(0,_op1);
+         loadref(1,_op2);
+         loadreg(2,_op3);
+      end;
+
+
+    constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;const _op3 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=3;
+         loadconst(0,_op1);
+         loadreg(1,_op2);
+         loadref(2,_op3);
+      end;
+
+
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         init(_size);
+         condition:=cond;
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+    constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+    constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadsymbol(0,_op1,_op1ofs);
+      end;
+
+
+    constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadsymbol(0,_op1,_op1ofs);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadsymbol(0,_op1,_op1ofs);
+         loadref(1,_op2);
+      end;
+
+
+    function taicpu.GetString:string;
+      var
+        i : longint;
+        s : string;
+        addsize : boolean;
+      begin
+        s:='['+std_op2str[opcode];
+        for i:=1to ops do
+         begin
+           if i=1 then
+            s:=s+' '
+           else
+            s:=s+',';
+           { type }
+           addsize:=false;
+           if (oper[i-1].ot and OT_XMMREG)=OT_XMMREG then
+            s:=s+'xmmreg'
+           else
+             if (oper[i-1].ot and OT_MMXREG)=OT_MMXREG then
+              s:=s+'mmxreg'
+           else
+             if (oper[i-1].ot and OT_FPUREG)=OT_FPUREG then
+              s:=s+'fpureg'
+           else
+            if (oper[i-1].ot and OT_REGISTER)=OT_REGISTER then
+             begin
+               s:=s+'reg';
+               addsize:=true;
+             end
+           else
+            if (oper[i-1].ot and OT_IMMEDIATE)=OT_IMMEDIATE then
+             begin
+               s:=s+'imm';
+               addsize:=true;
+             end
+           else
+            if (oper[i-1].ot and OT_MEMORY)=OT_MEMORY then
+             begin
+               s:=s+'mem';
+               addsize:=true;
+             end
+           else
+             s:=s+'???';
+           { size }
+           if addsize then
+            begin
+              if (oper[i-1].ot and OT_BITS8)<>0 then
+                s:=s+'8'
+              else
+               if (oper[i-1].ot and OT_BITS16)<>0 then
+                s:=s+'16'
+              else
+               if (oper[i-1].ot and OT_BITS32)<>0 then
+                s:=s+'32'
+              else
+                s:=s+'??';
+              { signed }
+              if (oper[i-1].ot and OT_SIGNED)<>0 then
+               s:=s+'s';
+            end;
+         end;
+        GetString:=s+']';
+      end;
+
+
+    procedure taicpu.Swatoperands;
+      var
+        p : TOper;
+      begin
+        { Fix the operands which are in AT&T style and we need them in Intel style }
+        case ops of
+          2 : begin
+                { 0,1 -> 1,0 }
+                p:=oper[0];
+                oper[0]:=oper[1];
+                oper[1]:=p;
+              end;
+          3 : begin
+                { 0,1,2 -> 2,1,0 }
+                p:=oper[0];
+                oper[0]:=oper[2];
+                oper[2]:=p;
+              end;
+        end;
+      end;
+
+
+    procedure taicpu.SetOperandOrder(order:TOperandOrder);
+      begin
+        if FOperandOrder<>order then
+         begin
+           Swatoperands;
+           FOperandOrder:=order;
+         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 taicpu.CheckNonCommutativeOpcodes;
+      begin
+        if ((ops=2) and
+           (oper[0].typ=top_reg) and
+           (oper[1].typ=top_reg) and
+           { if the first is ST and the second is also a register
+             it is necessarily ST1 .. ST7 }
+           (oper[0].reg=R_ST)) or
+           { ((ops=1) and
+            (oper[0].typ=top_reg) and
+            (oper[0].reg in [R_ST1..R_ST7]))  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
+            (oper[0].typ=top_reg) and
+            (oper[0].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;
+
+
+{*****************************************************************************
+                                Assembler
+*****************************************************************************}
+
+{$ifndef NOAG386BIN}
+
+    type
+      ea=packed record
+        sib_present : boolean;
+        bytes : byte;
+        size  : byte;
+        modrm : byte;
+        sib   : byte;
+      end;
+
+    procedure taicpu.create_ot;
+      {
+        this function will also fix some other fields which only needs to be once
+      }
+      var
+        i,l,relsize : longint;
+      begin
+        if ops=0 then
+         exit;
+        { update oper[].ot field }
+        for i:=0 to ops-1 do
+         with oper[i] do
+          begin
+            case typ of
+              top_reg :
+                ot:=reg2type[reg];
+              top_ref :
+                begin
+                { create ot field }
+                  if (ot and OT_SIZE_MASK)=0 then
+                    ot:=OT_MEMORY or opsize_2_type[i,opsize]
+                  else
+                    ot:=OT_MEMORY or (ot and OT_SIZE_MASK);
+                  if (ref^.base=R_NO) and (ref^.index=R_NO) then
+                    ot:=ot or OT_MEM_OFFS;
+                { fix scalefactor }
+                  if (ref^.index=R_NO) then
+                   ref^.scalefactor:=0
+                  else
+                   if (ref^.scalefactor=0) then
+                    ref^.scalefactor:=1;
+                end;
+              top_const :
+                begin
+                  if (opsize<>S_W) and (longint(val)>=-128) and (val<=127) then
+                    ot:=OT_IMM8 or OT_SIGNED
+                  else
+                    ot:=OT_IMMEDIATE or opsize_2_type[i,opsize];
+                end;
+              top_symbol :
+                begin
+                  if LastInsOffset=-1 then
+                   l:=0
+                  else
+                   l:=InsOffset-LastInsOffset;
+                  inc(l,symofs);
+                  if assigned(sym) then
+                   inc(l,sym.address);
+                  { instruction size will then always become 2 (PFV) }
+                  relsize:=(InsOffset+2)-l;
+                  if (not assigned(sym) or
+                      ((sym.currbind<>AB_EXTERNAL) and (sym.address<>0))) and
+                     (relsize>=-128) and (relsize<=127) then
+                   ot:=OT_IMM32 or OT_SHORT
+                  else
+                   ot:=OT_IMM32 or OT_NEAR;
+                end;
+            end;
+          end;
+      end;
+
+
+    function taicpu.InsEnd:longint;
+      begin
+        InsEnd:=InsOffset+InsSize;
+      end;
+
+
+      function taicpu.Matches(p:PInsEntry):longint;
+      { * IF_SM stands for Size Match: any operand whose size is not
+       * explicitly specified by the template is `really' intended to be
+       * the same size as the first size-specified operand.
+       * Non-specification is tolerated in the input instruction, but
+       * _wrong_ specification is not.
+       *
+       * IF_SM2 invokes Size Match on only the first _two_ operands, for
+       * three-operand instructions such as SHLD: it implies that the
+       * first two operands must match in size, but that the third is
+       * required to be _unspecified_.
+       *
+       * IF_SB invokes Size Byte: operands with unspecified size in the
+       * template are really bytes, and so no non-byte specification in
+       * the input instruction will be tolerated. IF_SW similarly invokes
+       * Size Word, and IF_SD invokes Size Doubleword.
+       *
+       * (The default state if neither IF_SM nor IF_SM2 is specified is
+       * that any operand with unspecified size in the template is
+       * required to have unspecified size in the instruction too...)
+      }
+      var
+        i,j,asize,oprs : longint;
+        siz : array[0..2] of longint;
+      begin
+        Matches:=100;
+
+        { Check the opcode and operands }
+        if (p^.opcode<>opcode) or (p^.ops<>ops) then
+         begin
+           Matches:=0;
+           exit;
+         end;
+
+        { Check that no spurious colons or TOs are present }
+        for i:=0 to p^.ops-1 do
+         if (oper[i].ot and (not p^.optypes[i]) and (OT_COLON or OT_TO))<>0 then
+          begin
+            Matches:=0;
+            exit;
+          end;
+
+        { Check that the operand flags all match up }
+        for i:=0 to p^.ops-1 do
+         begin
+           if ((p^.optypes[i] and (not oper[i].ot)) or
+               ((p^.optypes[i] and OT_SIZE_MASK) and
+                ((p^.optypes[i] xor oper[i].ot) and OT_SIZE_MASK)))<>0 then
+            begin
+              if ((p^.optypes[i] and (not oper[i].ot) and OT_NON_SIZE) or
+                  (oper[i].ot and OT_SIZE_MASK))<>0 then
+               begin
+                 Matches:=0;
+                 exit;
+               end
+              else
+               Matches:=1;
+            end;
+         end;
+
+      { Check operand sizes }
+        { as default an untyped size can get all the sizes, this is different
+          from nasm, but else we need to do a lot checking which opcodes want
+          size or not with the automatic size generation }
+        asize:=longint($ffffffff);
+        if (p^.flags and IF_SB)<>0 then
+          asize:=OT_BITS8
+        else if (p^.flags and IF_SW)<>0 then
+          asize:=OT_BITS16
+        else if (p^.flags and IF_SD)<>0 then
+          asize:=OT_BITS32;
+        if (p^.flags and IF_ARMASK)<>0 then
+         begin
+           siz[0]:=0;
+           siz[1]:=0;
+           siz[2]:=0;
+           if (p^.flags and IF_AR0)<>0 then
+            siz[0]:=asize
+           else if (p^.flags and IF_AR1)<>0 then
+            siz[1]:=asize
+           else if (p^.flags and IF_AR2)<>0 then
+            siz[2]:=asize;
+         end
+        else
+         begin
+         { we can leave because the size for all operands is forced to be
+           the same
+           but not if IF_SB IF_SW or IF_SD is set PM }
+           if asize=-1 then
+             exit;
+           siz[0]:=asize;
+           siz[1]:=asize;
+           siz[2]:=asize;
+         end;
+
+        if (p^.flags and (IF_SM or IF_SM2))<>0 then
+         begin
+           if (p^.flags and IF_SM2)<>0 then
+            oprs:=2
+           else
+            oprs:=p^.ops;
+           for i:=0 to oprs-1 do
+            if ((p^.optypes[i] and OT_SIZE_MASK) <> 0) then
+             begin
+               for j:=0 to oprs-1 do
+                siz[j]:=p^.optypes[i] and OT_SIZE_MASK;
+               break;
+             end;
+          end
+         else
+          oprs:=2;
+
+        { Check operand sizes }
+        for i:=0 to p^.ops-1 do
+         begin
+           if ((p^.optypes[i] and OT_SIZE_MASK)=0) and
+              ((oper[i].ot and OT_SIZE_MASK and (not siz[i]))<>0) and
+              { Immediates can always include smaller size }
+              ((oper[i].ot and OT_IMMEDIATE)=0) and
+               (((p^.optypes[i] and OT_SIZE_MASK) or siz[i])<(oper[i].ot and OT_SIZE_MASK)) then
+            Matches:=2;
+         end;
+      end;
+
+
+    procedure taicpu.ResetPass1;
+      begin
+        { we need to reset everything here, because the choosen insentry
+          can be invalid for a new situation where the previously optimized
+          insentry is not correct }
+        InsEntry:=nil;
+        InsSize:=0;
+        LastInsOffset:=-1;
+      end;
+
+
+    procedure taicpu.ResetPass2;
+      begin
+        { we are here in a second pass, check if the instruction can be optimized }
+        if assigned(InsEntry) and
+           ((InsEntry^.flags and IF_PASS2)<>0) then
+         begin
+           InsEntry:=nil;
+           InsSize:=0;
+         end;
+        LastInsOffset:=-1;
+      end;
+
+
+    function taicpu.CheckIfValid:boolean;
+      var
+        m,i : longint;
+      begin
+        CheckIfValid:=false;
+      { Things which may only be done once, not when a second pass is done to
+        optimize }
+        if (Insentry=nil) or ((InsEntry^.flags and IF_PASS2)<>0) then
+         begin
+           { We need intel style operands }
+           SetOperandOrder(op_intel);
+           { create the .ot fields }
+           create_ot;
+           { set the file postion }
+           aktfilepos:=fileinfo;
+         end
+        else
+         begin
+           { we've already an insentry so it's valid }
+           CheckIfValid:=true;
+           exit;
+         end;
+      { Lookup opcode in the table }
+        InsSize:=-1;
+        i:=instabcache^[opcode];
+        if i=-1 then
+         begin
+           Message1(asmw_e_opcode_not_in_table,gas_op2str[opcode]);
+           exit;
+         end;
+        insentry:=@instab[i];
+        while (insentry^.opcode=opcode) do
+         begin
+           m:=matches(insentry);
+           if m=100 then
+            begin
+              InsSize:=calcsize(insentry);
+              if (segprefix<>R_NO) then
+               inc(InsSize);
+              { For opsize if size if forced }
+              if (insentry^.flags and (IF_SB or IF_SW or IF_SD))<>0 then
+                 begin
+                   if (insentry^.flags and IF_ARMASK)=0 then
+                     begin
+                       if (insentry^.flags and IF_SB)<>0 then
+                         begin
+                           if opsize=S_NO then
+                             opsize:=S_B;
+                         end
+                       else if (insentry^.flags and IF_SW)<>0 then
+                         begin
+                           if opsize=S_NO then
+                             opsize:=S_W;
+                         end
+                       else if (insentry^.flags and IF_SD)<>0 then
+                         begin
+                           if opsize=S_NO then
+                             opsize:=S_L;
+                         end;
+                     end;
+                 end;
+              CheckIfValid:=true;
+              exit;
+            end;
+           inc(i);
+           insentry:=@instab[i];
+         end;
+        if insentry^.opcode<>opcode then
+         Message1(asmw_e_invalid_opcode_and_operands,GetString);
+      { No instruction found, set insentry to nil and inssize to -1 }
+        insentry:=nil;
+        inssize:=-1;
+      end;
+
+
+
+    function taicpu.Pass1(offset:longint):longint;
+      begin
+        Pass1:=0;
+      { Save the old offset and set the new offset }
+        InsOffset:=Offset;
+      { Things which may only be done once, not when a second pass is done to
+        optimize }
+        if Insentry=nil then
+         begin
+           { Check if error last time then InsSize=-1 }
+           if InsSize=-1 then
+            exit;
+           { set the file postion }
+           aktfilepos:=fileinfo;
+         end
+        else
+         begin
+{$ifdef PASS2FLAG}
+           { we are here in a second pass, check if the instruction can be optimized }
+           if (InsEntry^.flags and IF_PASS2)=0 then
+            begin
+              Pass1:=InsSize;
+              exit;
+            end;
+           { update the .ot fields, some top_const can be updated }
+           create_ot;
+{$endif PASS2FLAG}
+         end;
+      { Check if it's a valid instruction }
+        if CheckIfValid then
+         begin
+           LastInsOffset:=InsOffset;
+           Pass1:=InsSize;
+           exit;
+         end;
+        LastInsOffset:=-1;
+      end;
+
+
+    procedure taicpu.Pass2(sec:TAsmObjectData);
+      var
+        c : longint;
+      begin
+        { error in pass1 ? }
+        if insentry=nil then
+         exit;
+        aktfilepos:=fileinfo;
+        { Segment override }
+        if (segprefix<>R_NO) then
+         begin
+           case segprefix of
+             R_CS : c:=$2e;
+             R_DS : c:=$3e;
+             R_ES : c:=$26;
+             R_FS : c:=$64;
+             R_GS : c:=$65;
+             R_SS : c:=$36;
+           end;
+           sec.writebytes(c,1);
+           { fix the offset for GenNode }
+           inc(InsOffset);
+         end;
+        { Generate the instruction }
+        GenCode(sec);
+      end;
+
+
+    function taicpu.NeedAddrPrefix(opidx:byte):boolean;
+      var
+        i,b : tregister;
+      begin
+        if (OT_MEMORY and (not oper[opidx].ot))=0 then
+         begin
+           i:=oper[opidx].ref^.index;
+           b:=oper[opidx].ref^.base;
+           if not(i in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) or
+              not(b in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) then
+            begin
+              NeedAddrPrefix:=true;
+              exit;
+            end;
+         end;
+        NeedAddrPrefix:=false;
+      end;
+
+
+    function regval(r:tregister):byte;
+      begin
+        case r of
+          R_EAX,R_AX,R_AL,R_ES,R_CR0,R_DR0,R_ST,R_ST0,R_MM0,R_XMM0 :
+            regval:=0;
+          R_ECX,R_CX,R_CL,R_CS,R_DR1,R_ST1,R_MM1,R_XMM1 :
+            regval:=1;
+          R_EDX,R_DX,R_DL,R_SS,R_CR2,R_DR2,R_ST2,R_MM2,R_XMM2 :
+            regval:=2;
+          R_EBX,R_BX,R_BL,R_DS,R_CR3,R_DR3,R_TR3,R_ST3,R_MM3,R_XMM3 :
+            regval:=3;
+          R_ESP,R_SP,R_AH,R_FS,R_CR4,R_TR4,R_ST4,R_MM4,R_XMM4 :
+            regval:=4;
+          R_EBP,R_BP,R_CH,R_GS,R_TR5,R_ST5,R_MM5,R_XMM5 :
+            regval:=5;
+          R_ESI,R_SI,R_DH,R_DR6,R_TR6,R_ST6,R_MM6,R_XMM6 :
+            regval:=6;
+          R_EDI,R_DI,R_BH,R_DR7,R_TR7,R_ST7,R_MM7,R_XMM7 :
+            regval:=7;
+          else
+            begin
+              internalerror(777001);
+              regval:=0;
+            end;
+        end;
+      end;
+
+
+    function process_ea(const input:toper;var output:ea;rfield:longint):boolean;
+      const
+        regs : array[0..63] of tregister=(
+          R_MM0, R_EAX, R_AX, R_AL, R_XMM0, R_NO, R_NO, R_NO,
+          R_MM1, R_ECX, R_CX, R_CL, R_XMM1, R_NO, R_NO, R_NO,
+          R_MM2, R_EDX, R_DX, R_DL, R_XMM2, R_NO, R_NO, R_NO,
+          R_MM3, R_EBX, R_BX, R_BL, R_XMM3, R_NO, R_NO, R_NO,
+          R_MM4, R_ESP, R_SP, R_AH, R_XMM4, R_NO, R_NO, R_NO,
+          R_MM5, R_EBP, R_BP, R_CH, R_XMM5, R_NO, R_NO, R_NO,
+          R_MM6, R_ESI, R_SI, R_DH, R_XMM6, R_NO, R_NO, R_NO,
+          R_MM7, R_EDI, R_DI, R_BH, R_XMM7, R_NO, R_NO, R_NO
+        );
+      var
+        j     : longint;
+        i,b   : tregister;
+        sym   : tasmsymbol;
+        md,s  : byte;
+        base,index,scalefactor,
+        o     : longint;
+      begin
+        process_ea:=false;
+      { register ? }
+        if (input.typ=top_reg) then
+         begin
+           j:=0;
+           while (j<=high(regs)) do
+            begin
+              if input.reg=regs[j] then
+               break;
+              inc(j);
+            end;
+           if j<=high(regs) then
+            begin
+              output.sib_present:=false;
+              output.bytes:=0;
+              output.modrm:=$c0 or (rfield shl 3) or (j shr 3);
+              output.size:=1;
+              process_ea:=true;
+            end;
+           exit;
+         end;
+      { memory reference }
+        i:=input.ref^.index;
+        b:=input.ref^.base;
+        s:=input.ref^.scalefactor;
+        o:=input.ref^.offset+input.ref^.offsetfixup;
+        sym:=input.ref^.symbol;
+      { it's direct address }
+        if (b=R_NO) and (i=R_NO) then
+         begin
+           { it's a pure offset }
+           output.sib_present:=false;
+           output.bytes:=4;
+           output.modrm:=5 or (rfield shl 3);
+         end
+        else
+        { it's an indirection }
+         begin
+           { 16 bit address? }
+           if not((i in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) and
+                  (b in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI])) then
+            Message(asmw_e_16bit_not_supported);
+{$ifdef OPTEA}
+           { make single reg base }
+           if (b=R_NO) and (s=1) then
+            begin
+              b:=i;
+              i:=R_NO;
+            end;
+           { convert [3,5,9]*EAX to EAX+[2,4,8]*EAX }
+           if (b=R_NO) and
+              (((s=2) and (i<>R_ESP)) or
+                (s=3) or (s=5) or (s=9)) then
+            begin
+              b:=i;
+              dec(s);
+            end;
+           { swap ESP into base if scalefactor is 1 }
+           if (s=1) and (i=R_ESP) then
+            begin
+              i:=b;
+              b:=R_ESP;
+            end;
+{$endif OPTEA}
+           { wrong, for various reasons }
+           if (i=R_ESP) or ((s<>1) and (s<>2) and (s<>4) and (s<>8) and (i<>R_NO)) then
+            exit;
+           { base }
+           case b of
+             R_EAX : base:=0;
+             R_ECX : base:=1;
+             R_EDX : base:=2;
+             R_EBX : base:=3;
+             R_ESP : base:=4;
+             R_NO,
+             R_EBP : base:=5;
+             R_ESI : base:=6;
+             R_EDI : base:=7;
+           else
+             exit;
+           end;
+           { index }
+           case i of
+             R_EAX : index:=0;
+             R_ECX : index:=1;
+             R_EDX : index:=2;
+             R_EBX : index:=3;
+             R_NO  : index:=4;
+             R_EBP : index:=5;
+             R_ESI : index:=6;
+             R_EDI : index:=7;
+           else
+             exit;
+           end;
+           case s of
+            0,
+            1 : scalefactor:=0;
+            2 : scalefactor:=1;
+            4 : scalefactor:=2;
+            8 : scalefactor:=3;
+           else
+            exit;
+           end;
+           if (b=R_NO) or
+              ((b<>R_EBP) and (o=0) and (sym=nil)) then
+            md:=0
+           else
+            if ((o>=-128) and (o<=127) and (sym=nil)) then
+             md:=1
+            else
+             md:=2;
+           if (b=R_NO) or (md=2) then
+            output.bytes:=4
+           else
+            output.bytes:=md;
+           { SIB needed ? }
+           if (i=R_NO) and (b<>R_ESP) then
+            begin
+              output.sib_present:=false;
+              output.modrm:=(md shl 6) or (rfield shl 3) or base;
+            end
+           else
+            begin
+              output.sib_present:=true;
+              output.modrm:=(md shl 6) or (rfield shl 3) or 4;
+              output.sib:=(scalefactor shl 6) or (index shl 3) or base;
+            end;
+         end;
+        if output.sib_present then
+         output.size:=2+output.bytes
+        else
+         output.size:=1+output.bytes;
+        process_ea:=true;
+      end;
+
+
+    function taicpu.calcsize(p:PInsEntry):longint;
+      var
+        codes : pchar;
+        c     : byte;
+        len     : longint;
+        ea_data : ea;
+      begin
+        len:=0;
+        codes:=@p^.code;
+        repeat
+          c:=ord(codes^);
+          inc(codes);
+          case c of
+            0 :
+              break;
+            1,2,3 :
+              begin
+                inc(codes,c);
+                inc(len,c);
+              end;
+            8,9,10 :
+              begin
+                inc(codes);
+                inc(len);
+              end;
+            4,5,6,7 :
+              begin
+                if opsize=S_W then
+                  inc(len,2)
+                else
+                  inc(len);
+              end;
+            15,
+            12,13,14,
+            16,17,18,
+            20,21,22,
+            40,41,42 :
+              inc(len);
+            24,25,26,
+            31,
+            48,49,50 :
+              inc(len,2);
+            28,29,30, { we don't have 16 bit immediates code }
+            32,33,34,
+            52,53,54,
+            56,57,58 :
+              inc(len,4);
+            192,193,194 :
+              if NeedAddrPrefix(c-192) then
+               inc(len);
+            208 :
+              inc(len);
+            200,
+            201,
+            202,
+            209,
+            210,
+            217,218,219 : ;
+            216 :
+              begin
+                inc(codes);
+                inc(len);
+              end;
+            224,225,226 :
+              begin
+                InternalError(777002);
+              end;
+            else
+              begin
+                if (c>=64) and (c<=191) then
+                 begin
+                   if not process_ea(oper[(c shr 3) and 7], ea_data, 0) then
+                    Message(asmw_e_invalid_effective_address)
+                   else
+                    inc(len,ea_data.size);
+                 end
+                else
+                 InternalError(777003);
+              end;
+          end;
+        until false;
+        calcsize:=len;
+      end;
+
+
+    procedure taicpu.GenCode(sec:TAsmObjectData);
+      {
+       * the actual codes (C syntax, i.e. octal):
+       * \0            - terminates the code. (Unless it's a literal of course.)
+       * \1, \2, \3    - that many literal bytes follow in the code stream
+       * \4, \6        - the POP/PUSH (respectively) codes for CS, DS, ES, SS
+       *                 (POP is never used for CS) depending on operand 0
+       * \5, \7        - the second byte of POP/PUSH codes for FS, GS, depending
+       *                 on operand 0
+       * \10, \11, \12 - a literal byte follows in the code stream, to be added
+       *                 to the register value of operand 0, 1 or 2
+       * \17           - encodes the literal byte 0. (Some compilers don't take
+       *                 kindly to a zero byte in the _middle_ of a compile time
+       *                 string constant, so I had to put this hack in.)
+       * \14, \15, \16 - a signed byte immediate operand, from operand 0, 1 or 2
+       * \20, \21, \22 - a byte immediate operand, from operand 0, 1 or 2
+       * \24, \25, \26 - an unsigned byte immediate operand, from operand 0, 1 or 2
+       * \30, \31, \32 - a word immediate operand, from operand 0, 1 or 2
+       * \34, \35, \36 - select between \3[012] and \4[012] depending on 16/32 bit
+       *                 assembly mode or the address-size override on the operand
+       * \37           - a word constant, from the _segment_ part of operand 0
+       * \40, \41, \42 - a long immediate operand, from operand 0, 1 or 2
+       * \50, \51, \52 - a byte relative operand, from operand 0, 1 or 2
+       * \60, \61, \62 - a word relative operand, from operand 0, 1 or 2
+       * \64, \65, \66 - select between \6[012] and \7[012] depending on 16/32 bit
+       *                 assembly mode or the address-size override on the operand
+       * \70, \71, \72 - a long relative operand, from operand 0, 1 or 2
+       * \1ab          - a ModRM, calculated on EA in operand a, with the spare
+       *                 field the register value of operand b.
+       * \2ab          - a ModRM, calculated on EA in operand a, with the spare
+       *                 field equal to digit b.
+       * \30x          - might be an 0x67 byte, depending on the address size of
+       *                 the memory reference in operand x.
+       * \310          - indicates fixed 16-bit address size, i.e. optional 0x67.
+       * \311          - indicates fixed 32-bit address size, i.e. optional 0x67.
+       * \320          - indicates fixed 16-bit operand size, i.e. optional 0x66.
+       * \321          - indicates fixed 32-bit operand size, i.e. optional 0x66.
+       * \322          - indicates that this instruction is only valid when the
+       *                 operand size is the default (instruction to disassembler,
+       *                 generates no code in the assembler)
+       * \330          - a literal byte follows in the code stream, to be added
+       *                 to the condition code value of the instruction.
+       * \340          - reserve <operand 0> bytes of uninitialised storage.
+       *                 Operand 0 had better be a segmentless constant.
+      }
+
+      var
+        currval : longint;
+        currsym : tasmsymbol;
+
+        procedure getvalsym(opidx:longint);
+        begin
+          case oper[opidx].typ of
+            top_ref :
+              begin
+                currval:=oper[opidx].ref^.offset+oper[opidx].ref^.offsetfixup;
+                currsym:=oper[opidx].ref^.symbol;
+              end;
+            top_const :
+              begin
+                currval:=longint(oper[opidx].val);
+                currsym:=nil;
+              end;
+            top_symbol :
+              begin
+                currval:=oper[opidx].symofs;
+                currsym:=oper[opidx].sym;
+              end;
+            else
+              Message(asmw_e_immediate_or_reference_expected);
+          end;
+        end;
+
+      const
+        CondVal:array[TAsmCond] of byte=($0,
+         $7, $3, $2, $6, $2, $4, $F, $D, $C, $E, $6, $2,
+         $3, $7, $3, $5, $E, $C, $D, $F, $1, $B, $9, $5,
+         $0, $A, $A, $B, $8, $4);
+      var
+        c : byte;
+        pb,
+        codes : pchar;
+        bytes : array[0..3] of byte;
+        rfield,
+        data,s,opidx : longint;
+        ea_data : ea;
+      begin
+{$ifdef EXTDEBUG}
+        { safety check }
+        if sec.sects[sec.currsec].datasize<>insoffset then
+         internalerror(200130121);
+{$endif EXTDEBUG}
+        { load data to write }
+        codes:=insentry^.code;
+        { Force word push/pop for registers }
+        if (opsize=S_W) and ((codes[0]=#4) or (codes[0]=#6) or
+            ((codes[0]=#1) and ((codes[2]=#5) or (codes[2]=#7)))) then
+          begin
+            bytes[0]:=$66;
+            sec.writebytes(bytes,1);
+          end;
+        repeat
+          c:=ord(codes^);
+          inc(codes);
+          case c of
+            0 :
+              break;
+            1,2,3 :
+              begin
+                sec.writebytes(codes^,c);
+                inc(codes,c);
+              end;
+            4,6 :
+              begin
+                case oper[0].reg of
+                  R_CS :
+                    begin
+                      if c=4 then
+                       bytes[0]:=$f
+                      else
+                       bytes[0]:=$e;
+                    end;
+                  R_NO,
+                  R_DS :
+                    begin
+                      if c=4 then
+                       bytes[0]:=$1f
+                      else
+                       bytes[0]:=$1e;
+                    end;
+                  R_ES :
+                    begin
+                      if c=4 then
+                       bytes[0]:=$7
+                      else
+                       bytes[0]:=$6;
+                    end;
+                  R_SS :
+                    begin
+                      if c=4 then
+                       bytes[0]:=$17
+                      else
+                       bytes[0]:=$16;
+                    end;
+                  else
+                    InternalError(777004);
+                end;
+                sec.writebytes(bytes,1);
+              end;
+            5,7 :
+              begin
+                case oper[0].reg of
+                  R_FS :
+                    begin
+                      if c=5 then
+                       bytes[0]:=$a1
+                      else
+                       bytes[0]:=$a0;
+                    end;
+                  R_GS :
+                    begin
+                      if c=5 then
+                       bytes[0]:=$a9
+                      else
+                       bytes[0]:=$a8;
+                    end;
+                  else
+                    InternalError(777005);
+                end;
+                sec.writebytes(bytes,1);
+              end;
+            8,9,10 :
+              begin
+                bytes[0]:=ord(codes^)+regval(oper[c-8].reg);
+                inc(codes);
+                sec.writebytes(bytes,1);
+              end;
+            15 :
+              begin
+                bytes[0]:=0;
+                sec.writebytes(bytes,1);
+              end;
+            12,13,14 :
+              begin
+                getvalsym(c-12);
+                if (currval<-128) or (currval>127) then
+                 Message2(asmw_e_value_exceeds_bounds,'signed byte',tostr(currval));
+                if assigned(currsym) then
+                  sec.writereloc(currval,1,currsym,RELOC_ABSOLUTE)
+                else
+                  sec.writebytes(currval,1);
+              end;
+            16,17,18 :
+              begin
+                getvalsym(c-16);
+                if (currval<-256) or (currval>255) then
+                 Message2(asmw_e_value_exceeds_bounds,'byte',tostr(currval));
+                if assigned(currsym) then
+                 sec.writereloc(currval,1,currsym,RELOC_ABSOLUTE)
+                else
+                 sec.writebytes(currval,1);
+              end;
+            20,21,22 :
+              begin
+                getvalsym(c-20);
+                if (currval<0) or (currval>255) then
+                 Message2(asmw_e_value_exceeds_bounds,'unsigned byte',tostr(currval));
+                if assigned(currsym) then
+                 sec.writereloc(currval,1,currsym,RELOC_ABSOLUTE)
+                else
+                 sec.writebytes(currval,1);
+              end;
+            24,25,26 :
+              begin
+                getvalsym(c-24);
+                if (currval<-65536) or (currval>65535) then
+                 Message2(asmw_e_value_exceeds_bounds,'word',tostr(currval));
+                if assigned(currsym) then
+                 sec.writereloc(currval,2,currsym,RELOC_ABSOLUTE)
+                else
+                 sec.writebytes(currval,2);
+              end;
+            28,29,30 :
+              begin
+                getvalsym(c-28);
+                if assigned(currsym) then
+                 sec.writereloc(currval,4,currsym,RELOC_ABSOLUTE)
+                else
+                 sec.writebytes(currval,4);
+              end;
+            32,33,34 :
+              begin
+                getvalsym(c-32);
+                if assigned(currsym) then
+                 sec.writereloc(currval,4,currsym,RELOC_ABSOLUTE)
+                else
+                 sec.writebytes(currval,4);
+              end;
+            40,41,42 :
+              begin
+                getvalsym(c-40);
+                data:=currval-insend;
+                if assigned(currsym) then
+                 inc(data,currsym.address);
+                if (data>127) or (data<-128) then
+                 Message1(asmw_e_short_jmp_out_of_range,tostr(data));
+                sec.writebytes(data,1);
+              end;
+            52,53,54 :
+              begin
+                getvalsym(c-52);
+                if assigned(currsym) then
+                 sec.writereloc(currval,4,currsym,RELOC_RELATIVE)
+                else
+                 sec.writereloc(currval-insend,4,nil,RELOC_ABSOLUTE)
+              end;
+            56,57,58 :
+              begin
+                getvalsym(c-56);
+                if assigned(currsym) then
+                 sec.writereloc(currval,4,currsym,RELOC_RELATIVE)
+                else
+                 sec.writereloc(currval-insend,4,nil,RELOC_ABSOLUTE)
+              end;
+            192,193,194 :
+              begin
+                if NeedAddrPrefix(c-192) then
+                 begin
+                   bytes[0]:=$67;
+                   sec.writebytes(bytes,1);
+                 end;
+              end;
+            200 :
+              begin
+                bytes[0]:=$67;
+                sec.writebytes(bytes,1);
+              end;
+            208 :
+              begin
+                bytes[0]:=$66;
+                sec.writebytes(bytes,1);
+              end;
+            216 :
+              begin
+                bytes[0]:=ord(codes^)+condval[condition];
+                inc(codes);
+                sec.writebytes(bytes,1);
+              end;
+            201,
+            202,
+            209,
+            210,
+            217,218,219 :
+              begin
+                { these are dissambler hints or 32 bit prefixes which
+                  are not needed }
+              end;
+            31,
+            48,49,50,
+            224,225,226 :
+              begin
+                InternalError(777006);
+              end
+            else
+              begin
+                if (c>=64) and (c<=191) then
+                 begin
+                   if (c<127) then
+                    begin
+                      if (oper[c and 7].typ=top_reg) then
+                        rfield:=regval(oper[c and 7].reg)
+                      else
+                        rfield:=regval(oper[c and 7].ref^.base);
+                    end
+                   else
+                    rfield:=c and 7;
+                   opidx:=(c shr 3) and 7;
+                   if not process_ea(oper[opidx], ea_data, rfield) then
+                    Message(asmw_e_invalid_effective_address);
+
+                   pb:=@bytes;
+                   pb^:=chr(ea_data.modrm);
+                   inc(pb);
+                   if ea_data.sib_present then
+                    begin
+                      pb^:=chr(ea_data.sib);
+                      inc(pb);
+                    end;
+
+                   s:=pb-pchar(@bytes);
+                   sec.writebytes(bytes,s);
+
+                   case ea_data.bytes of
+                     0 : ;
+                     1 :
+                       begin
+                         if (oper[opidx].ot and OT_MEMORY)=OT_MEMORY then
+                          sec.writereloc(oper[opidx].ref^.offset+oper[opidx].ref^.offsetfixup,1,oper[opidx].ref^.symbol,RELOC_ABSOLUTE)
+                         else
+                          begin
+                            bytes[0]:=oper[opidx].ref^.offset+oper[opidx].ref^.offsetfixup;
+                            sec.writebytes(bytes,1);
+                          end;
+                         inc(s);
+                       end;
+                     2,4 :
+                       begin
+                         sec.writereloc(oper[opidx].ref^.offset+oper[opidx].ref^.offsetfixup,ea_data.bytes,
+                           oper[opidx].ref^.symbol,RELOC_ABSOLUTE);
+                         inc(s,ea_data.bytes);
+                       end;
+                   end;
+                 end
+                else
+                 InternalError(777007);
+              end;
+          end;
+        until false;
+      end;
+{$endif NOAG386BIN}
+
+{*****************************************************************************
+                              Instruction table
+*****************************************************************************}
+
+    procedure BuildInsTabCache;
+{$ifndef NOAG386BIN}
+      var
+        i : longint;
+{$endif}
+      begin
+{$ifndef NOAG386BIN}
+        new(instabcache);
+        FillChar(instabcache^,sizeof(tinstabcache),$ff);
+        i:=0;
+        while (i<InsTabEntries) do
+         begin
+           if InsTabCache^[InsTab[i].OPcode]=-1 then
+            InsTabCache^[InsTab[i].OPcode]:=i;
+           inc(i);
+         end;
+{$endif NOAG386BIN}
+      end;
+
+
+    procedure InitAsm;
+      begin
+{$ifndef NOAG386BIN}
+        if not assigned(instabcache) then
+          BuildInsTabCache;
+{$endif NOAG386BIN}
+      end;
+
+
+    procedure DoneAsm;
+      begin
+{$ifndef NOAG386BIN}
+        if assigned(instabcache) then
+         dispose(instabcache);
+{$endif NOAG386BIN}
+      end;
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+}

compiler/i386/ag386att.pas

@@ -29,7 +29,7 @@ interface
     uses
       cclasses,cpubase,
       globals,
-      aasm,assemble,aggas;
+      aasmbase,aasmtai,aasmcpu,assemble,aggas;
 
     type
       T386ATTAssembler=class(TGNUassembler)
@@ -67,7 +67,7 @@ interface
 
     uses
       cutils,systems,
-      verbose,cpuasm;
+      verbose;
 
 
 
@@ -249,7 +249,7 @@ interface
     const
        as_i386_as_info : tasminfo =
           (
-            id           : as_i386_as;
+            id     : as_i386_as;
             idtxt  : 'AS';
             asmbin : 'as';
             asmcmd : '-o $OBJ $ASM';
@@ -264,7 +264,7 @@ interface
             secnames : ('',
               '.text','.data','.bss',
               '','','','','','',
-              '.stab','.stabstr')
+              '.stab','.stabstr','COMMON')
           );
 
        as_i386_as_aout_info : tasminfo =
@@ -284,7 +284,7 @@ interface
             secnames : ('',
               '.text','.data','.bss',
               '','','','','','',
-              '.stab','.stabstr')
+              '.stab','.stabstr','COMMON')
           );
 
        as_i386_asw_info : tasminfo =
@@ -305,7 +305,7 @@ interface
               '.text','.data','.section .bss',
               '.section .idata$2','.section .idata$4','.section .idata$5',
                 '.section .idata$6','.section .idata$7','.section .edata',
-              '.stab','.stabstr')
+              '.stab','.stabstr','COMMON')
           );
 
        as_i386_aswwdosx_info : tasminfo =
@@ -326,7 +326,7 @@ interface
               '.text','.data','.section .bss',
               '.section .idata$2','.section .idata$4','.section .idata$5',
                 '.section .idata$6','.section .idata$7','.section .edata',
-              '.stab','.stabstr')
+              '.stab','.stabstr','COMMON')
           );
 
 
@@ -338,7 +338,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.22  2002-05-18 13:34:21  peter
+  Revision 1.23  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.22  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.21  2002/05/16 19:46:49  carl

compiler/i386/ag386int.pas

@@ -26,7 +26,7 @@ unit ag386int;
 
 interface
 
-    uses aasm,assemble;
+    uses aasmbase,aasmtai,aasmcpu,assemble;
 
     type
       T386IntelAssembler = class(TExternalAssembler)
@@ -46,7 +46,7 @@ interface
       sysutils,
 {$endif}
       cutils,globtype,globals,systems,cclasses,
-      verbose,cpubase,cpuasm,finput,fmodule,script
+      verbose,cpubase,finput,fmodule,script
       ;
 
     const
@@ -294,7 +294,7 @@ interface
  ****************************************************************************}
 
     var
-      LastSec : tsection;
+      LasTSec : TSection;
       lastfileinfo : tfileposinfo;
       infile,
       lastinfile   : tinputfile;
@@ -326,8 +326,10 @@ interface
     const
       nolinetai =[ait_label,
                   ait_regalloc,ait_tempalloc,
-                  ait_stabn,ait_stabs,ait_section,
-                  ait_cut,ait_marker,ait_align,ait_stab_function_name];
+{$ifdef GDB}
+                  ait_stabn,ait_stabs,ait_stab_function_name,
+{$endif GDB}
+                  ait_cut,ait_marker,ait_align,ait_section];
     var
       s,
       prefix,
@@ -408,8 +410,8 @@ interface
        ait_regalloc,
        ait_tempalloc : ;
        ait_section : begin
-                       if LastSec<>sec_none then
-                        AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
+                       if LasTSec<>sec_none then
+                        AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');
                        if tai_section(hp).sec<>sec_none then
                         begin
                           AsmLn;
@@ -417,7 +419,7 @@ interface
                                      'SEGMENT'#9'PARA PUBLIC USE32 '''+
                                      target_asm.secnames[tai_section(hp).sec]+'''');
                         end;
-                       LastSec:=tai_section(hp).sec;
+                       LasTSec:=tai_section(hp).sec;
                      end;
          ait_align : begin
                      { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION   }
@@ -645,8 +647,8 @@ ait_stab_function_name : ;
                         AsmClear
                        else
                         begin
-                          if LastSec<>sec_none then
-                           AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
+                          if LasTSec<>sec_none then
+                           AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');
                           AsmLn;
                           AsmWriteLn(#9'END');
                           AsmClose;
@@ -658,7 +660,7 @@ ait_stab_function_name : ;
                         begin
                           if tai(hp.next).typ=ait_section then
                            begin
-                             lastsec:=tai_section(hp.next).sec;
+                             lasTSec:=tai_section(hp.next).sec;
                            end;
                           hp:=tai(hp.next);
                         end;
@@ -668,10 +670,10 @@ ait_stab_function_name : ;
                        { I was told that this isn't necesarry because }
                        { the labels generated by FPC are unique (FK)  }
                        { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
-                       if lastsec<>sec_none then
-                          AsmWriteLn('_'+target_asm.secnames[lastsec]+#9#9+
+                       if lasTSec<>sec_none then
+                          AsmWriteLn('_'+target_asm.secnames[lasTSec]+#9#9+
                                      'SEGMENT'#9'PARA PUBLIC USE32 '''+
-                                     target_asm.secnames[lastsec]+'''');
+                                     target_asm.secnames[lasTSec]+'''');
                        AsmStartSize:=AsmSize;
                      end;
            ait_marker :
@@ -738,7 +740,7 @@ ait_stab_function_name : ;
       if assigned(current_module.mainsource) then
        comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^);
 {$endif}
-      LastSec:=sec_none;
+      LasTSec:=sec_none;
       AsmWriteLn(#9'.386p');
       { masm 6.11 does not seem to like LOCALS PM }
       if (aktoutputformat = as_i386_tasm) then
@@ -749,8 +751,6 @@ ait_stab_function_name : ;
       AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
       AsmLn;
 
-      countlabelref:=false;
-
       WriteExternals;
 
     { INTEL ASM doesn't support stabs
@@ -762,7 +762,6 @@ ait_stab_function_name : ;
       WriteTree(rttilist);
       WriteTree(resourcestringlist);
       WriteTree(bsssegment);
-      countlabelref:=true;
 
       AsmWriteLn(#9'END');
       AsmLn;
@@ -795,7 +794,7 @@ ait_stab_function_name : ;
             secnames : ('',
               'CODE','DATA','BSS',
               '','','','','','',
-              '','')
+              '','','')
           );
 
        as_i386_masm_info : tasminfo =
@@ -815,7 +814,7 @@ ait_stab_function_name : ;
             secnames : ('',
               'CODE','DATA','BSS',
               '','','','','','',
-              '','')
+              '','','')
           );
 
 initialization
@@ -824,7 +823,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.21  2002-05-18 13:34:21  peter
+  Revision 1.22  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.21  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.20  2002/05/16 19:46:50  carl

compiler/i386/ag386nsm.pas

@@ -27,7 +27,7 @@ unit ag386nsm;
 
 interface
 
-    uses aasm,assemble;
+    uses aasmbase,aasmtai,aasmcpu,assemble;
 
     type
       T386NasmAssembler = class(texternalassembler)
@@ -45,7 +45,7 @@ interface
       sysutils,
 {$endif}
       cutils,globtype,globals,systems,cclasses,
-      fmodule,finput,verbose,cpubase,cpuasm,tainst
+      fmodule,finput,verbose,cpubase
       ;
 
     const
@@ -319,7 +319,7 @@ interface
  ****************************************************************************}
 
     var
-      LastSec : tsection;
+      LasTSec : TSection;
 
     const
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
@@ -350,8 +350,10 @@ interface
       allocstr : array[boolean] of string[10]=(' released',' allocated');
       nolinetai =[ait_label,
                   ait_regalloc,ait_tempalloc,
-                  ait_stabn,ait_stabs,ait_section,
-                  ait_cut,ait_marker,ait_align,ait_stab_function_name];
+{$ifdef GDB}
+                  ait_stabn,ait_stabs,ait_stab_function_name,
+{$endif GDB}
+                  ait_cut,ait_marker,ait_align,ait_section];
     var
       s : string;
       {prefix,
@@ -436,15 +438,15 @@ interface
            ait_regalloc :
              begin
                if (cs_asm_regalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Register '+std_reg2str[tairegalloc(hp).reg]+
-                   allocstr[tairegalloc(hp).allocation]);
+                 AsmWriteLn(target_asm.comment+'Register '+std_reg2str[tai_regalloc(hp).reg]+
+                   allocstr[tai_regalloc(hp).allocation]);
              end;
 
            ait_tempalloc :
              begin
                if (cs_asm_tempalloc in aktglobalswitches) then
-                 AsmWriteLn(target_asm.comment+'Temp '+tostr(taitempalloc(hp).temppos)+','+
-                   tostr(taitempalloc(hp).tempsize)+allocstr[taitempalloc(hp).allocation]);
+                 AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
+                   tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]);
              end;
 
            ait_section :
@@ -454,7 +456,7 @@ interface
                   AsmLn;
                   AsmWriteLn('SECTION '+target_asm.secnames[tai_section(hp).sec]);
                 end;
-               LastSec:=tai_section(hp).sec;
+               LasTSec:=tai_section(hp).sec;
              end;
 
            ait_align :
@@ -702,11 +704,11 @@ interface
                while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
                 begin
                   if tai(hp.next).typ=ait_section then
-                    lastsec:=tai_section(hp.next).sec;
+                    lasTSec:=tai_section(hp.next).sec;
                   hp:=tai(hp.next);
                 end;
-               if lastsec<>sec_none then
-                 AsmWriteLn('SECTION '+target_asm.secnames[lastsec]);
+               if lasTSec<>sec_none then
+                 AsmWriteLn('SECTION '+target_asm.secnames[lasTSec]);
                AsmStartSize:=AsmSize;
              end;
 
@@ -746,11 +748,10 @@ interface
       if assigned(current_module.mainsource) then
        comment(v_info,'Start writing nasm-styled assembler output for '+current_module.mainsource^);
 {$endif}
-      LastSec:=sec_none;
+      LasTSec:=sec_none;
       AsmWriteLn('BITS 32');
       AsmLn;
 
-      countlabelref:=false;
       lastfileinfo.line:=-1;
       lastfileinfo.fileindex:=0;
       lastinfile:=nil;
@@ -772,7 +773,6 @@ interface
       if not UseDeffileForExport and assigned(exportssection) then
         Writetree(exportssection);
       Writetree(resourcesection);
-      countlabelref:=true;
 
       AsmLn;
 {$ifdef EXTDEBUG}
@@ -804,7 +804,7 @@ interface
             secnames : ('',
               '.text','.data','.bss',
               '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr')
+              '.stab','.stabstr','')
           );
 
        as_i386_nasmwin32_info : tasminfo =
@@ -824,7 +824,7 @@ interface
             secnames : ('',
               '.text','.data','.bss',
               '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr')
+              '.stab','.stabstr','')
           );
 
        as_i386_nasmobj_info : tasminfo =
@@ -844,7 +844,7 @@ interface
             secnames : ('',
               '.text','.data','.bss',
               '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr')
+              '.stab','.stabstr','')
           );
 
        as_i386_nasmwdosx_info : tasminfo =
@@ -864,7 +864,7 @@ interface
             secnames : ('',
               '.text','.data','.bss',
               '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr')
+              '.stab','.stabstr','')
           );
 
 
@@ -885,7 +885,7 @@ interface
             secnames : ('',
               '.text','.data','.bss',
               '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr')
+              '.stab','.stabstr','')
           );
 
 
@@ -898,7 +898,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.20  2002-05-18 13:34:21  peter
+  Revision 1.21  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.20  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.19  2002/05/16 19:46:50  carl

compiler/i386/aopt386.pas

@@ -28,7 +28,7 @@ Unit aopt386;
 Interface
 
 Uses
-  aasm;
+  aasmbase,aasmtai,aasmcpu;
 
 Procedure Optimize(AsmL: TAasmOutput);
 
@@ -118,7 +118,11 @@ End;
 End.
 {
   $Log$
-  Revision 1.6  2002-05-18 13:34:21  peter
+  Revision 1.7  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.6  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.5  2002/05/16 19:46:50  carl

compiler/i386/cga.pas

@@ -28,8 +28,8 @@ unit cga;
 interface
 
     uses
-       cpuinfo,cpubase,cpuasm,cginfo,
-       symconst,symtype,symdef,aasm;
+       cpuinfo,cpubase,cginfo,
+       symconst,symtype,symdef,aasmbase,aasmtai,aasmcpu;
 
 {$define TESTGETTEMP to store const that
  are written into temps for later release PM }
@@ -174,7 +174,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  2002-05-18 13:34:21  peter
+  Revision 1.33  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.32  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.31  2002/05/16 19:46:50  carl

compiler/i386/cgcpu.pas

@@ -29,7 +29,8 @@ unit cgcpu;
 
     uses
        cginfo,cgbase,cgobj,cg64f32,
-       aasm,cpuasm,cpubase,cpuinfo,
+       aasmbase,aasmtai,aasmcpu,
+       cpubase,cpuinfo,
        node,symconst;
 
     type
@@ -160,7 +161,7 @@ unit cgcpu;
     uses
        globtype,globals,verbose,systems,cutils,
        symdef,symsym,types,
-       rgobj,tgobj,rgcpu,tainst;
+       rgobj,tgobj,rgcpu;
 
 {$ifndef NOTARGETWIN32}
     const
@@ -1279,7 +1280,7 @@ unit cgcpu;
            begin
               rg.getexplicitregisterint(list,R_EDI);
               a_loadaddr_ref_reg(list,dest,R_EDI);
-              list.concat(Tairegalloc.Alloc(R_ESI));
+              list.concat(tai_regalloc.Alloc(R_ESI));
               if loadref then
                 a_load_ref_reg(list,OS_ADDR,source,R_ESI)
               else
@@ -1319,7 +1320,7 @@ unit cgcpu;
                      list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
                 end;
               rg.ungetregisterint(list,R_EDI);
-              list.concat(Tairegalloc.DeAlloc(R_ESI));
+              list.concat(tai_regalloc.DeAlloc(R_ESI));
               if ecxpushed then
                 list.concat(Taicpu.Op_reg(A_POP,S_L,R_ECX))
               else
@@ -1349,9 +1350,9 @@ unit cgcpu;
          a_param_reg(list,OS_ADDR,accumulator,1);
          a_reg_dealloc(list,accumulator);
          a_call_name(list,'FPC_SETJMP');
-         list.concat(Tairegalloc.Alloc(accumulator));
+         list.concat(tai_regalloc.Alloc(accumulator));
          list.concat(Taicpu.op_reg(A_PUSH,S_L,accumulator));
-         list.concat(Tairegalloc.DeAlloc(accumulator));
+         list.concat(tai_regalloc.DeAlloc(accumulator));
          a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,accumulator,exceptlabel);
       end;
 
@@ -1783,7 +1784,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2002-07-01 16:23:55  peter
+  Revision 1.25  2002-07-01 18:46:30  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.24  2002/07/01 16:23:55  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/i386/cpuasm.pas

@@ -1,1863 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
-
-    Contains the assembler object for the i386
-
-    * This code was inspired by the NASM sources
-      The Netwide Assembler is Copyright (c) 1996 Simon Tatham and
-      Julian Hall. All rights reserved.
-
-    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 cpuasm;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  cclasses,tainst,
-  aasm,globals,verbose,
-  cpuinfo,cpubase;
-
-const
-  MaxPrefixes=4;
-
-{*****************************************************************************
-                              Instruction table
-*****************************************************************************}
-
-const
-{ Operand types }
-  OT_NONE      = $00000000;
-
-  OT_BITS8     = $00000001;  { size, and other attributes, of the operand  }
-  OT_BITS16    = $00000002;
-  OT_BITS32    = $00000004;
-  OT_BITS64    = $00000008;  { FPU only  }
-  OT_BITS80    = $00000010;
-  OT_FAR       = $00000020;  { this means 16:16 or 16:32, like in CALL/JMP }
-  OT_NEAR      = $00000040;
-  OT_SHORT     = $00000080;
-
-  OT_SIZE_MASK = $000000FF;  { all the size attributes  }
-  OT_NON_SIZE  = longint(not OT_SIZE_MASK);
-
-  OT_SIGNED    = $00000100;  { the operand need to be signed -128-127 }
-
-  OT_TO        = $00000200;  { operand is followed by a colon  }
-                             { reverse effect in FADD, FSUB &c  }
-  OT_COLON     = $00000400;
-
-  OT_REGISTER  = $00001000;
-  OT_IMMEDIATE = $00002000;
-  OT_IMM8      = $00002001;
-  OT_IMM16     = $00002002;
-  OT_IMM32     = $00002004;
-  OT_IMM64     = $00002008;
-  OT_IMM80     = $00002010;
-  OT_REGMEM    = $00200000;  { for r/m, ie EA, operands  }
-  OT_REGNORM   = $00201000;  { 'normal' reg, qualifies as EA  }
-  OT_REG8      = $00201001;
-  OT_REG16     = $00201002;
-  OT_REG32     = $00201004;
-  OT_MMXREG    = $00201008;  { MMX registers  }
-  OT_XMMREG    = $00201010;  { Katmai registers  }
-  OT_MEMORY    = $00204000;  { register number in 'basereg'  }
-  OT_MEM8      = $00204001;
-  OT_MEM16     = $00204002;
-  OT_MEM32     = $00204004;
-  OT_MEM64     = $00204008;
-  OT_MEM80     = $00204010;
-  OT_FPUREG    = $01000000;  { floating point stack registers  }
-  OT_FPU0      = $01000800;  { FPU stack register zero  }
-  OT_REG_SMASK = $00070000;  { special register operands: these may be treated differently  }
-                             { a mask for the following  }
-  OT_REG_ACCUM = $00211000;  { accumulator: AL, AX or EAX  }
-  OT_REG_AL    = $00211001;    { REG_ACCUM | BITSxx  }
-  OT_REG_AX    = $00211002;    { ditto  }
-  OT_REG_EAX   = $00211004;    { and again  }
-  OT_REG_COUNT = $00221000;  { counter: CL, CX or ECX  }
-  OT_REG_CL    = $00221001;    { REG_COUNT | BITSxx  }
-  OT_REG_CX    = $00221002;    { ditto  }
-  OT_REG_ECX   = $00221004;    { another one  }
-  OT_REG_DX    = $00241002;
-
-  OT_REG_SREG  = $00081002;  { any segment register  }
-  OT_REG_CS    = $01081002;  { CS  }
-  OT_REG_DESS  = $02081002;  { DS, ES, SS (non-CS 86 registers)  }
-  OT_REG_FSGS  = $04081002;  { FS, GS (386 extended registers)  }
-
-  OT_REG_CDT   = $00101004;  { CRn, DRn and TRn  }
-  OT_REG_CREG  = $08101004;  { CRn  }
-  OT_REG_CR4   = $08101404;  { CR4 (Pentium only)  }
-  OT_REG_DREG  = $10101004;  { DRn  }
-  OT_REG_TREG  = $20101004;  { TRn  }
-
-  OT_MEM_OFFS  = $00604000;  { special type of EA  }
-                             { simple [address] offset  }
-  OT_ONENESS   = $00800000;  { special type of immediate operand  }
-                             { so UNITY == IMMEDIATE | ONENESS  }
-  OT_UNITY     = $00802000;  { for shift/rotate instructions  }
-
-{Instruction flags }
-  IF_NONE   = $00000000;
-  IF_SM     = $00000001;        { size match first two operands  }
-  IF_SM2    = $00000002;
-  IF_SB     = $00000004;  { unsized operands can't be non-byte  }
-  IF_SW     = $00000008;  { unsized operands can't be non-word  }
-  IF_SD     = $00000010;  { unsized operands can't be nondword  }
-  IF_AR0    = $00000020;  { SB, SW, SD applies to argument 0  }
-  IF_AR1    = $00000040;  { SB, SW, SD applies to argument 1  }
-  IF_AR2    = $00000060;  { SB, SW, SD applies to argument 2  }
-  IF_ARMASK = $00000060;  { mask for unsized argument spec  }
-  IF_PRIV   = $00000100;  { it's a privileged instruction  }
-  IF_SMM    = $00000200;  { it's only valid in SMM  }
-  IF_PROT   = $00000400;  { it's protected mode only  }
-  IF_UNDOC  = $00001000;  { it's an undocumented instruction  }
-  IF_FPU    = $00002000;  { it's an FPU instruction  }
-  IF_MMX    = $00004000;  { it's an MMX instruction  }
-  IF_3DNOW  = $00008000;  { it's a 3DNow! instruction  }
-  IF_SSE    = $00010000;  { it's a SSE (KNI, MMX2) instruction  }
-  IF_PMASK  =
-     longint($FF000000);  { the mask for processor types  }
-  IF_PFMASK =
-     longint($F001FF00);  { the mask for disassembly "prefer"  }
-  IF_8086   = $00000000;  { 8086 instruction  }
-  IF_186    = $01000000;  { 186+ instruction  }
-  IF_286    = $02000000;  { 286+ instruction  }
-  IF_386    = $03000000;  { 386+ instruction  }
-  IF_486    = $04000000;  { 486+ instruction  }
-  IF_PENT   = $05000000;  { Pentium instruction  }
-  IF_P6     = $06000000;  { P6 instruction  }
-  IF_KATMAI = $07000000;  { Katmai instructions  }
-  IF_CYRIX  = $10000000;  { Cyrix-specific instruction  }
-  IF_AMD    = $20000000;  { AMD-specific instruction  }
-  { added flags }
-  IF_PRE    = $40000000;  { it's a prefix instruction }
-  IF_PASS2  =
-     longint($80000000);  { if the instruction can change in a second pass }
-
-  { Size of the instruction table converted by nasmconv.pas }
-  instabentries = {$i i386nop.inc}
-  maxinfolen    = 8;
-
-type
-  tinsentry=packed record
-    opcode  : tasmop;
-    ops     : byte;
-    optypes : array[0..2] of longint;
-    code    : array[0..maxinfolen] of char;
-    flags   : longint;
-  end;
-  pinsentry=^tinsentry;
-
-  TInsTabCache=array[TasmOp] of longint;
-  PInsTabCache=^TInsTabCache;
-
-const
-  InsTab:array[0..instabentries-1] of TInsEntry={$i i386tab.inc}
-
-var
-  InsTabCache : PInsTabCache;
-{*****************************************************************************}
-
-type
-  TOperandOrder = (op_intel,op_att);
-
-  { alignment for operator }
-  tai_align = class(tai_align_abstract)
-     reg       : tregister;
-     constructor create(b:byte);
-     constructor create_op(b: byte; _op: byte);
-     function getfillbuf:pchar;override;
-  end;
-
-  taicpu = class(taicpu_abstract)
-     opsize    : topsize;
-     constructor op_none(op : tasmop;_size : topsize);
-
-     constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister);
-     constructor op_const(op : tasmop;_size : topsize;_op1 : aword);
-     constructor op_ref(op : tasmop;_size : topsize;const _op1 : treference);
-
-     constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
-     constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference);
-     constructor op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aword);
-
-     constructor op_const_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister);
-     constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aword);
-     constructor op_const_ref(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference);
-
-     constructor op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister);
-     { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
-     constructor op_ref_ref(op : tasmop;_size : topsize;const _op1,_op2 : treference);
-
-     constructor op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
-     constructor op_const_reg_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;_op3 : tregister);
-     constructor op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference;_op3 : tregister);
-     constructor op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister; const _op3 : treference);
-     constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;const _op3 : treference);
-
-     { this is for Jmp instructions }
-     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
-
-     constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
-     constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
-     constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
-     constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
-
-     procedure changeopsize(siz:topsize);
-
-     function  GetString:string;
-     procedure CheckNonCommutativeOpcodes;
-  private
-     FOperandOrder : TOperandOrder;
-     procedure init(_size : topsize); { this need to be called by all constructor }
-{$ifndef NOAG386BIN}
-  public
-     { the next will reset all instructions that can change in pass 2 }
-     procedure ResetPass1;
-     procedure ResetPass2;
-     function  CheckIfValid:boolean;
-     function  Pass1(offset:longint):longint;virtual;
-     procedure Pass2;virtual;
-     procedure SetOperandOrder(order:TOperandOrder);
-  private
-     { next fields are filled in pass1, so pass2 is faster }
-     insentry  : PInsEntry;
-     insoffset,
-     inssize   : longint;
-     LastInsOffset : longint; { need to be public to be reset }
-     function  InsEnd:longint;
-     procedure create_ot;
-     function  Matches(p:PInsEntry):longint;
-     function  calcsize(p:PInsEntry):longint;
-     procedure gencode;
-     function  NeedAddrPrefix(opidx:byte):boolean;
-     procedure Swatoperands;
-{$endif NOAG386BIN}
-  end;
-
-  procedure InitAsm;
-  procedure DoneAsm;
-
-
-implementation
-
-uses
-  cutils,
-  ogbase,
-  ag386att;
-
-const
-  { Intel style operands ! }
-  opsize_2_type:array[0..2,topsize] of longint=(
-    (OT_NONE,
-     OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS16,OT_BITS32,OT_BITS32,
-     OT_BITS16,OT_BITS32,OT_BITS64,
-     OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
-     OT_NEAR,OT_FAR,OT_SHORT
-    ),
-    (OT_NONE,
-     OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS8,OT_BITS8,OT_BITS16,
-     OT_BITS16,OT_BITS32,OT_BITS64,
-     OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
-     OT_NEAR,OT_FAR,OT_SHORT
-    ),
-    (OT_NONE,
-     OT_BITS8,OT_BITS16,OT_BITS32,OT_NONE,OT_NONE,OT_NONE,
-     OT_BITS16,OT_BITS32,OT_BITS64,
-     OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
-     OT_NEAR,OT_FAR,OT_SHORT
-    )
-  );
-
-  { Convert reg to operand type }
-  reg2type : array[firstreg..lastreg] of longint = (OT_NONE,
-    OT_REG_EAX,OT_REG_ECX,OT_REG32,OT_REG32,OT_REG32,OT_REG32,OT_REG32,OT_REG32,
-    OT_REG_AX,OT_REG_CX,OT_REG_DX,OT_REG16,OT_REG16,OT_REG16,OT_REG16,OT_REG16,
-    OT_REG_AL,OT_REG_CL,OT_REG8,OT_REG8,OT_REG8,OT_REG8,OT_REG8,OT_REG8,
-    OT_REG_CS,OT_REG_DESS,OT_REG_DESS,OT_REG_DESS,OT_REG_FSGS,OT_REG_FSGS,
-    OT_FPU0,OT_FPU0,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,
-    OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,
-    OT_REG_CREG,OT_REG_CREG,OT_REG_CREG,OT_REG_CR4,
-    OT_REG_TREG,OT_REG_TREG,OT_REG_TREG,OT_REG_TREG,OT_REG_TREG,
-    OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,OT_MMXREG,
-    OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG,OT_XMMREG
-  );
-
-
-{****************************************************************************
-                              TAI_ALIGN
- ****************************************************************************}
-
-    constructor tai_align.create(b: byte);
-      begin
-        inherited create(b);
-        reg := R_ECX;
-      end;
-
-
-    constructor tai_align.create_op(b: byte; _op: byte);
-      begin
-        inherited create_op(b,_op);
-        reg := R_NO;
-      end;
-
-
-    function tai_align.getfillbuf:pchar;
-      const
-        alignarray:array[0..5] of string[8]=(
-          #$8D#$B4#$26#$00#$00#$00#$00,
-          #$8D#$B6#$00#$00#$00#$00,
-          #$8D#$74#$26#$00,
-          #$8D#$76#$00,
-          #$89#$F6,
-          #$90
-        );
-      var
-        bufptr : pchar;
-        j : longint;
-      begin
-        if not use_op then
-         begin
-           bufptr:=@buf;
-           while (fillsize>0) do
-            begin
-              for j:=0 to 5 do
-               if (fillsize>=length(alignarray[j])) then
-                break;
-              move(alignarray[j][1],bufptr^,length(alignarray[j]));
-              inc(bufptr,length(alignarray[j]));
-              dec(fillsize,length(alignarray[j]));
-            end;
-         end;
-        getfillbuf:=pchar(@buf);
-      end;
-
-
-{*****************************************************************************
-                                 Taicpu Constructors
-*****************************************************************************}
-
-    procedure taicpu.changeopsize(siz:topsize);
-      begin
-        opsize:=siz;
-      end;
-
-
-    procedure taicpu.init(_size : topsize);
-      begin
-         { default order is att }
-         FOperandOrder:=op_att;
-         segprefix:=R_NO;
-         opsize:=_size;
-{$ifndef NOAG386BIN}
-         insentry:=nil;
-         LastInsOffset:=-1;
-         InsOffset:=0;
-         InsSize:=0;
-{$endif}
-      end;
-
-
-    constructor taicpu.op_none(op : tasmop;_size : topsize);
-      begin
-         inherited create(op);
-         init(_size);
-      end;
-
-
-    constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=1;
-         loadreg(0,_op1);
-      end;
-
-
-    constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : aword);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=1;
-         loadconst(0,_op1);
-      end;
-
-
-    constructor taicpu.op_ref(op : tasmop;_size : topsize;const _op1 : treference);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=1;
-         loadref(0,_op1);
-      end;
-
-
-    constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-      end;
-
-
-    constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aword);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadreg(0,_op1);
-         loadconst(1,_op2);
-      end;
-
-
-    constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadreg(0,_op1);
-         loadref(1,_op2);
-      end;
-
-
-    constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadconst(0,_op1);
-         loadreg(1,_op2);
-      end;
-
-
-    constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aword);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadconst(0,_op1);
-         loadconst(1,_op2);
-      end;
-
-
-    constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadconst(0,_op1);
-         loadref(1,_op2);
-      end;
-
-
-    constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadref(0,_op1);
-         loadreg(1,_op2);
-      end;
-
-
-    constructor taicpu.op_ref_ref(op : tasmop;_size : topsize;const _op1,_op2 : treference);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadref(0,_op1);
-         loadref(1,_op2);
-      end;
-
-
-    constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadreg(2,_op3);
-      end;
-
-    constructor taicpu.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;_op3 : tregister);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=3;
-         loadconst(0,_op1);
-         loadreg(1,_op2);
-         loadreg(2,_op3);
-      end;
-
-    constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;const _op3 : treference);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadref(2,_op3);
-      end;
-
-
-    constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aword;const _op2 : treference;_op3 : tregister);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=3;
-         loadconst(0,_op1);
-         loadref(1,_op2);
-         loadreg(2,_op3);
-      end;
-
-
-    constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aword;_op2 : tregister;const _op3 : treference);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=3;
-         loadconst(0,_op1);
-         loadreg(1,_op2);
-         loadref(2,_op3);
-      end;
-
-
-    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
-      begin
-         inherited create(op);
-         init(_size);
-         condition:=cond;
-         ops:=1;
-         loadsymbol(0,_op1,0);
-      end;
-
-
-    constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=1;
-         loadsymbol(0,_op1,0);
-      end;
-
-
-    constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=1;
-         loadsymbol(0,_op1,_op1ofs);
-      end;
-
-
-    constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadsymbol(0,_op1,_op1ofs);
-         loadreg(1,_op2);
-      end;
-
-
-    constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
-      begin
-         inherited create(op);
-         init(_size);
-         ops:=2;
-         loadsymbol(0,_op1,_op1ofs);
-         loadref(1,_op2);
-      end;
-
-    function taicpu.GetString:string;
-      var
-        i : longint;
-        s : string;
-        addsize : boolean;
-      begin
-        s:='['+std_op2str[opcode];
-        for i:=1to ops do
-         begin
-           if i=1 then
-            s:=s+' '
-           else
-            s:=s+',';
-           { type }
-           addsize:=false;
-           if (oper[i-1].ot and OT_XMMREG)=OT_XMMREG then
-            s:=s+'xmmreg'
-           else
-             if (oper[i-1].ot and OT_MMXREG)=OT_MMXREG then
-              s:=s+'mmxreg'
-           else
-             if (oper[i-1].ot and OT_FPUREG)=OT_FPUREG then
-              s:=s+'fpureg'
-           else
-            if (oper[i-1].ot and OT_REGISTER)=OT_REGISTER then
-             begin
-               s:=s+'reg';
-               addsize:=true;
-             end
-           else
-            if (oper[i-1].ot and OT_IMMEDIATE)=OT_IMMEDIATE then
-             begin
-               s:=s+'imm';
-               addsize:=true;
-             end
-           else
-            if (oper[i-1].ot and OT_MEMORY)=OT_MEMORY then
-             begin
-               s:=s+'mem';
-               addsize:=true;
-             end
-           else
-             s:=s+'???';
-           { size }
-           if addsize then
-            begin
-              if (oper[i-1].ot and OT_BITS8)<>0 then
-                s:=s+'8'
-              else
-               if (oper[i-1].ot and OT_BITS16)<>0 then
-                s:=s+'16'
-              else
-               if (oper[i-1].ot and OT_BITS32)<>0 then
-                s:=s+'32'
-              else
-                s:=s+'??';
-              { signed }
-              if (oper[i-1].ot and OT_SIGNED)<>0 then
-               s:=s+'s';
-            end;
-         end;
-        GetString:=s+']';
-      end;
-
-
-    procedure taicpu.Swatoperands;
-      var
-        p : TOper;
-      begin
-        { Fix the operands which are in AT&T style and we need them in Intel style }
-        case ops of
-          2 : begin
-                { 0,1 -> 1,0 }
-                p:=oper[0];
-                oper[0]:=oper[1];
-                oper[1]:=p;
-              end;
-          3 : begin
-                { 0,1,2 -> 2,1,0 }
-                p:=oper[0];
-                oper[0]:=oper[2];
-                oper[2]:=p;
-              end;
-        end;
-      end;
-
-
-    procedure taicpu.SetOperandOrder(order:TOperandOrder);
-      begin
-        if FOperandOrder<>order then
-         begin
-           Swatoperands;
-           FOperandOrder:=order;
-         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 taicpu.CheckNonCommutativeOpcodes;
-begin
-  if ((ops=2) and
-     (oper[0].typ=top_reg) and
-     (oper[1].typ=top_reg) and
-     { if the first is ST and the second is also a register
-       it is necessarily ST1 .. ST7 }
-     (oper[0].reg=R_ST)) or
-     { ((ops=1) and
-      (oper[0].typ=top_reg) and
-      (oper[0].reg in [R_ST1..R_ST7]))  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
-      (oper[0].typ=top_reg) and
-      (oper[0].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;
-
-
-{*****************************************************************************
-                                Assembler
-*****************************************************************************}
-
-{$ifndef NOAG386BIN}
-
-type
-  ea=packed record
-    sib_present : boolean;
-    bytes : byte;
-    size  : byte;
-    modrm : byte;
-    sib   : byte;
-  end;
-
-procedure taicpu.create_ot;
-{
-  this function will also fix some other fields which only needs to be once
-}
-var
-  i,l,relsize : longint;
-begin
-  if ops=0 then
-   exit;
-  { update oper[].ot field }
-  for i:=0 to ops-1 do
-   with oper[i] do
-    begin
-      case typ of
-        top_reg :
-          ot:=reg2type[reg];
-        top_ref :
-          begin
-          { create ot field }
-            if (ot and OT_SIZE_MASK)=0 then
-              ot:=OT_MEMORY or opsize_2_type[i,opsize]
-            else
-              ot:=OT_MEMORY or (ot and OT_SIZE_MASK);
-            if (ref^.base=R_NO) and (ref^.index=R_NO) then
-              ot:=ot or OT_MEM_OFFS;
-          { fix scalefactor }
-            if (ref^.index=R_NO) then
-             ref^.scalefactor:=0
-            else
-             if (ref^.scalefactor=0) then
-              ref^.scalefactor:=1;
-          end;
-        top_const :
-          begin
-            if (opsize<>S_W) and (longint(val)>=-128) and (val<=127) then
-              ot:=OT_IMM8 or OT_SIGNED
-            else
-              ot:=OT_IMMEDIATE or opsize_2_type[i,opsize];
-          end;
-        top_symbol :
-          begin
-            if LastInsOffset=-1 then
-             l:=0
-            else
-             l:=InsOffset-LastInsOffset;
-            inc(l,symofs);
-            if assigned(sym) then
-             inc(l,sym.address);
-            { instruction size will then always become 2 (PFV) }
-            relsize:=(InsOffset+2)-l;
-            if (not assigned(sym) or
-                ((sym.bind<>AB_EXTERNAL) and (sym.address<>0))) and
-               (relsize>=-128) and (relsize<=127) then
-             ot:=OT_IMM32 or OT_SHORT
-            else
-             ot:=OT_IMM32 or OT_NEAR;
-          end;
-      end;
-    end;
-end;
-
-
-function taicpu.InsEnd:longint;
-begin
-  InsEnd:=InsOffset+InsSize;
-end;
-
-
-function taicpu.Matches(p:PInsEntry):longint;
-{ * IF_SM stands for Size Match: any operand whose size is not
- * explicitly specified by the template is `really' intended to be
- * the same size as the first size-specified operand.
- * Non-specification is tolerated in the input instruction, but
- * _wrong_ specification is not.
- *
- * IF_SM2 invokes Size Match on only the first _two_ operands, for
- * three-operand instructions such as SHLD: it implies that the
- * first two operands must match in size, but that the third is
- * required to be _unspecified_.
- *
- * IF_SB invokes Size Byte: operands with unspecified size in the
- * template are really bytes, and so no non-byte specification in
- * the input instruction will be tolerated. IF_SW similarly invokes
- * Size Word, and IF_SD invokes Size Doubleword.
- *
- * (The default state if neither IF_SM nor IF_SM2 is specified is
- * that any operand with unspecified size in the template is
- * required to have unspecified size in the instruction too...)
-}
-var
-  i,j,asize,oprs : longint;
-  siz : array[0..2] of longint;
-begin
-  Matches:=100;
-
-  { Check the opcode and operands }
-  if (p^.opcode<>opcode) or (p^.ops<>ops) then
-   begin
-     Matches:=0;
-     exit;
-   end;
-
-  { Check that no spurious colons or TOs are present }
-  for i:=0 to p^.ops-1 do
-   if (oper[i].ot and (not p^.optypes[i]) and (OT_COLON or OT_TO))<>0 then
-    begin
-      Matches:=0;
-      exit;
-    end;
-
-  { Check that the operand flags all match up }
-  for i:=0 to p^.ops-1 do
-   begin
-     if ((p^.optypes[i] and (not oper[i].ot)) or
-         ((p^.optypes[i] and OT_SIZE_MASK) and
-          ((p^.optypes[i] xor oper[i].ot) and OT_SIZE_MASK)))<>0 then
-      begin
-        if ((p^.optypes[i] and (not oper[i].ot) and OT_NON_SIZE) or
-            (oper[i].ot and OT_SIZE_MASK))<>0 then
-         begin
-           Matches:=0;
-           exit;
-         end
-        else
-         Matches:=1;
-      end;
-   end;
-
-{ Check operand sizes }
-  { as default an untyped size can get all the sizes, this is different
-    from nasm, but else we need to do a lot checking which opcodes want
-    size or not with the automatic size generation }
-  asize:=longint($ffffffff);
-  if (p^.flags and IF_SB)<>0 then
-    asize:=OT_BITS8
-  else if (p^.flags and IF_SW)<>0 then
-    asize:=OT_BITS16
-  else if (p^.flags and IF_SD)<>0 then
-    asize:=OT_BITS32;
-  if (p^.flags and IF_ARMASK)<>0 then
-   begin
-     siz[0]:=0;
-     siz[1]:=0;
-     siz[2]:=0;
-     if (p^.flags and IF_AR0)<>0 then
-      siz[0]:=asize
-     else if (p^.flags and IF_AR1)<>0 then
-      siz[1]:=asize
-     else if (p^.flags and IF_AR2)<>0 then
-      siz[2]:=asize;
-   end
-  else
-   begin
-   { we can leave because the size for all operands is forced to be
-     the same
-     but not if IF_SB IF_SW or IF_SD is set PM }
-     if asize=-1 then
-       exit;
-     siz[0]:=asize;
-     siz[1]:=asize;
-     siz[2]:=asize;
-   end;
-
-  if (p^.flags and (IF_SM or IF_SM2))<>0 then
-   begin
-     if (p^.flags and IF_SM2)<>0 then
-      oprs:=2
-     else
-      oprs:=p^.ops;
-     for i:=0 to oprs-1 do
-      if ((p^.optypes[i] and OT_SIZE_MASK) <> 0) then
-       begin
-         for j:=0 to oprs-1 do
-          siz[j]:=p^.optypes[i] and OT_SIZE_MASK;
-         break;
-       end;
-    end
-   else
-    oprs:=2;
-
-  { Check operand sizes }
-  for i:=0 to p^.ops-1 do
-   begin
-     if ((p^.optypes[i] and OT_SIZE_MASK)=0) and
-        ((oper[i].ot and OT_SIZE_MASK and (not siz[i]))<>0) and
-        { Immediates can always include smaller size }
-        ((oper[i].ot and OT_IMMEDIATE)=0) and
-         (((p^.optypes[i] and OT_SIZE_MASK) or siz[i])<(oper[i].ot and OT_SIZE_MASK)) then
-      Matches:=2;
-   end;
-end;
-
-
-procedure taicpu.ResetPass1;
-begin
-  { we need to reset everything here, because the choosen insentry
-    can be invalid for a new situation where the previously optimized
-    insentry is not correct }
-  InsEntry:=nil;
-  InsSize:=0;
-  LastInsOffset:=-1;
-end;
-
-
-procedure taicpu.ResetPass2;
-begin
-  { we are here in a second pass, check if the instruction can be optimized }
-  if assigned(InsEntry) and
-     ((InsEntry^.flags and IF_PASS2)<>0) then
-   begin
-     InsEntry:=nil;
-     InsSize:=0;
-   end;
-  LastInsOffset:=-1;
-end;
-
-
-function taicpu.CheckIfValid:boolean;
-var
-  m,i : longint;
-begin
-  CheckIfValid:=false;
-{ Things which may only be done once, not when a second pass is done to
-  optimize }
-  if (Insentry=nil) or ((InsEntry^.flags and IF_PASS2)<>0) then
-   begin
-     { We need intel style operands }
-     SetOperandOrder(op_intel);
-     { create the .ot fields }
-     create_ot;
-     { set the file postion }
-     aktfilepos:=fileinfo;
-   end
-  else
-   begin
-     { we've already an insentry so it's valid }
-     CheckIfValid:=true;
-     exit;
-   end;
-{ Lookup opcode in the table }
-  InsSize:=-1;
-  i:=instabcache^[opcode];
-  if i=-1 then
-   begin
-{$ifdef TP}
-     Message1(asmw_e_opcode_not_in_table,'');
-{$else}
-     Message1(asmw_e_opcode_not_in_table,gas_op2str[opcode]);
-{$endif}
-     exit;
-   end;
-  insentry:=@instab[i];
-  while (insentry^.opcode=opcode) do
-   begin
-     m:=matches(insentry);
-     if m=100 then
-      begin
-        InsSize:=calcsize(insentry);
-        if (segprefix<>R_NO) then
-         inc(InsSize);
-        { For opsize if size if forced }
-        if (insentry^.flags and (IF_SB or IF_SW or IF_SD))<>0 then
-           begin
-             if (insentry^.flags and IF_ARMASK)=0 then
-               begin
-                 if (insentry^.flags and IF_SB)<>0 then
-                   begin
-                     if opsize=S_NO then
-                       opsize:=S_B;
-                   end
-                 else if (insentry^.flags and IF_SW)<>0 then
-                   begin
-                     if opsize=S_NO then
-                       opsize:=S_W;
-                   end
-                 else if (insentry^.flags and IF_SD)<>0 then
-                   begin
-                     if opsize=S_NO then
-                       opsize:=S_L;
-                   end;
-               end;
-           end;
-        CheckIfValid:=true;
-        exit;
-      end;
-     inc(i);
-     insentry:=@instab[i];
-   end;
-  if insentry^.opcode<>opcode then
-   Message1(asmw_e_invalid_opcode_and_operands,GetString);
-{ No instruction found, set insentry to nil and inssize to -1 }
-  insentry:=nil;
-  inssize:=-1;
-end;
-
-
-
-function taicpu.Pass1(offset:longint):longint;
-begin
-  Pass1:=0;
-{ Save the old offset and set the new offset }
-  InsOffset:=Offset;
-{ Things which may only be done once, not when a second pass is done to
-  optimize }
-  if Insentry=nil then
-   begin
-     { Check if error last time then InsSize=-1 }
-     if InsSize=-1 then
-      exit;
-     { set the file postion }
-     aktfilepos:=fileinfo;
-   end
-  else
-   begin
-{$ifdef PASS2FLAG}
-     { we are here in a second pass, check if the instruction can be optimized }
-     if (InsEntry^.flags and IF_PASS2)=0 then
-      begin
-        Pass1:=InsSize;
-        exit;
-      end;
-     { update the .ot fields, some top_const can be updated }
-     create_ot;
-{$endif}
-   end;
-{ Check if it's a valid instruction }
-  if CheckIfValid then
-   begin
-     LastInsOffset:=InsOffset;
-     Pass1:=InsSize;
-     exit;
-   end;
-  LastInsOffset:=-1;
-end;
-
-
-procedure taicpu.Pass2;
-var
-  c : longint;
-begin
-  { error in pass1 ? }
-  if insentry=nil then
-   exit;
-  aktfilepos:=fileinfo;
-  { Segment override }
-  if (segprefix<>R_NO) then
-   begin
-     case segprefix of
-       R_CS : c:=$2e;
-       R_DS : c:=$3e;
-       R_ES : c:=$26;
-       R_FS : c:=$64;
-       R_GS : c:=$65;
-       R_SS : c:=$36;
-     end;
-     objectdata.writebytes(c,1);
-     { fix the offset for GenNode }
-     inc(InsOffset);
-   end;
-  { Generate the instruction }
-  GenCode;
-end;
-
-
-function taicpu.NeedAddrPrefix(opidx:byte):boolean;
-var
-  i,b : tregister;
-begin
-  if (OT_MEMORY and (not oper[opidx].ot))=0 then
-   begin
-     i:=oper[opidx].ref^.index;
-     b:=oper[opidx].ref^.base;
-     if not(i in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) or
-        not(b in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) then
-      begin
-        NeedAddrPrefix:=true;
-        exit;
-      end;
-   end;
-  NeedAddrPrefix:=false;
-end;
-
-
-function regval(r:tregister):byte;
-begin
-  case r of
-    R_EAX,R_AX,R_AL,R_ES,R_CR0,R_DR0,R_ST,R_ST0,R_MM0,R_XMM0 :
-      regval:=0;
-    R_ECX,R_CX,R_CL,R_CS,R_DR1,R_ST1,R_MM1,R_XMM1 :
-      regval:=1;
-    R_EDX,R_DX,R_DL,R_SS,R_CR2,R_DR2,R_ST2,R_MM2,R_XMM2 :
-      regval:=2;
-    R_EBX,R_BX,R_BL,R_DS,R_CR3,R_DR3,R_TR3,R_ST3,R_MM3,R_XMM3 :
-      regval:=3;
-    R_ESP,R_SP,R_AH,R_FS,R_CR4,R_TR4,R_ST4,R_MM4,R_XMM4 :
-      regval:=4;
-    R_EBP,R_BP,R_CH,R_GS,R_TR5,R_ST5,R_MM5,R_XMM5 :
-      regval:=5;
-    R_ESI,R_SI,R_DH,R_DR6,R_TR6,R_ST6,R_MM6,R_XMM6 :
-      regval:=6;
-    R_EDI,R_DI,R_BH,R_DR7,R_TR7,R_ST7,R_MM7,R_XMM7 :
-      regval:=7;
-    else
-      begin
-        internalerror(777001);
-        regval:=0;
-      end;
-  end;
-end;
-
-
-function process_ea(const input:toper;var output:ea;rfield:longint):boolean;
-const
-  regs : array[0..63] of tregister=(
-    R_MM0, R_EAX, R_AX, R_AL, R_XMM0, R_NO, R_NO, R_NO,
-    R_MM1, R_ECX, R_CX, R_CL, R_XMM1, R_NO, R_NO, R_NO,
-    R_MM2, R_EDX, R_DX, R_DL, R_XMM2, R_NO, R_NO, R_NO,
-    R_MM3, R_EBX, R_BX, R_BL, R_XMM3, R_NO, R_NO, R_NO,
-    R_MM4, R_ESP, R_SP, R_AH, R_XMM4, R_NO, R_NO, R_NO,
-    R_MM5, R_EBP, R_BP, R_CH, R_XMM5, R_NO, R_NO, R_NO,
-    R_MM6, R_ESI, R_SI, R_DH, R_XMM6, R_NO, R_NO, R_NO,
-    R_MM7, R_EDI, R_DI, R_BH, R_XMM7, R_NO, R_NO, R_NO
-  );
-var
-  j     : longint;
-  i,b   : tregister;
-  sym   : tasmsymbol;
-  md,s  : byte;
-  base,index,scalefactor,
-  o     : longint;
-begin
-  process_ea:=false;
-{ register ? }
-  if (input.typ=top_reg) then
-   begin
-     j:=0;
-     while (j<=high(regs)) do
-      begin
-        if input.reg=regs[j] then
-         break;
-        inc(j);
-      end;
-     if j<=high(regs) then
-      begin
-        output.sib_present:=false;
-        output.bytes:=0;
-        output.modrm:=$c0 or (rfield shl 3) or (j shr 3);
-        output.size:=1;
-        process_ea:=true;
-      end;
-     exit;
-   end;
-{ memory reference }
-  i:=input.ref^.index;
-  b:=input.ref^.base;
-  s:=input.ref^.scalefactor;
-  o:=input.ref^.offset+input.ref^.offsetfixup;
-  sym:=input.ref^.symbol;
-{ it's direct address }
-  if (b=R_NO) and (i=R_NO) then
-   begin
-     { it's a pure offset }
-     output.sib_present:=false;
-     output.bytes:=4;
-     output.modrm:=5 or (rfield shl 3);
-   end
-  else
-  { it's an indirection }
-   begin
-     { 16 bit address? }
-     if not((i in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI]) and
-            (b in [R_NO,R_EAX,R_EBX,R_ECX,R_EDX,R_EBP,R_ESP,R_ESI,R_EDI])) then
-      Message(asmw_e_16bit_not_supported);
-{$ifdef OPTEA}
-     { make single reg base }
-     if (b=R_NO) and (s=1) then
-      begin
-        b:=i;
-        i:=R_NO;
-      end;
-     { convert [3,5,9]*EAX to EAX+[2,4,8]*EAX }
-     if (b=R_NO) and
-        (((s=2) and (i<>R_ESP)) or
-          (s=3) or (s=5) or (s=9)) then
-      begin
-        b:=i;
-        dec(s);
-      end;
-     { swap ESP into base if scalefactor is 1 }
-     if (s=1) and (i=R_ESP) then
-      begin
-        i:=b;
-        b:=R_ESP;
-      end;
-{$endif}
-     { wrong, for various reasons }
-     if (i=R_ESP) or ((s<>1) and (s<>2) and (s<>4) and (s<>8) and (i<>R_NO)) then
-      exit;
-     { base }
-     case b of
-       R_EAX : base:=0;
-       R_ECX : base:=1;
-       R_EDX : base:=2;
-       R_EBX : base:=3;
-       R_ESP : base:=4;
-       R_NO,
-       R_EBP : base:=5;
-       R_ESI : base:=6;
-       R_EDI : base:=7;
-     else
-       exit;
-     end;
-     { index }
-     case i of
-       R_EAX : index:=0;
-       R_ECX : index:=1;
-       R_EDX : index:=2;
-       R_EBX : index:=3;
-       R_NO  : index:=4;
-       R_EBP : index:=5;
-       R_ESI : index:=6;
-       R_EDI : index:=7;
-     else
-       exit;
-     end;
-     case s of
-      0,
-      1 : scalefactor:=0;
-      2 : scalefactor:=1;
-      4 : scalefactor:=2;
-      8 : scalefactor:=3;
-     else
-      exit;
-     end;
-     if (b=R_NO) or
-        ((b<>R_EBP) and (o=0) and (sym=nil)) then
-      md:=0
-     else
-      if ((o>=-128) and (o<=127) and (sym=nil)) then
-       md:=1
-      else
-       md:=2;
-     if (b=R_NO) or (md=2) then
-      output.bytes:=4
-     else
-      output.bytes:=md;
-     { SIB needed ? }
-     if (i=R_NO) and (b<>R_ESP) then
-      begin
-        output.sib_present:=false;
-        output.modrm:=(md shl 6) or (rfield shl 3) or base;
-      end
-     else
-      begin
-        output.sib_present:=true;
-        output.modrm:=(md shl 6) or (rfield shl 3) or 4;
-        output.sib:=(scalefactor shl 6) or (index shl 3) or base;
-      end;
-   end;
-  if output.sib_present then
-   output.size:=2+output.bytes
-  else
-   output.size:=1+output.bytes;
-  process_ea:=true;
-end;
-
-
-function taicpu.calcsize(p:PInsEntry):longint;
-var
-  codes : pchar;
-  c     : byte;
-  len     : longint;
-  ea_data : ea;
-begin
-  len:=0;
-  codes:=@p^.code;
-  repeat
-    c:=ord(codes^);
-    inc(codes);
-    case c of
-      0 :
-        break;
-      1,2,3 :
-        begin
-          inc(codes,c);
-          inc(len,c);
-        end;
-      8,9,10 :
-        begin
-          inc(codes);
-          inc(len);
-        end;
-      4,5,6,7 :
-        begin
-          if opsize=S_W then
-            inc(len,2)
-          else
-            inc(len);
-        end;
-      15,
-      12,13,14,
-      16,17,18,
-      20,21,22,
-      40,41,42 :
-        inc(len);
-      24,25,26,
-      31,
-      48,49,50 :
-        inc(len,2);
-      28,29,30, { we don't have 16 bit immediates code }
-      32,33,34,
-      52,53,54,
-      56,57,58 :
-        inc(len,4);
-      192,193,194 :
-        if NeedAddrPrefix(c-192) then
-         inc(len);
-      208 :
-        inc(len);
-      200,
-      201,
-      202,
-      209,
-      210,
-      217,218,219 : ;
-      216 :
-        begin
-          inc(codes);
-          inc(len);
-        end;
-      224,225,226 :
-        begin
-          InternalError(777002);
-        end;
-      else
-        begin
-          if (c>=64) and (c<=191) then
-           begin
-             if not process_ea(oper[(c shr 3) and 7], ea_data, 0) then
-              Message(asmw_e_invalid_effective_address)
-             else
-              inc(len,ea_data.size);
-           end
-          else
-           InternalError(777003);
-        end;
-    end;
-  until false;
-  calcsize:=len;
-end;
-
-
-procedure taicpu.GenCode;
-{
- * the actual codes (C syntax, i.e. octal):
- * \0            - terminates the code. (Unless it's a literal of course.)
- * \1, \2, \3    - that many literal bytes follow in the code stream
- * \4, \6        - the POP/PUSH (respectively) codes for CS, DS, ES, SS
- *                 (POP is never used for CS) depending on operand 0
- * \5, \7        - the second byte of POP/PUSH codes for FS, GS, depending
- *                 on operand 0
- * \10, \11, \12 - a literal byte follows in the code stream, to be added
- *                 to the register value of operand 0, 1 or 2
- * \17           - encodes the literal byte 0. (Some compilers don't take
- *                 kindly to a zero byte in the _middle_ of a compile time
- *                 string constant, so I had to put this hack in.)
- * \14, \15, \16 - a signed byte immediate operand, from operand 0, 1 or 2
- * \20, \21, \22 - a byte immediate operand, from operand 0, 1 or 2
- * \24, \25, \26 - an unsigned byte immediate operand, from operand 0, 1 or 2
- * \30, \31, \32 - a word immediate operand, from operand 0, 1 or 2
- * \34, \35, \36 - select between \3[012] and \4[012] depending on 16/32 bit
- *                 assembly mode or the address-size override on the operand
- * \37           - a word constant, from the _segment_ part of operand 0
- * \40, \41, \42 - a long immediate operand, from operand 0, 1 or 2
- * \50, \51, \52 - a byte relative operand, from operand 0, 1 or 2
- * \60, \61, \62 - a word relative operand, from operand 0, 1 or 2
- * \64, \65, \66 - select between \6[012] and \7[012] depending on 16/32 bit
- *                 assembly mode or the address-size override on the operand
- * \70, \71, \72 - a long relative operand, from operand 0, 1 or 2
- * \1ab          - a ModRM, calculated on EA in operand a, with the spare
- *                 field the register value of operand b.
- * \2ab          - a ModRM, calculated on EA in operand a, with the spare
- *                 field equal to digit b.
- * \30x          - might be an 0x67 byte, depending on the address size of
- *                 the memory reference in operand x.
- * \310          - indicates fixed 16-bit address size, i.e. optional 0x67.
- * \311          - indicates fixed 32-bit address size, i.e. optional 0x67.
- * \320          - indicates fixed 16-bit operand size, i.e. optional 0x66.
- * \321          - indicates fixed 32-bit operand size, i.e. optional 0x66.
- * \322          - indicates that this instruction is only valid when the
- *                 operand size is the default (instruction to disassembler,
- *                 generates no code in the assembler)
- * \330          - a literal byte follows in the code stream, to be added
- *                 to the condition code value of the instruction.
- * \340          - reserve <operand 0> bytes of uninitialised storage.
- *                 Operand 0 had better be a segmentless constant.
-}
-
-var
-  currval : longint;
-  currsym : tasmsymbol;
-
-  procedure getvalsym(opidx:longint);
-  begin
-    case oper[opidx].typ of
-      top_ref :
-        begin
-          currval:=oper[opidx].ref^.offset+oper[opidx].ref^.offsetfixup;
-          currsym:=oper[opidx].ref^.symbol;
-        end;
-      top_const :
-        begin
-          currval:=longint(oper[opidx].val);
-          currsym:=nil;
-        end;
-      top_symbol :
-        begin
-          currval:=oper[opidx].symofs;
-          currsym:=oper[opidx].sym;
-        end;
-      else
-        Message(asmw_e_immediate_or_reference_expected);
-    end;
-  end;
-
-const
-  CondVal:array[TAsmCond] of byte=($0,
-   $7, $3, $2, $6, $2, $4, $F, $D, $C, $E, $6, $2,
-   $3, $7, $3, $5, $E, $C, $D, $F, $1, $B, $9, $5,
-   $0, $A, $A, $B, $8, $4);
-var
-  c : byte;
-  pb,
-  codes : pchar;
-  bytes : array[0..3] of byte;
-  rfield,
-  data,s,opidx : longint;
-  ea_data : ea;
-begin
-{$ifdef EXTDEBUG}
-  { safety check }
-  if objectdata.currsectionsize<>insoffset then
-   internalerror(200130121);
-{$endif EXTDEBUG}
-  { load data to write }
-  codes:=insentry^.code;
-  { Force word push/pop for registers }
-  if (opsize=S_W) and ((codes[0]=#4) or (codes[0]=#6) or
-      ((codes[0]=#1) and ((codes[2]=#5) or (codes[2]=#7)))) then
-    begin
-      bytes[0]:=$66;
-      objectdata.writebytes(bytes,1);
-    end;
-  repeat
-    c:=ord(codes^);
-    inc(codes);
-    case c of
-      0 :
-        break;
-      1,2,3 :
-        begin
-          objectdata.writebytes(codes^,c);
-          inc(codes,c);
-        end;
-      4,6 :
-        begin
-          case oper[0].reg of
-            R_CS :
-              begin
-                if c=4 then
-                 bytes[0]:=$f
-                else
-                 bytes[0]:=$e;
-              end;
-            R_NO,
-            R_DS :
-              begin
-                if c=4 then
-                 bytes[0]:=$1f
-                else
-                 bytes[0]:=$1e;
-              end;
-            R_ES :
-              begin
-                if c=4 then
-                 bytes[0]:=$7
-                else
-                 bytes[0]:=$6;
-              end;
-            R_SS :
-              begin
-                if c=4 then
-                 bytes[0]:=$17
-                else
-                 bytes[0]:=$16;
-              end;
-            else
-              InternalError(777004);
-          end;
-          objectdata.writebytes(bytes,1);
-        end;
-      5,7 :
-        begin
-          case oper[0].reg of
-            R_FS :
-              begin
-                if c=5 then
-                 bytes[0]:=$a1
-                else
-                 bytes[0]:=$a0;
-              end;
-            R_GS :
-              begin
-                if c=5 then
-                 bytes[0]:=$a9
-                else
-                 bytes[0]:=$a8;
-              end;
-            else
-              InternalError(777005);
-          end;
-          objectdata.writebytes(bytes,1);
-        end;
-      8,9,10 :
-        begin
-          bytes[0]:=ord(codes^)+regval(oper[c-8].reg);
-          inc(codes);
-          objectdata.writebytes(bytes,1);
-        end;
-      15 :
-        begin
-          bytes[0]:=0;
-          objectdata.writebytes(bytes,1);
-        end;
-      12,13,14 :
-        begin
-          getvalsym(c-12);
-          if (currval<-128) or (currval>127) then
-           Message2(asmw_e_value_exceeds_bounds,'signed byte',tostr(currval));
-          if assigned(currsym) then
-            objectdata.writereloc(currval,1,currsym,relative_false)
-          else
-            objectdata.writebytes(currval,1);
-        end;
-      16,17,18 :
-        begin
-          getvalsym(c-16);
-          if (currval<-256) or (currval>255) then
-           Message2(asmw_e_value_exceeds_bounds,'byte',tostr(currval));
-          if assigned(currsym) then
-           objectdata.writereloc(currval,1,currsym,relative_false)
-          else
-           objectdata.writebytes(currval,1);
-        end;
-      20,21,22 :
-        begin
-          getvalsym(c-20);
-          if (currval<0) or (currval>255) then
-           Message2(asmw_e_value_exceeds_bounds,'unsigned byte',tostr(currval));
-          if assigned(currsym) then
-           objectdata.writereloc(currval,1,currsym,relative_false)
-          else
-           objectdata.writebytes(currval,1);
-        end;
-      24,25,26 :
-        begin
-          getvalsym(c-24);
-          if (currval<-65536) or (currval>65535) then
-           Message2(asmw_e_value_exceeds_bounds,'word',tostr(currval));
-          if assigned(currsym) then
-           objectdata.writereloc(currval,2,currsym,relative_false)
-          else
-           objectdata.writebytes(currval,2);
-        end;
-      28,29,30 :
-        begin
-          getvalsym(c-28);
-          if assigned(currsym) then
-           objectdata.writereloc(currval,4,currsym,relative_false)
-          else
-           objectdata.writebytes(currval,4);
-        end;
-      32,33,34 :
-        begin
-          getvalsym(c-32);
-          if assigned(currsym) then
-           objectdata.writereloc(currval,4,currsym,relative_false)
-          else
-           objectdata.writebytes(currval,4);
-        end;
-      40,41,42 :
-        begin
-          getvalsym(c-40);
-          data:=currval-insend;
-          if assigned(currsym) then
-           inc(data,currsym.address);
-          if (data>127) or (data<-128) then
-           Message1(asmw_e_short_jmp_out_of_range,tostr(data));
-          objectdata.writebytes(data,1);
-        end;
-      52,53,54 :
-        begin
-          getvalsym(c-52);
-          if assigned(currsym) then
-           objectdata.writereloc(currval,4,currsym,relative_true)
-          else
-           objectdata.writereloc(currval-insend,4,nil,relative_false)
-        end;
-      56,57,58 :
-        begin
-          getvalsym(c-56);
-          if assigned(currsym) then
-           objectdata.writereloc(currval,4,currsym,relative_true)
-          else
-           objectdata.writereloc(currval-insend,4,nil,relative_false)
-        end;
-      192,193,194 :
-        begin
-          if NeedAddrPrefix(c-192) then
-           begin
-             bytes[0]:=$67;
-             objectdata.writebytes(bytes,1);
-           end;
-        end;
-      200 :
-        begin
-          bytes[0]:=$67;
-          objectdata.writebytes(bytes,1);
-        end;
-      208 :
-        begin
-          bytes[0]:=$66;
-          objectdata.writebytes(bytes,1);
-        end;
-      216 :
-        begin
-          bytes[0]:=ord(codes^)+condval[condition];
-          inc(codes);
-          objectdata.writebytes(bytes,1);
-        end;
-      201,
-      202,
-      209,
-      210,
-      217,218,219 :
-        begin
-          { these are dissambler hints or 32 bit prefixes which
-            are not needed }
-        end;
-      31,
-      48,49,50,
-      224,225,226 :
-        begin
-          InternalError(777006);
-        end
-      else
-        begin
-          if (c>=64) and (c<=191) then
-           begin
-             if (c<127) then
-              begin
-                if (oper[c and 7].typ=top_reg) then
-                  rfield:=regval(oper[c and 7].reg)
-                else
-                  rfield:=regval(oper[c and 7].ref^.base);
-              end
-             else
-              rfield:=c and 7;
-             opidx:=(c shr 3) and 7;
-             if not process_ea(oper[opidx], ea_data, rfield) then
-              Message(asmw_e_invalid_effective_address);
-
-             pb:=@bytes;
-             pb^:=chr(ea_data.modrm);
-             inc(pb);
-             if ea_data.sib_present then
-              begin
-                pb^:=chr(ea_data.sib);
-                inc(pb);
-              end;
-
-             s:=pb-pchar(@bytes);
-             objectdata.writebytes(bytes,s);
-
-             case ea_data.bytes of
-               0 : ;
-               1 :
-                 begin
-                   if (oper[opidx].ot and OT_MEMORY)=OT_MEMORY then
-                    objectdata.writereloc(oper[opidx].ref^.offset+oper[opidx].ref^.offsetfixup,1,oper[opidx].ref^.symbol,relative_false)
-                   else
-                    begin
-                      bytes[0]:=oper[opidx].ref^.offset+oper[opidx].ref^.offsetfixup;
-                      objectdata.writebytes(bytes,1);
-                    end;
-                   inc(s);
-                 end;
-               2,4 :
-                 begin
-                   objectdata.writereloc(oper[opidx].ref^.offset+oper[opidx].ref^.offsetfixup,ea_data.bytes,
-                     oper[opidx].ref^.symbol,relative_false);
-                   inc(s,ea_data.bytes);
-                 end;
-             end;
-           end
-          else
-           InternalError(777007);
-        end;
-    end;
-  until false;
-end;
-{$endif NOAG386BIN}
-
-{*****************************************************************************
-                              Instruction table
-*****************************************************************************}
-
-    procedure BuildInsTabCache;
-{$ifndef NOAG386BIN}
-      var
-        i : longint;
-{$endif}
-      begin
-{$ifndef NOAG386BIN}
-        new(instabcache);
-        FillChar(instabcache^,sizeof(tinstabcache),$ff);
-        i:=0;
-        while (i<InsTabEntries) do
-         begin
-           if InsTabCache^[InsTab[i].OPcode]=-1 then
-            InsTabCache^[InsTab[i].OPcode]:=i;
-           inc(i);
-         end;
-{$endif NOAG386BIN}
-      end;
-
-
-    procedure InitAsm;
-      begin
-{$ifndef NOAG386BIN}
-        if not assigned(instabcache) then
-          BuildInsTabCache;
-{$endif NOAG386BIN}
-      end;
-
-
-    procedure DoneAsm;
-      begin
-{$ifndef NOAG386BIN}
-        if assigned(instabcache) then
-         dispose(instabcache);
-{$endif NOAG386BIN}
-      end;
-
-
-
-end.
-{
-  $Log$
-  Revision 1.25  2002-05-18 13:34:22  peter
-    * readded missing revisions
-
-  Revision 1.24  2002/05/16 19:46:50  carl
-  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
-  + try to fix temp allocation (still in ifdef)
-  + generic constructor calls
-  + start of tassembler / tmodulebase class cleanup
-
-  Revision 1.21  2002/05/12 16:53:16  peter
-    * moved entry and exitcode to ncgutil and cgobj
-    * foreach gets extra argument for passing local data to the
-      iterator function
-    * -CR checks also class typecasts at runtime by changing them
-      into as
-    * fixed compiler to cycle with the -CR option
-    * fixed stabs with elf writer, finally the global variables can
-      be watched
-    * removed a lot of routines from cga unit and replaced them by
-      calls to cgobj
-    * u32bit-s32bit updates for and,or,xor nodes. When one element is
-      u32bit then the other is typecasted also to u32bit without giving
-      a rangecheck warning/error.
-    * fixed pascal calling method with reversing also the high tree in
-      the parast, detected by tcalcst3 test
-
-  Revision 1.20  2002/04/15 19:44:20  peter
-    * fixed stackcheck that would be called recursively when a stack
-      error was found
-    * generic changeregsize(reg,size) for i386 register resizing
-    * removed some more routines from cga unit
-    * fixed returnvalue handling
-    * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
-
-  Revision 1.19  2002/04/15 19:12:09  carl
-  + target_info.size_of_pointer -> pointer_size
-  + some cleanup of unused types/variables
-  * move several constants from cpubase to their specific units
-    (where they are used)
-  + att_Reg2str -> gas_reg2str
-  + int_reg2str -> std_reg2str
-
-  Revision 1.18  2002/04/02 17:11:33  peter
-    * tlocation,treference update
-    * LOC_CONSTANT added for better constant handling
-    * secondadd splitted in multiple routines
-    * location_force_reg added for loading a location to a register
-      of a specified size
-    * secondassignment parses now first the right and then the left node
-      (this is compatible with Kylix). This saves a lot of push/pop especially
-      with string operations
-    * adapted some routines to use the new cg methods
-
-}

compiler/i386/cpubase.pas

@@ -35,7 +35,11 @@ unit cpubase;
 interface
 
 uses
-  globals,cutils,cclasses,aasm,cpuinfo,cginfo;
+  cutils,cclasses,
+  globals,
+  cpuinfo,
+  aasmbase,
+  cginfo;
 
 
 {*****************************************************************************
@@ -452,7 +456,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  2002-07-01 16:23:55  peter
+  Revision 1.25  2002-07-01 18:46:30  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.24  2002/07/01 16:23:55  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/i386/csopt386.pas

@@ -27,7 +27,7 @@ Unit CSOpt386;
 
 Interface
 
-Uses aasm, cpuinfo, cpubase, cpuasm, optbase;
+Uses aasmbase,aasmtai,aasmcpu, cpuinfo, cpubase, optbase;
 
 function CSE(asmL: TAAsmoutput; first, last: Tai; pass: longint): boolean;
 
@@ -1984,7 +1984,11 @@ End.
 
 {
   $Log$
-  Revision 1.35  2002-05-18 13:34:22  peter
+  Revision 1.36  2002-07-01 18:46:31  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.35  2002/05/18 13:34:22  peter
     * readded missing revisions
 
   Revision 1.34  2002/05/16 19:46:51  carl

compiler/i386/daopt386.pas

@@ -30,8 +30,8 @@ Interface
 
 Uses
   GlobType,
-  CClasses,Aasm,
-  cpubase,cpuasm,optbase;
+  CClasses,Aasmbase,aasmtai,aasmcpu,
+  cpubase,optbase;
 
 {******************************* Constants *******************************}
 
@@ -226,7 +226,7 @@ Var
 Implementation
 
 Uses
-  globals, systems, verbose, cgbase, symconst, symsym, tainst, cginfo, cgobj,
+  globals, systems, verbose, cgbase, symconst, symsym, cginfo, cgobj,
    rgobj;
 
 Type
@@ -294,10 +294,10 @@ Begin
     While Assigned(p) And
           (p.typ=ait_RegAlloc) Do
       Begin
-        if Tairegalloc(p).allocation then
-          UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
+        if tai_regalloc(p).allocation then
+          UsedRegs := UsedRegs + [tai_regalloc(p).Reg]
         else
-          UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
+          UsedRegs := UsedRegs - [tai_regalloc(p).Reg];
         p := Tai(p.next);
       End;
   Until Not(Assigned(p)) Or
@@ -358,8 +358,8 @@ Begin
     If Assigned(StartTai) and
        (StartTai.typ = ait_regAlloc) then
       begin
-        if (TairegAlloc(StartTai).allocation = alloc) and
-           (TairegAlloc(StartTai).Reg = Reg) then
+        if (tai_regalloc(StartTai).allocation = alloc) and
+           (tai_regalloc(StartTai).Reg = Reg) then
           begin
             FindRegAlloc:=true;
             break;
@@ -382,8 +382,8 @@ Procedure RemoveLastDeallocForFuncRes(asmL: TAAsmOutput; p: Tai);
       hp2 := Tai(hp2.previous);
       if assigned(hp2) and
          (hp2.typ = ait_regalloc) and
-         not(Tairegalloc(hp2).allocation) and
-         (Tairegalloc(hp2).reg = reg) then
+         not(tai_regalloc(hp2).allocation) and
+         (tai_regalloc(hp2).reg = reg) then
         begin
           asml.remove(hp2);
           hp2.free;
@@ -460,7 +460,7 @@ begin
          (Taicpu(hp1).opcode = A_JMP) and
          (tasmlabel(Taicpu(hp1).oper[0].sym) = aktexit2label)) then
     begin
-      p := TaiRegAlloc.deAlloc(reg);
+      p := tai_regalloc.deAlloc(reg);
       insertLLItem(AsmL, hp1.previous, hp1, p);
     end;
 end;
@@ -489,23 +489,23 @@ Begin
             LabelTable^[Tai_Label(p).l.labelnr-LowLabel].TaiObj := p;
         ait_regAlloc:
           { ESI and EDI are (de)allocated manually, don't mess with them }
-          if not(TaiRegAlloc(p).Reg in [R_EDI,R_ESI]) then
+          if not(tai_regalloc(p).Reg in [R_EDI,R_ESI]) then
             begin
-              if TairegAlloc(p).Allocation then
+              if tai_regalloc(p).Allocation then
                 Begin
-                  If Not(TaiRegAlloc(p).Reg in UsedRegs) Then
-                    UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
+                  If Not(tai_regalloc(p).Reg in UsedRegs) Then
+                    UsedRegs := UsedRegs + [tai_regalloc(p).Reg]
                   Else
-                    addRegDeallocFor(asmL, TaiRegAlloc(p).reg, p);
+                    addRegDeallocFor(asmL, tai_regalloc(p).reg, p);
                 End
               else
                 begin
-                  UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
+                  UsedRegs := UsedRegs - [tai_regalloc(p).Reg];
                   hp1 := p;
                   hp2 := nil;
-                  While Not(FindRegAlloc(TaiRegAlloc(p).Reg, Tai(hp1.Next),true)) And
+                  While Not(FindRegAlloc(tai_regalloc(p).Reg, Tai(hp1.Next),true)) And
                         GetNextInstruction(hp1, hp1) And
-                        RegInInstruction(TaiRegAlloc(p).Reg, hp1) Do
+                        RegInInstruction(tai_regalloc(p).Reg, hp1) Do
                     hp2 := hp1;
                   If hp2 <> nil Then
                     Begin
@@ -1145,10 +1145,10 @@ Begin
     While Assigned(p) And
           (p.typ=ait_RegAlloc) Do
       Begin
-        if Tairegalloc(p).allocation then
-          UsedRegs := UsedRegs + [TaiRegAlloc(p).Reg]
+        if tai_regalloc(p).allocation then
+          UsedRegs := UsedRegs + [tai_regalloc(p).Reg]
         else
-          UsedRegs := UsedRegs - [TaiRegAlloc(p).Reg];
+          UsedRegs := UsedRegs - [tai_regalloc(p).Reg];
         p := Tai(p.next);
       End;
   Until Not(Assigned(p)) Or
@@ -1195,14 +1195,14 @@ Begin
 { remove all allocation/deallocation info about the register in between }
       If assigned(p1) and
          (p1.typ = ait_regalloc) Then
-        If (TaiRegAlloc(p1).Reg = Reg) Then
+        If (tai_regalloc(p1).Reg = Reg) Then
           Begin
             if first then
               begin
-                firstRemovedWasAlloc := TaiRegAlloc(p1).allocation;
+                firstRemovedWasAlloc := tai_regalloc(p1).allocation;
                 first := false;
               end;
-            lastRemovedWasDealloc := not TaiRegAlloc(p1).allocation;
+            lastRemovedWasDealloc := not tai_regalloc(p1).allocation;
             hp := Tai(p1.Next);
             asml.Remove(p1);
             p1.free;
@@ -1219,13 +1219,13 @@ Begin
         include(PTaiProp(p1.OptInfo)^.UsedRegs,Reg);
       if lastRemovedWasDealloc then
         begin
-          hp := TaiRegalloc.DeAlloc(reg);
+          hp := tai_regalloc.DeAlloc(reg);
           insertLLItem(asmL,p1,p1.next,hp);
         end;
     end;
   if firstRemovedWasAlloc then
     begin
-      hp := TaiRegalloc.Alloc(reg);
+      hp := tai_regalloc.Alloc(reg);
       insertLLItem(asmL,start.previous,start,hp);
     end;
 End;
@@ -1245,8 +1245,8 @@ begin
     begin
       p := Tai(p.previous);
       if (p.typ = ait_regalloc) and
-         (Tairegalloc(p).reg = reg) then
-        if not(Tairegalloc(p).allocation) then
+         (tai_regalloc(p).reg = reg) then
+        if not(tai_regalloc(p).allocation) then
           if first then
             begin
               findregdealloc := true;
@@ -2591,7 +2591,11 @@ End.
 
 {
   $Log$
-  Revision 1.40  2002-06-24 12:43:00  jonas
+  Revision 1.41  2002-07-01 18:46:31  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.40  2002/06/24 12:43:00  jonas
     * fixed errors found with new -CR code from Peter when cycling with -O2p3r
 
   Revision 1.39  2002/06/09 12:56:04  jonas

compiler/i386/n386add.pas

@@ -56,11 +56,10 @@ interface
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,aasm,types,htypechk,
+      symconst,symdef,aasmbase,aasmtai,aasmcpu,types,htypechk,
       cgbase,pass_2,regvars,
-      cpuasm,
       ncon,nset,
-      tainst,cga,ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
+      cga,ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
 
 {*****************************************************************************
                                   Helpers
@@ -1487,23 +1486,23 @@ interface
                   location_release(exprasmlist,left.location);
                   { allocate EAX }
                   if R_EAX in rg.unusedregsint then
-                    exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+                    exprasmList.concat(tai_regalloc.Alloc(R_EAX));
                   { load he right value }
                   cg.a_load_loc_reg(exprasmlist,right.location,R_EAX);
                   location_release(exprasmlist,right.location);
                   { allocate EAX if it isn't yet allocated (JM) }
                   if (R_EAX in rg.unusedregsint) then
-                    exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+                    exprasmList.concat(tai_regalloc.Alloc(R_EAX));
                   { also allocate EDX, since it is also modified by }
                   { a mul (JM)                                      }
                   if R_EDX in rg.unusedregsint then
-                    exprasmList.concat(Tairegalloc.Alloc(R_EDX));
+                    exprasmList.concat(tai_regalloc.Alloc(R_EDX));
                   emit_reg(A_MUL,S_L,R_EDI);
                   rg.ungetregisterint(exprasmlist,R_EDI);
                   if R_EDX in rg.unusedregsint then
-                    exprasmList.concat(Tairegalloc.DeAlloc(R_EDX));
+                    exprasmList.concat(tai_regalloc.DeAlloc(R_EDX));
                   if R_EAX in rg.unusedregsint then
-                    exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+                    exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
                   location.register:=rg.getregisterint(exprasmlist);
                   emit_reg_reg(A_MOV,S_L,R_EAX,location.register);
                   if popedx then
@@ -1572,7 +1571,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.40  2002-07-01 16:23:55  peter
+  Revision 1.41  2002-07-01 18:46:31  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.40  2002/07/01 16:23:55  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/i386/n386cal.pas

@@ -61,7 +61,7 @@ implementation
       gdb,
 {$endif GDB}
       cginfo,cgbase,pass_2,
-      cpubase,aasm,tainst,
+      cpubase,aasmbase,aasmtai,aasmcpu,
       nmem,nld,ncnv,
       ncgutil,cga,cgobj,tgobj,regvars,rgobj,rgcpu,cg64f32,cgcpu;
 
@@ -1080,9 +1080,9 @@ implementation
                        rg.getexplicitregisterint(exprasmlist,R_EDI);
                        emit_reg(A_POP,S_L,R_EDI);
                        rg.ungetregisterint(exprasmlist,R_EDI);
-                       exprasmList.concat(Tairegalloc.Alloc(R_ESI));
+                       exprasmList.concat(tai_regalloc.Alloc(R_ESI));
                        emit_reg(A_POP,S_L,R_ESI);
-                       exprasmList.concat(Tairegalloc.DeAlloc(R_ESI));
+                       exprasmList.concat(tai_regalloc.DeAlloc(R_ESI));
                     end
                 else if pushedparasize<>0 then
                   emit_const_reg(A_ADD,S_L,pushedparasize,R_ESP);
@@ -1129,7 +1129,7 @@ implementation
               reference_reset_base(href,tmpreg,68);
               cg.a_call_ref(exprasmlist,href);
               cg.free_scratch_reg(exprasmlist,tmpreg);
-              exprasmList.concat(Tairegalloc.Alloc(accumulator));
+              exprasmList.concat(tai_regalloc.Alloc(accumulator));
               cg.a_label(exprasmlist,constructorfailed);
               cg.a_load_reg_reg(exprasmlist,OS_ADDR,self_pointer_reg,accumulator);
            end;
@@ -1475,7 +1475,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.55  2002-07-01 16:23:56  peter
+  Revision 1.56  2002-07-01 18:46:31  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.55  2002/07/01 16:23:56  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/i386/n386cnv.pas

@@ -62,10 +62,10 @@ implementation
 
    uses
       verbose,systems,
-      symconst,symdef,aasm,
+      symconst,symdef,aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_2,
       ncon,ncal,ncnv,
-      cpubase,cpuasm,
+      cpubase,
       cgobj,cga,tgobj,rgobj,rgcpu,ncgutil;
 
 
@@ -365,7 +365,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.42  2002-05-20 13:30:40  carl
+  Revision 1.43  2002-07-01 18:46:31  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.42  2002/05/20 13:30:40  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/i386/n386flw.pas

@@ -52,11 +52,11 @@ implementation
 
     uses
       verbose,systems,
-      symsym,aasm,
+      symsym,aasmbase,aasmtai,aasmcpu,
       cgbase,pass_2,
-      cpuinfo,cpubase,cpuasm,
+      cpuinfo,cpubase,
       nld,ncon,
-      tainst,cga,cgobj,tgobj,rgobj;
+      cga,cgobj,tgobj,rgobj;
 
 {*****************************************************************************
                              SecondRaise
@@ -123,10 +123,10 @@ implementation
 
       begin
          cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK');
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
          cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
          cg.g_maybe_loadself(exprasmlist);
       end;
 
@@ -137,10 +137,10 @@ implementation
       begin
          cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK');
          { allocate eax }
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          emit_reg(A_POP,S_L,R_EAX);
          { deallocate eax }
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
       end;
 
     procedure ti386tryexceptnode.pass_2;
@@ -209,13 +209,13 @@ implementation
          cg.a_call_name(exprasmlist,'FPC_PUSHEXCEPTADDR');
 
          { allocate eax }
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
          cg.a_call_name(exprasmlist,'FPC_SETJMP');
          emit_reg(A_PUSH,S_L,R_EAX);
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
          { deallocate eax }
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
          emitjmp(C_NE,exceptlabel);
 
          { try block }
@@ -239,10 +239,10 @@ implementation
          tg.ungetpersistanttempreference(exprasmlist,tempaddr);
          tg.ungetpersistanttempreference(exprasmlist,tempbuf);
 
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          emit_reg(A_POP,S_L,R_EAX);
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
 
          emitjmp(C_E,endexceptlabel);
          cg.a_label(exprasmlist,doexceptlabel);
@@ -287,13 +287,13 @@ implementation
               cg.a_call_name(exprasmlist,'FPC_PUSHEXCEPTADDR');
 
               { allocate eax }
-              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(tai_regalloc.Alloc(R_EAX));
               emit_reg(A_PUSH,S_L,R_EAX);
               cg.a_call_name(exprasmlist,'FPC_SETJMP');
               emit_reg(A_PUSH,S_L,R_EAX);
               emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
               { deallocate eax }
-              exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+              exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
               emitjmp(C_NE,exceptlabel);
 
               { here we don't have to reset flowcontrol           }
@@ -306,16 +306,16 @@ implementation
               tg.ungetpersistanttempreference(exprasmlist,tempaddr);
               tg.ungetpersistanttempreference(exprasmlist,tempbuf);
 
-              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(tai_regalloc.Alloc(R_EAX));
               exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
               exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
-              exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+              exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
               emitjmp(C_E,doobjectdestroy);
               cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
-              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(tai_regalloc.Alloc(R_EAX));
               emit_reg(A_PUSH,S_L,R_EAX);
               cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
-              exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+              exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
               { we don't need to restore esi here because reraise never }
               { returns                                                 }
               cg.a_call_name(exprasmlist,'FPC_RERAISE');
@@ -429,7 +429,7 @@ implementation
            newasmsymbol(excepttype.vmt_mangledname));
          cg.a_call_name(exprasmlist,'FPC_CATCHES');
          { allocate eax }
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
          emitjmp(C_E,nextonlabel);
          ref.symbol:=nil;
@@ -441,7 +441,7 @@ implementation
 
          emit_reg_ref(A_MOV,S_L,R_EAX,ref);
          { deallocate eax }
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
 
          { in the case that another exception is risen }
          { we've to destroy the old one                }
@@ -454,14 +454,14 @@ implementation
          cg.a_param_const(exprasmlist,OS_INT,1,1);
          cg.a_call_name(exprasmlist,'FPC_PUSHEXCEPTADDR');
 
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
          cg.a_call_name(exprasmlist,'FPC_SETJMP');
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          exprasmList.concat(Taicpu.op_reg(A_PUSH,S_L,R_EAX));
          exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
          emitjmp(C_NE,doobjectdestroyandreraise);
 
          if assigned(right) then
@@ -491,16 +491,16 @@ implementation
          tg.ungetpersistanttempreference(exprasmlist,tempaddr);
          tg.ungetpersistanttempreference(exprasmlist,tempbuf);
 
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          exprasmList.concat(Taicpu.op_reg(A_POP,S_L,R_EAX));
          exprasmList.concat(Taicpu.op_reg_reg(A_TEST,S_L,R_EAX,R_EAX));
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
          emitjmp(C_E,doobjectdestroy);
          cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
          cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
          { we don't need to restore esi here because reraise never }
          { returns                                                 }
          cg.a_call_name(exprasmlist,'FPC_RERAISE');
@@ -610,13 +610,13 @@ implementation
          cg.a_call_name(exprasmlist,'FPC_PUSHEXCEPTADDR');
 
          { allocate eax }
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          emit_reg(A_PUSH,S_L,R_EAX);
          cg.a_call_name(exprasmlist,'FPC_SETJMP');
          emit_reg(A_PUSH,S_L,R_EAX);
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
          { deallocate eax }
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
          emitjmp(C_NE,finallylabel);
 
          { try code }
@@ -641,7 +641,7 @@ implementation
          if codegenerror then
            exit;
          { allocate eax }
-         exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+         exprasmList.concat(tai_regalloc.Alloc(R_EAX));
          emit_reg(A_POP,S_L,R_EAX);
          emit_reg_reg(A_TEST,S_L,R_EAX,R_EAX);
          emitjmp(C_E,endfinallylabel);
@@ -669,7 +669,7 @@ implementation
               emitjmp(C_Z,oldaktcontinuelabel);
            end;
          { deallocate eax }
-         exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+         exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
          cg.a_label(exprasmlist,reraiselabel);
          cg.a_call_name(exprasmlist,'FPC_RERAISE');
          { do some magic for exit,break,continue in the try block }
@@ -677,9 +677,9 @@ implementation
            begin
               cg.a_label(exprasmlist,exitfinallylabel);
               { allocate eax }
-              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(tai_regalloc.Alloc(R_EAX));
               emit_reg(A_POP,S_L,R_EAX);
-              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(tai_regalloc.Alloc(R_EAX));
               emit_const(A_PUSH,S_L,2);
               cg.a_jmp_always(exprasmlist,finallylabel);
            end;
@@ -687,19 +687,19 @@ implementation
           begin
              cg.a_label(exprasmlist,breakfinallylabel);
              { allocate eax }
-             exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+             exprasmList.concat(tai_regalloc.Alloc(R_EAX));
              emit_reg(A_POP,S_L,R_EAX);
              { deallocate eax }
-             exprasmList.concat(Tairegalloc.DeAlloc(R_EAX));
+             exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
              emit_const(A_PUSH,S_L,3);
              cg.a_jmp_always(exprasmlist,finallylabel);
            end;
          if fc_continue in tryflowcontrol then
            begin
               cg.a_label(exprasmlist,continuefinallylabel);
-              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(tai_regalloc.Alloc(R_EAX));
               emit_reg(A_POP,S_L,R_EAX);
-              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+              exprasmList.concat(tai_regalloc.Alloc(R_EAX));
               emit_const(A_PUSH,S_L,4);
               cg.a_jmp_always(exprasmlist,finallylabel);
            end;
@@ -726,7 +726,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  2002-05-20 13:30:41  carl
+  Revision 1.28  2002-07-01 18:46:33  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.27  2002/05/20 13:30:41  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/i386/n386inl.pas

@@ -39,7 +39,8 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,fmodule,
-      symconst,symdef,aasm,types,
+      symconst,symdef,types,
+      aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_1,pass_2,
       cpubase,
       nbas,ncon,ncal,ncnv,nld,
@@ -460,7 +461,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.45  2002-07-01 16:23:56  peter
+  Revision 1.46  2002-07-01 18:46:33  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.45  2002/07/01 16:23:56  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/i386/n386mat.pas

@@ -52,7 +52,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,aasm,types,
+      symconst,symdef,aasmbase,aasmtai,aasmcpu,types,
       cginfo,cgbase,pass_1,pass_2,
       ncon,
       cpubase,
@@ -830,7 +830,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2002-05-18 13:34:25  peter
+  Revision 1.32  2002-07-01 18:46:33  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.31  2002/05/18 13:34:25  peter
     * readded missing revisions
 
   Revision 1.30  2002/05/16 19:46:51  carl

compiler/i386/n386mem.pas

@@ -50,7 +50,8 @@ implementation
 {$endif}
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symtype,symdef,symsym,symtable,aasm,types,
+      symconst,symtype,symdef,symsym,symtable,types,
+      aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_2,
       pass_1,nld,ncon,nadd,
       cpubase,
@@ -519,7 +520,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  2002-06-24 12:43:01  jonas
+  Revision 1.35  2002-07-01 18:46:33  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.34  2002/06/24 12:43:01  jonas
     * fixed errors found with new -CR code from Peter when cycling with -O2p3r
 
   Revision 1.33  2002/05/18 13:34:25  peter

compiler/i386/n386obj.pas

@@ -32,7 +32,7 @@ implementation
 uses
   systems,
   verbose,globals,globtype,
-  aasm,
+  aasmbase,aasmtai,aasmcpu,
   symconst,symtype,symdef,symsym,
   fmodule,
   nobj,
@@ -237,7 +237,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.10  2002-05-18 13:34:25  peter
+  Revision 1.11  2002-07-01 18:46:33  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.10  2002/05/18 13:34:25  peter
     * readded missing revisions
 
   Revision 1.9  2002/05/16 19:46:52  carl

compiler/i386/n386opt.pas

@@ -44,7 +44,7 @@ implementation
 uses
   pass_1, types, htypechk,
   symdef,
-  aasm,
+  aasmbase,aasmtai,aasmcpu,
   ncnv, ncon, pass_2,
   cginfo, cgbase, cpubase,
   tgobj, rgobj, cgobj, ncgutil;
@@ -248,7 +248,11 @@ end.
 
 {
   $Log$
-  Revision 1.17  2002-05-18 13:34:25  peter
+  Revision 1.18  2002-07-01 18:46:33  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.17  2002/05/18 13:34:25  peter
     * readded missing revisions
 
   Revision 1.16  2002/05/16 19:46:52  carl

compiler/i386/n386set.pas

@@ -46,7 +46,8 @@ implementation
     uses
       globtype,systems,
       verbose,globals,
-      symconst,symdef,aasm,types,
+      symconst,symdef,types,
+      aasmbase,aasmtai,aasmcpu,
       cginfo,cgbase,pass_2,
       ncon,
       cpubase,
@@ -1016,7 +1017,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2002-05-18 13:34:25  peter
+  Revision 1.32  2002-07-01 18:46:33  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.31  2002/05/18 13:34:25  peter
     * readded missing revisions
 
   Revision 1.30  2002/05/16 19:46:52  carl

compiler/i386/popt386.pas

@@ -26,7 +26,7 @@ Unit POpt386;
 
 Interface
 
-Uses Aasm;
+Uses Aasmbase,aasmtai,aasmcpu;
 
 Procedure PrePeepHoleOpts(AsmL: TAAsmOutput; BlockStart, BlockEnd: Tai);
 Procedure PeepHoleOptPass1(AsmL: TAAsmOutput; BlockStart, BlockEnd: Tai);
@@ -41,7 +41,7 @@ Uses
 {$ifdef finaldestdebug}
   cobjects,
 {$endif finaldestdebug}
-  tainst,cpuinfo,cpubase,cpuasm,DAOpt386,cginfo,rgobj;
+  cpuinfo,cpubase,DAOpt386,cginfo,rgobj;
 
 Function RegUsedAfterInstruction(Reg: TRegister; p: Tai; Var UsedRegs: TRegSet): Boolean;
 Begin
@@ -1176,7 +1176,7 @@ Begin
                                   { allocregbetween doesn't insert this because at }
                                   { this time, no regalloc info is available in    }
                                   { the optinfo field, so do it manually (JM)      }
-                                  hp2 := TaiRegalloc.Alloc(Taicpu(hp1).oper[1].reg);
+                                  hp2 := tai_regalloc.Alloc(Taicpu(hp1).oper[1].reg);
                                   insertllitem(asml,p.previous,p,hp2);
                                   Taicpu(hp1).LoadReg(0,Taicpu(hp1).oper[1].reg);
                                   Taicpu(hp1).LoadRef(1,Taicpu(p).oper[1].ref^);
@@ -2044,7 +2044,11 @@ End.
 
 {
   $Log$
-  Revision 1.28  2002-06-09 12:55:23  jonas
+  Revision 1.29  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.28  2002/06/09 12:55:23  jonas
     * fixed detection of register usage
 
   Revision 1.27  2002/05/18 13:34:25  peter

compiler/i386/ra386.pas

@@ -27,7 +27,8 @@ unit Ra386;
 interface
 
 uses
-  aasm,cpubase,rautils,cclasses;
+  aasmbase,aasmtai,aasmcpu,
+  cpubase,rautils,cclasses;
 
 { Parser helpers }
 function is_prefix(t:tasmop):boolean;
@@ -92,7 +93,7 @@ implementation
 
 uses
   globtype,globals,systems,verbose,
-  cpuinfo,cpuasm,ag386att;
+  cpuinfo,ag386att;
 
 {$define ATTOP}
 {$define INTELOP}
@@ -668,7 +669,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.21  2002-05-18 13:34:25  peter
+  Revision 1.22  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.21  2002/05/18 13:34:25  peter
     * readded missing revisions
 
   Revision 1.20  2002/05/16 19:46:52  carl

compiler/i386/ra386att.pas

@@ -41,7 +41,7 @@ Implementation
        globtype,globals,verbose,
        systems,
        { aasm }
-       cpubase,aasm,
+       cpubase,aasmbase,aasmtai,aasmcpu,
        { symtable }
        symconst,symbase,symtype,symsym,symtable,
        { pass 1 }
@@ -1880,7 +1880,7 @@ Function Assemble: tnode;
 Var
   hl         : tasmlabel;
   commname   : string;
-  lastsec    : tsection;
+  lasTSec    : TSection;
   l1,l2      : longint;
   instr      : T386ATTInstruction;
 Begin
@@ -1893,7 +1893,7 @@ Begin
      _asmsorted:=TRUE;
    end;
   curlist:=TAAsmoutput.Create;
-  lastsec:=sec_code;
+  lasTSec:=sec_code;
   { setup label linked list }
   LocalLabelList:=TLocalLabelList.Create;
   { start tokenizer }
@@ -1927,14 +1927,14 @@ Begin
       AS_DATA:
         Begin
           curList.Concat(Tai_section.Create(sec_data));
-          lastsec:=sec_data;
+          lasTSec:=sec_data;
           Consume(AS_DATA);
         end;
 
       AS_TEXT:
         Begin
           curList.Concat(Tai_section.Create(sec_code));
-          lastsec:=sec_code;
+          lasTSec:=sec_code;
           Consume(AS_TEXT);
         end;
 
@@ -2095,7 +2095,7 @@ Begin
   LocalLabelList.CheckEmitted;
   LocalLabelList.Free;
   { are we back in the code section? }
-  if lastsec<>sec_code then
+  if lasTSec<>sec_code then
    begin
      Message(asmr_w_assembler_code_not_returned_to_text);
      curList.Concat(Tai_section.Create(sec_code));
@@ -2129,7 +2129,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.24  2002-05-18 13:34:25  peter
+  Revision 1.25  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.24  2002/05/18 13:34:25  peter
     * readded missing revisions
 
   Revision 1.23  2002/05/16 19:46:52  carl

compiler/i386/ra386dir.pas

@@ -40,7 +40,7 @@ interface
        globals,verbose,
        systems,
        { aasm }
-       aasm,
+       aasmbase,aasmtai,aasmcpu,
        { symtable }
        symconst,symbase,symtype,symsym,symtable,types,
        { pass 1 }
@@ -304,7 +304,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.18  2002-05-18 13:34:26  peter
+  Revision 1.19  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.18  2002/05/18 13:34:26  peter
     * readded missing revisions
 
   Revision 1.17  2002/05/16 19:46:52  carl

compiler/i386/ra386int.pas

@@ -41,7 +41,7 @@ Implementation
        globtype,globals,verbose,
        systems,
        { aasm }
-       cpubase,aasm,
+       cpubase,aasmbase,aasmtai,aasmcpu,
        { symtable }
        symconst,symbase,symtype,symsym,symtable,
        { pass 1 }
@@ -1959,7 +1959,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.28  2002-05-18 13:34:26  peter
+  Revision 1.29  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.28  2002/05/18 13:34:26  peter
     * readded missing revisions
 
   Revision 1.27  2002/05/16 19:46:52  carl

compiler/i386/rgcpu.pas

@@ -31,9 +31,8 @@ unit rgcpu;
     uses
       cpubase,
       cpuinfo,
-      cpuasm,
-      tainst,
-      cclasses,globtype,cgbase,aasm,cginfo,rgobj;
+      aasmbase,aasmtai,aasmcpu,
+      cclasses,globtype,cgbase,cginfo,rgobj;
 
     type
        trgcpu = class(trgobj)
@@ -169,7 +168,7 @@ unit rgcpu;
 {$ifdef TEMPREGDEBUG}
               reg_user[R_EAX]:=curptree^;
 {$endif TEMPREGDEBUG}
-              exprasmlist.concat(tairegalloc.alloc(R_EAX));
+              exprasmlist.concat(tai_regalloc.alloc(R_EAX));
            end
          else if R_EDX in unusedregsint then
            begin
@@ -179,7 +178,7 @@ unit rgcpu;
 {$ifdef TEMPREGDEBUG}
               reg_user[R_EDX]:=curptree^;
 {$endif TEMPREGDEBUG}
-              exprasmlist.concat(tairegalloc.alloc(R_EDX));
+              exprasmlist.concat(tai_regalloc.alloc(R_EDX));
            end
          else if R_EBX in unusedregsint then
            begin
@@ -189,7 +188,7 @@ unit rgcpu;
 {$ifdef TEMPREGDEBUG}
               reg_user[R_EBX]:=curptree^;
 {$endif TEMPREGDEBUG}
-              exprasmlist.concat(tairegalloc.alloc(R_EBX));
+              exprasmlist.concat(tai_regalloc.alloc(R_EBX));
            end
          else if R_ECX in unusedregsint then
            begin
@@ -199,7 +198,7 @@ unit rgcpu;
 {$ifdef TEMPREGDEBUG}
               reg_user[R_ECX]:=curptree^;
 {$endif TEMPREGDEBUG}
-              exprasmlist.concat(tairegalloc.alloc(R_ECX));
+              exprasmlist.concat(tai_regalloc.alloc(R_ECX));
            end
          else internalerror(10);
 {$ifdef TEMPREGDEBUG}
@@ -215,7 +214,7 @@ unit rgcpu;
          if (r = R_EDI) or
             ((not assigned(procinfo^._class)) and (r = R_ESI)) then
            begin
-             list.concat(Tairegalloc.DeAlloc(r));
+             list.concat(tai_regalloc.DeAlloc(r));
              exit;
            end;
          if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then
@@ -228,7 +227,7 @@ unit rgcpu;
      begin
        if r in [R_ESI,R_EDI] then
          begin
-           list.concat(Tairegalloc.Alloc(r));
+           list.concat(tai_regalloc.Alloc(r));
            getexplicitregisterint := r;
            exit;
          end;
@@ -430,7 +429,11 @@ end.
 
 {
   $Log$
-  Revision 1.7  2002-05-16 19:46:52  carl
+  Revision 1.8  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.7  2002/05/16 19:46:52  carl
   + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
   + try to fix temp allocation (still in ifdef)
   + generic constructor calls

compiler/i386/rropt386.pas

@@ -27,7 +27,7 @@ Unit rrOpt386;
 
 Interface
 
-Uses aasm;
+Uses aasmbase,aasmtai,aasmcpu;
 
 procedure doRenaming(asml: TAAsmoutput; first, last: Tai);
 
@@ -35,7 +35,7 @@ Implementation
 
 Uses
   {$ifdef replaceregdebug}cutils,{$endif}
-  verbose,globals,cpubase,cpuasm,daopt386,csopt386,cginfo,rgobj;
+  verbose,globals,cpubase,daopt386,csopt386,cginfo,rgobj;
 
 function canBeFirstSwitch(p: Taicpu; reg: tregister): boolean;
 { checks whether an operation on reg can be switched to another reg without an }
@@ -350,7 +350,11 @@ End.
 
 {
   $Log$
-  Revision 1.17  2002-05-18 13:34:26  peter
+  Revision 1.18  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.17  2002/05/18 13:34:26  peter
     * readded missing revisions
 
   Revision 1.16  2002/05/16 19:46:52  carl

compiler/import.pas

@@ -28,10 +28,10 @@ interface
 uses
   cutils,cclasses,
   systems,
-  aasm;
+  aasmbase;
 
 type
-   timported_item = class(tlinkedlistitem)
+   timported_item = class(TLinkedListItem)
       ordnr  : word;
       name,
       func   : pstring;
@@ -42,7 +42,7 @@ type
       destructor Destroy;override;
    end;
 
-   timportlist = class(tlinkedlistitem)
+   timportlist = class(TLinkedListItem)
       dllname : pstring;
       imported_items : tlinkedlist;
       constructor Create(const n : string);
@@ -237,7 +237,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.17  2002-05-18 13:34:08  peter
+  Revision 1.18  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.17  2002/05/18 13:34:08  peter
     * readded missing revisions
 
   Revision 1.16  2002/05/16 19:46:37  carl

compiler/link.pas

@@ -49,11 +49,9 @@ Type
 
     TLinker = class
     public
-       Info            : TLinkerInfo;
        ObjectFiles,
        SharedLibFiles,
        StaticLibFiles  : TStringList;
-     { Methods }
        Constructor Create;virtual;
        Destructor Destroy;override;
        procedure AddModuleFiles(hp:tmodule);
@@ -62,15 +60,31 @@ Type
        Procedure AddSharedLibrary(S : String);
        Procedure AddStaticCLibrary(const S : String);
        Procedure AddSharedCLibrary(S : String);
-       Function  FindUtil(const s:string):String;
-       Function  DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
-     { Virtuals }
-       procedure SetDefaultInfo;virtual;
        Function  MakeExecutable:boolean;virtual;
        Function  MakeSharedLibrary:boolean;virtual;
        Function  MakeStaticLibrary:boolean;virtual;
      end;
 
+    TExternalLinker = class(TLinker)
+    public
+       Info : TLinkerInfo;
+       Constructor Create;override;
+       Destructor Destroy;override;
+       Function  FindUtil(const s:string):String;
+       Function  DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
+       procedure SetDefaultInfo;virtual;
+       Function  MakeStaticLibrary:boolean;override;
+     end;
+
+    TInternalLinker = class(TLinker)
+    private
+       procedure readobj(const fn:string);
+    public
+       Constructor Create;override;
+       Destructor Destroy;override;
+       Function  MakeExecutable:boolean;override;
+     end;
+
      TLinkerClass = class of TLinker;
 
 var
@@ -94,7 +108,9 @@ uses
   dos,
 {$endif Delphi}
   cutils,globtype,
-  script,globals,verbose,ppu;
+  script,globals,verbose,ppu,
+  aasmbase,aasmtai,aasmcpu,
+  ogbase,ogmap;
 
 
 {*****************************************************************************
@@ -198,20 +214,6 @@ begin
   ObjectFiles:=TStringList.Create_no_double;
   SharedLibFiles:=TStringList.Create_no_double;
   StaticLibFiles:=TStringList.Create_no_double;
-{ set generic defaults }
-  FillChar(Info,sizeof(Info),0);
-  Info.ResName:='link.res';
-  Info.ScriptName:='script.res';
-{ set the linker specific defaults }
-  SetDefaultInfo;
-{ Allow Parameter overrides for linker info }
-  with Info do
-   begin
-     if ParaLinkOptions<>'' then
-      ExtraOptions:=ParaLinkOptions;
-     if ParaDynamicLinker<>'' then
-      DynamicLinker:=ParaDynamicLinker;
-   end;
 end;
 
 
@@ -223,11 +225,6 @@ begin
 end;
 
 
-Procedure TLinker.SetDefaultInfo;
-begin
-end;
-
-
 procedure TLinker.AddModuleFiles(hp:tmodule);
 var
   mask : longint;
@@ -310,36 +307,6 @@ begin
 end;
 
 
-Function TLinker.FindUtil(const s:string):string;
-var
-  Found    : boolean;
-  FoundBin : string;
-  UtilExe  : string;
-begin
-  if cs_link_on_target in aktglobalswitches then
-    begin
-      { If linking on target, don't add any path PM }
-      FindUtil:=AddExtension(s,target_info.exeext);
-      exit;
-    end;
-  UtilExe:=AddExtension(s,source_info.exeext);
-  FoundBin:='';
-  Found:=false;
-  if utilsdirectory<>'' then
-   Found:=FindFile(utilexe,utilsdirectory,Foundbin);
-  if (not Found) then
-   Found:=FindExe(utilexe,Foundbin);
-  if (not Found) and not(cs_link_extern in aktglobalswitches) then
-   begin
-     Message1(exec_e_util_not_found,utilexe);
-     aktglobalswitches:=aktglobalswitches+[cs_link_extern];
-   end;
-  if (FoundBin<>'') then
-   Message1(exec_t_using_util,FoundBin);
-  FindUtil:=FoundBin;
-end;
-
-
 Procedure TLinker.AddObject(const S,unitpath : String);
 begin
   ObjectFiles.Concat(FindObjectFile(s,unitpath));
@@ -404,7 +371,93 @@ begin
 end;
 
 
-Function TLinker.DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
+function TLinker.MakeExecutable:boolean;
+begin
+  MakeExecutable:=false;
+  Message(exec_e_exe_not_supported);
+end;
+
+
+Function TLinker.MakeSharedLibrary:boolean;
+begin
+  MakeSharedLibrary:=false;
+  Message(exec_e_dll_not_supported);
+end;
+
+
+Function TLinker.MakeStaticLibrary:boolean;
+begin
+  MakeStaticLibrary:=false;
+  Message(exec_e_dll_not_supported);
+end;
+
+
+{*****************************************************************************
+                              TEXTERNALLINKER
+*****************************************************************************}
+
+Constructor TExternalLinker.Create;
+begin
+  inherited Create;
+  { set generic defaults }
+  FillChar(Info,sizeof(Info),0);
+  Info.ResName:='link.res';
+  Info.ScriptName:='script.res';
+  { set the linker specific defaults }
+  SetDefaultInfo;
+  { Allow Parameter overrides for linker info }
+  with Info do
+   begin
+     if ParaLinkOptions<>'' then
+      ExtraOptions:=ParaLinkOptions;
+     if ParaDynamicLinker<>'' then
+      DynamicLinker:=ParaDynamicLinker;
+   end;
+end;
+
+
+Destructor TExternalLinker.Destroy;
+begin
+  inherited destroy;
+end;
+
+
+Procedure TExternalLinker.SetDefaultInfo;
+begin
+end;
+
+
+Function TExternalLinker.FindUtil(const s:string):string;
+var
+  Found    : boolean;
+  FoundBin : string;
+  UtilExe  : string;
+begin
+  if cs_link_on_target in aktglobalswitches then
+    begin
+      { If linking on target, don't add any path PM }
+      FindUtil:=AddExtension(s,target_info.exeext);
+      exit;
+    end;
+  UtilExe:=AddExtension(s,source_info.exeext);
+  FoundBin:='';
+  Found:=false;
+  if utilsdirectory<>'' then
+   Found:=FindFile(utilexe,utilsdirectory,Foundbin);
+  if (not Found) then
+   Found:=FindExe(utilexe,Foundbin);
+  if (not Found) and not(cs_link_extern in aktglobalswitches) then
+   begin
+     Message1(exec_e_util_not_found,utilexe);
+     aktglobalswitches:=aktglobalswitches+[cs_link_extern];
+   end;
+  if (FoundBin<>'') then
+   Message1(exec_t_using_util,FoundBin);
+  FindUtil:=FoundBin;
+end;
+
+
+Function TExternalLinker.DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
 begin
   DoExec:=true;
   if not(cs_link_extern in aktglobalswitches) then
@@ -449,21 +502,7 @@ begin
 end;
 
 
-function TLinker.MakeExecutable:boolean;
-begin
-  MakeExecutable:=false;
-  Message(exec_e_exe_not_supported);
-end;
-
-
-Function TLinker.MakeSharedLibrary:boolean;
-begin
-  MakeSharedLibrary:=false;
-  Message(exec_e_dll_not_supported);
-end;
-
-
-Function TLinker.MakeStaticLibrary:boolean;
+Function TExternalLinker.MakeStaticLibrary:boolean;
 var
   smartpath,
   cmdstr,
@@ -496,6 +535,78 @@ begin
 end;
 
 
+{*****************************************************************************
+                              TINTERNALLINKER
+*****************************************************************************}
+
+Constructor TInternalLinker.Create;
+begin
+  inherited Create;
+  exemap:=nil;
+  exeoutput:=nil;
+end;
+
+
+Destructor TInternalLinker.Destroy;
+begin
+  exeoutput.free;
+  exeoutput:=nil;
+  inherited destroy;
+end;
+
+
+procedure TInternalLinker.readobj(const fn:string);
+var
+  objdata  : TAsmObjectData;
+  objinput : tobjectinput;
+begin
+  Comment(V_Info,'Reading object '+fn);
+  objinput:=exeoutput.newobjectinput;
+  objdata:=objinput.newobjectdata(fn);
+  if objinput.readobjectfile(fn,objdata) then
+    exeoutput.addobjdata(objdata);
+  { release input object }
+  objinput.free;
+end;
+
+
+function TInternalLinker.MakeExecutable:boolean;
+var
+  s : string;
+begin
+  MakeExecutable:=false;
+
+  { no support yet for libraries }
+  if (not StaticLibFiles.Empty) or
+     (not SharedLibFiles.Empty) then
+   internalerror(123456789);
+
+  if (cs_link_map in aktglobalswitches) then
+   exemap:=texemap.create(current_module.mapfilename^);
+
+  { read objects }
+  readobj(FindObjectFile('prt0',''));
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      readobj(s);
+   end;
+
+  { generate executable }
+  exeoutput.GenerateExecutable(current_module.exefilename^);
+
+  { close map }
+  if assigned(exemap) then
+   begin
+     exemap.free;
+     exemap:=nil;
+   end;
+
+  MakeExecutable:=true;
+end;
+
+
 {*****************************************************************************
                                  Init/Done
 *****************************************************************************}
@@ -508,8 +619,11 @@ end;
 
 procedure InitLinker;
 begin
-  if assigned(CLinker[target_info.link]) then
+  if (cs_link_internal in aktglobalswitches) and
+     assigned(CLinker[target_info.link]) then
    linker:=CLinker[target_info.link].Create
+  else if assigned(CLinker[target_info.linkextern]) then
+   linker:=CLinker[target_info.linkextern].Create
   else
    linker:=Tlinker.Create;
 end;
@@ -539,7 +653,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.28  2002-05-18 13:34:08  peter
+  Revision 1.29  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.28  2002/05/18 13:34:08  peter
     * readded missing revisions
 
   Revision 1.27  2002/05/16 19:46:37  carl

compiler/nbas.pas

@@ -27,7 +27,7 @@ unit nbas;
 interface
 
     uses
-       aasm,symtype,node,cpubase;
+       aasmbase,aasmtai,aasmcpu,symtype,node,cpubase;
 
     type
        tnothingnode = class(tnode)
@@ -675,7 +675,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2002-06-24 12:43:00  jonas
+  Revision 1.27  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.26  2002/06/24 12:43:00  jonas
     * fixed errors found with new -CR code from Peter when cycling with -O2p3r
 
   Revision 1.25  2002/05/18 13:34:09  peter

compiler/ncgbas.pas

@@ -63,8 +63,8 @@ interface
     uses
       globtype,systems,
       cutils,verbose,globals,
-      aasm,symsym,
-      cpubase,cpuasm,
+      aasmbase,aasmtai,aasmcpu,symsym,
+      cpubase,
       nflw,pass_2,
       cgbase,cgobj,tgobj,rgobj
       ;
@@ -294,7 +294,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2002-05-18 13:34:09  peter
+  Revision 1.20  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.19  2002/05/18 13:34:09  peter
     * readded missing revisions
 
   Revision 1.18  2002/05/16 19:46:37  carl

compiler/ncgcnv.pas

@@ -62,7 +62,7 @@ interface
 
     uses
       cutils,verbose,
-      aasm,symconst,symdef,
+      aasmbase,aasmtai,aasmcpu,symconst,symdef,
       ncon,ncal,
       cpubase,cpuinfo,
       pass_2,
@@ -490,7 +490,11 @@ end.
 
 {
   $Log$
-  Revision 1.16  2002-07-01 16:23:53  peter
+  Revision 1.17  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.16  2002/07/01 16:23:53  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/ncgcon.pas

@@ -65,7 +65,7 @@ implementation
     uses
       globtype,widestr,systems,
       verbose,globals,
-      symconst,symdef,aasm,types,
+      symconst,symdef,aasmbase,aasmtai,types,
       cpuinfo,cpubase,
       cginfo,cgbase,tgobj,rgobj;
 
@@ -519,7 +519,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  2002-07-01 16:23:53  peter
+  Revision 1.12  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.11  2002/07/01 16:23:53  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/ncgflw.pas

@@ -71,9 +71,9 @@ implementation
 
     uses
       verbose,globals,systems,globtype,
-      symconst,symsym,aasm,types,
+      symconst,symsym,aasmbase,aasmtai,aasmcpu,types,
       cginfo,cgbase,pass_2,
-      cpubase,cpuasm,cpuinfo,
+      cpubase,cpuinfo,
       nld,ncon,
       tgobj,rgobj,
       ncgutil,
@@ -628,7 +628,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.20  2002-07-01 16:23:53  peter
+  Revision 1.21  2002-07-01 18:46:22  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.20  2002/07/01 16:23:53  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/ncgld.pas

@@ -55,7 +55,7 @@ implementation
       verbose,globals,
       symconst,symtype,symdef,symsym,symtable,types,
       ncnv,ncon,nmem,
-      aasm,cpuasm,regvars,
+      aasmbase,aasmtai,aasmcpu,regvars,
       cginfo,cgbase,pass_2,
       cpubase,cpuinfo,
       tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu;
@@ -921,7 +921,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2002-07-01 16:23:53  peter
+  Revision 1.11  2002-07-01 18:46:23  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.10  2002/07/01 16:23:53  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/ncgmem.pas

@@ -72,7 +72,8 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,symsym,aasm,
+      symconst,symdef,symsym,
+      aasmbase,aasmtai,aasmcpu,
       cgbase,pass_2,
       nld,ncon,nadd,
       cpuinfo,cpubase,cgobj,cgcpu,
@@ -462,7 +463,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2002-07-01 16:23:53  peter
+  Revision 1.15  2002-07-01 18:46:23  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.14  2002/07/01 16:23:53  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/ncgutil.pas

@@ -28,7 +28,7 @@ interface
 
     uses
       node,
-      cginfo,cpubase,aasm,
+      cginfo,cpubase,aasmbase,aasmtai,aasmcpu,
       rgobj;
 
     type
@@ -74,7 +74,7 @@ implementation
     cutils,cclasses,globtype,globals,systems,verbose,
     symbase,symconst,symtype,symsym,symdef,symtable,types,
     fmodule,
-    cgbase,regvars,tainst,cpuasm,
+    cgbase,regvars,
 {$ifdef GDB}
     gdb,
 {$endif GDB}
@@ -1165,7 +1165,7 @@ implementation
           we must load it into ESI }
         If (po_containsself in aktprocdef.procoptions) then
           begin
-             list.concat(Tairegalloc.Alloc(self_pointer_reg));
+             list.concat(tai_regalloc.Alloc(self_pointer_reg));
              reference_reset_base(href,procinfo^.framepointer,procinfo^.selfpointer_offset);
              cg.a_load_ref_reg(list,OS_ADDR,href,self_pointer_reg);
           end;
@@ -1611,7 +1611,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.18  2002-07-01 16:23:53  peter
+  Revision 1.19  2002-07-01 18:46:23  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.18  2002/07/01 16:23:53  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/ncon.pas

@@ -29,7 +29,7 @@ interface
     uses
       globtype,widestr,
       node,
-      aasm,cpuinfo,globals,
+      aasmbase,aasmtai,cpuinfo,globals,
       symconst,symtype,symdef,symsym;
 
     type
@@ -721,7 +721,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  2002-05-18 13:34:09  peter
+  Revision 1.33  2002-07-01 18:46:23  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.32  2002/05/18 13:34:09  peter
     * readded missing revisions
 
   Revision 1.31  2002/05/16 19:46:37  carl

compiler/nflw.pas

@@ -28,7 +28,7 @@ unit nflw;
 interface
 
     uses
-       node,aasm,cpubase,
+       node,aasmbase,aasmtai,aasmcpu,cpubase,
        symbase,symdef,symsym;
 
     type
@@ -1113,7 +1113,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  2002-05-18 13:34:10  peter
+  Revision 1.33  2002-07-01 18:46:23  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.32  2002/05/18 13:34:10  peter
     * readded missing revisions
 
   Revision 1.31  2002/05/16 19:46:38  carl

compiler/nobj.pas

@@ -29,7 +29,7 @@ interface
 
     uses
        cutils,cclasses,
-       symdef,aasm;
+       symdef,aasmbase,aasmtai,aasmcpu;
 
     type
       pprocdeftree = ^tprocdeftree;
@@ -1269,7 +1269,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.20  2002-05-18 13:34:10  peter
+  Revision 1.21  2002-07-01 18:46:23  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.20  2002/05/18 13:34:10  peter
     * readded missing revisions
 
   Revision 1.19  2002/05/16 19:46:39  carl

compiler/node.pas

@@ -30,7 +30,7 @@ interface
        cclasses,
        globtype,globals,
        cpubase,
-       aasm,
+       aasmbase,
        symtype;
 
     type
@@ -806,7 +806,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2002-05-18 13:34:10  peter
+  Revision 1.28  2002-07-01 18:46:24  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.27  2002/05/18 13:34:10  peter
     * readded missing revisions
 
   Revision 1.26  2002/05/16 19:46:39  carl

compiler/nset.pas

@@ -27,7 +27,7 @@ unit nset;
 interface
 
     uses
-       node,globals,aasm;
+       node,globals,aasmbase,aasmtai;
 
     type
       pcaserecord = ^tcaserecord;
@@ -574,7 +574,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2002-05-18 13:34:10  peter
+  Revision 1.25  2002-07-01 18:46:24  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.24  2002/05/18 13:34:10  peter
     * readded missing revisions
 
   Revision 1.23  2002/05/16 19:46:39  carl

compiler/ogelf.pas

@@ -36,12 +36,12 @@ interface
        { target }
        systems,
        { assembler }
-       cpubase,aasm,assemble,
+       cpubase,aasmbase,assemble,
        { output }
        ogbase;
 
     type
-       telf32section = class(tobjectsection)
+       telf32section = class(TAsmSection)
        public
           secshidx  : longint; { index for the section in symtab }
           shstridx,
@@ -57,39 +57,40 @@ interface
           destructor  destroy;override;
        end;
 
-       telf32data = class(tobjectdata)
+       telf32objectdata = class(TAsmObjectData)
        public
          symtabsect,
          strtabsect,
          shstrtabsect,
          gotpcsect,
          gotoffsect,
-         gotsect,
-         pltsect,
+         goTSect,
+         plTSect,
          symsect  : telf32Section;
          syms     : Tdynamicarray;
-         constructor create;
+         constructor create(const n:string);
          destructor  destroy;override;
-         procedure createsection(sec:tsection);override;
-         procedure setsectionsizes(var s:tsecsize);override;
-         procedure writereloc(data,len:longint;p:tasmsymbol;relative:relative_type);override;
+         procedure createsection(sec:TSection);override;
+         procedure seTSectionsizes(var s:TAsmSectionSizes);override;
+         procedure writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);override;
          procedure writesymbol(p:tasmsymbol);override;
-         procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
-         procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:tasmsymbol;
+         procedure writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
+         procedure writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;
                                  nidx,nother,line:longint;reloc:boolean);override;
        end;
 
        telf32objectoutput = class(tobjectoutput)
        private
-         initsym  : longint;
+         elf32data : telf32objectdata;
+         initsym   : longint;
          procedure createrelocsection(s:telf32section);
          procedure createshstrtab;
          procedure createsymtab;
          procedure writesectionheader(s:telf32section);
        protected
-         procedure writetodisk;override;
+         function writedata(data:TAsmObjectData):boolean;override;
        public
-         function  initwriting(const fn:string):boolean;override;
+         function newobjectdata(const n:string):TAsmObjectData;override;
        end;
 
        telf32assembler = class(tinternalassembler)
@@ -275,14 +276,14 @@ implementation
 
 
 {****************************************************************************
-                            TElf32Data
+                            telf32objectdata
 ****************************************************************************}
 
-    constructor telf32data.create;
+    constructor telf32objectdata.create(const n:string);
       var
         s : string;
       begin
-        inherited create;
+        inherited create(n);
         { reset }
         Syms:=TDynamicArray.Create(symbolresize);
         { default sections }
@@ -309,7 +310,7 @@ implementation
       end;
 
 
-    destructor telf32data.destroy;
+    destructor telf32objectdata.destroy;
       begin
         Syms.Free;
         symtabsect.free;
@@ -319,60 +320,33 @@ implementation
       end;
 
 
-    procedure telf32data.createsection(sec:tsection);
+    procedure telf32objectdata.createsection(sec:TSection);
       begin
         sects[sec]:=telf32Section.createsec(Sec);
       end;
 
 
-    procedure telf32data.writesymbol(p:tasmsymbol);
-      var
-        sym : toutputsymbol;
+    procedure telf32objectdata.writesymbol(p:tasmsymbol);
       begin
         { already written ? }
-        if p.idx<>-1 then
+        if p.indexnr<>-1 then
          exit;
         { be sure that the section will exists }
         if (p.section<>sec_none) and not(assigned(sects[p.section])) then
           createsection(p.section);
-        FillChar(sym,sizeof(sym),0);
-        sym.size:=p.size;
-        sym.bind:=p.bind;
-        sym.typ:=p.typ;
-        { if local of global then set the section value to the address
-          of the symbol }
-        case sym.bind of
-          AB_LOCAL,
-          AB_GLOBAL :
-            begin
-              sym.section:=p.section;
-              sym.value:=p.address;
-            end;
-          AB_COMMON :
-            begin
-              sym.value:=$10;
-            end;
-        end;
-        { store the symbol, but not the local ones }
-        if (sym.bind<>AB_LOCAL) then
+        { calculate symbol index }
+        if (p.currbind<>AB_LOCAL) then
          begin
-           { symbolname, write the #0 separate to overcome 255+1 char not possible }
-           sym.nameidx:=strtabsect.datasize;
-           strtabsect.writestr(p.name);
-           strtabsect.writestr(#0);
-           { update the asmsymbol index }
-           p.idx:=syms.size div sizeof(toutputsymbol);
-           { symbol }
-           Syms.write(sym,sizeof(toutputsymbol));
+           { insert the symbol in the local index, the indexarray
+             will take care of the numbering }
+           symbols.insert(p);
          end
         else
-         begin
-           p.idx:=-2; { local }
-         end;
+         p.indexnr:=-2; { local }
       end;
 
 
-    procedure telf32data.writereloc(data,len:longint;p:tasmsymbol;relative:relative_type);
+    procedure telf32objectdata.writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);
       var
         symaddr : longint;
       begin
@@ -386,32 +360,32 @@ implementation
            if p.section=currsec then
              begin
                case relative of
-                 relative_false :
+                 RELOC_ABSOLUTE :
                    begin
-                     sects[currsec].addsectionreloc(sects[currsec].datasize,currsec,relative_false);
+                     sects[currsec].addsectionreloc(sects[currsec].datasize,currsec,RELOC_ABSOLUTE);
                      inc(data,symaddr);
                    end;
-                 relative_true :
+                 RELOC_RELATIVE :
                    begin
                      inc(data,symaddr-len-sects[currsec].datasize);
                    end;
-                 relative_rva :
+                 RELOC_RVA :
                    internalerror(3219583);
                end;
              end
            else
              begin
                writesymbol(p);
-               if (p.section<>sec_none) and (relative<>relative_true) then
+               if (p.section<>sec_none) and (relative<>RELOC_RELATIVE) then
                 begin
                   sects[currsec].addsectionreloc(sects[currsec].datasize,p.section,relative);
                   inc(data,symaddr);
                 end
                else
                 sects[currsec].addsymreloc(sects[currsec].datasize,p,relative);
-               if relative=relative_true then
+               if relative=RELOC_RELATIVE then
                 begin
-                  if p.bind=AB_EXTERNAL then
+                  if p.currbind=AB_EXTERNAL then
                    dec(data,len)
                   else
                    dec(data,len+sects[currsec].datasize);
@@ -422,7 +396,7 @@ implementation
       end;
 
 
-    procedure telf32data.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
+    procedure telf32objectdata.writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
       var
         stab : telf32stab;
       begin
@@ -450,12 +424,12 @@ implementation
         { when the offset is not 0 then write a relocation, take also the
           hdrstab into account with the offset }
         if reloc then
-         sects[sec_stab].addsectionreloc(sects[sec_stab].datasize-4,section,relative_false);
+         sects[sec_stab].addsectionreloc(sects[sec_stab].datasize-4,section,RELOC_ABSOLUTE);
       end;
 
 
-    procedure telf32data.writesymstabs(section:tsection;offset:longint;p:pchar;ps:tasmsymbol;
-                                                 nidx,nother,line:longint;reloc:boolean);
+    procedure telf32objectdata.writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;
+                                             nidx,nother,line:longint;reloc:boolean);
       var
         stab : telf32stab;
       begin
@@ -473,11 +447,11 @@ implementation
         { when the offset is not 0 then write a relocation, take also the
           hdrstab into account with the offset }
         if reloc then
-         sects[sec_stab].addsymreloc(sects[sec_stab].datasize-4,ps,relative_false);
+         sects[sec_stab].addsymreloc(sects[sec_stab].datasize-4,ps,RELOC_ABSOLUTE);
       end;
 
 
-    procedure telf32data.setsectionsizes(var s:tsecsize);
+    procedure telf32objectdata.seTSectionsizes(var s:TAsmSectionSizes);
       begin
       end;
 
@@ -486,61 +460,54 @@ implementation
                             telf32objectoutput
 ****************************************************************************}
 
-    function telf32objectoutput.initwriting(const fn:string):boolean;
+    function telf32objectoutput.newobjectdata(const n:string):TAsmObjectData;
       begin
-        result:=inherited initwriting(fn);
-        if result then
-         begin
-           initsym:=0;
-           Fdata:=telf32data.create;
-         end;
+        result:=telf32objectdata.create(n);
       end;
 
 
     procedure telf32objectoutput.createrelocsection(s:telf32section);
       var
         rel  : telf32reloc;
-        hr,r : poutputreloc;
+        r    : tasmrelocation;
         relsym,reltyp : longint;
       begin
-        with telf32data(data) do
+        with elf32data do
          begin
            { create the reloc section }
            s.relocsect:=telf32section.createname('.rel'+s.name,9,0,symtabsect.secshidx,s.secshidx,4,8);
            { add the relocations }
-           r:=s.relochead;
+           r:=TasmRelocation(s.relocations.first);
            while assigned(r) do
             begin
-              rel.address:=r^.address;
-              if assigned(r^.symbol) then
+              rel.address:=r.address;
+              if assigned(r.symbol) then
                begin
-                 if (r^.symbol.bind=AB_LOCAL) then
-                  relsym:=sects[r^.symbol.section].secsymidx
+                 if (r.symbol.currbind=AB_LOCAL) then
+                  relsym:=sects[r.symbol.section].secsymidx
                  else
                   begin
-                    if r^.symbol.idx=-1 then
+                    if r.symbol.indexnr=-1 then
                       internalerror(4321);
-                    relsym:=(r^.symbol.idx+initsym);
+                    { indexnr starts with 1, ELF starts with 0 }
+                    relsym:=r.symbol.indexnr+initsym-1;
                   end;
                end
               else
-               if r^.section<>sec_none then
-                relsym:=sects[r^.section].secsymidx
+               if r.section<>sec_none then
+                relsym:=sects[r.section].secsymidx
                else
                 relsym:=SHN_UNDEF;
-              case r^.typ of
-                relative_true :
+              case r.typ of
+                RELOC_RELATIVE :
                   reltyp:=R_386_PC32;
-                relative_false :
+                RELOC_ABSOLUTE :
                   reltyp:=R_386_32;
               end;
               rel.info:=(relsym shl 8) or reltyp;
               { write reloc }
               s.relocsect.write(rel,sizeof(rel));
-              { goto next and dispose this reloc }
-              hr:=r;
-              r:=r^.next;
-              dispose(hr);
+              r:=TAsmRelocation(r.next);
             end;
          end;
       end;
@@ -549,24 +516,24 @@ implementation
     procedure telf32objectoutput.createsymtab;
       var
         elfsym : telf32symbol;
-        sym : toutputsymbol;
-        sec : tsection;
+        sec : TSection;
         locals,
         i : longint;
+        sym : tasmsymbol;
       begin
-        with telf32data(data) do
+        with elf32data do
          begin
            locals:=2;
-         { empty entry }
+           { empty entry }
            fillchar(elfsym,sizeof(elfsym),0);
            symtabsect.write(elfsym,sizeof(elfsym));
-         { filename entry }
+           { filename entry }
            elfsym.st_name:=1;
            elfsym.st_info:=STT_FILE;
            elfsym.st_shndx:=SHN_ABS;
            symtabsect.write(elfsym,sizeof(elfsym));
-         { section }
-           for sec:=low(tsection) to high(tsection) do
+           { section }
+           for sec:=low(TSection) to high(TSection) do
             if assigned(sects[sec]) then
              begin
                fillchar(elfsym,sizeof(elfsym),0);
@@ -576,16 +543,24 @@ implementation
                symtabsect.write(elfsym,sizeof(elfsym));
                inc(locals);
              end;
-         { symbols }
-           Syms.seek(0);
-           for i:=1 to (Syms.size div sizeof(toutputsymbol)) do
+           { symbols }
+           sym:=Tasmsymbol(symbols.First);
+           while assigned(sym) do
             begin
-              Syms.read(sym,sizeof(toutputsymbol));
               fillchar(elfsym,sizeof(elfsym),0);
-              elfsym.st_name:=sym.nameidx;
-              elfsym.st_value:=sym.value;
+              { symbolname, write the #0 separate to overcome 255+1 char not possible }
+              elfsym.st_name:=strtabsect.datasize;
+              strtabsect.writestr(sym.name);
+              strtabsect.writestr(#0);
+              case sym.currbind of
+                AB_LOCAL,
+                AB_GLOBAL :
+                 elfsym.st_value:=sym.address;
+                AB_COMMON :
+                 elfsym.st_value:=$10;
+              end;
               elfsym.st_size:=sym.size;
-              case sym.bind of
+              case sym.currbind of
                 AB_LOCAL :
                   begin
                     elfsym.st_info:=STB_LOCAL shl 4;
@@ -596,7 +571,7 @@ implementation
                 AB_GLOBAL :
                   elfsym.st_info:=STB_GLOBAL shl 4;
               end;
-              if sym.bind<>AB_EXTERNAL then
+              if sym.currbind<>AB_EXTERNAL then
                begin
                  case sym.typ of
                    AT_FUNCTION :
@@ -605,7 +580,7 @@ implementation
                      elfsym.st_info:=elfsym.st_info or STT_OBJECT;
                  end;
                end;
-              if sym.bind=AB_COMMON then
+              if sym.currbind=AB_COMMON then
                elfsym.st_shndx:=SHN_COMMON
               else
                if assigned(sects[sym.section]) then
@@ -613,8 +588,9 @@ implementation
                else
                 elfsym.st_shndx:=SHN_UNDEF;
               symtabsect.write(elfsym,sizeof(elfsym));
+              sym:=tasmsymbol(sym.indexnext);
             end;
-         { update the .symtab section header }
+           { update the .symtab section header }
            symtabsect.shlink:=strtabsect.secshidx;
            symtabsect.shinfo:=locals;
          end;
@@ -623,9 +599,9 @@ implementation
 
     procedure telf32objectoutput.createshstrtab;
       var
-        sec : tsection;
+        sec : TSection;
       begin
-        with telf32data(data) do
+        with elf32data do
          begin
            with shstrtabsect do
             begin
@@ -633,7 +609,7 @@ implementation
               symtabsect.shstridx:=writestr('.symtab'#0);
               strtabsect.shstridx:=writestr('.strtab'#0);
               shstrtabsect.shstridx:=writestr('.shstrtab'#0);
-              for sec:=low(tsection) to high(tsection) do
+              for sec:=low(TSection) to high(TSection) do
                if assigned(sects[sec]) then
                 begin
                   telf32section(sects[sec]).shstridx:=writestr(sects[sec].name+#0);
@@ -663,24 +639,26 @@ implementation
       end;
 
 
-    procedure telf32objectoutput.writetodisk;
+    function telf32objectoutput.writedata(data:TAsmObjectData):boolean;
       var
         header : telf32header;
         datapos,
         shoffset,
         nsects : longint;
         hstab  : telf32stab;
-        sec    : tsection;
+        sec    : TSection;
         empty  : array[0..63] of byte;
         hp     : pdynamicblock;
       begin
-        with telf32data(data) do
+        result:=false;
+        elf32data:=telf32objectdata(data);
+        with elf32data do
          begin
          { calc amount of sections we have }
            fillchar(empty,sizeof(empty),0);
            nsects:=1;
            initsym:=2;
-           for sec:=low(tsection) to high(tsection) do
+           for sec:=low(TSection) to high(TSection) do
             if assigned(sects[sec]) then
              begin
                { each section requires a symbol for relocation }
@@ -689,7 +667,7 @@ implementation
                { also create the index in the section header table }
                telf32section(sects[sec]).secshidx:=nsects;
                inc(nsects);
-               if assigned(sects[sec].relochead) then
+               if sects[sec].relocations.count>0 then
                 inc(nsects);
              end;
            { add default sections follows }
@@ -712,18 +690,18 @@ implementation
               sects[sec_stab].Data.write(hstab,sizeof(hstab));
             end;
          { Create the relocation sections }
-           for sec:=low(tsection) to high(tsection) do
+           for sec:=low(TSection) to high(TSection) do
             if assigned(sects[sec]) and
-               (sects[sec].nrelocs>0) then
+               (sects[sec].relocations.count>0) then
               createrelocsection(telf32section(sects[sec]));
-         { create .symtab }
+         { create .symtab and .strtab }
            createsymtab;
          { create .shstrtab }
            createshstrtab;
          { Calculate the filepositions }
            datapos:=$40; { elfheader + alignment }
            { sections first }
-           for sec:=low(tsection) to high(tsection) do
+           for sec:=low(TSection) to high(TSection) do
             if assigned(sects[sec]) then
              begin
                sects[sec].datapos:=datapos;
@@ -743,7 +721,7 @@ implementation
            strtabsect.datapos:=datapos;
            inc(datapos,align(strtabsect.datasize,4));
            { .rel sections }
-           for sec:=low(tsection) to high(tsection) do
+           for sec:=low(TSection) to high(TSection) do
             if assigned(sects[sec]) and
                assigned(telf32section(sects[sec]).relocsect) then
              begin
@@ -767,7 +745,7 @@ implementation
            writer.write(header,sizeof(header));
            writer.write(empty,$40-sizeof(header)); { align }
          { Sections }
-           for sec:=low(tsection) to high(tsection) do
+           for sec:=low(TSection) to high(TSection) do
             if assigned(sects[sec]) and
                assigned(sects[sec].data) then
              begin
@@ -789,7 +767,7 @@ implementation
             end;
          { section headers, start with an empty header for sh_undef }
            writer.write(empty,sizeof(telf32sechdr));
-           for sec:=low(tsection) to high(tsection) do
+           for sec:=low(TSection) to high(TSection) do
             if assigned(sects[sec]) then
              begin
                writesectionheader(telf32section(sects[sec]));
@@ -816,7 +794,7 @@ implementation
               hp:=hp^.next;
             end;
          { .rel sections }
-           for sec:=low(tsection) to high(tsection) do
+           for sec:=low(TSection) to high(TSection) do
             if assigned(sects[sec]) and
                assigned(telf32section(sects[sec]).relocsect) then
              begin
@@ -829,6 +807,7 @@ implementation
                 end;
              end;
          end;
+        result:=true;
       end;
 
 
@@ -865,7 +844,7 @@ implementation
             secnames : ('',
               '.text','.data','.bss',
               '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.stab','.stabstr')
+              '.stab','.stabstr','')
           );
 
 
@@ -874,7 +853,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.15  2002-05-18 13:34:10  peter
+  Revision 1.16  2002-07-01 18:46:24  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.15  2002/05/18 13:34:10  peter
     * readded missing revisions
 
   Revision 1.14  2002/05/16 19:46:39  carl

compiler/ogmap.pas

@@ -0,0 +1,145 @@
+{
+    $Id$
+    Copyright (c) 2001-2002 by Peter Vreman
+
+    Contains the class for generating a map file
+
+    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 ogmap;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       { common }
+       cclasses,systems,
+       { object writer }
+       aasmbase,ogbase
+       ;
+
+    type
+       texemap = class
+       private
+         t : text;
+       public
+         constructor Create(const s:string);
+         destructor Destroy;override;
+         procedure Add(const s:string);
+         procedure AddCommonSymbolsHeader;
+         procedure AddCommonSymbol(p:tasmsymbol);
+         procedure AddMemoryMapHeader;
+         procedure AddMemoryMapSection(p:texesection);
+         procedure AddMemoryMapObjectData(p:TAsmObjectData;sec:TSection);
+         procedure AddMemoryMapSymbol(p:tasmsymbol);
+       end;
+
+    var
+      exemap : texemap;
+
+
+implementation
+
+    uses
+      cutils,globtype,globals,verbose,fmodule;
+
+
+{****************************************************************************
+                                  TExeMap
+****************************************************************************}
+
+     constructor TExeMap.Create(const s:string);
+       begin
+         Assign(t,FixFileName(s));
+         Rewrite(t);
+       end;
+
+
+     destructor TExeMap.Destroy;
+       begin
+         Close(t);
+       end;
+
+
+     procedure TExeMap.Add(const s:string);
+       begin
+         writeln(t,s);
+       end;
+
+
+     procedure TExeMap.AddCommonSymbolsHeader;
+       begin
+         writeln(t,'');
+         writeln(t,'Allocating common symbols');
+         writeln(t,'Common symbol       size              file');
+         writeln(t,'');
+       end;
+
+
+     procedure TExeMap.AddCommonSymbol(p:tasmsymbol);
+       var
+         s : string;
+       begin
+         { Common symbol       size              file }
+         s:=p.name;
+         if length(s)>20 then
+          begin
+            writeln(t,p.name);
+            s:='';
+          end;
+         writeln(t,PadSpace(s,20)+'0x'+PadSpace(hexstr(p.size,1),16)+TAsmObjectData(p.objectdata).name);
+       end;
+
+
+     procedure TExeMap.AddMemoryMapHeader;
+       begin
+         writeln(t,'');
+         writeln(t,'Memory map');
+         writeln(t,'');
+       end;
+
+
+     procedure TExeMap.AddMemoryMapSection(p:texesection);
+       begin
+         { .text           0x000018a8     0xd958 }
+         writeln(t,PadSpace(p.name,18)+PadSpace('0x'+HexStr(p.mempos,8),15)+'0x'+HexStr(p.memsize,1));
+       end;
+
+
+     procedure TExeMap.AddMemoryMapObjectData(p:TAsmObjectData;sec:TSection);
+       begin
+         { .text           0x000018a8     0xd958     object.o }
+         writeln(t,' '+PadSpace(p.sects[sec].name,17)+PadSpace('0x'+HexStr(p.sects[sec].mempos,8),16)+
+                   '0x'+HexStr(p.sects[sec].memsize,1)+' '+p.name);
+       end;
+
+
+     procedure TExeMap.AddMemoryMapSymbol(p:tasmsymbol);
+       begin
+         {                 0x00001e30                setup_screens }
+         writeln(t,Space(18)+PadSpace('0x'+HexStr(p.address,8),26)+p.name);
+       end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-07-01 18:46:24  peter
+    * internal linker
+    * reorganized aasm layer
+
+}

compiler/options.pas

@@ -854,6 +854,8 @@ begin
               'X' : begin
                       for j:=1 to length(More) do
                        case More[j] of
+                        'i' : include(initglobalswitches,cs_link_internal);
+                        'm' : include(initglobalswitches,cs_link_map);
                         's' : include(initglobalswitches,cs_link_strip);
                         't' : include(initglobalswitches,cs_link_staticflag);
                         'D' : begin
@@ -886,6 +888,7 @@ begin
                         '-' : begin
                                 exclude(initglobalswitches,cs_link_staticflag);
                                 exclude(initglobalswitches,cs_link_strip);
+                                exclude(initglobalswitches,cs_link_map);
                                 set_default_link_type;
                               end;
                        else
@@ -1665,7 +1668,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.74  2002-07-01 16:23:53  peter
+  Revision 1.75  2002-07-01 18:46:24  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.74  2002/07/01 16:23:53  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/owbase.pas

@@ -270,6 +270,7 @@ end;
 
 function tobjectreader.readarray(a:TDynamicArray;len:longint):boolean;
 var
+  orglen,
   left,
   idx : longint;
 begin
@@ -277,6 +278,7 @@ begin
   if bufmax=0 then
    if not readbuf then
     exit;
+  orglen:=len;
   idx:=0;
   while len>0 do
    begin
@@ -298,14 +300,18 @@ begin
         break;
       end;
    end;
-  readarray:=(idx=len);
+  readarray:=(idx=orglen);
 end;
 
 
 end.
 {
   $Log$
-  Revision 1.10  2002-05-18 13:34:11  peter
+  Revision 1.11  2002-07-01 18:46:24  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.10  2002/05/18 13:34:11  peter
     * readded missing revisions
 
   Revision 1.9  2002/05/16 19:46:42  carl

compiler/parser.pas

@@ -38,7 +38,9 @@ implementation
     uses
       cutils,cclasses,
       globtype,version,tokens,systems,globals,verbose,
-      symbase,symtable,symdef,symsym,fmodule,fppu,aasm,
+      symbase,symtable,symdef,symsym,
+      fmodule,fppu,
+      aasmbase,aasmtai,
       cgbase,
       script,gendef,
 {$ifdef BrowserLog}
@@ -628,7 +630,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.33  2002-05-18 13:34:11  peter
+  Revision 1.34  2002-07-01 18:46:24  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.33  2002/05/18 13:34:11  peter
     * readded missing revisions
 
   Revision 1.32  2002/05/16 19:46:42  carl

compiler/pass_2.pas

@@ -52,7 +52,8 @@ implementation
 {$endif}
      globtype,systems,verbose,
      cclasses,globals,
-     symconst,symbase,symtype,symsym,aasm,
+     symconst,symbase,symtype,symsym,
+     aasmbase,aasmtai,
      pass_1,cpubase,cgbase,regvars,nflw,rgobj;
 
 {*****************************************************************************
@@ -321,7 +322,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  2002-05-18 13:34:11  peter
+  Revision 1.31  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.30  2002/05/18 13:34:11  peter
     * readded missing revisions
 
   Revision 1.29  2002/05/16 19:46:42  carl

compiler/pdecl.pas

@@ -52,7 +52,7 @@ implementation
        globtype,tokens,verbose,
        systems,
        { aasm }
-       aasm,fmodule,
+       aasmbase,aasmtai,aasmcpu,fmodule,
        { symtable }
        symconst,symbase,symtype,symdef,symtable,
        { pass 1 }
@@ -611,7 +611,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  2002-06-12 13:20:29  jonas
+  Revision 1.48  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.47  2002/06/12 13:20:29  jonas
     * fix from Florian for init/final info of forward classes
 
   Revision 1.46  2002/05/18 13:34:12  peter

compiler/pdecsub.pas

@@ -69,7 +69,7 @@ implementation
        globtype,globals,verbose,
        systems,cpubase,
        { aasm }
-       aasm,
+       aasmbase,aasmtai,aasmcpu,
        { symtable }
        symbase,symtable,types,
        { pass 1 }
@@ -1957,7 +1957,11 @@ const
 end.
 {
   $Log$
-  Revision 1.57  2002-05-18 13:34:12  peter
+  Revision 1.58  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.57  2002/05/18 13:34:12  peter
     * readded missing revisions
 
   Revision 1.56  2002/05/16 19:46:42  carl

compiler/pmodules.pas

@@ -38,11 +38,12 @@ implementation
        globtype,version,systems,tokens,
        cutils,cclasses,comphook,
        globals,verbose,fmodule,finput,fppu,
-       symconst,symbase,symtype,symdef,symsym,symtable,aasm,
+       symconst,symbase,symtype,symdef,symsym,symtable,
+       aasmbase,aasmtai,aasmcpu,
        cgbase,
        ncgutil,
        link,assemble,import,export,gendef,ppu,comprsrc,
-       cresstr,cpubase,cpuasm,
+       cresstr,cpubase,
 {$ifdef GDB}
        gdb,
 {$endif GDB}
@@ -130,7 +131,7 @@ implementation
 
     procedure insertsegment;
 
-        procedure fixseg(p:TAAsmoutput;sec:tsection);
+        procedure fixseg(p:TAAsmoutput;sec:TSection);
         begin
           p.insert(Tai_section.Create(sec));
           if (cs_create_smart in aktmoduleswitches) then
@@ -1383,7 +1384,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.66  2002-05-16 19:46:43  carl
+  Revision 1.67  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.66  2002/05/16 19:46:43  carl
   + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
   + try to fix temp allocation (still in ifdef)
   + generic constructor calls

compiler/pstatmnt.pas

@@ -42,9 +42,9 @@ implementation
        cutils,
        { global }
        globtype,globals,verbose,
-       systems,cpuinfo,cpuasm,
+       systems,cpuinfo,
        { aasm }
-       cpubase,aasm,
+       cpubase,aasmbase,aasmtai,aasmcpu,
        { symtable }
        symconst,symbase,symtype,symdef,symsym,symtable,types,
        { pass 1 }
@@ -1217,7 +1217,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  2002-05-18 13:34:13  peter
+  Revision 1.59  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.58  2002/05/18 13:34:13  peter
     * readded missing revisions
 
   Revision 1.57  2002/05/16 19:46:44  carl

compiler/psub.pas

@@ -47,7 +47,7 @@ implementation
        globtype,globals,tokens,verbose,comphook,
        systems,
        { aasm }
-       cpubase,cpuinfo,aasm,
+       cpubase,cpuinfo,aasmbase,aasmtai,aasmcpu,
        { symtable }
        symconst,symbase,symdef,symsym,symtype,symtable,types,
        ppu,fmodule,
@@ -819,7 +819,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2002-05-18 13:34:14  peter
+  Revision 1.54  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.53  2002/05/18 13:34:14  peter
     * readded missing revisions
 
   Revision 1.52  2002/05/16 19:46:44  carl

compiler/ptconst.pas

@@ -43,7 +43,7 @@ implementation
 {$endif Delphi}
        globtype,systems,tokens,
        cutils,globals,widestr,scanner,
-       symconst,symbase,symdef,aasm,cpuasm,types,verbose,
+       symconst,symbase,symdef,aasmbase,aasmtai,aasmcpu,types,verbose,
        { pass 1 }
        node,
        nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,
@@ -971,7 +971,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.49  2002-05-18 13:34:16  peter
+  Revision 1.50  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.49  2002/05/18 13:34:16  peter
     * readded missing revisions
 
   Revision 1.48  2002/05/16 19:46:44  carl

compiler/rautils.pas

@@ -28,7 +28,7 @@ Interface
 
 Uses
   cutils,cclasses,
-  globtype,aasm,cpubase,
+  globtype,aasmbase,aasmtai,cpubase,
   symconst,symbase,symtype,symdef;
 
 Const
@@ -217,7 +217,8 @@ uses
   strings,
 {$endif}
   types,systems,verbose,globals,
-  symsym,symtable,cpuasm,
+  symsym,symtable,
+  aasmcpu,
   cpuinfo,cgbase;
 
 {*************************************************************************
@@ -1591,7 +1592,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.35  2002-05-18 13:34:17  peter
+  Revision 1.36  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.35  2002/05/18 13:34:17  peter
     * readded missing revisions
 
   Revision 1.34  2002/05/16 19:46:44  carl

compiler/regvars.pas

@@ -27,7 +27,7 @@ unit regvars;
 interface
 
     uses
-       aasm,
+       aasmbase,aasmtai,aasmcpu,
        node,
        symsym,
        cpubase, cginfo, tgobj, rgobj;
@@ -49,7 +49,7 @@ implementation
       globtype,systems,comphook,
       cutils,cclasses,verbose,globals,
       symconst,symbase,symtype,symdef,types,
-      tainst,cgbase,cpuasm,cgobj,cgcpu,rgcpu;
+      cgbase,cgobj,cgcpu,rgcpu;
 
 
     procedure searchregvars(p : tnamedindexitem;arg:pointer);
@@ -286,7 +286,7 @@ implementation
                     hr.base:=procinfo^.framepointer;
                     cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
                   end;
-                asml.concat(Tairegalloc.dealloc(rg.makeregsize(reg,OS_INT)));
+                asml.concat(tai_regalloc.dealloc(rg.makeregsize(reg,OS_INT)));
                 rg.regvar_loaded[rg.makeregsize(reg,OS_INT)] := false;
               end;
             break;
@@ -302,7 +302,7 @@ implementation
       reg:=rg.makeregsize(vsym.reg,OS_INT);
       if not rg.regvar_loaded[reg] then
         begin
-          asml.concat(Tairegalloc.alloc(reg));
+          asml.concat(tai_regalloc.alloc(reg));
           reference_reset(hr);
           if vsym.owner.symtabletype in [inlinelocalsymtable,localsymtable] then
             hr.offset:=-vsym.address+vsym.owner.address_fixup
@@ -454,7 +454,7 @@ implementation
                 begin
                   reg:=rg.makeregsize(regvars[i].reg,OS_INT);
                   if (rg.regvar_loaded[reg]) then
-                   asml.concat(Tairegalloc.dealloc(reg));
+                   asml.concat(tai_regalloc.dealloc(reg));
                 end;
              end;
           end;
@@ -464,7 +464,11 @@ end.
 
 {
   $Log$
-  Revision 1.34  2002-06-24 12:43:00  jonas
+  Revision 1.35  2002-07-01 18:46:25  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.34  2002/06/24 12:43:00  jonas
     * fixed errors found with new -CR code from Peter when cycling with -O2p3r
 
   Revision 1.33  2002/05/18 13:34:17  peter

compiler/rgobj.pas

@@ -30,9 +30,8 @@ unit rgobj;
     uses
       cpubase,
       cpuinfo,
-      cpuasm,
-      tainst,
-      cclasses,globtype,cginfo,cgbase,aasm,node;
+      aasmbase,aasmtai,aasmcpu,
+      cclasses,globtype,cginfo,cgbase,node;
 
     type
        regvar_longintarray = array[firstreg..lastreg] of longint;
@@ -232,7 +231,7 @@ unit rgobj;
                    exclude(unusedregs,i);
                    include(usedinproc,i);
                    dec(countunusedregs);
-                   list.concat(tairegalloc.alloc(i));
+                   list.concat(tai_regalloc.alloc(i));
                    result := i;
                    exit;
                 end;
@@ -262,7 +261,7 @@ unit rgobj;
 {$endif TEMPREGDEBUG}
           inc(countunusedregs);
         include(unusedregs,r);
-        list.concat(tairegalloc.dealloc(r));
+        list.concat(tai_regalloc.dealloc(r));
       end;
 
 
@@ -314,7 +313,7 @@ unit rgobj;
 {$endif TEMPREGDEBUG}
               exclude(unusedregsint,r);
               include(usedinproc,r);
-              list.concat(tairegalloc.alloc(r));
+              list.concat(tai_regalloc.alloc(r));
               getexplicitregisterint:=r;
 {$ifdef TEMPREGDEBUG}
               testregisters32;
@@ -855,7 +854,11 @@ end.
 
 {
   $Log$
-  Revision 1.11  2002-05-18 13:34:17  peter
+  Revision 1.12  2002-07-01 18:46:26  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.11  2002/05/18 13:34:17  peter
     * readded missing revisions
 
   Revision 1.10  2002/05/16 19:46:44  carl

compiler/symdef.pas

@@ -37,7 +37,7 @@ interface
        { node }
        node,
        { aasm }
-       aasm,cpubase,cpuinfo
+       aasmbase,aasmtai,cpubase,cpuinfo
        ;
 
 
@@ -93,7 +93,7 @@ interface
           savesize  : longint;
        end;
 
-       tparaitem = class(tlinkedlistitem)
+       tparaitem = class(TLinkedListItem)
           paratype     : ttype;
           parasym      : tsym;
           paratyp      : tvarspez;
@@ -4822,7 +4822,7 @@ implementation
 
 
     type
-       tclasslistitem = class(tlinkedlistitem)
+       tclasslistitem = class(TLinkedListItem)
           index : longint;
           p : tobjectdef;
        end;
@@ -5478,7 +5478,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.80  2002-07-01 16:23:54  peter
+  Revision 1.81  2002-07-01 18:46:26  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.80  2002/07/01 16:23:54  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/symsym.pas

@@ -35,7 +35,7 @@ interface
        { ppu }
        ppu,symppu,
        { aasm }
-       aasm,cpubase,
+       aasmbase,aasmtai,cpubase,
        globals
        ;
 
@@ -362,7 +362,7 @@ implementation
        gdb,
 {$endif GDB}
        { aasm }
-       cpuasm,
+       aasmcpu,
        { module }
        fmodule,
        { codegen }
@@ -2517,7 +2517,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  2002-05-18 13:34:18  peter
+  Revision 1.40  2002-07-01 18:46:27  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.39  2002/05/18 13:34:18  peter
     * readded missing revisions
 
   Revision 1.38  2002/05/16 19:46:45  carl

compiler/symtable.pas

@@ -35,7 +35,7 @@ interface
        { ppu }
        ppu,symppu,
        { assembler }
-       aasm
+       aasmbase,aasmtai
        ;
 
 
@@ -2060,7 +2060,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.61  2002-05-18 13:34:19  peter
+  Revision 1.62  2002-07-01 18:46:28  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.61  2002/05/18 13:34:19  peter
     * readded missing revisions
 
   Revision 1.60  2002/05/16 19:46:45  carl

compiler/symtype.pas

@@ -32,7 +32,7 @@ interface
       { symtable }
       symconst,symbase,
       { aasm }
-      aasm
+      aasmbase
       ;
 
     type
@@ -528,7 +528,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.18  2002-05-18 13:34:21  peter
+  Revision 1.19  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.18  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.17  2002/05/16 19:46:45  carl

compiler/systems.pas

@@ -54,10 +54,10 @@ interface
             ,MC68000,MC68100,MC68020
        );
 
-       tsection=(sec_none,
+       TSection=(sec_none,
          sec_code,sec_data,sec_bss,
          sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_edata,
-         sec_stab,sec_stabstr
+         sec_stab,sec_stabstr,sec_common
        );
 
        tasmmode= (asmmode_none
@@ -120,6 +120,7 @@ interface
             ld_i386_GO32V1,ld_i386_GO32V2,ld_i386_linux,
               ld_i386_OS2,ld_i386_Win32,ld_i386_freebsd,
               ld_i386_Netware,ld_i386_sunos,ld_i386_beos,
+              ld_i386_coff,ld_i386_pecoff,
             ld_m68k_Amiga,ld_m68k_Atari,ld_m68k_Mac,
               ld_m68k_linux,ld_m68k_PalmOS,ld_m68k_freebsd,
             ld_alpha_linux,
@@ -176,7 +177,7 @@ interface
           labelprefix_only_inside_procedure : boolean;
           labelprefix : string[3];
           comment     : string[2];
-          secnames    : array[tsection] of string[20];
+          secnames    : array[TSection] of string[20];
        end;
 
        parinfo = ^tarinfo;
@@ -686,7 +687,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.45  2002-05-18 13:34:21  peter
+  Revision 1.46  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.45  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.44  2002/05/16 19:46:45  carl

compiler/tainst.pas

@@ -1,325 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by Michael Van Canneyt
-
-    Contains a generic assembler instruction object;
-
-    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 tainst;
-
-{$i fpcdefs.inc}
-
-interface
-
-    Uses
-      cpuinfo,cpubase,aasm,cclasses;
-
-    Type
-      tairegalloc = class(tai)
-         allocation : boolean;
-         reg        : tregister;
-         constructor alloc(r : tregister);
-         constructor dealloc(r : tregister);
-      end;
-
-      taicpu_abstract = class(tai)
-        condition : TAsmCond;
-        ops       : longint;
-        oper      : array[0..max_operands-1] of toper;
-        opcode    : tasmop;
-{$ifdef i386}
-        segprefix : tregister;
-{$endif i386}
-        is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
-        Constructor Create(op : tasmop);
-        Destructor Destroy;override;
-        function getcopy:tlinkedlistitem;override;
-        procedure loadconst(opidx:longint;l:aword);
-        procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
-        procedure loadref(opidx:longint;const r:treference);
-        procedure loadreg(opidx:longint;r:tregister);
-        procedure loadoper(opidx:longint;o:toper);
-        procedure SetCondition(const c:TAsmCond);
-      end;
-
-      { alignment for operator }
-      tai_align_abstract = class(tai)
-         buf       : array[0..63] of char; { buf used for fill }
-         aligntype : byte;   { 1 = no align, 2 = word align, 4 = dword align }
-         fillsize  : byte;   { real size to fill }
-         fillop    : byte;   { value to fill with - optional }
-         use_op    : boolean;
-         constructor Create(b:byte);
-         constructor Create_op(b: byte; _op: byte);
-         function getfillbuf:pchar;virtual;
-      end;
-
-
-implementation
-
-    uses
-      verbose;
-
-
-{*****************************************************************************
-                                 TaiRegAlloc
-*****************************************************************************}
-
-    constructor tairegalloc.alloc(r : tregister);
-      begin
-        inherited create;
-        typ:=ait_regalloc;
-        allocation:=true;
-        reg:=r;
-      end;
-
-
-    constructor tairegalloc.dealloc(r : tregister);
-      begin
-        inherited create;
-        typ:=ait_regalloc;
-        allocation:=false;
-        reg:=r;
-      end;
-
-
-{*****************************************************************************
-                               TaiInstruction
-*****************************************************************************}
-
-    constructor taicpu_abstract.Create(op : tasmop);
-
-      begin
-         inherited create;
-         typ:=ait_instruction;
-         is_jmp:=false;
-         opcode:=op;
-         ops:=0;
-         fillchar(condition,sizeof(condition),0);
-         fillchar(oper,sizeof(oper),0);
-      end;
-
-
-
-    destructor taicpu_abstract.Destroy;
-
-      var
-        i : longint;
-      begin
-        for i:=0 to ops-1 do
-        case oper[i].typ of
-          top_ref:
-            dispose(oper[i].ref);
-          top_symbol:
-            dec(tasmsymbol(oper[i].sym).refs);
-        end;
-        inherited destroy;
-      end;
-
-
-
-{ ---------------------------------------------------------------------
-    Loading of operands.
-  ---------------------------------------------------------------------}
-
-
-
-    procedure taicpu_abstract.loadconst(opidx:longint;l:aword);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ=top_ref then
-            dispose(ref);
-           val:=l;
-           typ:=top_const;
-         end;
-      end;
-
-
-
-    procedure taicpu_abstract.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
-      begin
-        if not assigned(s) then
-         internalerror(200204251);
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ=top_ref then
-            dispose(ref);
-           sym:=s;
-           symofs:=sofs;
-           typ:=top_symbol;
-         end;
-        inc(s.refs);
-      end;
-
-
-
-    procedure taicpu_abstract.loadref(opidx:longint;const r:treference);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ<>top_ref then
-            new(ref);
-           ref^:=r;
-{$ifdef i386}
-           { We allow this exception for i386, since overloading this would be
-             too much of a a speed penalty}
-           if not(ref^.segment in [R_DS,R_NO]) then
-            segprefix:=ref^.segment;
-{$endif}
-           typ:=top_ref;
-           { mark symbol as used }
-           if assigned(ref^.symbol) then
-             inc(ref^.symbol.refs);
-         end;
-      end;
-
-
-
-    procedure taicpu_abstract.loadreg(opidx:longint;r:tregister);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        with oper[opidx] do
-         begin
-           if typ=top_ref then
-            dispose(ref);
-           reg:=r;
-           typ:=top_reg;
-         end;
-      end;
-
-
-
-    procedure taicpu_abstract.loadoper(opidx:longint;o:toper);
-      begin
-        if opidx>=ops then
-         ops:=opidx+1;
-        if oper[opidx].typ=top_ref then
-         dispose(oper[opidx].ref);
-        oper[opidx]:=o;
-        { copy also the reference }
-        if oper[opidx].typ=top_ref then
-         begin
-           new(oper[opidx].ref);
-           oper[opidx].ref^:=o.ref^;
-         end;
-      end;
-
-
-{ ---------------------------------------------------------------------
-    Miscellaneous methods.
-  ---------------------------------------------------------------------}
-
-    procedure taicpu_abstract.SetCondition(const c:TAsmCond);
-      begin
-         condition:=c;
-      end;
-
-
-    Function taicpu_abstract.getcopy:tlinkedlistitem;
-      var
-        i : longint;
-        p : tlinkedlistitem;
-      begin
-        p:=inherited getcopy;
-        { make a copy of the references }
-        for i:=1 to ops do
-         if (taicpu_abstract(p).oper[i-1].typ=top_ref) then
-          begin
-            new(taicpu_abstract(p).oper[i-1].ref);
-            taicpu_abstract(p).oper[i-1].ref^:=oper[i-1].ref^;
-          end;
-        getcopy:=p;
-      end;
-
-{****************************************************************************
-                              tai_align_abstract
- ****************************************************************************}
-
-     constructor tai_align_abstract.Create(b: byte);
-       begin
-          inherited Create;
-          typ:=ait_align;
-          if b in [1,2,4,8,16,32] then
-            aligntype := b
-          else
-            aligntype := 1;
-          fillsize:=0;
-          fillop:=0;
-          use_op:=false;
-       end;
-
-
-     constructor tai_align_abstract.Create_op(b: byte; _op: byte);
-       begin
-          inherited Create;
-          typ:=ait_align;
-          if b in [1,2,4,8,16,32] then
-            aligntype := b
-          else
-            aligntype := 1;
-          fillsize:=0;
-          fillop:=_op;
-          use_op:=true;
-          fillchar(buf,sizeof(buf),_op)
-       end;
-
-
-     function tai_align_abstract.getfillbuf:pchar;
-       begin
-         getfillbuf:=@buf;
-       end;
-
-end.
-
-{
-  $Log$
-  Revision 1.9  2002-05-18 13:34:21  peter
-    * readded missing revisions
-
-  Revision 1.7  2002/05/14 19:34:52  peter
-    * removed old logs and updated copyright year
-
-  Revision 1.6  2002/05/14 17:28:09  peter
-    * synchronized cpubase between powerpc and i386
-    * moved more tables from cpubase to cpuasm
-    * tai_align_abstract moved to tainst, cpuasm must define
-      the tai_align class now, which may be empty
-
-  Revision 1.5  2002/04/25 20:16:39  peter
-    * moved more routines from cga/n386util
-
-  Revision 1.4  2002/04/02 17:11:32  peter
-    * tlocation,treference update
-    * LOC_CONSTANT added for better constant handling
-    * secondadd splitted in multiple routines
-    * location_force_reg added for loading a location to a register
-      of a specified size
-    * secondassignment parses now first the right and then the left node
-      (this is compatible with Kylix). This saves a lot of push/pop especially
-      with string operations
-    * adapted some routines to use the new cg methods
-
-}

compiler/targets/t_beos.pas

@@ -45,7 +45,7 @@ interface
       procedure generatelib;override;
     end;
 
-    tlinkerbeos=class(tlinker)
+    tlinkerbeos=class(texternallinker)
     private
       Function  WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean;
     public
@@ -63,7 +63,7 @@ implementation
     cutils,cclasses,
     verbose,systems,globtype,globals,
     symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym;
+    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym;
 
 {*****************************************************************************
                                TIMPORTLIBBEOS
@@ -532,7 +532,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.18  2002-05-18 13:34:26  peter
+  Revision 1.19  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.18  2002/05/18 13:34:26  peter
     * readded missing revisions
 
   Revision 1.17  2002/05/16 19:46:53  carl

compiler/targets/t_fbsd.pas

@@ -35,7 +35,7 @@ implementation
     cutils,cclasses,
     verbose,systems,globtype,globals,
     symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym,
+    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,
     import,export,link;
 
   type
@@ -53,7 +53,7 @@ implementation
       procedure generatelib;override;
     end;
 
-    tlinkerfreebsd=class(tlinker)
+    tlinkerfreebsd=class(texternallinker)
     private
       Glibc2,
       Glibc21,
@@ -707,7 +707,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.21  2002-05-18 13:34:26  peter
+  Revision 1.22  2002-07-01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.21  2002/05/18 13:34:26  peter
     * readded missing revisions
 
   Revision 1.20  2002/05/16 19:46:53  carl

compiler/targets/t_go32v2.pas

@@ -36,7 +36,7 @@ implementation
        globtype,globals,systems,verbose,script,fmodule;
 
   type
-    tlinkergo32v2=class(tlinker)
+    tlinkergo32v2=class(texternallinker)
     private
        Function  WriteResponseFile(isdll:boolean) : Boolean;
        Function  WriteScript(isdll:boolean) : Boolean;
@@ -272,8 +272,8 @@ type
     lineno2  : word;
     flags    : longint;
   end;
-  psecfill=^tsecfill;
-  tsecfill=record
+  psecfill=^TSecfill;
+  TSecfill=record
     fillpos,
     fillsize : longint;
     next : psecfill;
@@ -391,7 +391,7 @@ end;
             files_case_relevent : false;
             assem        : as_i386_coff;
             assemextern  : as_i386_as;
-            link         : ld_i386_go32v2;
+            link         : ld_i386_coff;
             linkextern   : ld_i386_go32v2;
             ar           : ar_gnu_ar;
             res          : res_none;
@@ -427,7 +427,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.22  2002-05-18 13:34:26  peter
+  Revision 1.23  2002-07-01 18:46:35  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.22  2002/05/18 13:34:26  peter
     * readded missing revisions
 
   Revision 1.21  2002/05/16 19:46:53  carl

compiler/targets/t_linux.pas

@@ -45,7 +45,7 @@ interface
       procedure generatelib;override;
     end;
 
-    tlinkerlinux=class(tlinker)
+    tlinkerlinux=class(texternallinker)
     private
       Glibc2,
       Glibc21 : boolean;
@@ -66,7 +66,7 @@ implementation
     symconst,script,
     fmodule,symsym
 {$ifdef i386}
-    ,aasm,cpuasm,cpubase
+    ,aasmbase,aasmtai,aasmcpu,cpubase
 {$endif i386}
     ;
 
@@ -849,7 +849,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.26  2002-05-18 13:34:26  peter
+  Revision 1.27  2002-07-01 18:46:35  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.26  2002/05/18 13:34:26  peter
     * readded missing revisions
 
   Revision 1.25  2002/05/16 19:46:53  carl

compiler/targets/t_nwm.pas

@@ -95,7 +95,7 @@ implementation
     cutils,
     verbose,systems,globtype,globals,
     symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym,
+    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,
     import,export,link;
 
   type
@@ -113,7 +113,7 @@ implementation
       procedure generatelib;override;
     end;
 
-    tlinkernetware=class(tlinker)
+    tlinkernetware=class(texternallinker)
     private
       Function  WriteResponseFile(isdll:boolean) : Boolean;
     public
@@ -549,7 +549,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.24  2002-05-18 13:34:27  peter
+  Revision 1.25  2002-07-01 18:46:35  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.24  2002/05/18 13:34:27  peter
     * readded missing revisions
 
   Revision 1.23  2002/05/16 19:46:53  carl

compiler/targets/t_os2.pas

@@ -57,7 +57,7 @@ implementation
       procedure generatelib;override;
     end;
 
-    tlinkeros2=class(tlinker)
+    tlinkeros2=class(texternallinker)
     private
        Function  WriteResponseFile(isdll:boolean) : Boolean;
     public
@@ -591,7 +591,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.21  2002-05-18 13:34:27  peter
+  Revision 1.22  2002-07-01 18:46:35  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.21  2002/05/18 13:34:27  peter
     * readded missing revisions
 
   Revision 1.20  2002/05/16 19:46:53  carl

compiler/targets/t_palmos.pas

@@ -31,7 +31,7 @@ interface
     link;
 
   type
-    tlinkerPalmOS=class(tlinker)
+    tlinkerPalmOS=class(texternallinker)
     private
        Function  WriteResponseFile : Boolean;
     public
@@ -261,7 +261,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.12  2002-05-18 13:34:27  peter
+  Revision 1.13  2002-07-01 18:46:35  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.12  2002/05/18 13:34:27  peter
     * readded missing revisions
 
   Revision 1.11  2002/05/16 19:46:53  carl

compiler/targets/t_sunos.pas

@@ -38,7 +38,7 @@ implementation
     cutils,cclasses,
     verbose,systems,globtype,globals,
     symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym,
+    fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,
     import,export,link;
 
   type
@@ -56,7 +56,7 @@ implementation
       procedure generatelib;override;
     end;
 
-    tlinkersunos=class(tlinker)
+    tlinkersunos=class(texternallinker)
     private
       Glibc2,
       Glibc21 : boolean;
@@ -552,7 +552,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.23  2002-05-18 13:34:27  peter
+  Revision 1.24  2002-07-01 18:46:35  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.23  2002/05/18 13:34:27  peter
     * readded missing revisions
 
   Revision 1.22  2002/05/16 19:46:53  carl

compiler/targets/t_win32.pas

@@ -32,10 +32,10 @@ interface
        dos,
 {$endif Delphi}
        cutils,cclasses,
-       aasm,fmodule,globtype,globals,systems,verbose,
+       aasmbase,aasmtai,aasmcpu,fmodule,globtype,globals,systems,verbose,
        symconst,symsym,
        script,gendef,
-       cpubase,cpuasm,
+       cpubase,
 {$ifdef GDB}
        gdb,
 {$endif}
@@ -70,7 +70,7 @@ interface
       procedure generatenasmlib;virtual;
     end;
 
-    tlinkerwin32=class(tlinker)
+    tlinkerwin32=class(texternallinker)
     private
        Function  WriteResponseFile(isdll:boolean) : Boolean;
        Function  PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
@@ -288,7 +288,7 @@ const
                     getlabel(lcode);
                     reference_reset_symbol(href,lcode,0);
                     { place jump in codesegment, insert a code section in the
-                      importsection to reduce the amount of .s files (PFV) }
+                      imporTSection to reduce the amount of .s files (PFV) }
                     importsSection.concat(Tai_section.Create(sec_code));
 {$IfDef GDB}
                     if (cs_debuginfo in aktmoduleswitches) then
@@ -305,7 +305,7 @@ const
                  getlabel(tasmlabel(hp2.lab));
                  importsSection.concat(Tai_section.Create(sec_idata4));
                  importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
-                 { add jump field to importsection }
+                 { add jump field to imporTSection }
                  importsSection.concat(Tai_section.Create(sec_idata5));
                  if hp2.is_var then
                   importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0))
@@ -442,7 +442,7 @@ const
                       importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
                       importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,href));
                       importsSection.concat(Tai_align.Create_op(4,$90));
-                      { add jump field to importsection }
+                      { add jump field to imporTSection }
                       importsSection.concat(Tai_section.Create(sec_idata5));
 {$ifdef GDB}
                       if (cs_debuginfo in aktmoduleswitches) then
@@ -1155,8 +1155,8 @@ type
     lineno2  : word;
     flags    : longint;
   end;
-  psecfill=^tsecfill;
-  tsecfill=record
+  psecfill=^TSecfill;
+  TSecfill=record
     fillpos,
     fillsize : longint;
     next : psecfill;
@@ -1633,7 +1633,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.34  2002-05-18 13:34:27  peter
+  Revision 1.35  2002-07-01 18:46:35  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.34  2002/05/18 13:34:27  peter
     * readded missing revisions
 
   Revision 1.33  2002/05/16 19:46:53  carl

compiler/tgobj.pas

@@ -36,9 +36,7 @@ unit tgobj;
       globals,
       cpubase,
       cpuinfo,
-      cpuasm,
-      tainst,
-      cclasses,globtype,cgbase,aasm;
+      cclasses,globtype,cgbase,aasmbase,aasmtai,aasmcpu;
 
     type
       ttemptype = (tt_none,tt_free,tt_normal,tt_persistant,
@@ -339,7 +337,7 @@ unit tgobj;
 {$ifdef EXTDEBUG}
          tl^.posinfo:=aktfilepos;
 {$endif}
-         list.concat(Taitempalloc.alloc(ofs,size));
+         list.concat(tai_tempalloc.alloc(ofs,size));
          gettempofsize:=ofs;
       end;
 
@@ -430,7 +428,7 @@ unit tgobj;
 {$endif}
             templist^.temptype:=usedtype;
           end;
-         list.concat(Taitempalloc.alloc(ref.offset,pointer_size));
+         list.concat(tai_tempalloc.alloc(ref.offset,pointer_size));
       end;
 
     function ttgobj.ungettemppointeriftype(list: taasmoutput; const ref : treference; const usedtype, freetype: ttemptype) : boolean;
@@ -447,7 +445,7 @@ unit tgobj;
                begin
                  tl^.temptype:=freetype;
                  ungettemppointeriftype:=true;
-                 list.concat(Taitempalloc.dealloc(tl^.pos,tl^.size));
+                 list.concat(tai_tempalloc.dealloc(tl^.pos,tl^.size));
                  exit;
 {$ifdef EXTDEBUG}
                end
@@ -573,7 +571,7 @@ unit tgobj;
                 begin
                   exit;
                 end;
-               list.concat(Taitempalloc.dealloc(hp^.pos,hp^.size));
+               list.concat(tai_tempalloc.dealloc(hp^.pos,hp^.size));
                { set this block to free }
                hp^.temptype:=tt_free;
                { Update tempfreelist }
@@ -681,7 +679,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.9  2002-05-18 13:34:21  peter
+  Revision 1.10  2002-07-01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.9  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.8  2002/05/16 19:46:45  carl