* removed oldasm

  * plabel -> pasmlabel
  * -a switches to source writing automaticly
  * assembler readers OOPed
  * asmsymbol automaticly external
  * jumptables and other label fixes for asm readers

compiler/aasm.pas

@@ -1,1345 +1,1081 @@
-{
-    $Id$
-    Copyright (c) 1996-98 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.
-
- ****************************************************************************
-}
-unit aasm;
-
-  interface
-
-    uses
-       globtype,systems,cobjects,files,globals;
-
-    type
-       tait = (
-          ait_none,
-          ait_direct,
-          ait_string,
-{$ifndef NEWLAB}
-          ait_label,
-          ait_labeled_instruction,
-          ait_external,
-{$endif}
-          ait_comment,
-          ait_instruction,
-          ait_datablock,
-          ait_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,
-          { never used, makes insertation of new ait_ easier to type }
-          ait_dummy);
-
-
-  { asm symbol functions }
-    type
-       TAsmsymtype=(AS_EXTERNAL,AS_LOCAL,AS_GLOBAL);
-
-       pasmsymbol = ^tasmsymbol;
-       tasmsymbol = object(tnamedindexobject)
-         typ     : TAsmsymtype;
-         { the next fields are filled in the binary writer }
-         idx     : longint;
-         section : tsection;
-         address,
-         size    : longint;
-         constructor init(const s:string;_typ:TAsmsymtype);
-         procedure reset;
-         procedure setaddress(sec:tsection;offset,len:longint);
-       end;
-
-       pasmlabel = ^tasmlabel;
-       tasmlabel = object(tasmsymbol)
-         labelnr : longint;
-         refs    : longint;
-         constructor init;
-         constructor initdata;
-       end;
-
-
-       pasmsymbollist = ^tasmsymbollist;
-       tasmsymbollist = object(tdictionary)
-       end;
-
-       { the short name makes typing easier }
-       pai = ^tai;
-       tai = object(tlinkedlist_item)
-          typ      : tait;
-          { pointer to record with optimizer info about this tai object }
-          optinfo  : pointer;
-          fileinfo : tfileposinfo;
-          constructor init;
-       end;
-
-       pai_string = ^tai_string;
-       tai_string = object(tai)
-          str : pchar;
-          { extra len so the string can contain an \0 }
-          len : longint;
-          constructor init(const _str : string);
-          constructor init_pchar(_str : pchar);
-          constructor init_length_pchar(_str : pchar;length : longint);
-          destructor done;virtual;
-       end;
-
-       { generates a common label }
-       pai_symbol = ^tai_symbol;
-       tai_symbol = object(tai)
-          sym : pasmsymbol;
-          is_global : boolean;
-          constructor init(_sym:PAsmSymbol);
-          constructor initname(const _name : string);
-          constructor initname_global(const _name : string);
-       end;
-
-{$ifndef NEWLAB}
-       { external types defined for TASM }
-       { EXT_ANY for search purposes     }
-       texternal_typ = (EXT_ANY,EXT_NEAR, EXT_FAR, EXT_PROC, EXT_BYTE,
-                        EXT_WORD, EXT_DWORD, EXT_CODEPTR, EXT_DATAPTR,
-                        EXT_FWORD, EXT_PWORD, EXT_QWORD, EXT_TBYTE, EXT_ABS);
-
-       { generates an symbol which is marked as external }
-       pai_external = ^tai_external;
-       tai_external = object(tai)
-          sym    : pasmsymbol;
-          exttyp : texternal_typ;
-          constructor init(_sym:pasmsymbol;exttype : texternal_typ);
-       end;
-
-     { type for a temporary label test if used for dispose of
-       unnecessary labels }
-       plabel = ^tlabel;
-       tlabel = record
-                  nb        : longint;
-                  address   : longint;
-                  is_data   : boolean;
-                  is_used   : boolean;
-                  is_set    : boolean;
-                  is_symbol : boolean; { if its used as symbol lab2str() }
-                  refcount  : word;
-                end;
-
-       pai_label = ^tai_label;
-       tai_label = object(tai)
-          l : plabel;
-          sym : pasmsymbol; { filled in pass1 of ag386bin }
-          constructor init(_l : plabel);
-          destructor done; virtual;
-          procedure setaddress(offset:longint);
-       end;
-{$endif}
-
-       pai_direct = ^tai_direct;
-       tai_direct = object(tai)
-          str : pchar;
-          constructor init(_str : pchar);
-          destructor done; virtual;
-       end;
-
-
-       { to insert a comment into the generated assembler file }
-       pai_asm_comment = ^tai_asm_comment;
-       tai_asm_comment = object(tai)
-          str : pchar;
-          constructor init(_str : pchar);
-          destructor done; virtual;
-       end;
-
-
-       { alignment for operator }
-       pai_align = ^tai_align;
-       tai_align = object(tai)
-          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 init(b:byte);
-          constructor init_op(b: byte; _op: byte);
-       end;
-
-       { Insert a section/segment directive }
-       pai_section = ^tai_section;
-       tai_section = object(tai)
-          sec : tsection;
-          constructor init(s : tsection);
-       end;
-
-
-       { generates an uninitializised data block }
-       pai_datablock = ^tai_datablock;
-       tai_datablock = object(tai)
-          sym  : pasmsymbol;
-          size : longint;
-          is_global : boolean;
-          constructor init(const _name : string;_size : longint);
-          constructor init_global(const _name : string;_size : longint);
-       end;
-
-
-       { generates a long integer (32 bit) }
-       pai_const = ^tai_const;
-       tai_const = object(tai)
-          value : longint;
-          constructor init_32bit(_value : longint);
-          constructor init_16bit(_value : word);
-          constructor init_8bit(_value : byte);
-       end;
-
-       pai_const_symbol = ^tai_const_symbol;
-       tai_const_symbol = object(tai)
-          sym    : pasmsymbol;
-          offset : longint;
-          constructor init(_sym:PAsmSymbol);
-          constructor init_offset(_sym:PAsmSymbol;ofs:longint);
-          constructor init_rva(_sym:PAsmSymbol);
-          constructor initname(const name:string);
-          constructor initname_offset(const name:string;ofs:longint);
-          constructor initname_rva(const name:string);
-       end;
-
-       { generates a single (32 bit real) }
-       pai_real_32bit = ^tai_real_32bit;
-       tai_real_32bit = object(tai)
-          value : ts32real;
-          constructor init(_value : ts32real);
-       end;
-
-       { generates a double (64 bit real) }
-       pai_real_64bit = ^tai_real_64bit;
-       tai_real_64bit = object(tai)
-          value : ts64real;
-          constructor init(_value : ts64real);
-       end;
-
-       { generates an extended (80 bit real) }
-       pai_real_80bit = ^tai_real_80bit;
-       tai_real_80bit = object(tai)
-          value : ts80real;
-          constructor init(_value : ts80real);
-       end;
-
-       { generates an comp (integer over 64 bits) }
-       pai_comp_64bit = ^tai_comp_64bit;
-       tai_comp_64bit = object(tai)
-          value : ts64comp;
-          constructor init(_value : ts64comp);
-       end;
-
-       { insert a cut to split into several smaller files }
-       pai_cut = ^tai_cut;
-       tai_cut = object(tai)
-          endname : boolean;
-          constructor init;
-          constructor init_end;
-       end;
-
-       TMarker = (NoPropInfoStart, NoPropInfoEnd, AsmBlockStart, AsmBlockEnd);
-       pai_marker = ^tai_marker;
-       tai_marker = object(tai)
-         Kind: TMarker;
-         Constructor init(_Kind: TMarker);
-       end;
-
-
-{ for each processor define the best precision }
-{ bestreal is defined in globals }
-{$ifdef i386}
-const
-       ait_bestreal = ait_real_80bit;
-type
-       pai_bestreal = pai_real_80bit;
-       tai_bestreal = tai_real_80bit;
-{$endif i386}
-{$ifdef m68k}
-const
-       ait_bestreal = ait_real_32bit;
-type
-       pai_bestreal = pai_real_32bit;
-       tai_bestreal = tai_real_32bit;
-{$endif m68k}
-
-
-       paasmoutput = ^taasmoutput;
-       taasmoutput = object(tlinkedlist)
-         function getlasttaifilepos : pfileposinfo;
-       end;
-
-    var
-    { temporary lists }
-      exprasmlist,
-    { default lists }
-      datasegment,codesegment,bsssegment,
-      internals,externals,debuglist,consts,
-      importssection,exportssection,
-      resourcesection,rttilist         : paasmoutput;
-  { asm symbol list }
-      asmsymbollist : pasmsymbollist;
-
-{$ifdef NEWLAB}
-    type
-    { For Easier conversion of old code, can be remove in the future }
-      plabel = pasmlabel;
-      pai_label  = Pai_symbol;
-
-    const
-      nextlabelnr : longint = 1;
-      countlabelref : boolean = true;
-
-    { make l as a new label }
-    procedure getlabel(var l : plabel);
-    { make l as a new label and flag is_data }
-    procedure getdatalabel(var l : plabel);
-    { free a label }
-    procedure freelabel(var l : plabel);
-    {just get a label number }
-    procedure getlabelnr(var l : longint);
-    { convert label to string}
-    function lab2str(l : plabel) : string;
-{$endif}
-
-    function  newasmsymbol(const s : string) : pasmsymbol;
-    function  newasmsymboltyp(const s : string;_typ:TAsmSymType) : pasmsymbol;
-    function  getasmsymbol(const s : string) : pasmsymbol;
-    function  renameasmsymbol(const sold, snew : string):pasmsymbol;
-
-    procedure ResetAsmsymbolList;
-
-{$ifndef NEWLAB}
-  { external symbols without repetition }
-    function search_assembler_symbol(pl : paasmoutput;const _name : string;exttype : texternal_typ) : pai_external;
-    procedure concat_external(const _name : string;exttype : texternal_typ);
-    procedure concat_internal(const _name : string;exttype : texternal_typ);
-
-  { label functions }
-    const
-      nextlabelnr : longint = 1;
-      countlabelref : boolean = true;
-    { convert label to string}
-    function lab2str(l : plabel) : string;
-    { make l as a new label }
-    procedure getlabel(var l : plabel);
-    { make l as a new label and flag is_data }
-    procedure getdatalabel(var l : plabel);
-    { frees the label if unused }
-    procedure freelabel(var l : plabel);
-    { make a new zero label }
-    procedure getzerolabel(var l : plabel);
-    { reset a label to a zero label }
-    procedure setzerolabel(var l : plabel);
-    {just get a label number }
-    procedure getlabelnr(var l : longint);
-{$endif}
-
-
-implementation
-
-uses
-  strings,verbose;
-
-{****************************************************************************
-                             TAI
- ****************************************************************************}
-
-    constructor tai.init;
-      begin
-        optinfo := nil;
-        fileinfo:=aktfilepos;
-      end;
-
-{****************************************************************************
-                             TAI_SECTION
- ****************************************************************************}
-
-    constructor tai_section.init(s : tsection);
-      begin
-         inherited init;
-         typ:=ait_section;
-         sec:=s;
-      end;
-
-
-{****************************************************************************
-                             TAI_DATABLOCK
- ****************************************************************************}
-
-    constructor tai_datablock.init(const _name : string;_size : longint);
-
-      begin
-         inherited init;
-         typ:=ait_datablock;
-         sym:=newasmsymboltyp(_name,AS_LOCAL);
-{$ifndef NEWLAB}
-         concat_internal(_name,EXT_ANY);
-{$endif}
-         size:=_size;
-         is_global:=false;
-      end;
-
-
-    constructor tai_datablock.init_global(const _name : string;_size : longint);
-      begin
-         inherited init;
-         typ:=ait_datablock;
-         sym:=newasmsymboltyp(_name,AS_GLOBAL);
-{$ifndef NEWLAB}
-         concat_internal(_name,EXT_ANY);
-{$endif}
-         size:=_size;
-         is_global:=true;
-      end;
-
-
-{****************************************************************************
-                               TAI_SYMBOL
- ****************************************************************************}
-
-    constructor tai_symbol.init(_sym:PAsmSymbol);
-      begin
-         inherited init;
-         typ:=ait_symbol;
-         sym:=_sym;
-      end;
-
-    constructor tai_symbol.initname(const _name : string);
-      begin
-         inherited init;
-         typ:=ait_symbol;
-         sym:=newasmsymboltyp(_name,AS_LOCAL);
-         is_global:=false;
-{$ifndef NEWLAB}
-         concat_internal(_name,EXT_ANY);
-{$endif}
-      end;
-
-    constructor tai_symbol.initname_global(const _name : string);
-      begin
-         inherited init;
-         typ:=ait_symbol;
-         sym:=newasmsymboltyp(_name,AS_GLOBAL);
-         is_global:=true;
-{$ifndef NEWLAB}
-         concat_internal(_name,EXT_ANY);
-{$endif}
-      end;
-
-{$ifndef NEWLAB}
-
-{****************************************************************************
-                               TAI_EXTERNAL
- ****************************************************************************}
-
-    constructor tai_external.init(_sym:pasmsymbol;exttype : texternal_typ);
-
-      begin
-         inherited init;
-         typ:=ait_external;
-         exttyp:=exttype;
-         sym:=_sym;
-      end;
-
-{$endif}
-
-
-{****************************************************************************
-                               TAI_CONST
- ****************************************************************************}
-
-    constructor tai_const.init_32bit(_value : longint);
-
-      begin
-         inherited init;
-         typ:=ait_const_32bit;
-         value:=_value;
-      end;
-
-    constructor tai_const.init_16bit(_value : word);
-
-      begin
-         inherited init;
-         typ:=ait_const_16bit;
-         value:=_value;
-      end;
-
-    constructor tai_const.init_8bit(_value : byte);
-
-      begin
-         inherited init;
-         typ:=ait_const_8bit;
-         value:=_value;
-      end;
-
-
-{****************************************************************************
-                               TAI_CONST_SYMBOL_OFFSET
- ****************************************************************************}
-
-    constructor tai_const_symbol.init(_sym:PAsmSymbol);
-      begin
-         inherited init;
-         typ:=ait_const_symbol;
-         sym:=_sym;
-         offset:=0;
-      end;
-
-    constructor tai_const_symbol.init_offset(_sym:PAsmSymbol;ofs:longint);
-      begin
-         inherited init;
-         typ:=ait_const_symbol;
-         sym:=_sym;
-         offset:=ofs;
-      end;
-
-    constructor tai_const_symbol.init_rva(_sym:PAsmSymbol);
-      begin
-         inherited init;
-         typ:=ait_const_rva;
-         sym:=_sym;
-         offset:=0;
-      end;
-
-    constructor tai_const_symbol.initname(const name:string);
-      begin
-         inherited init;
-         typ:=ait_const_symbol;
-         sym:=newasmsymboltyp(name,AS_EXTERNAL);
-         offset:=0;
-      end;
-
-    constructor tai_const_symbol.initname_offset(const name:string;ofs:longint);
-      begin
-         inherited init;
-         typ:=ait_const_symbol;
-         sym:=newasmsymboltyp(name,AS_EXTERNAL);
-         offset:=ofs;
-      end;
-
-    constructor tai_const_symbol.initname_rva(const name:string);
-      begin
-         inherited init;
-         typ:=ait_const_rva;
-         sym:=newasmsymboltyp(name,AS_EXTERNAL);
-         offset:=0;
-      end;
-
-
-{****************************************************************************
-                               TAI_real_32bit
- ****************************************************************************}
-
-    constructor tai_real_32bit.init(_value : ts32real);
-
-      begin
-         inherited init;
-         typ:=ait_real_32bit;
-         value:=_value;
-      end;
-
-{****************************************************************************
-                               TAI_real_64bit
- ****************************************************************************}
-
-    constructor tai_real_64bit.init(_value : ts64real);
-
-      begin
-         inherited init;
-         typ:=ait_real_64bit;
-         value:=_value;
-      end;
-
-{****************************************************************************
-                               TAI_real_80bit
- ****************************************************************************}
-
-    constructor tai_real_80bit.init(_value : ts80real);
-
-      begin
-         inherited init;
-         typ:=ait_real_80bit;
-         value:=_value;
-      end;
-
-{****************************************************************************
-                               Tai_comp_64bit
- ****************************************************************************}
-
-    constructor tai_comp_64bit.init(_value : ts64comp);
-
-      begin
-         inherited init;
-         typ:=ait_comp_64bit;
-         value:=_value;
-      end;
-
-
-{****************************************************************************
-                               TAI_STRING
- ****************************************************************************}
-
-     constructor tai_string.init(const _str : string);
-
-       begin
-          inherited init;
-          typ:=ait_string;
-          getmem(str,length(_str)+1);
-          strpcopy(str,_str);
-          len:=length(_str);
-       end;
-
-     constructor tai_string.init_pchar(_str : pchar);
-
-       begin
-          inherited init;
-          typ:=ait_string;
-          str:=_str;
-          len:=strlen(_str);
-       end;
-
-    constructor tai_string.init_length_pchar(_str : pchar;length : longint);
-
-       begin
-          inherited init;
-          typ:=ait_string;
-          str:=_str;
-          len:=length;
-       end;
-
-    destructor tai_string.done;
-
-      begin
-         { you can have #0 inside the strings so }
-         if str<>nil then
-           freemem(str,len+1);
-         inherited done;
-      end;
-
-{$ifndef NEWLAB}
-
-{****************************************************************************
-                               TAI_LABEL
- ****************************************************************************}
-
-    constructor tai_label.init(_l : plabel);
-      begin
-        inherited init;
-        typ:=ait_label;
-        l:=_l;
-        sym:=nil;
-        l^.is_set:=true;
-      end;
-
-
-    destructor tai_label.done;
-      begin
-        if (l^.refcount>0) then
-        { can now be disposed by a tai_labeled instruction !! }
-          l^.is_set:=false
-        else
-          dispose(l);
-        inherited done;
-      end;
-
-
-   procedure tai_label.setaddress(offset:longint);
-      begin
-        l^.address:=offset;
-      end;
-
-{$endif}
-
-
-{****************************************************************************
-                              TAI_DIRECT
- ****************************************************************************}
-
-     constructor tai_direct.init(_str : pchar);
-
-       begin
-          inherited init;
-          typ:=ait_direct;
-          str:=_str;
-       end;
-
-    destructor tai_direct.done;
-
-      begin
-         strdispose(str);
-         inherited done;
-      end;
-
-{****************************************************************************
-          TAI_ASM_COMMENT  comment to be inserted in the assembler file
- ****************************************************************************}
-
-     constructor tai_asm_comment.init(_str : pchar);
-
-       begin
-          inherited init;
-          typ:=ait_comment;
-          str:=_str;
-       end;
-
-    destructor tai_asm_comment.done;
-
-      begin
-         strdispose(str);
-         inherited done;
-      end;
-
-{****************************************************************************
-                              TAI_ALIGN
- ****************************************************************************}
-
-     constructor tai_align.init(b: byte);
-
-       begin
-          inherited init;
-          typ:=ait_align;
-          if b in [1,2,4,8,16] then
-            aligntype := b
-          else
-            aligntype := 1;
-          fillsize:=0;
-          fillop:=0;
-          use_op:=false;
-       end;
-
-
-     constructor tai_align.init_op(b: byte; _op: byte);
-
-       begin
-          inherited init;
-          typ:=ait_align;
-          if b in [1,2,4,8,16] then
-            aligntype := b
-          else
-            aligntype := 1;
-          fillsize:=0;
-          fillop:=_op;
-          use_op:=true;
-       end;
-
-
-{****************************************************************************
-                              TAI_CUT
- ****************************************************************************}
-
-     constructor tai_cut.init;
-       begin
-          inherited init;
-          typ:=ait_cut;
-          endname:=false;
-       end;
-
-
-     constructor tai_cut.init_end;
-       begin
-          inherited init;
-          typ:=ait_cut;
-          endname:=true;
-       end;
-
-
-{****************************************************************************
-                             Tai_Marker
- ****************************************************************************}
-
-     Constructor Tai_Marker.Init(_Kind: TMarker);
-     Begin
-       Inherited Init;
-       typ := ait_marker;
-       Kind := _Kind;
-     End;
-
-{$ifndef NEWLAB}
-
-{*****************************************************************************
-                           External Helpers
-*****************************************************************************}
-
-    function search_assembler_symbol(pl : paasmoutput;const _name : string;exttype : texternal_typ) : pai_external;
-      var
-         p : pai;
-      begin
-         search_assembler_symbol:=nil;
-         if pl=nil then
-           internalerror(2001)
-         else
-           begin
-              p:=pai(pl^.first);
-              while (p<>nil) and
-                    (p<>pai(pl^.last)) do
-                { if we get the same name with a different typ }
-                { there is probably an error                   }
-                if (p^.typ=ait_external) and
-                   ((exttype=EXT_ANY) or (pai_external(p)^.exttyp=exttype)) and
-                   (pai_external(p)^.sym^.name=_name) then
-                  begin
-                     search_assembler_symbol:=pai_external(p);
-                     exit;
-                  end
-                else
-                  p:=pai(p^.next);
-              if (p<>nil) and
-                 (p^.typ=ait_external) and
-                 (pai_external(p)^.exttyp=exttype) and
-                 (pai_external(p)^.sym^.name=_name) then
-                begin
-                   search_assembler_symbol:=pai_external(p);
-                   exit;
-                end;
-           end;
-      end;
-
-
-    { insert each need external only once }
-    procedure concat_external(const _name : string;exttype : texternal_typ);
-      var
-        hp : pasmsymbol;
-      begin
-        if not target_asm.externals then
-         exit;
-        { insert in symbollist }
-        hp:=newasmsymboltyp(_name,AS_EXTERNAL);
-        { insert in externals }
-        if search_assembler_symbol(externals,_name,exttype)=nil then
-         externals^.concat(new(pai_external,init(hp,exttype)));
-      end;
-
-
-    { insert each need internal only once }
-    procedure concat_internal(const _name : string;exttype : texternal_typ);
-      var
-        hp : pasmsymbol;
-      begin
-        if not target_asm.externals then
-         exit;
-        { insert in symbollist }
-        hp:=newasmsymboltyp(_name,AS_EXTERNAL);
-        { insert in externals }
-        if search_assembler_symbol(internals,_name,exttype)=nil then
-         internals^.concat(new(pai_external,init(hp,exttype)));
-      end;
-
-{$endif}
-
-
-{*****************************************************************************
-                                  AsmSymbol
-*****************************************************************************}
-
-    constructor tasmsymbol.init(const s:string;_typ:TAsmsymtype);
-      begin;
-        inherited initname(s);
-        reset;
-        typ:=_typ;
-      end;
-
-    procedure tasmsymbol.reset;
-      begin
-        section:=sec_none;
-        address:=0;
-        size:=0;
-        idx:=-1;
-        typ:=AS_EXTERNAL;
-      end;
-
-    procedure tasmsymbol.setaddress(sec:tsection;offset,len:longint);
-      begin
-        section:=sec;
-        address:=offset;
-        size:=len;
-      end;
-
-{*****************************************************************************
-                                  AsmLabel
-*****************************************************************************}
-
-    constructor tasmlabel.init;
-      begin;
-        labelnr:=nextlabelnr;
-        inc(nextlabelnr);
-        inherited init(target_asm.labelprefix+tostr(labelnr),AS_LOCAL);
-        refs:=0;
-      end;
-
-
-    constructor tasmlabel.initdata;
-      begin;
-        labelnr:=nextlabelnr;
-        inc(nextlabelnr);
-        if (cs_smartlink in aktmoduleswitches) then
-         inherited init('_$'+current_module^.modulename^+'$_L'+tostr(labelnr),AS_GLOBAL)
-        else
-         inherited init(target_asm.labelprefix+tostr(labelnr),AS_LOCAL);
-        refs:=0;
-      end;
-
-
-{*****************************************************************************
-                              AsmSymbolList helpers
-*****************************************************************************}
-
-    function newasmsymbol(const s : string) : pasmsymbol;
-      var
-        hp : pasmsymbol;
-      begin
-        hp:=pasmsymbol(asmsymbollist^.search(s));
-        if assigned(hp) then
-         begin
-           newasmsymbol:=hp;
-           exit;
-         end;
-        { Not found, insert it as an External }
-        hp:=new(pasmsymbol,init(s,AS_EXTERNAL));
-        asmsymbollist^.insert(hp);
-        newasmsymbol:=hp;
-      end;
-
-
-    function  newasmsymboltyp(const s : string;_typ:TAsmSymType) : pasmsymbol;
-      var
-        hp : pasmsymbol;
-      begin
-        hp:=pasmsymbol(asmsymbollist^.search(s));
-        if assigned(hp) then
-         begin
-           hp^.typ:=_typ;
-           newasmsymboltyp:=hp;
-           exit;
-         end;
-        { Not found, insert it as an External }
-        hp:=new(pasmsymbol,init(s,_typ));
-        asmsymbollist^.insert(hp);
-        newasmsymboltyp:=hp;
-      end;
-
-
-    function getasmsymbol(const s : string) : pasmsymbol;
-      begin
-        getasmsymbol:=pasmsymbol(asmsymbollist^.search(s));
-      end;
-
-
-    { renames an asmsymbol }
-    function renameasmsymbol(const sold, snew : string):pasmsymbol;
-{$ifdef nodictonaryrename}
-      var
-        hpold,hpnew : pasmsymbol;
-      begin
-        hpnew:=pasmsymbol(asmsymbollist^.search(snew));
-        if assigned(hpnew) then
-          internalerror(405405);
-        hpold:=pasmsymbol(asmsymbollist^.search(sold));
-        if not assigned(hpold) then
-          internalerror(405406);
-
-        hpnew:=new(pasmsymbol,init(sold));
-        { replace the old one }
-        { WARNING this heavily depends on the
-          feature that tdictionnary.insert does not delete
-          the tree element that it replaces !! }
-        asmsymbollist^.replace_existing:=true;
-        asmsymbollist^.insert(hpnew);
-        asmsymbollist^.replace_existing:=false;
-        { restore the tree }
-        hpnew^.left:=hpold^.left;
-        hpnew^.right:=hpold^.right;
-        stringdispose(hpold^._name);
-        hpold^._name:=stringdup(snew);
-        hpold^.speedvalue:=getspeedvalue(snew);
-        { now reinsert it at right location !! }
-        asmsymbollist^.insert(hpold);
-        renameasmsymbol:=hpold;
-      end;
-{$else}
-      begin
-        renameasmsymbol:=pasmsymbol(asmsymbollist^.rename(sold,snew));
-      end;
-{$endif}
-
-
-    procedure ResetAsmSym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif}
-      begin
-        pasmsymbol(p)^.reset;
-      end;
-
-
-    procedure ResetAsmsymbolList;
-      begin
-        {$ifdef tp}
-        asmsymbollist^.foreach(resetasmsym);
-        {$else}
-        asmsymbollist^.foreach(@resetasmsym);
-        {$endif}
-      end;
-
-
-{*****************************************************************************
-                              Label Helpers
-*****************************************************************************}
-
-{$ifndef NEWLAB}
-
-    function lab2str(l : plabel) : string;
-      begin
-         if (l=nil) or (l^.nb=0) then
-           begin
-{$ifdef EXTDEBUG}
-             lab2str:='ILLEGAL'
-{$else EXTDEBUG}
-             internalerror(2000);
-{$endif EXTDEBUG}
-           end
-         else
-           begin
-             if (l^.is_data) and (cs_smartlink in aktmoduleswitches) then
-              lab2str:='_$'+current_module^.modulename^+'$_L'+tostr(l^.nb)
-             else
-              lab2str:=target_asm.labelprefix+tostr(l^.nb);
-           end;
-         { inside the WriteTree we must not count the refs PM }
-{$ifndef HEAPTRC}
-         if countlabelref then
-           inc(l^.refcount);
-{$endif HEAPTRC}
-         l^.is_symbol:=true;
-         l^.is_used:=true;
-      end;
-
-
-    procedure getlabel(var l : plabel);
-      begin
-         new(l);
-         l^.nb:=nextlabelnr;
-         l^.is_used:=false;
-         l^.is_set:=false;
-         l^.is_data:=false;
-         l^.is_symbol:=false;
-         l^.address:=-1;
-         l^.refcount:=0;
-         inc(nextlabelnr);
-      end;
-
-
-    procedure getdatalabel(var l : plabel);
-      begin
-         new(l);
-         l^.nb:=nextlabelnr;
-         l^.is_used:=false;
-         l^.is_set:=false;
-         l^.is_data:=true;
-         l^.is_symbol:=false;
-         l^.address:=-1;
-         l^.refcount:=0;
-         inc(nextlabelnr);
-      end;
-
-
-    procedure freelabel(var l : plabel);
-      begin
-         if (l<>nil) and (not l^.is_set) and (not l^.is_used) then
-           dispose(l);
-         l:=nil;
-      end;
-
-
-    procedure setzerolabel(var l : plabel);
-      begin
-        with l^ do
-         begin
-           nb:=0;
-           is_used:=false;
-           is_set:=false;
-           is_data:=false;
-           is_symbol:=false;
-           address:=-1;
-           refcount:=0;
-         end;
-      end;
-
-
-    procedure getzerolabel(var l : plabel);
-      begin
-         new(l);
-         l^.nb:=0;
-         l^.is_used:=false;
-         l^.is_set:=false;
-         l^.is_data:=false;
-         l^.is_symbol:=false;
-         l^.address:=-1;
-         l^.refcount:=0;
-      end;
-
-
-    procedure getlabelnr(var l : longint);
-      begin
-         l:=nextlabelnr;
-         inc(nextlabelnr);
-      end;
-
-{$else}
-
-    procedure getlabel(var l : plabel);
-      begin
-        l:=new(pasmlabel,init);
-        asmsymbollist^.insert(l);
-      end;
-
-
-    procedure getdatalabel(var l : plabel);
-      begin
-        l:=new(pasmlabel,initdata);
-        asmsymbollist^.insert(l);
-      end;
-
-
-    procedure freelabel(var l : plabel);
-      begin
-        { nothing to do, the dispose of the asmsymbollist will do it }
-        l:=nil;
-      end;
-
-    procedure getlabelnr(var l : longint);
-      begin
-         l:=nextlabelnr;
-         inc(nextlabelnr);
-      end;
-
-    function lab2str(l : plabel) : string;
-      begin
-        lab2str:=l^.name;
-      end;
-
-{$endif}
-
-
-{*****************************************************************************
-                                 TAAsmOutput
-*****************************************************************************}
-
-    function taasmoutput.getlasttaifilepos : pfileposinfo;
-      begin
-         if assigned(last) then
-           getlasttaifilepos:=@pai(last)^.fileinfo
-         else
-           getlasttaifilepos:=nil;
-      end;
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1996-98 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.
+
+ ****************************************************************************
+}
+unit aasm;
+
+  interface
+
+    uses
+       globtype,systems,cobjects,files,globals;
+
+    type
+       tait = (
+          ait_none,
+          ait_direct,
+          ait_string,
+          ait_label,
+          ait_comment,
+          ait_instruction,
+          ait_datablock,
+          ait_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,
+          { never used, makes insertation of new ait_ easier to type }
+          ait_dummy);
+
+
+  { asm symbol functions }
+    type
+       TAsmsymtype=(AS_EXTERNAL,AS_LOCAL,AS_GLOBAL);
+
+       pasmsymbol = ^tasmsymbol;
+       tasmsymbol = object(tnamedindexobject)
+         typ     : TAsmsymtype;
+         { this need te incremented with every symbol loading into the
+           paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
+         refs    : longint;
+         { the next fields are filled in the binary writer }
+         idx     : longint;
+         section : tsection;
+         address,
+         size    : longint;
+         constructor init(const s:string;_typ:TAsmsymtype);
+         procedure reset;
+         function  is_used:boolean;
+         procedure setaddress(sec:tsection;offset,len:longint);
+       end;
+
+       pasmlabel = ^tasmlabel;
+       tasmlabel = object(tasmsymbol)
+         labelnr : longint;
+         { this is set by the pai_label.init }
+         is_set  : boolean;
+         constructor init;
+         constructor initdata;
+       end;
+
+
+       pasmsymbollist = ^tasmsymbollist;
+       tasmsymbollist = object(tdictionary)
+       end;
+
+       { the short name makes typing easier }
+       pai = ^tai;
+       tai = object(tlinkedlist_item)
+          typ      : tait;
+          { pointer to record with optimizer info about this tai object }
+          optinfo  : pointer;
+          fileinfo : tfileposinfo;
+          constructor init;
+       end;
+
+       pai_string = ^tai_string;
+       tai_string = object(tai)
+          str : pchar;
+          { extra len so the string can contain an \0 }
+          len : longint;
+          constructor init(const _str : string);
+          constructor init_pchar(_str : pchar);
+          constructor init_length_pchar(_str : pchar;length : longint);
+          destructor done;virtual;
+       end;
+
+       { generates a common label }
+       pai_symbol = ^tai_symbol;
+       tai_symbol = object(tai)
+          sym : pasmsymbol;
+          is_global : boolean;
+          constructor init(_sym:PAsmSymbol);
+          constructor initname(const _name : string);
+          constructor initname_global(const _name : string);
+       end;
+
+       pai_label = ^tai_label;
+       tai_label = object(tai)
+          l : pasmlabel;
+          is_global : boolean;
+          constructor init(_l : pasmlabel);
+       end;
+
+       pai_direct = ^tai_direct;
+       tai_direct = object(tai)
+          str : pchar;
+          constructor init(_str : pchar);
+          destructor done; virtual;
+       end;
+
+
+       { to insert a comment into the generated assembler file }
+       pai_asm_comment = ^tai_asm_comment;
+       tai_asm_comment = object(tai)
+          str : pchar;
+          constructor init(_str : pchar);
+          destructor done; virtual;
+       end;
+
+
+       { alignment for operator }
+       pai_align = ^tai_align;
+       tai_align = object(tai)
+          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 init(b:byte);
+          constructor init_op(b: byte; _op: byte);
+       end;
+
+       { Insert a section/segment directive }
+       pai_section = ^tai_section;
+       tai_section = object(tai)
+          sec : tsection;
+          constructor init(s : tsection);
+       end;
+
+
+       { generates an uninitializised data block }
+       pai_datablock = ^tai_datablock;
+       tai_datablock = object(tai)
+          sym  : pasmsymbol;
+          size : longint;
+          is_global : boolean;
+          constructor init(const _name : string;_size : longint);
+          constructor init_global(const _name : string;_size : longint);
+       end;
+
+
+       { generates a long integer (32 bit) }
+       pai_const = ^tai_const;
+       tai_const = object(tai)
+          value : longint;
+          constructor init_32bit(_value : longint);
+          constructor init_16bit(_value : word);
+          constructor init_8bit(_value : byte);
+       end;
+
+       pai_const_symbol = ^tai_const_symbol;
+       tai_const_symbol = object(tai)
+          sym    : pasmsymbol;
+          offset : longint;
+          constructor init(_sym:PAsmSymbol);
+          constructor init_offset(_sym:PAsmSymbol;ofs:longint);
+          constructor init_rva(_sym:PAsmSymbol);
+          constructor initname(const name:string);
+          constructor initname_offset(const name:string;ofs:longint);
+          constructor initname_rva(const name:string);
+       end;
+
+       { generates a single (32 bit real) }
+       pai_real_32bit = ^tai_real_32bit;
+       tai_real_32bit = object(tai)
+          value : ts32real;
+          constructor init(_value : ts32real);
+       end;
+
+       { generates a double (64 bit real) }
+       pai_real_64bit = ^tai_real_64bit;
+       tai_real_64bit = object(tai)
+          value : ts64real;
+          constructor init(_value : ts64real);
+       end;
+
+       { generates an extended (80 bit real) }
+       pai_real_80bit = ^tai_real_80bit;
+       tai_real_80bit = object(tai)
+          value : ts80real;
+          constructor init(_value : ts80real);
+       end;
+
+       { generates an comp (integer over 64 bits) }
+       pai_comp_64bit = ^tai_comp_64bit;
+       tai_comp_64bit = object(tai)
+          value : ts64comp;
+          constructor init(_value : ts64comp);
+       end;
+
+       { insert a cut to split into several smaller files }
+       pai_cut = ^tai_cut;
+       tai_cut = object(tai)
+          endname : boolean;
+          constructor init;
+          constructor init_end;
+       end;
+
+       TMarker = (NoPropInfoStart, NoPropInfoEnd, AsmBlockStart, AsmBlockEnd);
+       pai_marker = ^tai_marker;
+       tai_marker = object(tai)
+         Kind: TMarker;
+         Constructor init(_Kind: TMarker);
+       end;
+
+
+{ for each processor define the best precision }
+{ bestreal is defined in globals }
+{$ifdef i386}
+const
+       ait_bestreal = ait_real_80bit;
+type
+       pai_bestreal = pai_real_80bit;
+       tai_bestreal = tai_real_80bit;
+{$endif i386}
+{$ifdef m68k}
+const
+       ait_bestreal = ait_real_32bit;
+type
+       pai_bestreal = pai_real_32bit;
+       tai_bestreal = tai_real_32bit;
+{$endif m68k}
+
+
+       paasmoutput = ^taasmoutput;
+       taasmoutput = object(tlinkedlist)
+         function getlasttaifilepos : pfileposinfo;
+       end;
+
+    var
+    { temporary lists }
+      exprasmlist,
+    { default lists }
+      datasegment,codesegment,bsssegment,
+      debuglist,consts,
+      importssection,exportssection,
+      resourcesection,rttilist         : paasmoutput;
+  { asm symbol list }
+      asmsymbollist : pasmsymbollist;
+
+    const
+      nextlabelnr : longint = 1;
+      countlabelref : boolean = true;
+
+    { make l as a new label }
+    procedure getlabel(var l : pasmlabel);
+    { make l as a new label and flag is_data }
+    procedure getdatalabel(var l : pasmlabel);
+    { free a label }
+    procedure freelabel(var l : pasmlabel);
+    {just get a label number }
+    procedure getlabelnr(var l : longint);
+
+    function  newasmsymbol(const s : string) : pasmsymbol;
+    function  newasmsymboltyp(const s : string;_typ:TAsmSymType) : pasmsymbol;
+    function  getasmsymbol(const s : string) : pasmsymbol;
+    function  renameasmsymbol(const sold, snew : string):pasmsymbol;
+
+    procedure ResetAsmsymbolList;
+
+
+implementation
+
+uses
+  strings,verbose;
+
+{****************************************************************************
+                             TAI
+ ****************************************************************************}
+
+    constructor tai.init;
+      begin
+        optinfo := nil;
+        fileinfo:=aktfilepos;
+      end;
+
+{****************************************************************************
+                             TAI_SECTION
+ ****************************************************************************}
+
+    constructor tai_section.init(s : tsection);
+      begin
+         inherited init;
+         typ:=ait_section;
+         sec:=s;
+      end;
+
+
+{****************************************************************************
+                             TAI_DATABLOCK
+ ****************************************************************************}
+
+    constructor tai_datablock.init(const _name : string;_size : longint);
+
+      begin
+         inherited init;
+         typ:=ait_datablock;
+         sym:=newasmsymboltyp(_name,AS_LOCAL);
+         size:=_size;
+         is_global:=false;
+      end;
+
+
+    constructor tai_datablock.init_global(const _name : string;_size : longint);
+      begin
+         inherited init;
+         typ:=ait_datablock;
+         sym:=newasmsymboltyp(_name,AS_GLOBAL);
+         size:=_size;
+         is_global:=true;
+      end;
+
+
+{****************************************************************************
+                               TAI_SYMBOL
+ ****************************************************************************}
+
+    constructor tai_symbol.init(_sym:PAsmSymbol);
+      begin
+         inherited init;
+         typ:=ait_symbol;
+         sym:=_sym;
+      end;
+
+    constructor tai_symbol.initname(const _name : string);
+      begin
+         inherited init;
+         typ:=ait_symbol;
+         sym:=newasmsymboltyp(_name,AS_LOCAL);
+         is_global:=false;
+      end;
+
+    constructor tai_symbol.initname_global(const _name : string);
+      begin
+         inherited init;
+         typ:=ait_symbol;
+         sym:=newasmsymboltyp(_name,AS_GLOBAL);
+         is_global:=true;
+      end;
+
+
+{****************************************************************************
+                               TAI_CONST
+ ****************************************************************************}
+
+    constructor tai_const.init_32bit(_value : longint);
+
+      begin
+         inherited init;
+         typ:=ait_const_32bit;
+         value:=_value;
+      end;
+
+    constructor tai_const.init_16bit(_value : word);
+
+      begin
+         inherited init;
+         typ:=ait_const_16bit;
+         value:=_value;
+      end;
+
+    constructor tai_const.init_8bit(_value : byte);
+
+      begin
+         inherited init;
+         typ:=ait_const_8bit;
+         value:=_value;
+      end;
+
+
+{****************************************************************************
+                               TAI_CONST_SYMBOL_OFFSET
+ ****************************************************************************}
+
+    constructor tai_const_symbol.init(_sym:PAsmSymbol);
+      begin
+         inherited init;
+         typ:=ait_const_symbol;
+         sym:=_sym;
+         offset:=0;
+         { update sym info }
+         inc(sym^.refs);
+      end;
+
+    constructor tai_const_symbol.init_offset(_sym:PAsmSymbol;ofs:longint);
+      begin
+         inherited init;
+         typ:=ait_const_symbol;
+         sym:=_sym;
+         offset:=ofs;
+         { update sym info }
+         inc(sym^.refs);
+      end;
+
+    constructor tai_const_symbol.init_rva(_sym:PAsmSymbol);
+      begin
+         inherited init;
+         typ:=ait_const_rva;
+         sym:=_sym;
+         offset:=0;
+         { update sym info }
+         inc(sym^.refs);
+      end;
+
+    constructor tai_const_symbol.initname(const name:string);
+      begin
+         inherited init;
+         typ:=ait_const_symbol;
+         sym:=newasmsymbol(name);
+         offset:=0;
+         { update sym info }
+         inc(sym^.refs);
+      end;
+
+    constructor tai_const_symbol.initname_offset(const name:string;ofs:longint);
+      begin
+         inherited init;
+         typ:=ait_const_symbol;
+         sym:=newasmsymbol(name);
+         offset:=ofs;
+         { update sym info }
+         inc(sym^.refs);
+      end;
+
+    constructor tai_const_symbol.initname_rva(const name:string);
+      begin
+         inherited init;
+         typ:=ait_const_rva;
+         sym:=newasmsymbol(name);
+         offset:=0;
+         { update sym info }
+         inc(sym^.refs);
+      end;
+
+
+{****************************************************************************
+                               TAI_real_32bit
+ ****************************************************************************}
+
+    constructor tai_real_32bit.init(_value : ts32real);
+
+      begin
+         inherited init;
+         typ:=ait_real_32bit;
+         value:=_value;
+      end;
+
+{****************************************************************************
+                               TAI_real_64bit
+ ****************************************************************************}
+
+    constructor tai_real_64bit.init(_value : ts64real);
+
+      begin
+         inherited init;
+         typ:=ait_real_64bit;
+         value:=_value;
+      end;
+
+{****************************************************************************
+                               TAI_real_80bit
+ ****************************************************************************}
+
+    constructor tai_real_80bit.init(_value : ts80real);
+
+      begin
+         inherited init;
+         typ:=ait_real_80bit;
+         value:=_value;
+      end;
+
+{****************************************************************************
+                               Tai_comp_64bit
+ ****************************************************************************}
+
+    constructor tai_comp_64bit.init(_value : ts64comp);
+
+      begin
+         inherited init;
+         typ:=ait_comp_64bit;
+         value:=_value;
+      end;
+
+
+{****************************************************************************
+                               TAI_STRING
+ ****************************************************************************}
+
+     constructor tai_string.init(const _str : string);
+
+       begin
+          inherited init;
+          typ:=ait_string;
+          getmem(str,length(_str)+1);
+          strpcopy(str,_str);
+          len:=length(_str);
+       end;
+
+     constructor tai_string.init_pchar(_str : pchar);
+
+       begin
+          inherited init;
+          typ:=ait_string;
+          str:=_str;
+          len:=strlen(_str);
+       end;
+
+    constructor tai_string.init_length_pchar(_str : pchar;length : longint);
+
+       begin
+          inherited init;
+          typ:=ait_string;
+          str:=_str;
+          len:=length;
+       end;
+
+    destructor tai_string.done;
+
+      begin
+         { you can have #0 inside the strings so }
+         if str<>nil then
+           freemem(str,len+1);
+         inherited done;
+      end;
+
+
+{****************************************************************************
+                               TAI_LABEL
+ ****************************************************************************}
+
+    constructor tai_label.init(_l : pasmlabel);
+      begin
+        inherited init;
+        typ:=ait_label;
+        l:=_l;
+        l^.is_set:=true;
+        is_global:=(l^.typ=AS_GLOBAL);
+      end;
+
+
+{****************************************************************************
+                              TAI_DIRECT
+ ****************************************************************************}
+
+     constructor tai_direct.init(_str : pchar);
+
+       begin
+          inherited init;
+          typ:=ait_direct;
+          str:=_str;
+       end;
+
+    destructor tai_direct.done;
+
+      begin
+         strdispose(str);
+         inherited done;
+      end;
+
+{****************************************************************************
+          TAI_ASM_COMMENT  comment to be inserted in the assembler file
+ ****************************************************************************}
+
+     constructor tai_asm_comment.init(_str : pchar);
+
+       begin
+          inherited init;
+          typ:=ait_comment;
+          str:=_str;
+       end;
+
+    destructor tai_asm_comment.done;
+
+      begin
+         strdispose(str);
+         inherited done;
+      end;
+
+{****************************************************************************
+                              TAI_ALIGN
+ ****************************************************************************}
+
+     constructor tai_align.init(b: byte);
+
+       begin
+          inherited init;
+          typ:=ait_align;
+          if b in [1,2,4,8,16] then
+            aligntype := b
+          else
+            aligntype := 1;
+          fillsize:=0;
+          fillop:=0;
+          use_op:=false;
+       end;
+
+
+     constructor tai_align.init_op(b: byte; _op: byte);
+
+       begin
+          inherited init;
+          typ:=ait_align;
+          if b in [1,2,4,8,16] then
+            aligntype := b
+          else
+            aligntype := 1;
+          fillsize:=0;
+          fillop:=_op;
+          use_op:=true;
+       end;
+
+
+{****************************************************************************
+                              TAI_CUT
+ ****************************************************************************}
+
+     constructor tai_cut.init;
+       begin
+          inherited init;
+          typ:=ait_cut;
+          endname:=false;
+       end;
+
+
+     constructor tai_cut.init_end;
+       begin
+          inherited init;
+          typ:=ait_cut;
+          endname:=true;
+       end;
+
+
+{****************************************************************************
+                             Tai_Marker
+ ****************************************************************************}
+
+     Constructor Tai_Marker.Init(_Kind: TMarker);
+     Begin
+       Inherited Init;
+       typ := ait_marker;
+       Kind := _Kind;
+     End;
+
+
+{*****************************************************************************
+                                  AsmSymbol
+*****************************************************************************}
+
+    constructor tasmsymbol.init(const s:string;_typ:TAsmsymtype);
+      begin;
+        inherited initname(s);
+        reset;
+        typ:=_typ;
+      end;
+
+    procedure tasmsymbol.reset;
+      begin
+        section:=sec_none;
+        address:=0;
+        size:=0;
+        idx:=-1;
+        typ:=AS_EXTERNAL;
+        { mainly used to remove unused labels from the codesegment }
+        refs:=0;
+      end;
+
+    function tasmsymbol.is_used:boolean;
+      begin
+        is_used:=(refs>0);
+      end;
+
+    procedure tasmsymbol.setaddress(sec:tsection;offset,len:longint);
+      begin
+        section:=sec;
+        address:=offset;
+        size:=len;
+      end;
+
+
+{*****************************************************************************
+                                  AsmLabel
+*****************************************************************************}
+
+    constructor tasmlabel.init;
+      begin;
+        labelnr:=nextlabelnr;
+        inc(nextlabelnr);
+        inherited init(target_asm.labelprefix+tostr(labelnr),AS_LOCAL);
+        is_set:=false;
+      end;
+
+
+    constructor tasmlabel.initdata;
+      begin;
+        labelnr:=nextlabelnr;
+        inc(nextlabelnr);
+        if (cs_smartlink in aktmoduleswitches) then
+          inherited init('_$'+current_module^.modulename^+'$_L'+tostr(labelnr),AS_GLOBAL)
+        else
+          inherited init(target_asm.labelprefix+tostr(labelnr),AS_LOCAL);
+        is_set:=false;
+        { write it always }
+        refs:=1;
+      end;
+
+
+{*****************************************************************************
+                              AsmSymbolList helpers
+*****************************************************************************}
+
+    function newasmsymbol(const s : string) : pasmsymbol;
+      var
+        hp : pasmsymbol;
+      begin
+        hp:=pasmsymbol(asmsymbollist^.search(s));
+        if assigned(hp) then
+         begin
+           newasmsymbol:=hp;
+           exit;
+         end;
+        { Not found, insert it as an External }
+        hp:=new(pasmsymbol,init(s,AS_EXTERNAL));
+        asmsymbollist^.insert(hp);
+        newasmsymbol:=hp;
+      end;
+
+
+    function  newasmsymboltyp(const s : string;_typ:TAsmSymType) : pasmsymbol;
+      var
+        hp : pasmsymbol;
+      begin
+        hp:=pasmsymbol(asmsymbollist^.search(s));
+        if assigned(hp) then
+         begin
+           hp^.typ:=_typ;
+           newasmsymboltyp:=hp;
+           exit;
+         end;
+        { Not found, insert it as an External }
+        hp:=new(pasmsymbol,init(s,_typ));
+        asmsymbollist^.insert(hp);
+        newasmsymboltyp:=hp;
+      end;
+
+
+    function getasmsymbol(const s : string) : pasmsymbol;
+      begin
+        getasmsymbol:=pasmsymbol(asmsymbollist^.search(s));
+      end;
+
+
+    { renames an asmsymbol }
+    function renameasmsymbol(const sold, snew : string):pasmsymbol;
+{$ifdef nodictonaryrename}
+      var
+        hpold,hpnew : pasmsymbol;
+      begin
+        hpnew:=pasmsymbol(asmsymbollist^.search(snew));
+        if assigned(hpnew) then
+          internalerror(405405);
+        hpold:=pasmsymbol(asmsymbollist^.search(sold));
+        if not assigned(hpold) then
+          internalerror(405406);
+
+        hpnew:=new(pasmsymbol,init(sold));
+        { replace the old one }
+        { WARNING this heavily depends on the
+          feature that tdictionnary.insert does not delete
+          the tree element that it replaces !! }
+        asmsymbollist^.replace_existing:=true;
+        asmsymbollist^.insert(hpnew);
+        asmsymbollist^.replace_existing:=false;
+        { restore the tree }
+        hpnew^.left:=hpold^.left;
+        hpnew^.right:=hpold^.right;
+        stringdispose(hpold^._name);
+        hpold^._name:=stringdup(snew);
+        hpold^.speedvalue:=getspeedvalue(snew);
+        { now reinsert it at right location !! }
+        asmsymbollist^.insert(hpold);
+        renameasmsymbol:=hpold;
+      end;
+{$else}
+      begin
+        renameasmsymbol:=pasmsymbol(asmsymbollist^.rename(sold,snew));
+      end;
+{$endif}
+
+
+    procedure ResetAsmSym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif}
+      begin
+        pasmsymbol(p)^.reset;
+      end;
+
+
+    procedure ResetAsmsymbolList;
+      begin
+        {$ifdef tp}
+        asmsymbollist^.foreach(resetasmsym);
+        {$else}
+        asmsymbollist^.foreach(@resetasmsym);
+        {$endif}
+      end;
+
+
+{*****************************************************************************
+                              Label Helpers
+*****************************************************************************}
+
+    procedure getlabel(var l : pasmlabel);
+      begin
+        l:=new(pasmlabel,init);
+        asmsymbollist^.insert(l);
+      end;
+
+
+    procedure getdatalabel(var l : pasmlabel);
+      begin
+        l:=new(pasmlabel,initdata);
+        asmsymbollist^.insert(l);
+      end;
+
+
+    procedure freelabel(var l : pasmlabel);
+      begin
+        { nothing to do, the dispose of the asmsymbollist will do it }
+        l:=nil;
+      end;
+
+    procedure getlabelnr(var l : longint);
+      begin
+         l:=nextlabelnr;
+         inc(nextlabelnr);
+      end;
+
+
+{*****************************************************************************
+                                 TAAsmOutput
+*****************************************************************************}
+
+    function taasmoutput.getlasttaifilepos : pfileposinfo;
+      begin
+         if assigned(last) then
+           getlasttaifilepos:=@pai(last)^.fileinfo
+         else
+           getlasttaifilepos:=nil;
+      end;
+
+end.
+{
   $Log$
-  Revision 1.46  1999-05-21 13:54:38  peter
+  Revision 1.47  1999-05-27 19:43:55  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.46  1999/05/21 13:54:38  peter
     * NEWLAB for label as symbol
-
-  Revision 1.45  1999/05/20 22:18:51  pierre
-   * fix from Peter for double bug reported 20/05/1999
-
-  Revision 1.44  1999/05/12 00:19:34  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.43  1999/05/08 20:38:02  jonas
-    * seperate OPTimizer INFO pointer field in tai object
-
-  Revision 1.42  1999/05/06 09:05:05  peter
-    * generic write_float and str_float
-    * fixed constant float conversions
-
-  Revision 1.41  1999/05/02 22:41:46  peter
-    * moved section names to systems
-    * fixed nasm,intel writer
-
-  Revision 1.40  1999/04/21 09:43:28  peter
-    * storenumber works
-    * fixed some typos in double_checksum
-    + incompatible types type1 and type2 message (with storenumber)
-
-  Revision 1.39  1999/04/16 11:49:36  peter
-    + tempalloc
-    + -at to show temp alloc info in .s file
-
-  Revision 1.38  1999/04/14 09:14:44  peter
-    * first things to store the symbol/def number in the ppu
-
-  Revision 1.37  1999/03/10 13:25:42  pierre
-    section order changed to get closer output from coff writer
-
-  Revision 1.36  1999/03/08 14:51:04  peter
-    + smartlinking for ag386bin
-
-  Revision 1.35  1999/03/05 13:09:48  peter
-    * first things for tai_cut support for ag386bin
-
-  Revision 1.34  1999/03/03 11:59:27  pierre
-   + getasmsymbol to search for existing assembler symbol only
-
-  Revision 1.33  1999/03/02 02:56:08  peter
-    + stabs support for binary writers
-    * more fixes and missing updates from the previous commit :(
-
-  Revision 1.32  1999/03/01 13:31:59  pierre
-   * external used before implemented problem fixed
-
-  Revision 1.31  1999/02/25 21:02:16  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.30  1999/02/17 10:16:24  peter
-    * small fixes for the binary writer
-
-  Revision 1.29  1998/12/29 18:48:24  jonas
-    + optimize pascal code surrounding assembler blocks
-
-  Revision 1.28  1998/12/16 00:27:16  peter
-    * removed some obsolete version checks
-
-  Revision 1.27  1998/12/11 00:02:37  peter
-    + globtype,tokens,version unit splitted from globals
-
-  Revision 1.26  1998/12/01 23:36:31  pierre
-   * zero padded alignment was buggy
-
-  Revision 1.25  1998/11/30 09:42:52  pierre
-    * some range check bugs fixed (still not working !)
-    + added DLL writing support for win32 (also accepts variables)
-    + TempAnsi for code that could be used for Temporary ansi strings
-      handling
-
-  Revision 1.24  1998/11/12 11:19:30  pierre
-   * fix for first line of function break
-
-  Revision 1.23  1998/10/14 15:56:37  pierre
-    * all references to comp suppressed for m68k
-
-  Revision 1.22  1998/10/12 12:20:38  pierre
-    + added tai_const_symbol_offset
-      for r : pointer = @var.field;
-    * better message for different arg names on implementation
-      of function
-
-  Revision 1.21  1998/10/08 17:17:07  pierre
-    * current_module old scanner tagged as invalid if unit is recompiled
-    + added ppheap for better info on tracegetmem of heaptrc
-      (adds line column and file index)
-    * several memory leaks removed ith help of heaptrc !!
-
-  Revision 1.20  1998/10/06 17:16:31  pierre
-    * some memory leaks fixed (thanks to Peter for heaptrc !)
-
-  Revision 1.19  1998/10/01 20:19:11  jonas
-    + ait_marker support
-
-  Revision 1.18  1998/09/20 17:11:25  jonas
-    * released REGALLOC
-
-  Revision 1.17  1998/09/07 18:33:31  peter
-    + smartlinking for win95 imports
-
-  Revision 1.16  1998/09/03 17:08:37  pierre
-    * better lines for stabs
-      (no scroll back to if before else part
-      no return to case line at jump outside case)
-    + source lines also if not in order
-
-  Revision 1.15  1998/08/11 15:31:36  peter
-    * write extended to ppu file
-    * new version 0.99.7
-
-  Revision 1.14  1998/08/10 23:56:03  peter
-    * fixed extended writing
-
-  Revision 1.13  1998/08/10 14:49:33  peter
-    + localswitches, moduleswitches, globalswitches splitting
-
-  Revision 1.12  1998/07/14 14:46:36  peter
-    * released NEWINPUT
-
-  Revision 1.11  1998/07/07 11:19:50  peter
-    + NEWINPUT for a better inputfile and scanner object
-
-  Revision 1.10  1998/06/08 22:59:41  peter
-    * smartlinking works for win32
-    * some defines to exclude some compiler parts
-
-  Revision 1.9  1998/06/04 23:51:26  peter
-    * m68k compiles
-    + .def file creation moved to gendef.pas so it could also be used
-      for win32
-
-  Revision 1.8  1998/05/23 01:20:53  peter
-    + aktasmmode, aktoptprocessor, aktoutputformat
-    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
-    + $LIBNAME to set the library name where the unit will be put in
-    * splitted cgi386 a bit (codeseg to large for bp7)
-    * nasm, tasm works again. nasm moved to ag386nsm.pas
-
-  Revision 1.7  1998/05/07 00:16:59  peter
-    * smartlinking for sets
-    + consts labels are now concated/generated in hcodegen
-    * moved some cpu code to cga and some none cpu depended code from cga
-      to tree and hcodegen and cleanup of hcodegen
-    * assembling .. output reduced for smartlinking ;)
-
-  Revision 1.6  1998/05/06 18:36:53  peter
-    * tai_section extended with code,data,bss sections and enumerated type
-    * ident 'compiled by FPC' moved to pmodules
-    * small fix for smartlink
-
-  Revision 1.5  1998/05/01 07:43:52  florian
-    + basics for rtti implemented
-    + switch $m (generate rtti for published sections)
-
-  Revision 1.4  1998/04/29 10:33:40  pierre
-    + added some code for ansistring (not complete nor working yet)
-    * corrected operator overloading
-    * corrected nasm output
-    + started inline procedures
-    + added starstarn : use ** for exponentiation (^ gave problems)
-    + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.3  1998/04/27 23:10:27  peter
-    + new scanner
-    * $makelib -> if smartlink
-    * small filename fixes pmodule.setfilename
-    * moved import from files.pas -> import.pas
-
-  Revision 1.2  1998/04/09 15:46:37  florian
-    + register allocation tracing stuff added
-
-}
+
+  Revision 1.45  1999/05/20 22:18:51  pierre
+   * fix from Peter for double bug reported 20/05/1999
+
+  Revision 1.44  1999/05/12 00:19:34  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.43  1999/05/08 20:38:02  jonas
+    * seperate OPTimizer INFO pointer field in tai object
+
+  Revision 1.42  1999/05/06 09:05:05  peter
+    * generic write_float and str_float
+    * fixed constant float conversions
+
+  Revision 1.41  1999/05/02 22:41:46  peter
+    * moved section names to systems
+    * fixed nasm,intel writer
+
+  Revision 1.40  1999/04/21 09:43:28  peter
+    * storenumber works
+    * fixed some typos in double_checksum
+    + incompatible types type1 and type2 message (with storenumber)
+
+  Revision 1.39  1999/04/16 11:49:36  peter
+    + tempalloc
+    + -at to show temp alloc info in .s file
+
+  Revision 1.38  1999/04/14 09:14:44  peter
+    * first things to store the symbol/def number in the ppu
+
+  Revision 1.37  1999/03/10 13:25:42  pierre
+    section order changed to get closer output from coff writer
+
+  Revision 1.36  1999/03/08 14:51:04  peter
+    + smartlinking for ag386bin
+
+  Revision 1.35  1999/03/05 13:09:48  peter
+    * first things for tai_cut support for ag386bin
+
+  Revision 1.34  1999/03/03 11:59:27  pierre
+   + getasmsymbol to search for existing assembler symbol only
+
+  Revision 1.33  1999/03/02 02:56:08  peter
+    + stabs support for binary writers
+    * more fixes and missing updates from the previous commit :(
+
+  Revision 1.32  1999/03/01 13:31:59  pierre
+   * external used before implemented problem fixed
+
+  Revision 1.31  1999/02/25 21:02:16  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.30  1999/02/17 10:16:24  peter
+    * small fixes for the binary writer
+
+  Revision 1.29  1998/12/29 18:48:24  jonas
+    + optimize pascal code surrounding assembler blocks
+
+  Revision 1.28  1998/12/16 00:27:16  peter
+    * removed some obsolete version checks
+
+  Revision 1.27  1998/12/11 00:02:37  peter
+    + globtype,tokens,version unit splitted from globals
+
+  Revision 1.26  1998/12/01 23:36:31  pierre
+   * zero padded alignment was buggy
+
+  Revision 1.25  1998/11/30 09:42:52  pierre
+    * some range check bugs fixed (still not working !)
+    + added DLL writing support for win32 (also accepts variables)
+    + TempAnsi for code that could be used for Temporary ansi strings
+      handling
+
+  Revision 1.24  1998/11/12 11:19:30  pierre
+   * fix for first line of function break
+
+  Revision 1.23  1998/10/14 15:56:37  pierre
+    * all references to comp suppressed for m68k
+
+  Revision 1.22  1998/10/12 12:20:38  pierre
+    + added tai_const_symbol_offset
+      for r : pointer = @var.field;
+    * better message for different arg names on implementation
+      of function
+
+  Revision 1.21  1998/10/08 17:17:07  pierre
+    * current_module old scanner tagged as invalid if unit is recompiled
+    + added ppheap for better info on tracegetmem of heaptrc
+      (adds line column and file index)
+    * several memory leaks removed ith help of heaptrc !!
+
+  Revision 1.20  1998/10/06 17:16:31  pierre
+    * some memory leaks fixed (thanks to Peter for heaptrc !)
+
+  Revision 1.19  1998/10/01 20:19:11  jonas
+    + ait_marker support
+
+  Revision 1.18  1998/09/20 17:11:25  jonas
+    * released REGALLOC
+
+  Revision 1.17  1998/09/07 18:33:31  peter
+    + smartlinking for win95 imports
+
+  Revision 1.16  1998/09/03 17:08:37  pierre
+    * better lines for stabs
+      (no scroll back to if before else part
+      no return to case line at jump outside case)
+    + source lines also if not in order
+
+  Revision 1.15  1998/08/11 15:31:36  peter
+    * write extended to ppu file
+    * new version 0.99.7
+
+  Revision 1.14  1998/08/10 23:56:03  peter
+    * fixed extended writing
+
+  Revision 1.13  1998/08/10 14:49:33  peter
+    + localswitches, moduleswitches, globalswitches splitting
+
+  Revision 1.12  1998/07/14 14:46:36  peter
+    * released NEWINPUT
+
+  Revision 1.11  1998/07/07 11:19:50  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.10  1998/06/08 22:59:41  peter
+    * smartlinking works for win32
+    * some defines to exclude some compiler parts
+
+  Revision 1.9  1998/06/04 23:51:26  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.8  1998/05/23 01:20:53  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.7  1998/05/07 00:16:59  peter
+    * smartlinking for sets
+    + consts labels are now concated/generated in hcodegen
+    * moved some cpu code to cga and some none cpu depended code from cga
+      to tree and hcodegen and cleanup of hcodegen
+    * assembling .. output reduced for smartlinking ;)
+
+  Revision 1.6  1998/05/06 18:36:53  peter
+    * tai_section extended with code,data,bss sections and enumerated type
+    * ident 'compiled by FPC' moved to pmodules
+    * small fix for smartlink
+
+  Revision 1.5  1998/05/01 07:43:52  florian
+    + basics for rtti implemented
+    + switch $m (generate rtti for published sections)
+
+  Revision 1.4  1998/04/29 10:33:40  pierre
+    + added some code for ansistring (not complete nor working yet)
+    * corrected operator overloading
+    * corrected nasm output
+    + started inline procedures
+    + added starstarn : use ** for exponentiation (^ gave problems)
+    + started UseTokenInfo cond to get accurate positions
+
+  Revision 1.3  1998/04/27 23:10:27  peter
+    + new scanner
+    * $makelib -> if smartlink
+    * small filename fixes pmodule.setfilename
+    * moved import from files.pas -> import.pas
+
+  Revision 1.2  1998/04/09 15:46:37  florian
+    + register allocation tracing stuff added
+
+}

compiler/ag386bin.pas

@@ -1,940 +1,900 @@
-{
-    $Id$
-    Copyright (c) 1996-98 by the FPC development team
-
-    This unit implements an binary assembler output class
-
-    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.
-
- ****************************************************************************
-}
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
-unit ag386bin;
-
-{$define MULTIPASS}
-{define EXTERNALBSS}
-
-  interface
-
-    uses
-       i386base,
-       cobjects,aasm,files,assemble;
-
-    type
-      togtype=(og_none,og_dbg,og_coff,og_pecoff);
-
-      pi386binasmlist=^ti386binasmlist;
-      ti386binasmlist=object
-        constructor init(t:togtype);
-        destructor  done;
-        procedure WriteBin;
-      private
-        currpass : byte;
-{$ifdef GDB}
-        n_line       : byte;     { different types of source lines }
-        linecount,
-        includecount : longint;
-        funcname     : pasmsymbol;
-        stabslastfileinfo : tfileposinfo;
-        procedure convertstabs(p:pchar);
-{$ifdef unused}
-        procedure emitsymbolstabs(s : string;nidx,nother,line : longint;firstasm,secondasm : pasmsymbol);
-{$endif}
-        procedure emitlineinfostabs(nidx,line : longint);
-        procedure emitstabs(s:string);
-        procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
-        procedure StartFileLineInfo;
-{$endif}
-        function  TreePass0(hp:pai):pai;
-        function  TreePass1(hp:pai):pai;
-        function  TreePass2(hp:pai):pai;
-        procedure writetree(p:paasmoutput);
-      end;
-
-  implementation
-
-    uses
-       strings,
-       globtype,globals,systems,verbose,
-       i386asm,
-{$ifdef GDB}
-       gdb,
-{$endif}
-       og386,og386dbg,og386cff;
-
-{$ifdef GDB}
-
-    procedure ti386binasmlist.convertstabs(p:pchar);
-      var
-        ofs,
-        nidx,nother,i,line,j : longint;
-        code : integer;
-        hp : pchar;
-        reloc : boolean;
-        sec : tsection;
-        ps : pasmsymbol;
-        s : string;
-      begin
-        ofs:=0;
-        reloc:=true;
-        ps:=nil;
-        sec:=sec_none;
-        if p[0]='"' then
-         begin
-           i:=1;
-           { we can have \" inside the string !! PM }
-           while not ((p[i]='"') and (p[i-1]<>'\')) do
-            inc(i);
-           p[i]:=#0;
-           hp:=@p[1];
-           s:=StrPas(@P[i+2]);
-         end
-        else
-         begin
-           hp:=nil;
-           s:=StrPas(P);
-         end;
-      { When in pass 1 then only alloc and leave }
-        if currpass=1 then
-         begin
-           objectalloc^.staballoc(hp);
-           if assigned(hp) then
-            p[i]:='"';
-           exit;
-         end;
-      { Parse the rest of the stabs }
-        if s='' then
-         internalerror(33000);
-        j:=pos(',',s);
-        if j=0 then
-         internalerror(33001);
-        Val(Copy(s,1,j-1),nidx,code);
-        if code<>0 then
-         internalerror(33002);
-        Delete(s,1,j);
-        j:=pos(',',s);
-        if (j=0) then
-         internalerror(33003);
-        Val(Copy(s,1,j-1),nother,code);
-        if code<>0 then
-         internalerror(33004);
-        Delete(s,1,j);
-        j:=pos(',',s);
-        if j=0 then
-         begin
-           j:=256;
-           ofs:=-1;
-         end;
-        Val(Copy(s,1,j-1),line,code);
-        if code<>0 then
-          internalerror(33005);
-        if ofs=0 then
-          Delete(s,1,j);
-        if ofs=0 then
-          begin
-            Val(s,ofs,code);
-            if code=0 then
-              reloc:=false
-            else
-              begin
-                ofs:=0;
-                { handle asmsymbol or
-                    asmsymbol - asmsymbol }
-                j:=pos(' ',s);
-                if j=0 then
-                  j:=pos('-',s);
-                { single asmsymbol }
-                if j=0 then
-                  j:=256;
-                ps:=getasmsymbol(copy(s,1,j-1));
-                if not assigned(ps) then
-                  internalerror(33006)
-                else
-                  begin
-                    sec:=ps^.section;
-                    ofs:=ps^.address;
-                    reloc:=true;
-                  end;
-                if j<256 then
-                  begin
-                    delete(s,1,j);
-                    while (s<>'') and (s[1]=' ') do
-                      delete(s,1,1);
-                    ps:=getasmsymbol(s);
-                    if not assigned(ps) then
-                      internalerror(33007)
-                    else
-                      begin
-                        if ps^.section<>sec then
-                          internalerror(33008);
-                        ofs:=ofs-ps^.address;
-                        reloc:=false;
-                      end;
-                  end;
-              end;
-          end;
-        { external bss need speical handling (PM) }
-        if assigned(ps) and (ps^.section=sec_none) then
-          objectoutput^.WriteSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc)
-        else
-          objectoutput^.WriteStabs(sec,ofs,hp,nidx,nother,line,reloc);
-        if assigned(hp) then
-         p[i]:='"';
-      end;
-
-
-{$ifdef unused}
-    procedure ti386binasmlist.emitsymbolstabs(s : string;nidx,nother,line : longint;
-                firstasm,secondasm : pasmsymbol);
-      var
-         hp : pchar;
-      begin
-        if s='' then
-          hp:=nil
-        else
-          begin
-            s:=s+#0;
-            hp:=@s[1];
-          end;
-        if not assigned(secondasm) then
-          begin
-            if not assigned(firstasm) then
-              internalerror(33009);
-            objectoutput^.WriteStabs(firstasm^.section,firstasm^.address,hp,nidx,nother,line,true);
-          end
-        else
-          begin
-            if firstasm^.section<>secondasm^.section then
-              internalerror(33010);
-            objectoutput^.WriteStabs(firstasm^.section,firstasm^.address-secondasm^.address,
-              hp,nidx,nother,line,false);
-          end;
-      end;
-{$endif}
-
-
-    procedure ti386binasmlist.emitlineinfostabs(nidx,line : longint);
-      var
-         sec : tsection;
-      begin
-        if currpass=1 then
-          begin
-            objectalloc^.staballoc(nil);
-            exit;
-          end;
-
-        if (nidx=n_textline) and assigned(funcname) and
-           (target_os.use_function_relative_addresses) then
-          objectoutput^.WriteStabs(sec_code,pgenericcoffoutput(objectoutput)^.sects[sec_code]^.len-funcname^.address,
-              nil,nidx,0,line,false)
-        else
-          begin
-            if nidx=n_textline then
-              sec:=sec_code
-            else if nidx=n_dataline then
-              sec:=sec_data
-            else
-              sec:=sec_bss;
-            objectoutput^.WriteStabs(sec,pgenericcoffoutput(objectoutput)^.sects[sec]^.len,
-              nil,nidx,0,line,true);
-          end;
-      end;
-
-    procedure ti386binasmlist.emitstabs(s:string);
-      begin
-        s:=s+#0;
-        ConvertStabs(@s[1]);
-      end;
-
-
-    procedure ti386binasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
-      var
-        curr_n : byte;
-        hp : pasmsymbol;
-        infile : pinputfile;
-      begin
-        if not (cs_debuginfo in aktmoduleswitches) then
-         exit;
-      { file changed ? (must be before line info) }
-        if (fileinfo.fileindex<>0) and
-           (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
-         begin
-           infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex);
-           if includecount=0 then
-            curr_n:=n_sourcefile
-           else
-            curr_n:=n_includefile;
-           { get symbol for this includefile }
-           hp:=newasmsymbol('Ltext'+ToStr(IncludeCount));
-           if currpass=1 then
-             begin
-                hp^.typ:=AS_LOCAL;
-                hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
-             end
-           else
-             objectoutput^.writesymbol(hp);
-           { emit stabs }
-           if (infile^.path^<>'') then
-             EmitStabs('"'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+tostr(curr_n)+
-               ',0,0,Ltext'+ToStr(IncludeCount));
-           EmitStabs('"'+lower(FixFileName(infile^.name^))+'",'+tostr(curr_n)+
-             ',0,0,Ltext'+ToStr(IncludeCount));
-           inc(includecount);
-         end;
-      { line changed ? }
-        if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
-          emitlineinfostabs(n_line,fileinfo.line);
-        stabslastfileinfo:=fileinfo;
-      end;
-
-
-    procedure ti386binasmlist.StartFileLineInfo;
-      var
-        fileinfo : tfileposinfo;
-      begin
-        FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
-        n_line:=n_textline;
-        funcname:=nil;
-        linecount:=1;
-        includecount:=0;
-        fileinfo.fileindex:=1;
-        fileinfo.line:=1;
-        WriteFileLineInfo(fileinfo);
-      end;
-{$endif GDB}
-
-
-    function ti386binasmlist.TreePass0(hp:pai):pai;
-      var
-        lastsec : tsection;
-        l : longint;
-      begin
-        while assigned(hp) do
-         begin
-           case hp^.typ of
-             ait_align :
-               begin
-                 if (objectalloc^.sectionsize mod pai_align(hp)^.aligntype)<>0 then
-                   begin
-                     pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype-
-                       (objectalloc^.sectionsize mod pai_align(hp)^.aligntype);
-                     objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
-                   end
-                 else
-                   pai_align(hp)^.fillsize:=0;
-               end;
-             ait_datablock :
-               begin
-{$ifdef EXTERNALBSS}
-                 if not pai_datablock(hp)^.is_global then
-                  begin
-                     l:=pai_datablock(hp)^.size;
-                     if l>2 then
-                       objectalloc^.sectionalign(4)
-                     else if l>1 then
-                       objectalloc^.sectionalign(2);
-                     objectalloc^.sectionalloc(pai_datablock(hp)^.size);
-                  end;
-{$else}
-                 l:=pai_datablock(hp)^.size;
-                 if l>2 then
-                   objectalloc^.sectionalign(4)
-                 else if l>1 then
-                   objectalloc^.sectionalign(2);
-                 objectalloc^.sectionalloc(pai_datablock(hp)^.size);
-{$endif}
-               end;
-             ait_const_32bit :
-               objectalloc^.sectionalloc(4);
-             ait_const_16bit :
-               objectalloc^.sectionalloc(2);
-             ait_const_8bit :
-               objectalloc^.sectionalloc(1);
-             ait_real_80bit :
-               objectalloc^.sectionalloc(10);
-             ait_real_64bit :
-               objectalloc^.sectionalloc(8);
-             ait_real_32bit :
-               objectalloc^.sectionalloc(4);
-             ait_comp_64bit :
-               objectalloc^.sectionalloc(8);
-             ait_const_rva,
-             ait_const_symbol :
-               objectalloc^.sectionalloc(4);
-             ait_section:
-               begin
-                 objectalloc^.setsection(pai_section(hp)^.sec);
-                 lastsec:=pai_section(hp)^.sec;
-               end;
-             ait_symbol :
-               pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
-{$ifndef NEWLAB}
-             ait_label :
-               begin
-                 pai_label(hp)^.setaddress(objectalloc^.sectionsize);
-                 if pai_label(hp)^.l^.is_symbol then
-                   begin
-                     pai_label(hp)^.sym:=newasmsymbol(lab2str(pai_label(hp)^.l));
-                     if (pai_label(hp)^.l^.is_data) and (cs_smartlink in aktmoduleswitches) then
-                       pai_label(hp)^.sym^.typ:=AS_GLOBAL
-                     else
-                       pai_label(hp)^.sym^.typ:=AS_LOCAL;
-                     pai_label(hp)^.sym^.setaddress(objectalloc^.currsec,pai_label(hp)^.l^.address,0);
-                   end;
-               end;
-{$endif}
-             ait_string :
-               objectalloc^.sectionalloc(pai_string(hp)^.len);
-{$ifndef NEWLAB}
-             ait_labeled_instruction,
-{$endif}
-             ait_instruction :
-               objectalloc^.sectionalloc(pai386(hp)^.Pass1(objectalloc^.sectionsize));
-             ait_cut :
-               begin
-                 objectalloc^.resetsections;
-                 objectalloc^.setsection(lastsec);
-               end;
-           end;
-           hp:=pai(hp^.next);
-         end;
-        TreePass0:=hp;
-      end;
-
-
-    function ti386binasmlist.TreePass1(hp:pai):pai;
-      var
-        l : longint;
-      begin
-        while assigned(hp) do
-         begin
-{$ifdef GDB}
-           { write stabs }
-           if (cs_debuginfo in aktmoduleswitches) then
-            begin
-              if (objectalloc^.currsec<>sec_none) and
-                 not(hp^.typ in  [
-{$ifndef NEWLAB}
-                     ait_external,ait_label,
-{$endif}
-                     ait_regalloc,ait_tempalloc,
-                     ait_stabn,ait_stabs,ait_section,
-                     ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
-               WriteFileLineInfo(hp^.fileinfo);
-            end;
-{$endif GDB}
-           case hp^.typ of
-             ait_align :
-               begin
-                 if (objectalloc^.sectionsize mod pai_align(hp)^.aligntype)<>0 then
-                   begin
-                     pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype-
-                       (objectalloc^.sectionsize mod pai_align(hp)^.aligntype);
-                     objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
-                   end
-                 else
-                   pai_align(hp)^.fillsize:=0;
-               end;
-             ait_datablock :
-               begin
-                 if objectalloc^.currsec<>sec_bss then
-                  Message(asmw_e_alloc_data_only_in_bss);
-{$ifdef EXTERNALBSS}
-                 if pai_datablock(hp)^.is_global then
-                  begin
-                    pai_datablock(hp)^.sym^.typ:=AS_EXTERNAL;
-                    pai_datablock(hp)^.sym^.setaddress(sec_none,pai_datablock(hp)^.size,pai_datablock(hp)^.size);
-                  end
-                 else
-                  begin
-                    l:=pai_datablock(hp)^.size;
-                    if l>2 then
-                      objectalloc^.sectionalign(4)
-                    else if l>1 then
-                      objectalloc^.sectionalign(2);
-                    pai_datablock(hp)^.sym^.typ:=AS_LOCAL;
-                    pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size);
-                    objectalloc^.sectionalloc(pai_datablock(hp)^.size);
-                  end;
-{$else}
-                 if pai_datablock(hp)^.is_global then
-                  pai_datablock(hp)^.sym^.typ:=AS_GLOBAL
-                 else
-                  pai_datablock(hp)^.sym^.typ:=AS_LOCAL;
-                 l:=pai_datablock(hp)^.size;
-                 if l>2 then
-                   objectalloc^.sectionalign(4)
-                 else if l>1 then
-                   objectalloc^.sectionalign(2);
-                 pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size);
-                 objectalloc^.sectionalloc(pai_datablock(hp)^.size);
-{$endif}
-               end;
-             ait_const_32bit :
-               objectalloc^.sectionalloc(4);
-             ait_const_16bit :
-               objectalloc^.sectionalloc(2);
-             ait_const_8bit :
-               objectalloc^.sectionalloc(1);
-             ait_real_80bit :
-               objectalloc^.sectionalloc(10);
-             ait_real_64bit :
-               objectalloc^.sectionalloc(8);
-             ait_real_32bit :
-               objectalloc^.sectionalloc(4);
-             ait_comp_64bit :
-               objectalloc^.sectionalloc(8);
-             ait_const_rva,
-             ait_const_symbol :
-               objectalloc^.sectionalloc(4);
-{$ifndef NEWLAB}
-             ait_external :
-               pai_external(hp)^.sym^.typ:=AS_EXTERNAL;
-{$endif}
-             ait_section:
-               begin
-                 objectalloc^.setsection(pai_section(hp)^.sec);
-{$ifdef GDB}
-                 case pai_section(hp)^.sec of
-                  sec_code : n_line:=n_textline;
-                  sec_data : n_line:=n_dataline;
-                   sec_bss : n_line:=n_bssline;
-                 else
-                  n_line:=n_dataline;
-                 end;
-                 stabslastfileinfo.line:=-1;
-{$endif GDB}
-               end;
-{$ifdef GDB}
-             ait_stabn :
-               convertstabs(pai_stabn(hp)^.str);
-             ait_stabs :
-               convertstabs(pai_stabs(hp)^.str);
-             ait_stab_function_name :
-               if assigned(pai_stab_function_name(hp)^.str) then
-                 funcname:=getasmsymbol(pai_stab_function_name(hp)^.str)
-               else
-                 funcname:=nil;
-             ait_force_line :
-               stabslastfileinfo.line:=0;
-{$endif}
-             ait_symbol :
-               begin
-                 if pai_symbol(hp)^.is_global then
-                  pai_symbol(hp)^.sym^.typ:=AS_GLOBAL
-                 else
-                  pai_symbol(hp)^.sym^.typ:=AS_LOCAL;
-                 pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
-               end;
-{$ifndef NEWLAB}
-             ait_label :
-               begin
-                 pai_label(hp)^.setaddress(objectalloc^.sectionsize);
-                 if pai_label(hp)^.l^.is_symbol then
-                   begin
-                     pai_label(hp)^.sym:=newasmsymbol(lab2str(pai_label(hp)^.l));
-                     if (pai_label(hp)^.l^.is_data) and (cs_smartlink in aktmoduleswitches) then
-                       pai_label(hp)^.sym^.typ:=AS_GLOBAL
-                     else
-                       pai_label(hp)^.sym^.typ:=AS_LOCAL;
-                     pai_label(hp)^.sym^.setaddress(objectalloc^.currsec,pai_label(hp)^.l^.address,0);
-                   end;
-               end;
-{$endif}
-             ait_string :
-               objectalloc^.sectionalloc(pai_string(hp)^.len);
-{$ifndef NEWLAB}
-             ait_labeled_instruction,
-{$endif}
-             ait_instruction :
-               objectalloc^.sectionalloc(pai386(hp)^.Pass1(objectalloc^.sectionsize));
-             ait_direct :
-               Message(asmw_f_direct_not_supported);
-             ait_cut :
-               break;
-           end;
-           hp:=pai(hp^.next);
-         end;
-        TreePass1:=hp;
-      end;
-
-
-    function ti386binasmlist.TreePass2(hp:pai):pai;
-      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
-        l,j : longint;
-{$ifdef I386}
-        co : comp;
-{$endif I386}
-      begin
-        { main loop }
-        while assigned(hp) do
-         begin
-{$ifdef GDB}
-           { write stabs }
-           if cs_debuginfo in aktmoduleswitches then
-            begin
-              if (objectoutput^.currsec<>sec_none) and
-                 not(hp^.typ in  [
-{$ifndef NEWLAB}
-                     ait_external,ait_label,
-{$endif}
-                     ait_regalloc,ait_tempalloc,
-                     ait_stabn,ait_stabs,ait_section,
-                     ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
-               WriteFileLineInfo(hp^.fileinfo);
-            end;
-{$endif GDB}
-           case hp^.typ of
-             ait_align :
-               begin
-                 l:=pai_align(hp)^.fillsize;
-                 while (l>0) do
-                  begin
-                    for j:=0to 5 do
-                     if (l>=length(alignarray[j])) then
-                      break;
-                    objectoutput^.writebytes(alignarray[j][1],length(alignarray[j]));
-                    dec(l,length(alignarray[j]));
-                  end;
-               end;
-             ait_section :
-               begin
-                 objectoutput^.defaultsection(pai_section(hp)^.sec);
-{$ifdef GDB}
-                 case pai_section(hp)^.sec of
-                  sec_code : n_line:=n_textline;
-                  sec_data : n_line:=n_dataline;
-                   sec_bss : n_line:=n_bssline;
-                 else
-                  n_line:=n_dataline;
-                 end;
-                 stabslastfileinfo.line:=-1;
-{$endif GDB}
-               end;
-{$ifndef NEWLAB}
-             ait_external :
-               objectoutput^.writesymbol(pai_external(hp)^.sym);
-{$endif}
-             ait_symbol :
-               objectoutput^.writesymbol(pai_symbol(hp)^.sym);
-             ait_datablock :
-               begin
-                 l:=pai_datablock(hp)^.size;
-                 if l>2 then
-                   objectoutput^.writealign(4)
-                 else if l>1 then
-                   objectoutput^.writealign(2);
-                 objectoutput^.writesymbol(pai_datablock(hp)^.sym);
-{$ifdef EXTERNALBSS}
-                 if not pai_datablock(hp)^.is_global then
-{$endif}
-                   objectoutput^.writealloc(pai_datablock(hp)^.size);
-               end;
-             ait_const_32bit :
-               objectoutput^.writebytes(pai_const(hp)^.value,4);
-             ait_const_16bit :
-               objectoutput^.writebytes(pai_const(hp)^.value,2);
-             ait_const_8bit :
-               objectoutput^.writebytes(pai_const(hp)^.value,1);
-             ait_real_80bit :
-               objectoutput^.writebytes(pai_real_80bit(hp)^.value,10);
-             ait_real_64bit :
-               objectoutput^.writebytes(pai_real_64bit(hp)^.value,8);
-             ait_real_32bit :
-               objectoutput^.writebytes(pai_real_32bit(hp)^.value,4);
-             ait_comp_64bit :
-               begin
-{$ifdef FPC}
-                 co:=comp(pai_comp_64bit(hp)^.value);
-{$else}
-                 co:=pai_comp_64bit(hp)^.value;
-{$endif}
-                 objectoutput^.writebytes(co,8);
-               end;
-             ait_string :
-               objectoutput^.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len);
-             ait_const_rva :
-               objectoutput^.writereloc(pai_const_symbol(hp)^.offset,4,
-                 pai_const_symbol(hp)^.sym,relative_rva);
-             ait_const_symbol :
-               objectoutput^.writereloc(pai_const_symbol(hp)^.offset,4,
-                 pai_const_symbol(hp)^.sym,relative_false);
-{$ifndef NEWLAB}
-             ait_label :
-               begin
-                 if assigned(pai_label(hp)^.sym) then
-                  objectoutput^.writesymbol(pai_label(hp)^.sym);
-               end;
-{$endif}
-{$ifndef NEWLAB}
-             ait_labeled_instruction,
-{$endif}
-             ait_instruction :
-               pai386(hp)^.Pass2;
-{$ifdef GDB}
-             ait_stabn :
-               convertstabs(pai_stabn(hp)^.str);
-             ait_stabs :
-               convertstabs(pai_stabs(hp)^.str);
-             ait_stab_function_name :
-               if assigned(pai_stab_function_name(hp)^.str) then
-                 funcname:=getasmsymbol(pai_stab_function_name(hp)^.str)
-               else
-                 funcname:=nil;
-             ait_force_line :
-               stabslastfileinfo.line:=0;
-{$endif}
-             ait_cut :
-               break;
-           end;
-           hp:=pai(hp^.next);
-         end;
-        TreePass2:=hp;
-      end;
-
-
-    procedure ti386binasmlist.writetree(p:paasmoutput);
-      var
-        hp,hp1 : pai;
-      begin
-        if not assigned(p) then
-         exit;
-        objectalloc^.setsection(sec_code);
-        objectoutput^.defaultsection(sec_code);
-        hp:=pai(p^.first);
-        while assigned(hp) do
-         begin
-         { Pass 1 }
-           currpass:=1;
-{$ifdef GDB}
-           StartFileLineInfo;
-{$endif GDB}
-           hp1:=TreePass1(hp);
-
-         { set section sizes }
-           objectoutput^.setsectionsizes(objectalloc^.secsize);
-         { Pass 2 }
-           currpass:=2;
-{$ifdef GDB}
-           StartFileLineInfo;
-{$endif GDB}
-           hp1:=TreePass2(hp);
-
-         { if assigned then we have a ait_cut }
-           hp:=hp1;
-           if assigned(hp) then
-            begin
-              if hp^.typ<>ait_cut then
-               internalerror(3334443);
-              { write the current objectfile }
-              objectoutput^.donewriting;
-              { start the writing again }
-              objectoutput^.initwriting;
-              { we will start a new objectfile so reset everything }
-              ResetAsmsymbolList;
-              objectalloc^.resetsections;
-              { avoid empty files }
-              while assigned(hp^.next) and
-                    (pai(hp^.next)^.typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
-               begin
-                 if pai(hp^.next)^.typ=ait_section then
-                   begin
-                     objectalloc^.setsection(pai_section(hp^.next)^.sec);
-                     objectoutput^.defaultsection(pai_section(hp^.next)^.sec);
-                   end;
-                 hp:=pai(hp^.next);
-               end;
-              hp:=pai(hp^.next);
-            end;
-         end;
-      end;
-
-
-    procedure ti386binasmlist.writebin;
-      var
-        mylist : paasmoutput;
-
-        procedure addlist(p:paasmoutput);
-        begin
-          mylist^.concat(new(pai_section,init(sec_code)));
-          mylist^.concatlist(p);
-        end;
-
-      begin
-{$ifdef MULTIPASS}
-        { Process the codesegment twice so the short jmp instructions can
-          be optimized }
-        currpass:=0;
-        TreePass0(pai(codesegment^.first));
-{$endif}
-
-        objectalloc^.resetsections;
-        objectalloc^.setsection(sec_code);
-
-        objectoutput^.initwriting;
-        objectoutput^.defaultsection(sec_code);
-
-        new(mylist,init);
-
-        if not(cs_compilesystem in aktmoduleswitches) then
-          addlist(externals);
-        if cs_debuginfo in aktmoduleswitches then
-          addlist(debuglist);
-        addlist(codesegment);
-        addlist(datasegment);
-        addlist(consts);
-        addlist(rttilist);
-        addlist(bsssegment);
-        if assigned(importssection) then
-          addlist(importssection);
-        if assigned(exportssection) then
-          addlist(exportssection);
-        if assigned(resourcesection) then
-          addlist(resourcesection);
-
-        WriteTree(mylist);
-
-        dispose(mylist,done);
-
-        objectoutput^.donewriting;
-      end;
-
-
-    constructor ti386binasmlist.init(t:togtype);
-      begin
-        case t of
-          og_none :
-            Message(asmw_f_no_binary_writer_selected);
-          og_dbg :
-            objectoutput:=new(pdbgoutput,init);
-          og_coff :
-            objectoutput:=new(pdjgppcoffoutput,init);
-          og_pecoff :
-            objectoutput:=new(pwin32coffoutput,init);
-        end;
-        objectalloc:=new(pobjectalloc,init);
-        currpass:=0;
-      end;
-
-
-   destructor ti386binasmlist.done;
-      begin
-        dispose(objectoutput,done);
-        dispose(objectalloc,done);
-      end;
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1996-98 by the FPC development team
+
+    This unit implements an binary assembler output class
+
+    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.
+
+ ****************************************************************************
+}
+{$ifdef TP}
+  {$N+,E+}
+{$endif}
+unit ag386bin;
+
+{$define MULTIPASS}
+{define EXTERNALBSS}
+
+  interface
+
+    uses
+       i386base,
+       cobjects,aasm,files,assemble;
+
+    type
+      togtype=(og_none,og_dbg,og_coff,og_pecoff);
+
+      pi386binasmlist=^ti386binasmlist;
+      ti386binasmlist=object
+        constructor init(t:togtype);
+        destructor  done;
+        procedure WriteBin;
+      private
+        currpass : byte;
+{$ifdef GDB}
+        n_line       : byte;     { different types of source lines }
+        linecount,
+        includecount : longint;
+        funcname     : pasmsymbol;
+        stabslastfileinfo : tfileposinfo;
+        procedure convertstabs(p:pchar);
+{$ifdef unused}
+        procedure emitsymbolstabs(s : string;nidx,nother,line : longint;firstasm,secondasm : pasmsymbol);
+{$endif}
+        procedure emitlineinfostabs(nidx,line : longint);
+        procedure emitstabs(s:string);
+        procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
+        procedure StartFileLineInfo;
+{$endif}
+        function  TreePass0(hp:pai):pai;
+        function  TreePass1(hp:pai):pai;
+        function  TreePass2(hp:pai):pai;
+        procedure writetree(p:paasmoutput);
+      end;
+
+  implementation
+
+    uses
+       strings,
+       globtype,globals,systems,verbose,
+       i386asm,
+{$ifdef GDB}
+       gdb,
+{$endif}
+       og386,og386dbg,og386cff;
+
+{$ifdef GDB}
+
+    procedure ti386binasmlist.convertstabs(p:pchar);
+      var
+        ofs,
+        nidx,nother,i,line,j : longint;
+        code : integer;
+        hp : pchar;
+        reloc : boolean;
+        sec : tsection;
+        ps : pasmsymbol;
+        s : string;
+      begin
+        ofs:=0;
+        reloc:=true;
+        ps:=nil;
+        sec:=sec_none;
+        if p[0]='"' then
+         begin
+           i:=1;
+           { we can have \" inside the string !! PM }
+           while not ((p[i]='"') and (p[i-1]<>'\')) do
+            inc(i);
+           p[i]:=#0;
+           hp:=@p[1];
+           s:=StrPas(@P[i+2]);
+         end
+        else
+         begin
+           hp:=nil;
+           s:=StrPas(P);
+         end;
+      { When in pass 1 then only alloc and leave }
+        if currpass=1 then
+         begin
+           objectalloc^.staballoc(hp);
+           if assigned(hp) then
+            p[i]:='"';
+           exit;
+         end;
+      { Parse the rest of the stabs }
+        if s='' then
+         internalerror(33000);
+        j:=pos(',',s);
+        if j=0 then
+         internalerror(33001);
+        Val(Copy(s,1,j-1),nidx,code);
+        if code<>0 then
+         internalerror(33002);
+        Delete(s,1,j);
+        j:=pos(',',s);
+        if (j=0) then
+         internalerror(33003);
+        Val(Copy(s,1,j-1),nother,code);
+        if code<>0 then
+         internalerror(33004);
+        Delete(s,1,j);
+        j:=pos(',',s);
+        if j=0 then
+         begin
+           j:=256;
+           ofs:=-1;
+         end;
+        Val(Copy(s,1,j-1),line,code);
+        if code<>0 then
+          internalerror(33005);
+        if ofs=0 then
+          Delete(s,1,j);
+        if ofs=0 then
+          begin
+            Val(s,ofs,code);
+            if code=0 then
+              reloc:=false
+            else
+              begin
+                ofs:=0;
+                { handle asmsymbol or
+                    asmsymbol - asmsymbol }
+                j:=pos(' ',s);
+                if j=0 then
+                  j:=pos('-',s);
+                { single asmsymbol }
+                if j=0 then
+                  j:=256;
+                ps:=getasmsymbol(copy(s,1,j-1));
+                if not assigned(ps) then
+                  internalerror(33006)
+                else
+                  begin
+                    sec:=ps^.section;
+                    ofs:=ps^.address;
+                    reloc:=true;
+                  end;
+                if j<256 then
+                  begin
+                    delete(s,1,j);
+                    while (s<>'') and (s[1]=' ') do
+                      delete(s,1,1);
+                    ps:=getasmsymbol(s);
+                    if not assigned(ps) then
+                      internalerror(33007)
+                    else
+                      begin
+                        if ps^.section<>sec then
+                          internalerror(33008);
+                        ofs:=ofs-ps^.address;
+                        reloc:=false;
+                      end;
+                  end;
+              end;
+          end;
+        { external bss need speical handling (PM) }
+        if assigned(ps) and (ps^.section=sec_none) then
+          objectoutput^.WriteSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc)
+        else
+          objectoutput^.WriteStabs(sec,ofs,hp,nidx,nother,line,reloc);
+        if assigned(hp) then
+         p[i]:='"';
+      end;
+
+
+{$ifdef unused}
+    procedure ti386binasmlist.emitsymbolstabs(s : string;nidx,nother,line : longint;
+                firstasm,secondasm : pasmsymbol);
+      var
+         hp : pchar;
+      begin
+        if s='' then
+          hp:=nil
+        else
+          begin
+            s:=s+#0;
+            hp:=@s[1];
+          end;
+        if not assigned(secondasm) then
+          begin
+            if not assigned(firstasm) then
+              internalerror(33009);
+            objectoutput^.WriteStabs(firstasm^.section,firstasm^.address,hp,nidx,nother,line,true);
+          end
+        else
+          begin
+            if firstasm^.section<>secondasm^.section then
+              internalerror(33010);
+            objectoutput^.WriteStabs(firstasm^.section,firstasm^.address-secondasm^.address,
+              hp,nidx,nother,line,false);
+          end;
+      end;
+{$endif}
+
+
+    procedure ti386binasmlist.emitlineinfostabs(nidx,line : longint);
+      var
+         sec : tsection;
+      begin
+        if currpass=1 then
+          begin
+            objectalloc^.staballoc(nil);
+            exit;
+          end;
+
+        if (nidx=n_textline) and assigned(funcname) and
+           (target_os.use_function_relative_addresses) then
+          objectoutput^.WriteStabs(sec_code,pgenericcoffoutput(objectoutput)^.sects[sec_code]^.len-funcname^.address,
+              nil,nidx,0,line,false)
+        else
+          begin
+            if nidx=n_textline then
+              sec:=sec_code
+            else if nidx=n_dataline then
+              sec:=sec_data
+            else
+              sec:=sec_bss;
+            objectoutput^.WriteStabs(sec,pgenericcoffoutput(objectoutput)^.sects[sec]^.len,
+              nil,nidx,0,line,true);
+          end;
+      end;
+
+    procedure ti386binasmlist.emitstabs(s:string);
+      begin
+        s:=s+#0;
+        ConvertStabs(@s[1]);
+      end;
+
+
+    procedure ti386binasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
+      var
+        curr_n : byte;
+        hp : pasmsymbol;
+        infile : pinputfile;
+      begin
+        if not (cs_debuginfo in aktmoduleswitches) then
+         exit;
+      { file changed ? (must be before line info) }
+        if (fileinfo.fileindex<>0) and
+           (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
+         begin
+           infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex);
+           if includecount=0 then
+            curr_n:=n_sourcefile
+           else
+            curr_n:=n_includefile;
+           { get symbol for this includefile }
+           hp:=newasmsymbol('Ltext'+ToStr(IncludeCount));
+           if currpass=1 then
+             begin
+                hp^.typ:=AS_LOCAL;
+                hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
+             end
+           else
+             objectoutput^.writesymbol(hp);
+           { emit stabs }
+           if (infile^.path^<>'') then
+             EmitStabs('"'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+tostr(curr_n)+
+               ',0,0,Ltext'+ToStr(IncludeCount));
+           EmitStabs('"'+lower(FixFileName(infile^.name^))+'",'+tostr(curr_n)+
+             ',0,0,Ltext'+ToStr(IncludeCount));
+           inc(includecount);
+         end;
+      { line changed ? }
+        if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
+          emitlineinfostabs(n_line,fileinfo.line);
+        stabslastfileinfo:=fileinfo;
+      end;
+
+
+    procedure ti386binasmlist.StartFileLineInfo;
+      var
+        fileinfo : tfileposinfo;
+      begin
+        FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
+        n_line:=n_textline;
+        funcname:=nil;
+        linecount:=1;
+        includecount:=0;
+        fileinfo.fileindex:=1;
+        fileinfo.line:=1;
+        WriteFileLineInfo(fileinfo);
+      end;
+{$endif GDB}
+
+
+    function ti386binasmlist.TreePass0(hp:pai):pai;
+      var
+        lastsec : tsection;
+        l : longint;
+      begin
+        while assigned(hp) do
+         begin
+           case hp^.typ of
+             ait_align :
+               begin
+                 if (objectalloc^.sectionsize mod pai_align(hp)^.aligntype)<>0 then
+                   begin
+                     pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype-
+                       (objectalloc^.sectionsize mod pai_align(hp)^.aligntype);
+                     objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
+                   end
+                 else
+                   pai_align(hp)^.fillsize:=0;
+               end;
+             ait_datablock :
+               begin
+{$ifdef EXTERNALBSS}
+                 if not pai_datablock(hp)^.is_global then
+                  begin
+                     l:=pai_datablock(hp)^.size;
+                     if l>2 then
+                       objectalloc^.sectionalign(4)
+                     else if l>1 then
+                       objectalloc^.sectionalign(2);
+                     objectalloc^.sectionalloc(pai_datablock(hp)^.size);
+                  end;
+{$else}
+                 l:=pai_datablock(hp)^.size;
+                 if l>2 then
+                   objectalloc^.sectionalign(4)
+                 else if l>1 then
+                   objectalloc^.sectionalign(2);
+                 objectalloc^.sectionalloc(pai_datablock(hp)^.size);
+{$endif}
+               end;
+             ait_const_32bit :
+               objectalloc^.sectionalloc(4);
+             ait_const_16bit :
+               objectalloc^.sectionalloc(2);
+             ait_const_8bit :
+               objectalloc^.sectionalloc(1);
+             ait_real_80bit :
+               objectalloc^.sectionalloc(10);
+             ait_real_64bit :
+               objectalloc^.sectionalloc(8);
+             ait_real_32bit :
+               objectalloc^.sectionalloc(4);
+             ait_comp_64bit :
+               objectalloc^.sectionalloc(8);
+             ait_const_rva,
+             ait_const_symbol :
+               objectalloc^.sectionalloc(4);
+             ait_section:
+               begin
+                 objectalloc^.setsection(pai_section(hp)^.sec);
+                 lastsec:=pai_section(hp)^.sec;
+               end;
+             ait_symbol :
+               pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
+             ait_label :
+               pai_label(hp)^.l^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
+             ait_string :
+               objectalloc^.sectionalloc(pai_string(hp)^.len);
+             ait_instruction :
+               objectalloc^.sectionalloc(pai386(hp)^.Pass1(objectalloc^.sectionsize));
+             ait_cut :
+               begin
+                 objectalloc^.resetsections;
+                 objectalloc^.setsection(lastsec);
+               end;
+           end;
+           hp:=pai(hp^.next);
+         end;
+        TreePass0:=hp;
+      end;
+
+
+    function ti386binasmlist.TreePass1(hp:pai):pai;
+      var
+        l : longint;
+      begin
+        while assigned(hp) do
+         begin
+{$ifdef GDB}
+           { write stabs }
+           if (cs_debuginfo in aktmoduleswitches) then
+            begin
+              if (objectalloc^.currsec<>sec_none) and
+                 not(hp^.typ in  [
+                     ait_label,
+                     ait_regalloc,ait_tempalloc,
+                     ait_stabn,ait_stabs,ait_section,
+                     ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
+               WriteFileLineInfo(hp^.fileinfo);
+            end;
+{$endif GDB}
+           case hp^.typ of
+             ait_align :
+               begin
+                 if (objectalloc^.sectionsize mod pai_align(hp)^.aligntype)<>0 then
+                   begin
+                     pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype-
+                       (objectalloc^.sectionsize mod pai_align(hp)^.aligntype);
+                     objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
+                   end
+                 else
+                   pai_align(hp)^.fillsize:=0;
+               end;
+             ait_datablock :
+               begin
+                 if objectalloc^.currsec<>sec_bss then
+                  Message(asmw_e_alloc_data_only_in_bss);
+{$ifdef EXTERNALBSS}
+                 if pai_datablock(hp)^.is_global then
+                  begin
+                    pai_datablock(hp)^.sym^.typ:=AS_EXTERNAL;
+                    pai_datablock(hp)^.sym^.setaddress(sec_none,pai_datablock(hp)^.size,pai_datablock(hp)^.size);
+                  end
+                 else
+                  begin
+                    l:=pai_datablock(hp)^.size;
+                    if l>2 then
+                      objectalloc^.sectionalign(4)
+                    else if l>1 then
+                      objectalloc^.sectionalign(2);
+                    pai_datablock(hp)^.sym^.typ:=AS_LOCAL;
+                    pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size);
+                    objectalloc^.sectionalloc(pai_datablock(hp)^.size);
+                  end;
+{$else}
+                 if pai_datablock(hp)^.is_global then
+                  pai_datablock(hp)^.sym^.typ:=AS_GLOBAL
+                 else
+                  pai_datablock(hp)^.sym^.typ:=AS_LOCAL;
+                 l:=pai_datablock(hp)^.size;
+                 if l>2 then
+                   objectalloc^.sectionalign(4)
+                 else if l>1 then
+                   objectalloc^.sectionalign(2);
+                 pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size);
+                 objectalloc^.sectionalloc(pai_datablock(hp)^.size);
+{$endif}
+               end;
+             ait_const_32bit :
+               objectalloc^.sectionalloc(4);
+             ait_const_16bit :
+               objectalloc^.sectionalloc(2);
+             ait_const_8bit :
+               objectalloc^.sectionalloc(1);
+             ait_real_80bit :
+               objectalloc^.sectionalloc(10);
+             ait_real_64bit :
+               objectalloc^.sectionalloc(8);
+             ait_real_32bit :
+               objectalloc^.sectionalloc(4);
+             ait_comp_64bit :
+               objectalloc^.sectionalloc(8);
+             ait_const_rva,
+             ait_const_symbol :
+               objectalloc^.sectionalloc(4);
+             ait_section:
+               begin
+                 objectalloc^.setsection(pai_section(hp)^.sec);
+{$ifdef GDB}
+                 case pai_section(hp)^.sec of
+                  sec_code : n_line:=n_textline;
+                  sec_data : n_line:=n_dataline;
+                   sec_bss : n_line:=n_bssline;
+                 else
+                  n_line:=n_dataline;
+                 end;
+                 stabslastfileinfo.line:=-1;
+{$endif GDB}
+               end;
+{$ifdef GDB}
+             ait_stabn :
+               convertstabs(pai_stabn(hp)^.str);
+             ait_stabs :
+               convertstabs(pai_stabs(hp)^.str);
+             ait_stab_function_name :
+               if assigned(pai_stab_function_name(hp)^.str) then
+                 funcname:=getasmsymbol(pai_stab_function_name(hp)^.str)
+               else
+                 funcname:=nil;
+             ait_force_line :
+               stabslastfileinfo.line:=0;
+{$endif}
+             ait_symbol :
+               begin
+                 if pai_symbol(hp)^.is_global then
+                  pai_symbol(hp)^.sym^.typ:=AS_GLOBAL
+                 else
+                  pai_symbol(hp)^.sym^.typ:=AS_LOCAL;
+                 pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
+               end;
+             ait_label :
+               begin
+                 if pai_label(hp)^.is_global then
+                  pai_label(hp)^.l^.typ:=AS_GLOBAL
+                 else
+                  pai_label(hp)^.l^.typ:=AS_LOCAL;
+                 pai_label(hp)^.l^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
+               end;
+             ait_string :
+               objectalloc^.sectionalloc(pai_string(hp)^.len);
+             ait_instruction :
+               objectalloc^.sectionalloc(pai386(hp)^.Pass1(objectalloc^.sectionsize));
+             ait_direct :
+               Message(asmw_f_direct_not_supported);
+             ait_cut :
+               break;
+           end;
+           hp:=pai(hp^.next);
+         end;
+        TreePass1:=hp;
+      end;
+
+
+    function ti386binasmlist.TreePass2(hp:pai):pai;
+      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
+        l,j : longint;
+{$ifdef I386}
+        co : comp;
+{$endif I386}
+      begin
+        { main loop }
+        while assigned(hp) do
+         begin
+{$ifdef GDB}
+           { write stabs }
+           if cs_debuginfo in aktmoduleswitches then
+            begin
+              if (objectoutput^.currsec<>sec_none) and
+                 not(hp^.typ in  [
+                     ait_label,
+                     ait_regalloc,ait_tempalloc,
+                     ait_stabn,ait_stabs,ait_section,
+                     ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
+               WriteFileLineInfo(hp^.fileinfo);
+            end;
+{$endif GDB}
+           case hp^.typ of
+             ait_align :
+               begin
+                 l:=pai_align(hp)^.fillsize;
+                 while (l>0) do
+                  begin
+                    for j:=0to 5 do
+                     if (l>=length(alignarray[j])) then
+                      break;
+                    objectoutput^.writebytes(alignarray[j][1],length(alignarray[j]));
+                    dec(l,length(alignarray[j]));
+                  end;
+               end;
+             ait_section :
+               begin
+                 objectoutput^.defaultsection(pai_section(hp)^.sec);
+{$ifdef GDB}
+                 case pai_section(hp)^.sec of
+                  sec_code : n_line:=n_textline;
+                  sec_data : n_line:=n_dataline;
+                   sec_bss : n_line:=n_bssline;
+                 else
+                  n_line:=n_dataline;
+                 end;
+                 stabslastfileinfo.line:=-1;
+{$endif GDB}
+               end;
+             ait_symbol :
+               objectoutput^.writesymbol(pai_symbol(hp)^.sym);
+             ait_datablock :
+               begin
+                 l:=pai_datablock(hp)^.size;
+                 if l>2 then
+                   objectoutput^.writealign(4)
+                 else if l>1 then
+                   objectoutput^.writealign(2);
+                 objectoutput^.writesymbol(pai_datablock(hp)^.sym);
+{$ifdef EXTERNALBSS}
+                 if not pai_datablock(hp)^.is_global then
+{$endif}
+                   objectoutput^.writealloc(pai_datablock(hp)^.size);
+               end;
+             ait_const_32bit :
+               objectoutput^.writebytes(pai_const(hp)^.value,4);
+             ait_const_16bit :
+               objectoutput^.writebytes(pai_const(hp)^.value,2);
+             ait_const_8bit :
+               objectoutput^.writebytes(pai_const(hp)^.value,1);
+             ait_real_80bit :
+               objectoutput^.writebytes(pai_real_80bit(hp)^.value,10);
+             ait_real_64bit :
+               objectoutput^.writebytes(pai_real_64bit(hp)^.value,8);
+             ait_real_32bit :
+               objectoutput^.writebytes(pai_real_32bit(hp)^.value,4);
+             ait_comp_64bit :
+               begin
+{$ifdef FPC}
+                 co:=comp(pai_comp_64bit(hp)^.value);
+{$else}
+                 co:=pai_comp_64bit(hp)^.value;
+{$endif}
+                 objectoutput^.writebytes(co,8);
+               end;
+             ait_string :
+               objectoutput^.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len);
+             ait_const_rva :
+               objectoutput^.writereloc(pai_const_symbol(hp)^.offset,4,
+                 pai_const_symbol(hp)^.sym,relative_rva);
+             ait_const_symbol :
+               objectoutput^.writereloc(pai_const_symbol(hp)^.offset,4,
+                 pai_const_symbol(hp)^.sym,relative_false);
+             ait_label :
+               objectoutput^.writesymbol(pai_label(hp)^.l);
+             ait_instruction :
+               pai386(hp)^.Pass2;
+{$ifdef GDB}
+             ait_stabn :
+               convertstabs(pai_stabn(hp)^.str);
+             ait_stabs :
+               convertstabs(pai_stabs(hp)^.str);
+             ait_stab_function_name :
+               if assigned(pai_stab_function_name(hp)^.str) then
+                 funcname:=getasmsymbol(pai_stab_function_name(hp)^.str)
+               else
+                 funcname:=nil;
+             ait_force_line :
+               stabslastfileinfo.line:=0;
+{$endif}
+             ait_cut :
+               break;
+           end;
+           hp:=pai(hp^.next);
+         end;
+        TreePass2:=hp;
+      end;
+
+
+    procedure ti386binasmlist.writetree(p:paasmoutput);
+      var
+        hp,hp1 : pai;
+      begin
+        if not assigned(p) then
+         exit;
+        objectalloc^.setsection(sec_code);
+        objectoutput^.defaultsection(sec_code);
+        hp:=pai(p^.first);
+        while assigned(hp) do
+         begin
+         { Pass 1 }
+           currpass:=1;
+{$ifdef GDB}
+           StartFileLineInfo;
+{$endif GDB}
+           hp1:=TreePass1(hp);
+
+         { set section sizes }
+           objectoutput^.setsectionsizes(objectalloc^.secsize);
+         { Pass 2 }
+           currpass:=2;
+{$ifdef GDB}
+           StartFileLineInfo;
+{$endif GDB}
+           hp1:=TreePass2(hp);
+
+         { if assigned then we have a ait_cut }
+           hp:=hp1;
+           if assigned(hp) then
+            begin
+              if hp^.typ<>ait_cut then
+               internalerror(3334443);
+              { write the current objectfile }
+              objectoutput^.donewriting;
+              { start the writing again }
+              objectoutput^.initwriting;
+              { we will start a new objectfile so reset everything }
+              ResetAsmsymbolList;
+              objectalloc^.resetsections;
+              { avoid empty files }
+              while assigned(hp^.next) and
+                    (pai(hp^.next)^.typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
+               begin
+                 if pai(hp^.next)^.typ=ait_section then
+                   begin
+                     objectalloc^.setsection(pai_section(hp^.next)^.sec);
+                     objectoutput^.defaultsection(pai_section(hp^.next)^.sec);
+                   end;
+                 hp:=pai(hp^.next);
+               end;
+              hp:=pai(hp^.next);
+            end;
+         end;
+      end;
+
+
+    procedure ti386binasmlist.writebin;
+      var
+        mylist : paasmoutput;
+
+        procedure addlist(p:paasmoutput);
+        begin
+          mylist^.concat(new(pai_section,init(sec_code)));
+          mylist^.concatlist(p);
+        end;
+
+      begin
+{$ifdef MULTIPASS}
+        { Process the codesegment twice so the short jmp instructions can
+          be optimized }
+        currpass:=0;
+        TreePass0(pai(codesegment^.first));
+{$endif}
+
+        objectalloc^.resetsections;
+        objectalloc^.setsection(sec_code);
+
+        objectoutput^.initwriting;
+        objectoutput^.defaultsection(sec_code);
+
+        new(mylist,init);
+
+        if cs_debuginfo in aktmoduleswitches then
+          addlist(debuglist);
+        addlist(codesegment);
+        addlist(datasegment);
+        addlist(consts);
+        addlist(rttilist);
+        addlist(bsssegment);
+        if assigned(importssection) then
+          addlist(importssection);
+        if assigned(exportssection) then
+          addlist(exportssection);
+        if assigned(resourcesection) then
+          addlist(resourcesection);
+
+        WriteTree(mylist);
+
+        dispose(mylist,done);
+
+        objectoutput^.donewriting;
+      end;
+
+
+    constructor ti386binasmlist.init(t:togtype);
+      begin
+        case t of
+          og_none :
+            Message(asmw_f_no_binary_writer_selected);
+          og_dbg :
+            objectoutput:=new(pdbgoutput,init);
+          og_coff :
+            objectoutput:=new(pdjgppcoffoutput,init);
+          og_pecoff :
+            objectoutput:=new(pwin32coffoutput,init);
+        end;
+        objectalloc:=new(pobjectalloc,init);
+        currpass:=0;
+      end;
+
+
+   destructor ti386binasmlist.done;
+      begin
+        dispose(objectoutput,done);
+        dispose(objectalloc,done);
+      end;
+
+end.
+{
   $Log$
-  Revision 1.11  1999-05-21 13:54:41  peter
+  Revision 1.12  1999-05-27 19:43:59  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.11  1999/05/21 13:54:41  peter
     * NEWLAB for label as symbol
-
-  Revision 1.10  1999/05/19 11:54:17  pierre
-   + experimental code for externalbss and stabs problem
-
-  Revision 1.9  1999/05/12 00:19:37  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.8  1999/05/09 11:38:04  peter
-    * don't write .o and link if errors occure during assembling
-
-  Revision 1.6  1999/05/07 00:36:58  pierre
-    * added alignment code for .bss
-    * stabs correct but externalbss disabled
-      would need a special treatment in writestabs
-
-  Revision 1.5  1999/05/06 09:05:07  peter
-    * generic write_float and str_float
-    * fixed constant float conversions
-
-  Revision 1.4  1999/05/05 22:21:47  peter
-    * updated messages
-
-  Revision 1.3  1999/05/05 17:34:29  peter
-    * output is more like as 2.9.1
-    * stabs really working for go32v2
-
-  Revision 1.2  1999/05/04 21:44:30  florian
-    * changes to compile it with Delphi 4.0
-
-  Revision 1.1  1999/05/01 13:23:57  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.14  1999/04/16 11:49:48  peter
-    + tempalloc
-    + -at to show temp alloc info in .s file
-
-  Revision 1.13  1999/03/12 00:20:03  pierre
-   + win32 output working !
-
-  Revision 1.12  1999/03/11 17:52:34  peter
-    * fixed wrong ot_signed generation in insns tab
-
-  Revision 1.11  1999/03/10 13:41:07  pierre
-   + partial implementation for win32 !
-     winhello works but pp still does not !
-
-  Revision 1.10  1999/03/08 14:51:05  peter
-    + smartlinking for ag386bin
-
-  Revision 1.9  1999/03/06 17:24:18  peter
-    * rewritten intel parser a lot, especially reference reading
-    * size checking added for asm parsers
-
-  Revision 1.8  1999/03/05 13:09:50  peter
-    * first things for tai_cut support for ag386bin
-
-  Revision 1.7  1999/03/03 11:41:53  pierre
-    + stabs info corrected to give results near to GAS output
-    * local labels (with .L are not stored in object anymore)
-      so we get the same number of symbols as from GAS !
-
-  Revision 1.6  1999/03/03 01:36:44  pierre
-    + stabs output working (though not really tested)
-      for a simple file the only difference to GAS output is due
-      to the VMA of the different sections
-
-  Revision 1.5  1999/03/02 02:56:18  peter
-    + stabs support for binary writers
-    * more fixes and missing updates from the previous commit :(
-
-  Revision 1.4  1999/03/01 15:46:20  peter
-    * ag386bin finally make cycles correct
-    * prefixes are now also normal opcodes
-
-  Revision 1.3  1999/02/25 21:03:01  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.2  1999/02/22 02:16:00  peter
-    * updates for ag386bin
-
-  Revision 1.1  1999/02/16 17:59:37  peter
-    + initial files
-
-}
+
+  Revision 1.10  1999/05/19 11:54:17  pierre
+   + experimental code for externalbss and stabs problem
+
+  Revision 1.9  1999/05/12 00:19:37  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.8  1999/05/09 11:38:04  peter
+    * don't write .o and link if errors occure during assembling
+
+  Revision 1.6  1999/05/07 00:36:58  pierre
+    * added alignment code for .bss
+    * stabs correct but externalbss disabled
+      would need a special treatment in writestabs
+
+  Revision 1.5  1999/05/06 09:05:07  peter
+    * generic write_float and str_float
+    * fixed constant float conversions
+
+  Revision 1.4  1999/05/05 22:21:47  peter
+    * updated messages
+
+  Revision 1.3  1999/05/05 17:34:29  peter
+    * output is more like as 2.9.1
+    * stabs really working for go32v2
+
+  Revision 1.2  1999/05/04 21:44:30  florian
+    * changes to compile it with Delphi 4.0
+
+  Revision 1.1  1999/05/01 13:23:57  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.14  1999/04/16 11:49:48  peter
+    + tempalloc
+    + -at to show temp alloc info in .s file
+
+  Revision 1.13  1999/03/12 00:20:03  pierre
+   + win32 output working !
+
+  Revision 1.12  1999/03/11 17:52:34  peter
+    * fixed wrong ot_signed generation in insns tab
+
+  Revision 1.11  1999/03/10 13:41:07  pierre
+   + partial implementation for win32 !
+     winhello works but pp still does not !
+
+  Revision 1.10  1999/03/08 14:51:05  peter
+    + smartlinking for ag386bin
+
+  Revision 1.9  1999/03/06 17:24:18  peter
+    * rewritten intel parser a lot, especially reference reading
+    * size checking added for asm parsers
+
+  Revision 1.8  1999/03/05 13:09:50  peter
+    * first things for tai_cut support for ag386bin
+
+  Revision 1.7  1999/03/03 11:41:53  pierre
+    + stabs info corrected to give results near to GAS output
+    * local labels (with .L are not stored in object anymore)
+      so we get the same number of symbols as from GAS !
+
+  Revision 1.6  1999/03/03 01:36:44  pierre
+    + stabs output working (though not really tested)
+      for a simple file the only difference to GAS output is due
+      to the VMA of the different sections
+
+  Revision 1.5  1999/03/02 02:56:18  peter
+    + stabs support for binary writers
+    * more fixes and missing updates from the previous commit :(
+
+  Revision 1.4  1999/03/01 15:46:20  peter
+    * ag386bin finally make cycles correct
+    * prefixes are now also normal opcodes
+
+  Revision 1.3  1999/02/25 21:03:01  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.2  1999/02/22 02:16:00  peter
+    * updates for ag386bin
+
+  Revision 1.1  1999/02/16 17:59:37  peter
+    + initial files
+
+}

compiler/ag386int.pas

@@ -34,6 +34,7 @@ unit ag386int;
       ti386intasmlist = object(tasmlist)
         procedure WriteTree(p:paasmoutput);virtual;
         procedure WriteAsmList;virtual;
+        procedure WriteExternals;
       end;
 
   implementation
@@ -42,11 +43,7 @@ unit ag386int;
       dos,strings,
       globtype,globals,systems,cobjects,
       files,verbose
-{$ifndef OLDASM}
       ,i386base,i386asm
-{$else}
-      ,i386
-{$endif}
 {$ifdef GDB}
       ,gdb
 {$endif GDB}
@@ -55,7 +52,7 @@ unit ag386int;
     const
       line_length = 70;
 
-{$ifndef NEWLAB}
+{$ifdef EXTTYPE}
       extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
              ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
               'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
@@ -176,7 +173,6 @@ unit ag386int;
        getreferencestring:=s;
      end;
 
-{$ifndef OLDASM}
 
     function getopstr(const o:toper;s : topsize; opcode: tasmop;dest : boolean) : string;
     var
@@ -267,89 +263,6 @@ unit ag386int;
       end;
     end;
 
-{$else}
-
-    function getopstr(t : byte;o : pointer;opofs:longint;s : topsize; _operator: tasmop;dest : boolean) : string;
-    var
-      hs : string;
-    begin
-      case t of
-       top_reg : getopstr:=int_reg2str[tregister(o)];
-     top_const,
-       top_ref : begin
-                   if t=top_const then
-                     hs := tostr(longint(o))
-                   else
-                     hs:=getreferencestring(preference(o)^);
-                   { can possibly give a range check error under tp }
-                   { if using in...                                 }
-                   if ((_operator <> A_LGS) and (_operator <> A_LSS) and
-                       (_operator <> A_LFS) and (_operator <> A_LDS) and
-                       (_operator <> A_LES)) then
-                    Begin
-                      case s of
-                       S_B : hs:='byte ptr '+hs;
-                       S_W : hs:='word ptr '+hs;
-                       S_L : hs:='dword ptr '+hs;
-                      S_IS : hs:='word ptr '+hs;
-                      S_IL : hs:='dword ptr '+hs;
-                      S_IQ : hs:='qword ptr '+hs;
-                      S_FS : hs:='dword ptr '+hs;
-                      S_FL : hs:='qword ptr '+hs;
-                      S_FX : hs:='tbyte ptr '+hs;
-                      S_BW : if dest then
-                              hs:='word ptr '+hs
-                             else
-                              hs:='byte ptr '+hs;
-                      S_BL : if dest then
-                              hs:='dword ptr '+hs
-                             else
-                              hs:='byte ptr '+hs;
-                      S_WL : if dest then
-                              hs:='dword ptr '+hs
-                             else
-                              hs:='word ptr '+hs;
-                      end;
-                    end;
-                   getopstr:=hs;
-                 end;
-    top_symbol : begin
-                   hs:='offset '+pasmsymbol(o)^.name;
-                   if opofs>0 then
-                    hs:=hs+'+'+tostr(opofs)
-                   else
-                    if opofs<0 then
-                     hs:=hs+tostr(opofs);
-                   getopstr:=hs;
-                 end;
-      else
-       internalerror(10001);
-      end;
-    end;
-
-    function getopstr_jmp(t : byte;o : pointer;opofs:longint) : string;
-    var
-      hs : string;
-    begin
-      case t of
-         top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
-         top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
-       top_const : getopstr_jmp:=tostr(longint(o));
-       top_symbol : begin
-                      hs:=pasmsymbol(o)^.name;
-                      if opofs>0 then
-                       hs:=hs+'+'+tostr(opofs)
-                      else
-                       if opofs<0 then
-                        hs:=hs+tostr(opofs);
-                      getopstr_jmp:=hs;
-                    end;
-      else
-       internalerror(10001);
-      end;
-    end;
-{$endif}
-
 
 {****************************************************************************
                                TI386INTASMLIST
@@ -382,10 +295,6 @@ unit ag386int;
     end;
 
     procedure ti386intasmlist.WriteTree(p:paasmoutput);
-    type
-      twowords=record
-        word1,word2:word;
-      end;
     var
       s,
       prefix,
@@ -397,9 +306,7 @@ unit ag386int;
       consttyp : tait;
       found,
       quoted   : boolean;
-{$ifndef OLDASM}
       sep      : char;
-{$endif}
     begin
       if not assigned(p) then
        exit;
@@ -432,10 +339,6 @@ unit ag386int;
                      { HERE UNDER TASM!                              }
                        AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
                      end;
-{$ifndef NEWLAB}
-      ait_external : AsmWriteLn(#9'EXTRN'#9+pai_external(hp)^.sym^.name+
-                                ' :'+extstr[pai_external(hp)^.exttyp]);
-{$endif}
      ait_datablock : begin
                        if pai_datablock(hp)^.is_global then
                          AsmWriteLn(#9'PUBLIC'#9+pai_datablock(hp)^.sym^.name);
@@ -548,11 +451,10 @@ unit ag386int;
                         end;
                        AsmLn;
                      end;
-{$ifndef NEWLAB}
          ait_label : begin
                        if pai_label(hp)^.l^.is_used then
                         begin
-                          AsmWrite(lab2str(pai_label(hp)^.l));
+                          AsmWrite(pai_label(hp)^.l^.name);
                           if assigned(hp^.next) and not(pai(hp^.next)^.typ in
                              [ait_const_32bit,ait_const_16bit,ait_const_8bit,
                               ait_const_symbol,ait_const_rva,
@@ -560,16 +462,10 @@ unit ag386int;
                            AsmWriteLn(':');
                         end;
                      end;
-{$endif}
         ait_direct : begin
                        AsmWritePChar(pai_direct(hp)^.str);
                        AsmLn;
                      end;
-{$ifndef NEWLAB}
-ait_labeled_instruction :
-               AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^.opcode]+
-                 cond2str[pai386_labeled(hp)^.condition]+#9+lab2str(pai386_labeled(hp)^.lab));
-{$endif}
         ait_symbol : begin
                        if pai_symbol(hp)^.is_global then
                          AsmWriteLn(#9'PUBLIC'#9+pai_symbol(hp)^.sym^.name);
@@ -581,10 +477,12 @@ ait_labeled_instruction :
                         AsmWriteLn(':')
                      end;
    ait_instruction : begin
+                     { We need intel order, no At&t }
+                       pai386(hp)^.SwapOperands;
+                     { Reset }
                        suffix:='';
                        prefix:= '';
                        s:='';
-{$ifndef OLDASM}
                      { added prefix instructions, must be on same line as opcode }
                        if (pai386(hp)^.ops = 0) and
                           ((pai386(hp)^.opcode = A_REP) or
@@ -611,7 +509,7 @@ ait_labeled_instruction :
                         prefix:= '';
                        if pai386(hp)^.ops<>0 then
                         begin
-                          if pai386(hp)^.opcode=A_CALL then
+                          if is_calljmp(pai386(hp)^.opcode) then
                            s:=#9+getopstr_jmp(pai386(hp)^.oper[0])
                           else
                            begin
@@ -621,99 +519,11 @@ ait_labeled_instruction :
                                  sep:=#9
                                 else
                                  sep:=',';
-                                s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
+                                s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=2));
                               end;
                            end;
                         end;
                        AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^.opcode]+cond2str[pai386(hp)^.condition]+suffix+s);
-{$else}
-                     { added prefix instructions, must be on same line as opcode }
-                       if (pai386(hp)^.op1t = top_none) and
-                          ((pai386(hp)^.opcode = A_REP) or
-                           (pai386(hp)^.opcode = A_LOCK) or
-                           (pai386(hp)^.opcode =  A_REPE) or
-                           (pai386(hp)^.opcode = A_REPNE)) then
-                        Begin
-                          prefix:=int_op2str[pai386(hp)^.opcode]+#9;
-                          hp:=Pai(hp^.next);
-                        { this is theorically impossible... }
-                          if hp=nil then
-                           begin
-                             s:=#9#9+prefix;
-                             AsmWriteLn(s);
-                             break;
-                           end;
-                        end
-                       else
-                        prefix:= '';
-                       if pai386(hp)^.op1t<>top_none then
-                        begin
-                          if pai386(hp)^.opcode=A_CALL then
-                           begin
-                           { with tasm call near ptr [edi+12] does not
-                             work but call near [edi+12] works ?? (PM)
-
-                             It works with call dword ptr [], but you
-                             need /m2 (2 passes) with tasm (PFV)
-                           }
-{                                    if pai386(hp)^.op1t=top_ref then
-                              s:='near '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
-                             else
-                              s:='near ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);}
-                             s:='dword ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs);
-                           end
-                          else
-                           begin
-                             s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs,pai386(hp)^.opsize,
-                               pai386(hp)^.opcode,false);
-                             if pai386(hp)^.op3t<>top_none then
-                              begin
-                                if pai386(hp)^.op2t<>top_none then
-{$ifdef NO_OP3}
-                                 s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),0,
-                                             pai386(hp)^.opsize,pai386(hp)^.opcode,true)+','+s;
-                                s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),0,
-                                            pai386(hp)^.opsize,pai386(hp)^.opcode,false)+','+s;
-{$else NO_OP3}
-                                 s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,0,
-                                             pai386(hp)^.opsize,pai386(hp)^.opcode,true)+','+s;
-                                s:=getopstr(pai386(hp)^.op3t,pai386(hp)^.op3,0,
-                                            pai386(hp)^.opsize,pai386(hp)^.opcode,false)+','+s;
-{$endif NO_OP3}
-                              end
-                             else
-                              if pai386(hp)^.op2t<>top_none then
-                               s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,0,pai386(hp)^.opsize,
-                                           pai386(hp)^.opcode,true)+','+s;
-                           end;
-                          s:=#9+s;
-                        end
-                       else
-                        begin
-                          { check if string instruction }
-                          { long form, otherwise may give range check errors }
-                          { in turbo pascal...                               }
-                          if ((pai386(hp)^.opcode = A_CMPS) or
-                             (pai386(hp)^.opcode = A_INS) or
-                             (pai386(hp)^.opcode = A_OUTS) or
-                             (pai386(hp)^.opcode = A_SCAS) or
-                             (pai386(hp)^.opcode = A_STOS) or
-                             (pai386(hp)^.opcode = A_MOVS) or
-                             (pai386(hp)^.opcode = A_LODS) or
-                             (pai386(hp)^.opcode = A_XLAT)) then
-                           Begin
-                             case pai386(hp)^.opsize of
-                              S_B: suffix:='b';
-                              S_W: suffix:='w';
-                              S_L: suffix:='d';
-                             else
-                              Message(assem_f_invalid_suffix_intel);
-                             end;
-                           end;
-                          s:='';
-                        end;
-                       AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^.opcode]+suffix+s);
-{$endif OLDASM}
                      end;
 {$ifdef GDB}
              ait_stabn,
@@ -762,9 +572,23 @@ ait_stab_function_name : ;
        end;
     end;
 
+    var
+      currentasmlist : PAsmList;
 
-    procedure ti386intasmlist.WriteAsmList;
+    procedure writeexternal(p:pasmsymbol);{$ifndef FPC}far;{$endif}
+      begin
+        if p^.typ=AS_EXTERNAL then
+         currentasmlist^.AsmWriteln(#9'EXTRN'#9+p^.name);
+      end;
+
+    procedure ti386intasmlist.WriteExternals;
+      begin
+        currentasmlist:=@self;
+        AsmSymbolList^.foreach(writeexternal);
+      end;
 
+
+    procedure ti386intasmlist.WriteAsmList;
     begin
 {$ifdef EXTDEBUG}
       if assigned(current_module^.mainsource) then
@@ -778,7 +602,9 @@ ait_stab_function_name : ;
       AsmLn;
 
       countlabelref:=false;
-      WriteTree(externals);
+
+      WriteExternals;
+
     { INTEL ASM doesn't support stabs
       WriteTree(debuglist);}
 
@@ -801,7 +627,15 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.43  1999-05-23 18:41:55  florian
+  Revision 1.44  1999-05-27 19:44:00  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.43  1999/05/23 18:41:55  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/ag386nsm.pas

@@ -35,6 +35,7 @@ unit ag386nsm;
       ti386nasmasmlist = object(tasmlist)
         procedure WriteTree(p:paasmoutput);virtual;
         procedure WriteAsmList;virtual;
+        procedure WriteExternals;
       end;
 
   implementation
@@ -43,11 +44,7 @@ unit ag386nsm;
       dos,strings,
       globtype,globals,systems,cobjects,
       files,verbose
-{$ifndef OLDASM}
       ,i386base,i386asm
-{$else}
-      ,i386
-{$endif}
 {$ifdef GDB}
       ,gdb
 {$endif GDB}
@@ -56,7 +53,7 @@ unit ag386nsm;
     const
       line_length = 70;
 
-{$ifndef NEWLAB}
+{$ifdef EXTTYPE}
       extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
              ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
               'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
@@ -178,184 +175,108 @@ unit ag386nsm;
        getreferencestring:=s;
      end;
 
-{$ifndef OLDASM}
-
-    function getopstr(const o:toper;s : topsize; opcode: tasmop;dest : boolean) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg :
-          getopstr:=int_nasmreg2str[o.reg];
-        top_const :
-          getopstr:=tostr(o.val);
-        top_symbol :
-          begin
-            if assigned(o.sym) then
-              hs:='dword '+o.sym^.name
-            else
-              hs:='dword ';
-            if o.symofs>0 then
-             hs:=hs+'+'+tostr(o.symofs)
-            else
-             if o.symofs<0 then
-              hs:=hs+tostr(o.symofs)
-            else
-             if not(assigned(o.sym)) then
-               hs:=hs+'0';
-            getopstr:=hs;
-          end;
-        top_ref :
-          begin
-            hs:=getreferencestring(o.ref^);
-            if not ((opcode = A_LEA) or (opcode = A_LGS) or
-                    (opcode = A_LSS) or (opcode = A_LFS) or
-                    (opcode = A_LES) or (opcode = A_LDS) or
-                    (opcode = A_SHR) or (opcode = A_SHL) or
-                    (opcode = A_SAR) or (opcode = A_SAL) or
-                    (opcode = A_OUT) or (opcode = A_IN)) then
-             begin
-               case s of
-                  S_B : hs:='byte '+hs;
-                  S_W : hs:='word '+hs;
-                  S_L : hs:='dword '+hs;
-                  S_IS : hs:='word '+hs;
-                  S_IL : hs:='dword '+hs;
-                  S_IQ : hs:='qword '+hs;
-                  S_FS : hs:='dword '+hs;
-                  S_FL : hs:='qword '+hs;
-                  S_FX : hs:='tword '+hs;
-                  S_BW : if dest then
-                      hs:='word '+hs
-                    else
-                      hs:='byte '+hs;
-                  S_BL : if dest then
-                      hs:='dword '+hs
-                    else
-                      hs:='byte '+hs;
-                  S_WL : if dest then
-                      hs:='dword '+hs
-                    else
-                      hs:='word '+hs;
-               end
-             end;
-            getopstr:=hs;
-          end;
-        else
-          internalerror(10001);
-      end;
-    end;
-
-    function getopstr_jmp(const o:toper) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg :
-          getopstr_jmp:=int_nasmreg2str[o.reg];
-        top_ref :
-          getopstr_jmp:=getreferencestring(o.ref^);
-        top_const :
-          getopstr_jmp:=tostr(o.val);
-        top_symbol :
-          begin
-            hs:=o.sym^.name;
-            if o.symofs>0 then
-             hs:=hs+'+'+tostr(o.symofs)
-            else
-             if o.symofs<0 then
-              hs:=hs+tostr(o.symofs);
-            getopstr_jmp:=hs;
-          end;
-        else
-          internalerror(10001);
+    function sizestr(s:topsize;dest:boolean):string;
+      begin
+        case s of
+           S_B : sizestr:='byte ';
+           S_W : sizestr:='word ';
+           S_L : sizestr:='dword ';
+           S_IS : sizestr:='word ';
+           S_IL : sizestr:='dword ';
+           S_IQ : sizestr:='qword ';
+           S_FS : sizestr:='dword ';
+           S_FL : sizestr:='qword ';
+           S_FX : sizestr:='tword ';
+           S_BW : if dest then
+               sizestr:='word '
+             else
+               sizestr:='byte ';
+           S_BL : if dest then
+               sizestr:='dword '
+             else
+               sizestr:='byte ';
+           S_WL : if dest then
+               sizestr:='dword '
+             else
+               sizestr:='word ';
+        end;
       end;
-    end;
 
-{$else}
 
-    function getopstr(t : byte;o : pointer;opofs:longint;s : topsize; opcode: tasmop;dest : boolean) : string;
-    var
-      hs : string;
-    begin
-      case t of
-       top_reg : getopstr:=int_nasmreg2str[tregister(o)];
-     top_const,
-       top_ref : begin
-                   if t=top_const then
-                     hs := tostr(longint(o))
-                   else
-                     hs:=getreferencestring(preference(o)^);
-                   if not ((opcode = A_LEA) or (opcode = A_LGS) or
-                           (opcode = A_LSS) or (opcode = A_LFS) or
-                           (opcode = A_LES) or (opcode = A_LDS) or
-                           (opcode = A_SHR) or (opcode = A_SHL) or
-                           (opcode = A_SAR) or (opcode = A_SAL) or
-                           (opcode = A_OUT) or (opcode = A_IN)) then
-                     begin
-                       case s of
-                          S_B : hs:='byte '+hs;
-                          S_W : hs:='word '+hs;
-                          S_L : hs:='dword '+hs;
-                          S_IS : hs:='word '+hs;
-                          S_IL : hs:='dword '+hs;
-                          S_IQ : hs:='qword '+hs;
-                          S_FS : hs:='dword '+hs;
-                          S_FL : hs:='qword '+hs;
-                          S_FX : hs:='tword '+hs;
-                          S_BW : if dest then
-                              hs:='word '+hs
-                            else
-                              hs:='byte '+hs;
-                          S_BL : if dest then
-                              hs:='dword '+hs
-                            else
-                              hs:='byte '+hs;
-                          S_WL : if dest then
-                              hs:='dword '+hs
-                            else
-                              hs:='word '+hs;
-                       end
-                     end;
-                   getopstr:=hs;
-                 end;
-    top_symbol : begin
-                   hs:='dword '+pasmsymbol(o)^.name;
-                   if opofs>0 then
-                    hs:=hs+'+'+tostr(opofs)
-                   else
-                    if opofs<0 then
-                     hs:=hs+tostr(opofs);
-                   getopstr:=hs;
-                 end;
-      else
-        internalerror(10001);
+    function getopstr(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean) : string;
+      var
+        hs : string;
+      begin
+        case o.typ of
+          top_reg :
+            getopstr:=int_nasmreg2str[o.reg];
+          top_const :
+            begin
+              if (ops=1) and (opcode<>A_RET) then
+               getopstr:=sizestr(s,dest)+tostr(o.val)
+              else
+               getopstr:=tostr(o.val);
+            end;
+          top_symbol :
+            begin
+              if assigned(o.sym) then
+               hs:='dword '+o.sym^.name
+              else
+               hs:='dword ';
+              if o.symofs>0 then
+               hs:=hs+'+'+tostr(o.symofs)
+              else
+               if o.symofs<0 then
+                hs:=hs+tostr(o.symofs)
+               else
+                if not(assigned(o.sym)) then
+                 hs:=hs+'0';
+              getopstr:=hs;
+            end;
+          top_ref :
+            begin
+              hs:=getreferencestring(o.ref^);
+              if not ((opcode = A_LEA) or (opcode = A_LGS) or
+                      (opcode = A_LSS) or (opcode = A_LFS) or
+                      (opcode = A_LES) or (opcode = A_LDS) or
+                      (opcode = A_SHR) or (opcode = A_SHL) or
+                      (opcode = A_SAR) or (opcode = A_SAL) or
+                      (opcode = A_OUT) or (opcode = A_IN)) then
+               begin
+                 hs:=sizestr(s,dest)+hs;
+               end;
+              getopstr:=hs;
+            end;
+          else
+            internalerror(10001);
+        end;
       end;
-    end;
 
-    function getopstr_jmp(t : byte;o : pointer;opofs:longint) : string;
-    var
-      hs : string;
-    begin
-      case t of
-          top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
-          top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
-        top_const : getopstr_jmp:=tostr(longint(o));
-       top_symbol : begin
-                      hs:=pasmsymbol(o)^.name;
-                      if opofs>0 then
-                       hs:=hs+'+'+tostr(opofs)
-                      else
-                       if opofs<0 then
-                        hs:=hs+tostr(opofs);
-                      getopstr_jmp:=hs;
-                    end;
-      else
-        internalerror(10001);
+    function getopstr_jmp(const o:toper) : string;
+      var
+        hs : string;
+      begin
+        case o.typ of
+          top_reg :
+            getopstr_jmp:=int_nasmreg2str[o.reg];
+          top_ref :
+            getopstr_jmp:=getreferencestring(o.ref^);
+          top_const :
+            getopstr_jmp:=tostr(o.val);
+          top_symbol :
+            begin
+              hs:=o.sym^.name;
+              if o.symofs>0 then
+               hs:=hs+'+'+tostr(o.symofs)
+              else
+               if o.symofs<0 then
+                hs:=hs+tostr(o.symofs);
+              getopstr_jmp:=hs;
+            end;
+          else
+            internalerror(10001);
+        end;
       end;
-    end;
-
-{$endif}
 
 
 {****************************************************************************
@@ -402,13 +323,10 @@ unit ag386nsm;
       counter,
       lines,
       i,j,l    : longint;
-      op       : tasmop;
       consttyp : tait;
       found,
       quoted   : boolean;
-{$ifndef OLDASM}
       sep      : char;
-{$endif}
     begin
       if not assigned(p) then
        exit;
@@ -432,9 +350,6 @@ unit ag386nsm;
                        LastSec:=pai_section(hp)^.sec;
                      end;
          ait_align : AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
-{$ifndef NEWLAB}
-      ait_external : AsmWriteLn('EXTERN '+pai_external(hp)^.sym^.name);
-{$endif}
      ait_datablock : begin
                        if pai_datablock(hp)^.is_global then
                         AsmWriteLn(#9'GLOBAL '+pai_datablock(hp)^.sym^.name);
@@ -547,30 +462,14 @@ unit ag386nsm;
                         end;
                        AsmLn;
                      end;
-{$ifndef NEWLAB}
          ait_label : begin
                        if pai_label(hp)^.l^.is_used then
-                        AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
+                        AsmWriteLn(pai_label(hp)^.l^.name+':');
                      end;
-{$endif}
         ait_direct : begin
                        AsmWritePChar(pai_direct(hp)^.str);
                        AsmLn;
                      end;
-{$ifndef NEWLAB}
-ait_labeled_instruction :
-                     begin
-                       op:=pai386_labeled(hp)^.opcode;
-                       if not((op=A_JMP) or (op=A_LOOP) or (op=A_LOOPZ) or
-                              (op=A_LOOPE) or (op=A_LOOPNZ) or (op=A_LOOPNE) or
-                              (op=A_JCXZ) or (op=A_JECXZ)) then
-                        AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^.opcode]+
-                          cond2str[pai386_labeled(hp)^.condition]+#9+'near '+lab2str(pai386_labeled(hp)^.lab))
-                       else
-                        AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^.opcode]+
-                          cond2str[pai386_labeled(hp)^.condition]+#9+lab2str(pai386_labeled(hp)^.lab));
-                     end;
-{$endif}
         ait_symbol : begin
                        if pai_symbol(hp)^.is_global then
                         AsmWriteLn(#9'GLOBAL '+pai_symbol(hp)^.sym^.name);
@@ -582,13 +481,15 @@ ait_labeled_instruction :
                         AsmWriteLn(':')
                      end;
    ait_instruction : begin
+                     { We need intel order, no At&t }
+                       pai386(hp)^.SwapOperands;
+                     { Reset }
                        suffix:='';
                        prefix:='';
                        s:='';
-{$ifndef OLDASM}
                        if pai386(hp)^.ops<>0 then
                         begin
-                          if pai386(hp)^.opcode=A_CALL then
+                          if is_calljmp(pai386(hp)^.opcode) then
                            s:=#9+getopstr_jmp(pai386(hp)^.oper[0])
                           else
                            begin
@@ -598,7 +499,7 @@ ait_labeled_instruction :
                                  sep:=#9
                                 else
                                  sep:=',';
-                                s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
+                                s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,pai386(hp)^.ops,(i=2));
                               end;
                            end;
                         end;
@@ -607,94 +508,6 @@ ait_labeled_instruction :
                        else
                         AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^.opcode]+
                           cond2str[pai386(hp)^.condition]+suffix+s);
-{$else}
-                     { added prefix instructions, must be on same line as opcode }
-                       if (pai386(hp)^.op1t = top_none) and
-                          ((pai386(hp)^.opcode = A_REP) or
-                           (pai386(hp)^.opcode = A_LOCK) or
-                           (pai386(hp)^.opcode =  A_REPE) or
-                           (pai386(hp)^.opcode = A_REPNE)) then
-                        Begin
-                          prefix:=int_op2str[pai386(hp)^.opcode]+#9;
-                          hp:=Pai(hp^.next);
-                        { this is theorically impossible... }
-                          if hp=nil then
-                           begin
-                             s:=#9#9+prefix;
-                             AsmWriteLn(s);
-                             break;
-                           end;
-                          { nasm prefers prefix on a line alone }
-                          AsmWriteln(#9#9+prefix);
-                          prefix:='';
-                        end
-                       else
-                        prefix:= '';
-                       { A_FNSTS need the w as suffix at least for nasm}
-                       if (pai386(hp)^.opcode = A_FNSTS) then
-                        pai386(hp)^.opcode:=A_FNSTSW
-                       else
-                        if (pai386(hp)^.opcode = A_FSTS) then
-                         pai386(hp)^.opcode:=A_FSTSW;
-                       if pai386(hp)^.op1t<>top_none then
-                        begin
-                          if pai386(hp)^.opcode=A_CALL then
-                           s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs)
-                          else
-                           begin
-                             s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs,
-                               pai386(hp)^.opsize,pai386(hp)^.opcode,false);
-                             if pai386(hp)^.op3t<>top_none then
-                              begin
-                                if pai386(hp)^.op2t<>top_none then
-{$ifdef NO_OP3}
-                                 s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),0,
-                                             pai386(hp)^.opsize,pai386(hp)^.opcode,true)+','+s;
-                                s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),0,
-                                            pai386(hp)^.opsize,pai386(hp)^.opcode,false)+','+s;
-{$else NO_OP3}
-                                 s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,0,
-                                             pai386(hp)^.opsize,pai386(hp)^.opcode,true)+','+s;
-                                s:=getopstr(pai386(hp)^.op3t,pai386(hp)^.op3,0,
-                                            pai386(hp)^.opsize,pai386(hp)^.opcode,false)+','+s;
-{$endif NO_OP3}
-                              end
-                             else
-                              if pai386(hp)^.op2t<>top_none then
-                               s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,0,pai386(hp)^.opsize,
-                                           pai386(hp)^.opcode,true)+','+s;
-                           end;
-                          s:=#9+s;
-                        end
-                       else
-                        begin
-                          { check if string instruction }
-                          { long form, otherwise may give range check errors }
-                          { in turbo pascal...                               }
-                          if ((pai386(hp)^.opcode = A_CMPS) or
-                             (pai386(hp)^.opcode = A_INS) or
-                             (pai386(hp)^.opcode = A_OUTS) or
-                             (pai386(hp)^.opcode = A_SCAS) or
-                             (pai386(hp)^.opcode = A_STOS) or
-                             (pai386(hp)^.opcode = A_MOVS) or
-                             (pai386(hp)^.opcode = A_LODS) or
-                             (pai386(hp)^.opcode = A_XLAT)) then
-                           Begin
-                             case pai386(hp)^.opsize of
-                              S_B: suffix:='b';
-                              S_W: suffix:='w';
-                              S_L: suffix:='d';
-                             else
-                              Message(assem_f_invalid_suffix_intel);
-                             end;
-                           end;
-                          s:='';
-                        end;
-                       if pai386(hp)^.opcode=A_FWAIT then
-                        AsmWriteln(#9#9'DB'#9'09bh')
-                       else
-                        AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^.opcode]+suffix+s);
-{$endif OLDASM}
                      end;
 {$ifdef GDB}
              ait_stabn,
@@ -734,6 +547,22 @@ ait_stab_function_name : ;
     end;
 
 
+    var
+      currentasmlist : PAsmList;
+
+    procedure writeexternal(p:pasmsymbol);{$ifndef FPC}far;{$endif}
+      begin
+        if p^.typ=AS_EXTERNAL then
+         currentasmlist^.AsmWriteln('EXTERN'#9+p^.name);
+      end;
+
+    procedure ti386nasmasmlist.WriteExternals;
+      begin
+        currentasmlist:=@self;
+        AsmSymbolList^.foreach(writeexternal);
+      end;
+
+
     procedure ti386nasmasmlist.WriteAsmList;
     begin
 {$ifdef EXTDEBUG}
@@ -745,7 +574,9 @@ ait_stab_function_name : ;
       AsmLn;
 
       countlabelref:=false;
-      WriteTree(externals);
+
+      WriteExternals;
+
     { Nasm doesn't support stabs
       WriteTree(debuglist);}
 
@@ -766,7 +597,15 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.39  1999-05-23 18:41:57  florian
+  Revision 1.40  1999-05-27 19:44:02  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.39  1999/05/23 18:41:57  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/assemble.pas

@@ -24,10 +24,6 @@ unit assemble;
 
 interface
 
-{$ifdef OLDASM}
-  {$define NOAG386BIN}
-{$endif}
-
 uses
 {$ifdef Delphi}
   dmisc,
@@ -47,7 +43,7 @@ type
   {filenames}
     path     : pathstr;
     name     : namestr;
-    asmfile,             { current .s and .o file }
+    asmfile,         { current .s and .o file }
     objfile,
     as_bin   : string;
     IsEndFile : boolean;  { special 'end' file for import dir ? }
@@ -553,7 +549,15 @@ end;
 end.
 {
   $Log$
-  Revision 1.47  1999-05-13 21:59:19  peter
+  Revision 1.48  1999-05-27 19:44:03  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.47  1999/05/13 21:59:19  peter
     * removed oldppu code
     * warning if objpas is loaded from uses
     * first things for new deref writing

compiler/cg386add.pas

@@ -37,11 +37,7 @@ implementation
       cobjects,verbose,globals,
       symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
       cgai386,tgeni386;
 
 {*****************************************************************************
@@ -179,16 +175,16 @@ implementation
                         end;
 
                         { push the still used registers }
-                        pushusedregisters(exprasmlist,pushedregs,$ff);
+                        pushusedregisters(pushedregs,$ff);
                         { push data }
                         clear_location(p^.location);
                         p^.location.loc:=LOC_MEM;
                         gettempansistringreference(p^.location.reference);
-                        emitpushreferenceaddr(exprasmlist,p^.location.reference);
+                        emitpushreferenceaddr(p^.location.reference);
                         emit_push_loc(p^.right^.location);
                         emit_push_loc(p^.left^.location);
-                        emitcall('FPC_ANSISTR_CONCAT',true);
-                        popusedregisters(exprasmlist,pushedregs);
+                        emitcall('FPC_ANSISTR_CONCAT');
+                        popusedregisters(pushedregs);
                         maybe_loadesi;
                         ungetiftempansi(p^.left^.location.reference);
                         ungetiftempansi(p^.right^.location.reference);
@@ -215,7 +211,7 @@ implementation
                             ungetregister32(p^.left^.location.register);
                         end;
                         { push the still used registers }
-                        pushusedregisters(exprasmlist,pushedregs,$ff);
+                        pushusedregisters(pushedregs,$ff);
                         { push data }
                         case p^.right^.location.loc of
                           LOC_REFERENCE,LOC_MEM:
@@ -229,9 +225,9 @@ implementation
                           LOC_REGISTER,LOC_CREGISTER:
                             exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
                         end;
-                        emitcall('FPC_ANSISTR_COMPARE',true);
+                        emitcall('FPC_ANSISTR_COMPARE');
                         emit_reg_reg(A_OR,S_L,R_EAX,R_EAX);
-                        popusedregisters(exprasmlist,pushedregs);
+                        popusedregisters(pushedregs);
                         maybe_loadesi;
                         { done in temptoremove (PM)
                         ungetiftemp(p^.left^.location.reference);
@@ -275,20 +271,20 @@ implementation
                         { on the right we do not need the register anymore too }
 {$IfNDef regallocfix}
                         del_reference(p^.right^.location.reference);
-                        pushusedregisters(exprasmlist,pushedregs,$ff);
+                        pushusedregisters(pushedregs,$ff);
 {$Else regallocfix}
                         pushusedregisters(pushedregs,$ff
                           xor ($80 shr byte(p^.right^.location.reference.base))
                           xor ($80 shr byte(p^.right^.location.reference.index)));
 {$EndIf regallocfix}
-                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                        emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                        emitpushreferenceaddr(p^.left^.location.reference);
+                        emitpushreferenceaddr(p^.right^.location.reference);
 {$IfDef regallocfix}
                         del_reference(p^.right^.location.reference);
 {$EndIf regallocfix}
-                        emitcall('FPC_SHORTSTR_CONCAT',true);
+                        emitcall('FPC_SHORTSTR_CONCAT');
                         maybe_loadesi;
-                        popusedregisters(exprasmlist,pushedregs);
+                        popusedregisters(pushedregs);
 
                         set_location(p^.location,p^.left^.location);
                         ungetiftemp(p^.right^.location.reference);
@@ -321,16 +317,16 @@ implementation
                           end
                         else
                           begin
-                             pushusedregisters(exprasmlist,pushedregs,$ff);
+                             pushusedregisters(pushedregs,$ff);
                              secondpass(p^.left);
-                             emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                             emitpushreferenceaddr(p^.left^.location.reference);
                              del_reference(p^.left^.location.reference);
                              secondpass(p^.right);
-                             emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                             emitpushreferenceaddr(p^.right^.location.reference);
                              del_reference(p^.right^.location.reference);
-                             emitcall('FPC_SHORTSTR_COMPARE',true);
+                             emitcall('FPC_SHORTSTR_COMPARE');
                              maybe_loadesi;
-                             popusedregisters(exprasmlist,pushedregs);
+                             popusedregisters(pushedregs);
                           end;
                         ungetiftemp(p^.left^.location.reference);
                         ungetiftemp(p^.right^.location.reference);
@@ -404,17 +400,17 @@ implementation
 {$IfNDef regallocfix}
                      del_reference(p^.left^.location.reference);
                      del_reference(p^.right^.location.reference);
-                     pushusedregisters(exprasmlist,pushedregs,$ff);
+                     pushusedregisters(pushedregs,$ff);
 {$EndIf regallocfix}
 {$IfNDef NoSetInclusion}
                      If (p^.treetype in [equaln, unequaln, lten]) Then
                        Begin
 {$EndIf NoSetInclusion}
-                         emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                         emitpushreferenceaddr(p^.right^.location.reference);
 {$IfDef regallocfix}
                          del_reference(p^.right^.location.reference);
 {$EndIf regallocfix}
-                         emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                         emitpushreferenceaddr(p^.left^.location.reference);
 {$IfDef regallocfix}
                          del_reference(p^.left^.location.reference);
 {$EndIf regallocfix}
@@ -422,11 +418,11 @@ implementation
                        End
                      Else  {gten = lten, if the arguments are reversed}
                        Begin
-                         emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                         emitpushreferenceaddr(p^.left^.location.reference);
 {$IfDef regallocfix}
                          del_reference(p^.left^.location.reference);
 {$EndIf regallocfix}
-                         emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                         emitpushreferenceaddr(p^.right^.location.reference);
 {$IfDef regallocfix}
                          del_reference(p^.right^.location.reference);
 {$EndIf regallocfix}
@@ -434,13 +430,13 @@ implementation
                      Case p^.treetype of
                        equaln, unequaln:
 {$EndIf NoSetInclusion}
-                         emitcall('FPC_SET_COMP_SETS',true);
+                         emitcall('FPC_SET_COMP_SETS');
 {$IfNDef NoSetInclusion}
-                       lten, gten: emitcall('FPC_SET_CONTAINS_SETS',true)
+                       lten, gten: emitcall('FPC_SET_CONTAINS_SETS')
                      End;
 {$EndIf NoSetInclusion}
                      maybe_loadesi;
-                     popusedregisters(exprasmlist,pushedregs);
+                     popusedregisters(pushedregs);
                      ungetiftemp(p^.left^.location.reference);
                      ungetiftemp(p^.right^.location.reference);
                    end;
@@ -449,7 +445,7 @@ implementation
 {$IfNDef regallocfix}
                      del_reference(p^.left^.location.reference);
                      del_reference(p^.right^.location.reference);
-                     pushusedregisters(exprasmlist,pushedregs,$ff);
+                     pushusedregisters(pushedregs,$ff);
 {$EndIf regallocfix}
                      href.symbol:=nil;
                      gettempofsizereference(32,href);
@@ -460,8 +456,8 @@ implementation
                         del_reference(p^.right^.location.reference);
 {$EndIf regallocfix}
                         pushsetelement(p^.right^.left);
-                        emitpushreferenceaddr(exprasmlist,href);
-                        emitcall('FPC_SET_CREATE_ELEMENT',true);
+                        emitpushreferenceaddr(href);
+                        emitcall('FPC_SET_CREATE_ELEMENT');
                       end
                      else
                       begin
@@ -477,33 +473,33 @@ implementation
                             begin
                               pushsetelement(p^.right^.right);
                               pushsetelement(p^.right^.left);
-                              emitpushreferenceaddr(exprasmlist,href);
-                              emitcall('FPC_SET_SET_RANGE',true);
+                              emitpushreferenceaddr(href);
+                              emitcall('FPC_SET_SET_RANGE');
                             end
                            else
                             begin
                               pushsetelement(p^.right^.left);
-                              emitpushreferenceaddr(exprasmlist,href);
-                              emitcall('FPC_SET_SET_BYTE',true);
+                              emitpushreferenceaddr(href);
+                              emitcall('FPC_SET_SET_BYTE');
                             end;
                          end
                         else
                          begin
                          { must be an other set }
-                           emitpushreferenceaddr(exprasmlist,href);
-                           emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                           emitpushreferenceaddr(href);
+                           emitpushreferenceaddr(p^.right^.location.reference);
 {$IfDef regallocfix}
                         del_reference(p^.right^.location.reference);
 {$EndIf regallocfix}
-                           emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                           emitpushreferenceaddr(p^.left^.location.reference);
 {$IfDef regallocfix}
                         del_reference(p^.left^.location.reference);
 {$EndIf regallocfix}
-                           emitcall('FPC_SET_ADD_SETS',true);
+                           emitcall('FPC_SET_ADD_SETS');
                          end;
                       end;
                      maybe_loadesi;
-                     popusedregisters(exprasmlist,pushedregs);
+                     popusedregisters(pushedregs);
                      ungetiftemp(p^.left^.location.reference);
                      ungetiftemp(p^.right^.location.reference);
                      p^.location.loc:=LOC_MEM;
@@ -515,26 +511,26 @@ implementation
 {$IfNDef regallocfix}
                      del_reference(p^.left^.location.reference);
                      del_reference(p^.right^.location.reference);
-                     pushusedregisters(exprasmlist,pushedregs,$ff);
+                     pushusedregisters(pushedregs,$ff);
 {$EndIf regallocfix}
                      href.symbol:=nil;
                      gettempofsizereference(32,href);
-                     emitpushreferenceaddr(exprasmlist,href);
-                     emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                     emitpushreferenceaddr(href);
+                     emitpushreferenceaddr(p^.right^.location.reference);
 {$IfDef regallocfix}
                      del_reference(p^.right^.location.reference);
 {$EndIf regallocfix}
-                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     emitpushreferenceaddr(p^.left^.location.reference);
 {$IfDef regallocfix}
                      del_reference(p^.left^.location.reference);
 {$EndIf regallocfix}
                      case p^.treetype of
-                      subn : emitcall('FPC_SET_SUB_SETS',true);
-                   symdifn : emitcall('FPC_SET_SYMDIF_SETS',true);
-                      muln : emitcall('FPC_SET_MUL_SETS',true);
+                      subn : emitcall('FPC_SET_SUB_SETS');
+                   symdifn : emitcall('FPC_SET_SYMDIF_SETS');
+                      muln : emitcall('FPC_SET_MUL_SETS');
                      end;
                      maybe_loadesi;
-                     popusedregisters(exprasmlist,pushedregs);
+                     popusedregisters(pushedregs);
                      ungetiftemp(p^.left^.location.reference);
                      ungetiftemp(p^.right^.location.reference);
                      p^.location.loc:=LOC_MEM;
@@ -553,7 +549,7 @@ implementation
 
     procedure secondadd(var p : ptree);
     { is also being used for xor, and "mul", "sub, or and comparative }
-    { operators                                                       }
+    { operators                                                }
 
       label do_normal;
 
@@ -563,10 +559,10 @@ implementation
          pushed,mboverflow,cmpop : boolean;
          op,op2 : tasmop;
          flags : tresflags;
-         otl,ofl,hl : plabel;
+         otl,ofl,hl : pasmlabel;
          power : longint;
          opsize : topsize;
-         hl4: plabel;
+         hl4: pasmlabel;
          hr : preference;
 
          { true, if unsigned types are compared }
@@ -1153,7 +1149,7 @@ implementation
                        end;
                    { at this point, p^.location.loc should be LOC_REGISTER }
                    { and p^.location.register should be a valid register   }
-                   { containing the left result                            }
+                   { containing the left result                     }
 
                     if p^.right^.location.loc<>LOC_REGISTER then
                      begin
@@ -1264,7 +1260,7 @@ implementation
                                p^.location.register,p^.right^.location.register)));
                                swap_location(p^.location,p^.right^.location);
                                { newly swapped also set swapped flag }
-                               { just to maintain ordering           }
+                               { just to maintain ordering         }
                                p^.swaped:=not(p^.swaped);
                           end
                         else
@@ -1290,7 +1286,7 @@ implementation
                    { only in case of overflow operations }
                    { produce overflow code }
                    { we must put it here directly, because sign of operation }
-                   { is in unsigned VAR!!                                    }
+                   { is in unsigned VAR!!                                   }
                    if mboverflow then
                     begin
                       if cs_check_overflow in aktlocalswitches  then
@@ -1300,7 +1296,7 @@ implementation
                           emitjmp(C_NB,hl4)
                          else
                           emitjmp(C_NO,hl4);
-                         emitcall('FPC_OVERFLOW',true);
+                         emitcall('FPC_OVERFLOW');
                          emitlab(hl4);
                        end;
                     end;
@@ -1522,7 +1518,7 @@ implementation
                         release_qword_loc(p^.right^.location);
                         p^.location.registerlow:=getexplicitregister32(R_EAX);
                         p^.location.registerhigh:=getexplicitregister32(R_EDX);
-                        pushusedregisters(exprasmlist,pushedreg,$ff
+                        pushusedregisters(pushedreg,$ff
                           and not($80 shr byte(p^.location.registerlow))
                           and not($80 shr byte(p^.location.registerhigh)));
                         if cs_check_overflow in aktlocalswitches then
@@ -1537,12 +1533,12 @@ implementation
                         clear_location(hloc);
                         emit_pushq_loc(p^.right^.location);
                         if porddef(p^.resulttype)^.typ=u64bit then
-                          emitcall('FPC_MUL_QWORD',true)
+                          emitcall('FPC_MUL_QWORD')
                         else
-                          emitcall('FPC_MUL_INT64',true);
+                          emitcall('FPC_MUL_INT64');
                         emit_reg_reg(A_MOV,S_L,R_EAX,p^.location.registerlow);
                         emit_reg_reg(A_MOV,S_L,R_EDX,p^.location.registerhigh);
-                        popusedregisters(exprasmlist,pushedreg);
+                        popusedregisters(pushedreg);
                         p^.location.loc:=LOC_REGISTER;
                      end
                    else
@@ -1625,7 +1621,7 @@ implementation
                             end;
                         { at this point, p^.location.loc should be LOC_REGISTER }
                         { and p^.location.register should be a valid register   }
-                        { containing the left result                            }
+                        { containing the left result                        }
 
                         if p^.right^.location.loc<>LOC_REGISTER then
                           begin
@@ -1683,6 +1679,8 @@ implementation
                                          p^.right^.location.reference),p^.location.registerlow)));
                                        secondjmp64bitcmp;
 
+                                       emitjmp(C_None,falselabel);
+
                                        ungetiftemp(p^.right^.location.reference);
                                        del_reference(p^.right^.location.reference);
                                     end;
@@ -1733,7 +1731,7 @@ implementation
                              { when swapped another result register }
                              if (p^.treetype=subn) and p^.swaped then
                                begin
-                                  exprasmlist^.concat(new(pai386,op_reg_reg(op,S_L,
+                                 exprasmlist^.concat(new(pai386,op_reg_reg(op,S_L,
                                     p^.location.registerlow,
                                     p^.right^.location.registerlow)));
                                  exprasmlist^.concat(new(pai386,op_reg_reg(op2,S_L,
@@ -1777,7 +1775,7 @@ implementation
                         { only in case of overflow operations }
                         { produce overflow code }
                         { we must put it here directly, because sign of operation }
-                        { is in unsigned VAR!!                                    }
+                        { is in unsigned VAR!!                              }
                         if mboverflow then
                          begin
                            if cs_check_overflow in aktlocalswitches  then
@@ -1787,7 +1785,7 @@ implementation
                                emitjmp(C_NB,hl4)
                               else
                                emitjmp(C_NO,hl4);
-                              emitcall('FPC_OVERFLOW',true);
+                              emitcall('FPC_OVERFLOW');
                               emitlab(hl4);
                             end;
                          end;
@@ -2044,7 +2042,7 @@ implementation
                        end;
                    { at this point, p^.location.loc should be LOC_MMXREGISTER }
                    { and p^.location.register should be a valid register      }
-                   { containing the left result                               }
+                   { containing the left result                        }
                    if p^.right^.location.loc<>LOC_MMXREGISTER then
                      begin
                         if (p^.treetype=subn) and p^.swaped then
@@ -2090,7 +2088,7 @@ implementation
                                p^.location.register,p^.right^.location.register)));
                                swap_location(p^.location,p^.right^.location);
                                { newly swapped also set swapped flag }
-                               { just to maintain ordering           }
+                               { just to maintain ordering         }
                                p^.swaped:=not(p^.swaped);
                           end
                         else
@@ -2112,7 +2110,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.61  1999-05-25 20:36:11  florian
+  Revision 1.62  1999-05-27 19:44:04  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.61  1999/05/25 20:36:11  florian
     * some bugs in the qword code generation fixed
 
   Revision 1.60  1999/05/23 19:55:10  florian

compiler/cg386cal.pas

@@ -44,11 +44,7 @@ implementation
       gdb,
 {$endif GDB}
       hcodegen,temp_gen,pass_2,
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
       cgai386,tgeni386,cg386ld;
 
 {*****************************************************************************
@@ -77,7 +73,7 @@ implementation
         end;
 
       var
-         otlabel,oflabel : plabel;
+         otlabel,oflabel : pasmlabel;
          align : longint;
          { temporary variables: }
          tempdeftype : tdeftype;
@@ -130,7 +126,7 @@ implementation
                            exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
                          end
                       else
-                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                        emitpushreferenceaddr(p^.left^.location.reference);
                         del_reference(p^.left^.location.reference);
                      end;
                 end;
@@ -150,7 +146,7 @@ implementation
                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
                 end
               else
-                emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                emitpushreferenceaddr(p^.left^.location.reference);
               del_reference(p^.left^.location.reference);
            end
          else
@@ -171,7 +167,7 @@ implementation
                           R_EDI,r)));
                      end
                    else
-                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                     emitpushreferenceaddr(p^.left^.location.reference);
                    del_reference(p^.left^.location.reference);
                 end
               else
@@ -213,7 +209,7 @@ implementation
          { true if a constructor is called again }
          extended_new : boolean;
          { adress returned from an I/O-error }
-         iolabel : plabel;
+         iolabel : pasmlabel;
          { lexlevel count }
          i : longint;
          { help reference pointer }
@@ -224,9 +220,9 @@ implementation
          inlinecode : ptree;
          para_offset : longint;
          { instruction for alignement correction }
-{         corr : pai386;}
+{        corr : pai386;}
          { we must pop this size also after !! }
-{         must_pop : boolean; }
+{        must_pop : boolean; }
          pop_size : longint;
 
       label
@@ -287,14 +283,14 @@ implementation
                 iolabel:=nil;
 
               { save all used registers }
-              pushusedregisters(exprasmlist,pushed,pprocdef(p^.procdefinition)^.usedregisters);
+              pushusedregisters(pushed,pprocdef(p^.procdefinition)^.usedregisters);
 
               { give used registers through }
               usedinproc:=usedinproc or pprocdef(p^.procdefinition)^.usedregisters;
            end
          else
            begin
-              pushusedregisters(exprasmlist,pushed,$ff);
+              pushusedregisters(pushed,$ff);
               usedinproc:=$ff;
               { no IO check for methods and procedure variables }
               iolabel:=nil;
@@ -384,7 +380,7 @@ implementation
                      R_EDI,r)));
                 end
               else
-                emitpushreferenceaddr(exprasmlist,funcretref);
+                emitpushreferenceaddr(funcretref);
            end;
          { procedure variable ? }
          if (p^.right=nil) then
@@ -469,10 +465,6 @@ implementation
                                              exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,S_L,
                                                newasmsymbol(pobjectdef(
                                                p^.methodpointer^.resulttype)^.vmt_mangledname),0,R_ESI)));
-{$ifndef NEWLAB}
-                                             maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
-                                               pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
-{$endif}
                                            end;
                                          { exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
                                            this is done below !! }
@@ -499,7 +491,7 @@ implementation
                                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
                                     { if an inherited con- or destructor should be  }
                                     { called in a con- or destructor then a warning }
-                                    { will be made                                  }
+                                    { will be made                                }
                                     { con- and destructors need a pointer to the vmt }
                                     if is_con_or_destructor and
                                     not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
@@ -527,10 +519,6 @@ implementation
                                     { insert the vmt }
                                     exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
                                       newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
-{$ifndef NEWLAB}
-                                    maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
-                                      pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
-{$endif}
                                     extended_new:=true;
                                  end;
                                hdisposen:
@@ -538,17 +526,13 @@ implementation
                                     secondpass(p^.methodpointer);
 
                                     { destructor with extended syntax called from dispose }
-                                    { hdisposen always deliver LOC_REFERENCE              }
+                                    { hdisposen always deliver LOC_REFERENCE          }
                                     exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
                                       newreference(p^.methodpointer^.location.reference),R_ESI)));
                                     del_reference(p^.methodpointer^.location.reference);
                                     exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
                                     exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
                                       newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
-{$ifndef NEWLAB}
-                                    maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
-                                      pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
-{$endif}
                                  end;
                                else
                                  begin
@@ -618,13 +602,9 @@ implementation
                                                    { it's no bad idea, to insert the VMT }
                                                    exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(
                                                      pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
-{$ifndef NEWLAB}
-                                                   maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
-                                                     pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
-{$endif}
                                                 end
                                               { destructors haven't to dispose the instance, if this is }
-                                              { a direct call                                           }
+                                              { a direct call                                      }
                                               else
                                                 push_int(0);
                                            end;
@@ -669,9 +649,9 @@ implementation
                 ((pprocdef(p^.procdefinition)^.parast^.symtablelevel)>normal_function_level) then
                 begin
                    { if we call a nested function in a method, we must      }
-                   { push also SELF!                                        }
+                   { push also SELF!                                    }
                    { THAT'S NOT TRUE, we have to load ESI via frame pointer }
-                   { access                                                 }
+                   { access                                              }
                    {
                      begin
                         loadesi:=false;
@@ -721,9 +701,9 @@ implementation
                  not(no_virtual_call) then
                 begin
                    { static functions contain the vmt_address in ESI }
-                   { also class methods                              }
+                   { also class methods                       }
                    { Here it is quite tricky because it also depends }
-                   { on the methodpointer                         PM }
+                   { on the methodpointer                        PM }
                    if assigned(aktprocsym) then
                      begin
                        if ((((aktprocsym^.properties and sp_static)<>0) or
@@ -773,7 +753,7 @@ implementation
                    if (cs_check_range in aktlocalswitches) then
                      begin
                         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
-                        emitcall('FPC_CHECK_OBJECT',true);
+                        emitcall('FPC_CHECK_OBJECT');
                      end;
 {$else TESTOBJEXT}
                    if (cs_check_range in aktlocalswitches) then
@@ -787,12 +767,7 @@ implementation
                    exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,r)));
                 end
               else if not inlined then
-                emitcall(pprocdef(p^.procdefinition)^.mangledname,
-                  (p^.symtableproc^.symtabletype=unitsymtable) or
-                  ((p^.symtableproc^.symtabletype=objectsymtable) and
-                  (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable))or
-                  ((p^.symtableproc^.symtabletype=withsymtable) and
-                  (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)))
+                emitcall(pprocdef(p^.procdefinition)^.mangledname)
               else { inlined proc }
                 { inlined code is in inlinecode }
                 begin
@@ -815,8 +790,8 @@ implementation
                    hregister:=R_NO;
 
                    { do some hacking if we call a method pointer }
-                   { which is a class member                     }
-                   { else ESI is overwritten !                   }
+                   { which is a class member                 }
+                   { else ESI is overwritten !             }
                    if (p^.right^.location.reference.base=R_ESI) or
                       (p^.right^.location.reference.index=R_ESI) then
                      begin
@@ -872,7 +847,7 @@ implementation
                 if pushedparasize=4 then
                   exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)))
                 { the pentium has two pipes and pop reg is pairable }
-                { but the registers must be different!              }
+                { but the registers must be different!        }
                 else if (pushedparasize=8) and
                   not(cs_littlesize in aktglobalswitches) and
                   (aktoptprocessor=ClassP5) and
@@ -897,7 +872,7 @@ implementation
               p^.location.reference.symbol:=nil;
               p^.location.reference:=funcretref;
            end;
-         { we have only to handle the result if it is used, but        }
+         { we have only to handle the result if it is used, but }
          { ansi/widestrings must be registered, so we can dispose them }
          if (p^.resulttype<>pdef(voiddef)) and (p^.return_value_used or
            is_ansistring(p^.resulttype) or is_widestring(p^.resulttype)) then
@@ -1018,7 +993,7 @@ implementation
                    gettempansistringreference(hr);
                    { cleanup the temp slot }
                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
-                   decrstringref(exprasmlist,p^.resulttype,hr);
+                   decrstringref(p^.resulttype,hr);
                    exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
 
                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EAX,
@@ -1046,14 +1021,14 @@ implementation
          { perhaps i/o check ? }
          if iolabel<>nil then
            begin
-              exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(lab2str(iolabel)))));
-              emitcall('FPC_IOCHECK',true);
+              exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,iolabel)));
+              emitcall('FPC_IOCHECK');
            end;
          if pop_size>0 then
            exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pop_size,R_ESP)));
 
          { restore registers }
-         popusedregisters(exprasmlist,pushed);
+         popusedregisters(pushed);
 
          { at last, restore instance pointer (SELF) }
          if loadesi then
@@ -1102,7 +1077,7 @@ implementation
                    if (p^.resulttype^.needs_inittable) and
                      ( (p^.resulttype^.deftype<>objectdef) or
                        not(pobjectdef(p^.resulttype)^.isclass)) then
-                      finalize(exprasmlist,p^.resulttype,p^.location.reference);
+                      finalize(p^.resulttype,p^.location.reference);
                    { release unused temp }
                    ungetiftemp(p^.location.reference)
                 end
@@ -1127,7 +1102,7 @@ implementation
            nostackframe,make_global : boolean;
            proc_names : tstringcontainer;
            inlineentrycode,inlineexitcode : paasmoutput;
-           oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
+           oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
        begin
           oldexitlabel:=aktexitlabel;
           oldexit2label:=aktexit2label;
@@ -1190,7 +1165,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.86  1999-05-23 18:41:58  florian
+  Revision 1.87  1999-05-27 19:44:07  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.86  1999/05/23 18:41:58  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/cg386cnv.pas

@@ -43,11 +43,7 @@ implementation
       cobjects,verbose,globtype,globals,systems,
       symtable,aasm,types,
       hcodegen,temp_gen,pass_2,pass_1,
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
       cgai386,tgeni386;
 
 
@@ -86,10 +82,10 @@ implementation
                       A_MOV,S_B,0,newreference(p^.left^.location.reference))))
                  else
                    begin
-                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                     emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                     emitpushreferenceaddr(p^.left^.location.reference);
+                     emitpushreferenceaddr(p^.right^.location.reference);
                      push_shortstring_length(p^.left);
-                     emitcall('FPC_SHORTSTR_COPY',true);
+                     emitcall('FPC_SHORTSTR_COPY');
                      maybe_loadesi;
                    end;
               end;
@@ -136,7 +132,7 @@ implementation
                 ungetiftemp(source^.location.reference);
 {$IfNDef regallocfix}
                 del_reference(source^.location.reference);
-                pushusedregisters(exprasmlist,pushed,$ff);
+                pushusedregisters(pushed,$ff);
                 emit_push_mem(source^.location.reference);
 {$Else regallocfix}
                  pushusedregisters(pushed,$ff
@@ -150,7 +146,7 @@ implementation
              begin
 {$IfNDef regallocfix}
                 ungetregister32(source^.location.register);
-                pushusedregisters(exprasmlist,pushed,$ff);
+                pushusedregisters(pushed,$ff);
                 exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,source^.location.register)));
 {$Else regallocfix}
                  pushusedregisters(pushed, $ff xor ($80 shr byte(source^.location.register)));
@@ -160,9 +156,9 @@ implementation
              end;
          end;
          push_shortstring_length(dest);
-         emitpushreferenceaddr(exprasmlist,dest^.location.reference);
-         emitcall('FPC_ANSISTR_TO_SHORTSTR',true);
-         popusedregisters(exprasmlist,pushed);
+         emitpushreferenceaddr(dest^.location.reference);
+         emitcall('FPC_ANSISTR_TO_SHORTSTR');
+         popusedregisters(pushed);
          maybe_loadesi;
       end;
 
@@ -177,7 +173,7 @@ implementation
 
     procedure second_int_to_int(pto,pfrom : ptree;convtyp : tconverttype);
       var
-        op        : tasmop;
+        op      : tasmop;
         opsize    : topsize;
         hregister : tregister;
       begin
@@ -257,7 +253,7 @@ implementation
 
       begin
          { does anybody know a better solution than this big case statement ? }
-         { ok, a proc table would do the job                                  }
+         { ok, a proc table would do the job                              }
          case pstringdef(pto^.resulttype)^.string_typ of
 
             st_shortstring:
@@ -317,12 +313,12 @@ implementation
                       clear_location(pto^.location);
                       pto^.location.loc:=LOC_REFERENCE;
                       gettempansistringreference(pto^.location.reference);
-                      pushusedregisters(exprasmlist,pushed,$ff);
+                      pushusedregisters(pushed,$ff);
                       emit_push_lea_loc(pfrom^.location);
                       emit_push_lea_loc(pto^.location);
-                      emitcall('FPC_SHORTSTR_TO_ANSISTR',true);
+                      emitcall('FPC_SHORTSTR_TO_ANSISTR');
                       maybe_loadesi;
-                      popusedregisters(exprasmlist,pushed);
+                      popusedregisters(pushed);
 
                       ungetiftemp(pfrom^.location.reference);
                    end;
@@ -458,7 +454,7 @@ implementation
 
 
     { generates the code for the type conversion from an array of char }
-    { to a string                                                        }
+    { to a string                                                       }
     procedure second_chararray_to_string(pto,pfrom : ptree;convtyp : tconverttype);
       var
          pushed : tpushed;
@@ -467,7 +463,7 @@ implementation
          { calc the length of the array }
          l:=parraydef(pfrom^.resulttype)^.highrange-parraydef(pfrom^.resulttype)^.lowrange+1;
          { this is a type conversion which copies the data, so we can't }
-         { return a reference                                             }
+         { return a reference                                        }
          clear_location(pto^.location);
          pto^.location.loc:=LOC_MEM;
          case pstringdef(pto^.resulttype)^.string_typ of
@@ -495,12 +491,12 @@ implementation
              begin
                gettempansistringreference(pto^.location.reference);
                release_loc(pfrom^.location);
-               pushusedregisters(exprasmlist,pushed,$ff);
+               pushusedregisters(pushed,$ff);
                push_int(l);
-               emitpushreferenceaddr(exprasmlist,pfrom^.location.reference);
-               emitpushreferenceaddr(exprasmlist,pto^.location.reference);
-               emitcall('FPC_CHARARRAY_TO_ANSISTR',true);
-               popusedregisters(exprasmlist,pushed);
+               emitpushreferenceaddr(pfrom^.location.reference);
+               emitpushreferenceaddr(pto^.location.reference);
+               emitcall('FPC_CHARARRAY_TO_ANSISTR');
+               popusedregisters(pushed);
                maybe_loadesi;
              end;
            st_longstring:
@@ -540,11 +536,11 @@ implementation
              begin
                gettempansistringreference(pto^.location.reference);
                release_loc(pfrom^.location);
-               pushusedregisters(exprasmlist,pushed,$ff);
+               pushusedregisters(pushed,$ff);
                emit_pushw_loc(pfrom^.location);
-               emitpushreferenceaddr(exprasmlist,pto^.location.reference);
-               emitcall('FPC_CHAR_TO_ANSISTR',true);
-               popusedregisters(exprasmlist,pushed);
+               emitpushreferenceaddr(pto^.location.reference);
+               emitcall('FPC_CHAR_TO_ANSISTR');
+               popusedregisters(pushed);
                maybe_loadesi;
              end;
            else
@@ -667,7 +663,7 @@ implementation
       var
         popeax,popebx,popecx,popedx : boolean;
         startreg : tregister;
-        hl : plabel;
+        hl : pasmlabel;
         r : treference;
       begin
          if (pfrom^.location.loc=LOC_REGISTER) or
@@ -796,7 +792,7 @@ implementation
 
     procedure second_bool_to_int(pto,pfrom : ptree;convtyp : tconverttype);
       var
-         oldtruelabel,oldfalselabel,hlabel : plabel;
+         oldtruelabel,oldfalselabel,hlabel : pasmlabel;
          hregister : tregister;
          newsize,
          opsize : topsize;
@@ -976,13 +972,13 @@ implementation
         pushedregs : tpushed;
       begin
         href.symbol:=nil;
-        pushusedregisters(exprasmlist,pushedregs,$ff);
+        pushusedregisters(pushedregs,$ff);
         gettempofsizereference(32,href);
-        emitpushreferenceaddr(exprasmlist,pfrom^.location.reference);
-        emitpushreferenceaddr(exprasmlist,href);
-        emitcall('FPC_SET_LOAD_SMALL',true);
+        emitpushreferenceaddr(pfrom^.location.reference);
+        emitpushreferenceaddr(href);
+        emitcall('FPC_SET_LOAD_SMALL');
         maybe_loadesi;
-        popusedregisters(exprasmlist,pushedregs);
+        popusedregisters(pushedregs);
         clear_location(pto^.location);
         pto^.location.loc:=LOC_MEM;
         pto^.location.reference:=href;
@@ -991,7 +987,7 @@ implementation
 
     procedure second_ansistring_to_pchar(pto,pfrom : ptree;convtyp : tconverttype);
       var
-         l1,l2 : plabel;
+         l1,l2 : pasmlabel;
          hr : preference;
       begin
          clear_location(pto^.location);
@@ -1035,7 +1031,7 @@ implementation
              begin
                 pto^.location.loc:=LOC_REFERENCE;
                 gettempofsizereference(pto^.resulttype^.size,pto^.location.reference);
-                pushusedregisters(exprasmlist,pushed,$ff);
+                pushusedregisters(pushed,$ff);
                 case pfrom^.location.loc of
                    LOC_REGISTER,LOC_CREGISTER:
                      begin
@@ -1048,10 +1044,10 @@ implementation
                         del_reference(pfrom^.location.reference);
                      end;
                 end;
-                emitpushreferenceaddr(exprasmlist,pto^.location.reference);
-                emitcall('FPC_PCHAR_TO_SHORTSTR',true);
+                emitpushreferenceaddr(pto^.location.reference);
+                emitcall('FPC_PCHAR_TO_SHORTSTR');
                 maybe_loadesi;
-                popusedregisters(exprasmlist,pushed);
+                popusedregisters(pushed);
              end;
            st_ansistring:
              begin
@@ -1062,7 +1058,7 @@ implementation
                     begin
 {$IfNDef regallocfix}
                       del_reference(pfrom^.location.reference);
-                      pushusedregisters(exprasmlist,pushed,$ff);
+                      pushusedregisters(pushed,$ff);
                       emit_push_mem(pfrom^.location.reference);
 {$Else regallocfix}
                       pushusedregisters(pushed,$ff
@@ -1076,7 +1072,7 @@ implementation
                     begin
 {$IfNDef regallocfix}
                       ungetregister32(pfrom^.location.register);
-                      pushusedregisters(exprasmlist,pushed,$ff);
+                      pushusedregisters(pushed,$ff);
                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,pfrom^.location.register)));
 {$Else regallocfix}
                       pushusedregisters(pushed, $ff xor ($80 shr byte(pfrom^.location.register)));
@@ -1085,10 +1081,10 @@ implementation
 {$EndIf regallocfix}
                    end;
                 end;
-                emitpushreferenceaddr(exprasmlist,pto^.location.reference);
-                emitcall('FPC_PCHAR_TO_ANSISTR',true);
+                emitpushreferenceaddr(pto^.location.reference);
+                emitcall('FPC_PCHAR_TO_ANSISTR');
                 maybe_loadesi;
-                popusedregisters(exprasmlist,pushed);
+                popusedregisters(pushed);
              end;
          else
           begin
@@ -1143,7 +1139,7 @@ implementation
       begin
 
          { this isn't good coding, I think tc_bool_2_int, shouldn't be }
-         { type conversion (FK)                                        }
+         { type conversion (FK)                                 }
 
          if not(p^.convtyp in [tc_bool_2_int,tc_bool_2_bool]) then
            begin
@@ -1176,20 +1172,15 @@ implementation
                           { NIL must be accepted !! }
                           exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,r^.base,r^.base)));
                           getlabel(nillabel);
-{$ifndef OLDASM}
-                          exprasmlist^.concat(new(pai386_labeled,op_cond_lab(A_Jcc,C_E,nillabel)));
-{$else}
-                          exprasmlist^.concat(new(pai386_labeled,op_lab(A_JE,nillabel)));
-{$endif}
-
+                          emitjmp(C_E,nillabel);
                           { this is one point where we need vmt_offset (PM) }
                           r^.offset:= pobjectdef(ppointerdef(p^.resulttype)^.definition)^.vmt_offset;
                           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
                           exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
                             newasmsymbol(pobjectdef(ppointerdef(p^.resulttype)^.definition)^.vmt_mangledname))));
                           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
-                          emitcall('FPC_CHECK_OBJECT_EXT',true);
-                          exprasmlist^.concat(new(pai_label,init(nillabel)));
+                          emitcall('FPC_CHECK_OBJECT_EXT');
+                          emitlab(nillabel);
                        end;
 {$endif TESTOBJEXT2}
       end;
@@ -1205,7 +1196,7 @@ implementation
 
       begin
          { save all used registers }
-         pushusedregisters(exprasmlist,pushed,$ff);
+         pushusedregisters(pushed,$ff);
          secondpass(p^.left);
          clear_location(p^.location);
          p^.location.loc:=LOC_FLAGS;
@@ -1245,9 +1236,9 @@ implementation
               end;
             else internalerror(100);
          end;
-         emitcall('FPC_DO_IS',true);
+         emitcall('FPC_DO_IS');
          exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_B,R_AL,R_AL)));
-         popusedregisters(exprasmlist,pushed);
+         popusedregisters(pushed);
          maybe_loadesi;
       end;
 
@@ -1262,7 +1253,7 @@ implementation
       begin
          secondpass(p^.left);
          { save all used registers }
-         pushusedregisters(exprasmlist,pushed,$ff);
+         pushusedregisters(pushed,$ff);
 
          { push instance to check: }
          case p^.left^.location.loc of
@@ -1295,17 +1286,25 @@ implementation
               end;
             else internalerror(100);
          end;
-         emitcall('FPC_DO_AS',true);
+         emitcall('FPC_DO_AS');
          { restore register, this restores automatically the }
-         { result                                            }
-         popusedregisters(exprasmlist,pushed);
+         { result                                           }
+         popusedregisters(pushed);
       end;
 
 
 end.
 {
   $Log$
-  Revision 1.73  1999-05-18 21:58:26  florian
+  Revision 1.74  1999-05-27 19:44:09  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.73  1999/05/18 21:58:26  florian
     * fixed some bugs related to temp. ansistrings and functions results
       which return records/objects/arrays which need init/final.
 

compiler/cg386con.pas

@@ -1,562 +1,551 @@
-{
-    $Id$
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Generate i386 assembler for constants
-
-    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 cg386con;
-interface
-
-    uses
-      tree;
-
-{$define SMALLSETORD}
-
-
-    procedure secondrealconst(var p : ptree);
-    procedure secondfixconst(var p : ptree);
-    procedure secondordconst(var p : ptree);
-    procedure secondstringconst(var p : ptree);
-    procedure secondsetconst(var p : ptree);
-    procedure secondniln(var p : ptree);
-
-
-implementation
-
-    uses
-      globtype,systems,
-      cobjects,verbose,globals,
-      symtable,aasm,types,
-      hcodegen,temp_gen,pass_2,
-{$ifndef OLDASM}
-      i386base,i386asm,
-{$else}
-      i386,
-{$endif}
-      cgai386,tgeni386;
-
-{*****************************************************************************
-                             SecondRealConst
-*****************************************************************************}
-
-    procedure secondrealconst(var p : ptree);
-      const
-        floattype2ait:array[tfloattype] of tait=
-          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_none,ait_none);
-
-      var
-         hp1 : pai;
-         lastlabel : plabel;
-         realait : tait;
-      begin
-         lastlabel:=nil;
-         realait:=floattype2ait[pfloatdef(p^.resulttype)^.typ];
-         { const already used ? }
-         if not assigned(p^.lab_real) then
-           begin
-              { tries to found an old entry }
-              hp1:=pai(consts^.first);
-              while assigned(hp1) do
-                begin
-{$ifdef NEWLAB}
-                   if hp1^.typ=ait_symbol then
-                     lastlabel:=pasmlabel(pai_symbol(hp1)^.sym)
-{$else}
-                   if hp1^.typ=ait_label then
-                     lastlabel:=pai_label(hp1)^.l
-{$endif}
-                   else
-                     begin
-                        if (hp1^.typ=realait) and (lastlabel<>nil) then
-                          begin
-                             if(
-                                ((realait=ait_real_32bit) and (pai_real_32bit(hp1)^.value=p^.value_real)) or
-                                ((realait=ait_real_64bit) and (pai_real_64bit(hp1)^.value=p^.value_real)) or
-                                ((realait=ait_real_80bit) and (pai_real_80bit(hp1)^.value=p^.value_real)) or
-                                ((realait=ait_comp_64bit) and (pai_comp_64bit(hp1)^.value=p^.value_real))
-                               ) then
-                               begin
-                                  { found! }
-                                  p^.lab_real:=lastlabel;
-                                  break;
-                               end;
-                          end;
-                        lastlabel:=nil;
-                     end;
-                   hp1:=pai(hp1^.next);
-                end;
-              { :-(, we must generate a new entry }
-              if not assigned(p^.lab_real) then
-                begin
-                   getdatalabel(lastlabel);
-                   p^.lab_real:=lastlabel;
-                   if (cs_smartlink in aktmoduleswitches) then
-                    consts^.concat(new(pai_cut,init));
-                   consts^.concat(new(pai_label,init(lastlabel)));
-                   case realait of
-                     ait_real_32bit :
-                       consts^.concat(new(pai_real_32bit,init(p^.value_real)));
-                     ait_real_64bit :
-                       consts^.concat(new(pai_real_64bit,init(p^.value_real)));
-                     ait_real_80bit :
-                       consts^.concat(new(pai_real_80bit,init(p^.value_real)));
-                     ait_comp_64bit :
-                       consts^.concat(new(pai_comp_64bit,init(p^.value_real)));
-                   else
-                     internalerror(10120);
-                   end;
-                end;
-           end;
-         reset_reference(p^.location.reference);
-         p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_real));
-         p^.location.loc:=LOC_MEM;
-      end;
-
-
-{*****************************************************************************
-                             SecondFixConst
-*****************************************************************************}
-
-    procedure secondfixconst(var p : ptree);
-      begin
-         { an fix comma const. behaves as a memory reference }
-         p^.location.loc:=LOC_MEM;
-         p^.location.reference.is_immediate:=true;
-         p^.location.reference.offset:=p^.value_fix;
-      end;
-
-
-{*****************************************************************************
-                             SecondOrdConst
-*****************************************************************************}
-
-    procedure secondordconst(var p : ptree);
-      begin
-         { an integer const. behaves as a memory reference }
-         p^.location.loc:=LOC_MEM;
-         p^.location.reference.is_immediate:=true;
-         p^.location.reference.offset:=p^.value;
-      end;
-
-
-{*****************************************************************************
-                             SecondStringConst
-*****************************************************************************}
-
-    procedure secondstringconst(var p : ptree);
-      var
-         hp1 : pai;
-         l1,l2,
-         lastlabel   : plabel;
-         pc          : pchar;
-         same_string : boolean;
-         l,j,
-         i,mylength  : longint;
-      begin
-         lastlabel:=nil;
-         { const already used ? }
-         if not assigned(p^.lab_str) then
-           begin
-              if is_shortstring(p^.resulttype) then
-               mylength:=p^.length+2
-              else
-               mylength:=p^.length+1;
-              { tries to found an old entry }
-              hp1:=pai(consts^.first);
-              while assigned(hp1) do
-                begin
-{$ifdef NEWLAB}
-                   if hp1^.typ=ait_symbol then
-                     lastlabel:=pasmlabel(pai_symbol(hp1)^.sym)
-{$else}
-                   if hp1^.typ=ait_label then
-                     lastlabel:=pai_label(hp1)^.l
-{$endif}
-                   else
-                     begin
-                        { when changing that code, be careful that }
-                        { you don't use typed consts, which are    }
-                        { are also written to consts               }
-                        { currently, this is no problem, because   }
-                        { typed consts have no leading length or   }
-                        { they have no trailing zero               }
-                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
-                           (pai_string(hp1)^.len=mylength) then
-                          begin
-                             same_string:=true;
-                             { if shortstring then check the length byte first and
-                               set the start index to 1 }
-                             if is_shortstring(p^.resulttype) then
-                              begin
-                                if p^.length<>ord(pai_string(hp1)^.str[0]) then
-                                 same_string:=false;
-                                j:=1;
-                              end
-                             else
-                              j:=0;
-                             { don't check if the length byte was already wrong }
-                             if same_string then
-                              begin
-                                for i:=0 to p^.length do
-                                 begin
-                                   if pai_string(hp1)^.str[j]<>p^.value_str[i] then
-                                    begin
-                                      same_string:=false;
-                                      break;
-                                    end;
-                                   inc(j);
-                                 end;
-                              end;
-                             { found ? }
-                             if same_string then
-                              begin
-                                p^.lab_str:=lastlabel;
-                                { create a new entry for ansistrings, but reuse the data }
-                                if (p^.stringtype in [st_ansistring,st_widestring]) then
-                                 begin
-                                   getdatalabel(l2);
-                                   consts^.concat(new(pai_label,init(l2)));
-                                   consts^.concat(new(pai_const_symbol,initname(lab2str(p^.lab_str))));
-                                   { return the offset of the real string }
-                                   p^.lab_str:=l2;
-                                 end;
-                                break;
-                              end;
-                          end;
-                        lastlabel:=nil;
-                     end;
-                   hp1:=pai(hp1^.next);
-                end;
-              { :-(, we must generate a new entry }
-              if not assigned(p^.lab_str) then
-                begin
-                   getdatalabel(lastlabel);
-                   p^.lab_str:=lastlabel;
-                   if (cs_smartlink in aktmoduleswitches) then
-                    consts^.concat(new(pai_cut,init));
-                   consts^.concat(new(pai_label,init(lastlabel)));
-                   { generate an ansi string ? }
-                   case p^.stringtype of
-                      st_ansistring:
-                        begin
-                           { an empty ansi string is nil! }
-                           if p^.length=0 then
-                             consts^.concat(new(pai_const,init_32bit(0)))
-                           else
-                             begin
-                                getdatalabel(l1);
-                                getdatalabel(l2);
-                                consts^.concat(new(pai_label,init(l2)));
-                                consts^.concat(new(pai_const_symbol,initname(lab2str(l1))));
-                                consts^.concat(new(pai_const,init_32bit(p^.length)));
-                                consts^.concat(new(pai_const,init_32bit(p^.length)));
-                                consts^.concat(new(pai_const,init_32bit(-1)));
-                                consts^.concat(new(pai_label,init(l1)));
-                                getmem(pc,p^.length+2);
-                                move(p^.value_str^,pc^,p^.length);
-                                pc[p^.length]:=#0;
-                                { to overcome this problem we set the length explicitly }
-                                { with the ending null char }
-                                consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
-                                { return the offset of the real string }
-                                p^.lab_str:=l2;
-                             end;
-                        end;
-                      st_shortstring:
-                        begin
-                          { truncate strings larger than 255 chars }
-                          if p^.length>255 then
-                           l:=255
-                          else
-                           l:=p^.length;
-                          { also length and terminating zero }
-                          getmem(pc,l+3);
-                          move(p^.value_str^,pc[1],l+1);
-                          pc[0]:=chr(l);
-                          { to overcome this problem we set the length explicitly }
-                          { with the ending null char }
-                          pc[l+1]:=#0;
-                          consts^.concat(new(pai_string,init_length_pchar(pc,l+2)));
-                        end;
-                   end;
-                end;
-           end;
-         reset_reference(p^.location.reference);
-         p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_str));
-         p^.location.loc:=LOC_MEM;
-      end;
-
-
-{*****************************************************************************
-                             SecondSetCons
-*****************************************************************************}
-
-    procedure secondsetconst(var p : ptree);
-      var
-         hp1         : pai;
-         lastlabel   : plabel;
-         i           : longint;
-         neededtyp   : tait;
-      begin
-{$ifdef SMALLSETORD}
-        { small sets are loaded as constants }
-        if psetdef(p^.resulttype)^.settype=smallset then
-         begin
-           p^.location.loc:=LOC_MEM;
-           p^.location.reference.is_immediate:=true;
-           p^.location.reference.offset:=plongint(p^.value_set)^;
-           exit;
-         end;
-{$endif}
-        if psetdef(p^.resulttype)^.settype=smallset then
-         neededtyp:=ait_const_32bit
-        else
-         neededtyp:=ait_const_8bit;
-        lastlabel:=nil;
-        { const already used ? }
-        if not assigned(p^.lab_set) then
-          begin
-             { tries to found an old entry }
-             hp1:=pai(consts^.first);
-             while assigned(hp1) do
-               begin
-{$ifdef NEWLAB}
-                  if hp1^.typ=ait_symbol then
-                    lastlabel:=pasmlabel(pai_symbol(hp1)^.sym)
-{$else}
-                  if hp1^.typ=ait_label then
-                    lastlabel:=pai_label(hp1)^.l
-{$endif}
-                  else
-                    begin
-                      if (lastlabel<>nil) and (hp1^.typ=neededtyp) then
-                        begin
-                          if (hp1^.typ=ait_const_8bit) then
-                           begin
-                             { compare normal set }
-                             i:=0;
-                             while assigned(hp1) and (i<32) do
-                              begin
-                                if pai_const(hp1)^.value<>p^.value_set^[i] then
-                                 break;
-                                inc(i);
-                                hp1:=pai(hp1^.next);
-                              end;
-                             if i=32 then
-                              begin
-                                { found! }
-                                p^.lab_set:=lastlabel;
-                                break;
-                              end;
-                             { leave when the end of consts is reached, so no
-                               hp1^.next is done }
-                             if not assigned(hp1) then
-                              break;
-                           end
-                          else
-                           begin
-                             { compare small set }
-                             if plongint(p^.value_set)^=pai_const(hp1)^.value then
-                              begin
-                                { found! }
-                                p^.lab_set:=lastlabel;
-                                break;
-                              end;
-                           end;
-                        end;
-                      lastlabel:=nil;
-                    end;
-                  hp1:=pai(hp1^.next);
-               end;
-             { :-(, we must generate a new entry }
-             if not assigned(p^.lab_set) then
-               begin
-                 getdatalabel(lastlabel);
-                 p^.lab_set:=lastlabel;
-                 if (cs_smartlink in aktmoduleswitches) then
-                  consts^.concat(new(pai_cut,init));
-                 consts^.concat(new(pai_label,init(lastlabel)));
-                 if psetdef(p^.resulttype)^.settype=smallset then
-                  begin
-                    move(p^.value_set^,i,sizeof(longint));
-                    consts^.concat(new(pai_const,init_32bit(i)));
-                  end
-                 else
-                  begin
-                    for i:=0 to 31 do
-                      consts^.concat(new(pai_const,init_8bit(p^.value_set^[i])));
-                  end;
-               end;
-          end;
-        reset_reference(p^.location.reference);
-        p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_set));
-        p^.location.loc:=LOC_MEM;
-      end;
-
-
-{*****************************************************************************
-                             SecondNilN
-*****************************************************************************}
-
-    procedure secondniln(var p : ptree);
-      begin
-         p^.location.loc:=LOC_MEM;
-         p^.location.reference.is_immediate:=true;
-         p^.location.reference.offset:=0;
-      end;
-
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 assembler for constants
+
+    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 cg386con;
+interface
+
+    uses
+      tree;
+
+{$define SMALLSETORD}
+
+
+    procedure secondrealconst(var p : ptree);
+    procedure secondfixconst(var p : ptree);
+    procedure secondordconst(var p : ptree);
+    procedure secondstringconst(var p : ptree);
+    procedure secondsetconst(var p : ptree);
+    procedure secondniln(var p : ptree);
+
+
+implementation
+
+    uses
+      globtype,systems,
+      cobjects,verbose,globals,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,
+      i386base,i386asm,
+      cgai386,tgeni386;
+
+{*****************************************************************************
+                             SecondRealConst
+*****************************************************************************}
+
+    procedure secondrealconst(var p : ptree);
+      const
+        floattype2ait:array[tfloattype] of tait=
+          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_none,ait_none);
+
+      var
+         hp1 : pai;
+         lastlabel : pasmlabel;
+         realait : tait;
+      begin
+         lastlabel:=nil;
+         realait:=floattype2ait[pfloatdef(p^.resulttype)^.typ];
+         { const already used ? }
+         if not assigned(p^.lab_real) then
+           begin
+              { tries to found an old entry }
+              hp1:=pai(consts^.first);
+              while assigned(hp1) do
+                begin
+                   if hp1^.typ=ait_label then
+                     lastlabel:=pai_label(hp1)^.l
+                   else
+                     begin
+                        if (hp1^.typ=realait) and (lastlabel<>nil) then
+                          begin
+                             if(
+                                ((realait=ait_real_32bit) and (pai_real_32bit(hp1)^.value=p^.value_real)) or
+                                ((realait=ait_real_64bit) and (pai_real_64bit(hp1)^.value=p^.value_real)) or
+                                ((realait=ait_real_80bit) and (pai_real_80bit(hp1)^.value=p^.value_real)) or
+                                ((realait=ait_comp_64bit) and (pai_comp_64bit(hp1)^.value=p^.value_real))
+                               ) then
+                               begin
+                                  { found! }
+                                  p^.lab_real:=lastlabel;
+                                  break;
+                               end;
+                          end;
+                        lastlabel:=nil;
+                     end;
+                   hp1:=pai(hp1^.next);
+                end;
+              { :-(, we must generate a new entry }
+              if not assigned(p^.lab_real) then
+                begin
+                   getdatalabel(lastlabel);
+                   p^.lab_real:=lastlabel;
+                   if (cs_smartlink in aktmoduleswitches) then
+                    consts^.concat(new(pai_cut,init));
+                   consts^.concat(new(pai_label,init(lastlabel)));
+                   case realait of
+                     ait_real_32bit :
+                       consts^.concat(new(pai_real_32bit,init(p^.value_real)));
+                     ait_real_64bit :
+                       consts^.concat(new(pai_real_64bit,init(p^.value_real)));
+                     ait_real_80bit :
+                       consts^.concat(new(pai_real_80bit,init(p^.value_real)));
+                     ait_comp_64bit :
+                       consts^.concat(new(pai_comp_64bit,init(p^.value_real)));
+                   else
+                     internalerror(10120);
+                   end;
+                end;
+           end;
+         reset_reference(p^.location.reference);
+         p^.location.reference.symbol:=p^.lab_real;
+         p^.location.loc:=LOC_MEM;
+      end;
+
+
+{*****************************************************************************
+                             SecondFixConst
+*****************************************************************************}
+
+    procedure secondfixconst(var p : ptree);
+      begin
+         { an fix comma const. behaves as a memory reference }
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.is_immediate:=true;
+         p^.location.reference.offset:=p^.value_fix;
+      end;
+
+
+{*****************************************************************************
+                             SecondOrdConst
+*****************************************************************************}
+
+    procedure secondordconst(var p : ptree);
+      begin
+         { an integer const. behaves as a memory reference }
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.is_immediate:=true;
+         p^.location.reference.offset:=p^.value;
+      end;
+
+
+{*****************************************************************************
+                             SecondStringConst
+*****************************************************************************}
+
+    procedure secondstringconst(var p : ptree);
+      var
+         hp1 : pai;
+         l1,l2,
+         lastlabel   : pasmlabel;
+         pc       : pchar;
+         same_string : boolean;
+         l,j,
+         i,mylength  : longint;
+      begin
+         lastlabel:=nil;
+         { const already used ? }
+         if not assigned(p^.lab_str) then
+           begin
+              if is_shortstring(p^.resulttype) then
+               mylength:=p^.length+2
+              else
+               mylength:=p^.length+1;
+              { tries to found an old entry }
+              hp1:=pai(consts^.first);
+              while assigned(hp1) do
+                begin
+                   if hp1^.typ=ait_label then
+                     lastlabel:=pai_label(hp1)^.l
+                   else
+                     begin
+                        { when changing that code, be careful that }
+                        { you don't use typed consts, which are    }
+                        { are also written to consts           }
+                        { currently, this is no problem, because   }
+                        { typed consts have no leading length or   }
+                        { they have no trailing zero           }
+                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
+                           (pai_string(hp1)^.len=mylength) then
+                          begin
+                             same_string:=true;
+                             { if shortstring then check the length byte first and
+                               set the start index to 1 }
+                             if is_shortstring(p^.resulttype) then
+                              begin
+                                if p^.length<>ord(pai_string(hp1)^.str[0]) then
+                                 same_string:=false;
+                                j:=1;
+                              end
+                             else
+                              j:=0;
+                             { don't check if the length byte was already wrong }
+                             if same_string then
+                              begin
+                                for i:=0 to p^.length do
+                                 begin
+                                   if pai_string(hp1)^.str[j]<>p^.value_str[i] then
+                                    begin
+                                      same_string:=false;
+                                      break;
+                                    end;
+                                   inc(j);
+                                 end;
+                              end;
+                             { found ? }
+                             if same_string then
+                              begin
+                                p^.lab_str:=lastlabel;
+                                { create a new entry for ansistrings, but reuse the data }
+                                if (p^.stringtype in [st_ansistring,st_widestring]) then
+                                 begin
+                                   getdatalabel(l2);
+                                   consts^.concat(new(pai_label,init(l2)));
+                                   consts^.concat(new(pai_const_symbol,init(p^.lab_str)));
+                                   { return the offset of the real string }
+                                   p^.lab_str:=l2;
+                                 end;
+                                break;
+                              end;
+                          end;
+                        lastlabel:=nil;
+                     end;
+                   hp1:=pai(hp1^.next);
+                end;
+              { :-(, we must generate a new entry }
+              if not assigned(p^.lab_str) then
+                begin
+                   getdatalabel(lastlabel);
+                   p^.lab_str:=lastlabel;
+                   if (cs_smartlink in aktmoduleswitches) then
+                    consts^.concat(new(pai_cut,init));
+                   consts^.concat(new(pai_label,init(lastlabel)));
+                   { generate an ansi string ? }
+                   case p^.stringtype of
+                      st_ansistring:
+                        begin
+                           { an empty ansi string is nil! }
+                           if p^.length=0 then
+                             consts^.concat(new(pai_const,init_32bit(0)))
+                           else
+                             begin
+                                getdatalabel(l1);
+                                getdatalabel(l2);
+                                consts^.concat(new(pai_label,init(l2)));
+                                consts^.concat(new(pai_const_symbol,init(l1)));
+                                consts^.concat(new(pai_const,init_32bit(p^.length)));
+                                consts^.concat(new(pai_const,init_32bit(p^.length)));
+                                consts^.concat(new(pai_const,init_32bit(-1)));
+                                consts^.concat(new(pai_label,init(l1)));
+                                getmem(pc,p^.length+2);
+                                move(p^.value_str^,pc^,p^.length);
+                                pc[p^.length]:=#0;
+                                { to overcome this problem we set the length explicitly }
+                                { with the ending null char }
+                                consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
+                                { return the offset of the real string }
+                                p^.lab_str:=l2;
+                             end;
+                        end;
+                      st_shortstring:
+                        begin
+                          { truncate strings larger than 255 chars }
+                          if p^.length>255 then
+                           l:=255
+                          else
+                           l:=p^.length;
+                          { also length and terminating zero }
+                          getmem(pc,l+3);
+                          move(p^.value_str^,pc[1],l+1);
+                          pc[0]:=chr(l);
+                          { to overcome this problem we set the length explicitly }
+                          { with the ending null char }
+                          pc[l+1]:=#0;
+                          consts^.concat(new(pai_string,init_length_pchar(pc,l+2)));
+                        end;
+                   end;
+                end;
+           end;
+         reset_reference(p^.location.reference);
+         p^.location.reference.symbol:=p^.lab_str;
+         p^.location.loc:=LOC_MEM;
+      end;
+
+
+{*****************************************************************************
+                             SecondSetCons
+*****************************************************************************}
+
+    procedure secondsetconst(var p : ptree);
+      var
+         hp1     : pai;
+         lastlabel   : pasmlabel;
+         i         : longint;
+         neededtyp   : tait;
+      begin
+{$ifdef SMALLSETORD}
+        { small sets are loaded as constants }
+        if psetdef(p^.resulttype)^.settype=smallset then
+         begin
+           p^.location.loc:=LOC_MEM;
+           p^.location.reference.is_immediate:=true;
+           p^.location.reference.offset:=plongint(p^.value_set)^;
+           exit;
+         end;
+{$endif}
+        if psetdef(p^.resulttype)^.settype=smallset then
+         neededtyp:=ait_const_32bit
+        else
+         neededtyp:=ait_const_8bit;
+        lastlabel:=nil;
+        { const already used ? }
+        if not assigned(p^.lab_set) then
+          begin
+             { tries to found an old entry }
+             hp1:=pai(consts^.first);
+             while assigned(hp1) do
+               begin
+                  if hp1^.typ=ait_label then
+                    lastlabel:=pai_label(hp1)^.l
+                  else
+                    begin
+                      if (lastlabel<>nil) and (hp1^.typ=neededtyp) then
+                        begin
+                          if (hp1^.typ=ait_const_8bit) then
+                           begin
+                             { compare normal set }
+                             i:=0;
+                             while assigned(hp1) and (i<32) do
+                              begin
+                                if pai_const(hp1)^.value<>p^.value_set^[i] then
+                                 break;
+                                inc(i);
+                                hp1:=pai(hp1^.next);
+                              end;
+                             if i=32 then
+                              begin
+                                { found! }
+                                p^.lab_set:=lastlabel;
+                                break;
+                              end;
+                             { leave when the end of consts is reached, so no
+                               hp1^.next is done }
+                             if not assigned(hp1) then
+                              break;
+                           end
+                          else
+                           begin
+                             { compare small set }
+                             if plongint(p^.value_set)^=pai_const(hp1)^.value then
+                              begin
+                                { found! }
+                                p^.lab_set:=lastlabel;
+                                break;
+                              end;
+                           end;
+                        end;
+                      lastlabel:=nil;
+                    end;
+                  hp1:=pai(hp1^.next);
+               end;
+             { :-(, we must generate a new entry }
+             if not assigned(p^.lab_set) then
+               begin
+                 getdatalabel(lastlabel);
+                 p^.lab_set:=lastlabel;
+                 if (cs_smartlink in aktmoduleswitches) then
+                  consts^.concat(new(pai_cut,init));
+                 consts^.concat(new(pai_label,init(lastlabel)));
+                 if psetdef(p^.resulttype)^.settype=smallset then
+                  begin
+                    move(p^.value_set^,i,sizeof(longint));
+                    consts^.concat(new(pai_const,init_32bit(i)));
+                  end
+                 else
+                  begin
+                    for i:=0 to 31 do
+                      consts^.concat(new(pai_const,init_8bit(p^.value_set^[i])));
+                  end;
+               end;
+          end;
+        reset_reference(p^.location.reference);
+        p^.location.reference.symbol:=p^.lab_set;
+        p^.location.loc:=LOC_MEM;
+      end;
+
+
+{*****************************************************************************
+                             SecondNilN
+*****************************************************************************}
+
+    procedure secondniln(var p : ptree);
+      begin
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.is_immediate:=true;
+         p^.location.reference.offset:=0;
+      end;
+
+
+end.
+{
   $Log$
-  Revision 1.35  1999-05-21 13:54:47  peter
+  Revision 1.36  1999-05-27 19:44:10  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.35  1999/05/21 13:54:47  peter
     * NEWLAB for label as symbol
-
-  Revision 1.34  1999/05/12 00:19:41  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.33  1999/05/06 09:05:12  peter
-    * generic write_float and str_float
-    * fixed constant float conversions
-
-  Revision 1.32  1999/05/01 13:24:06  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.31  1999/04/07 15:16:43  pierre
-   * zero length string were generated multiple times
-
-  Revision 1.30  1999/03/31 13:51:49  peter
-    * shortstring reuse fixed
-
-  Revision 1.29  1999/02/25 21:02:25  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.28  1999/02/22 02:15:08  peter
-    * updates for ag386bin
-
-  Revision 1.27  1999/01/19 14:21:59  peter
-    * shortstring truncated after 255 chars
-
-  Revision 1.26  1998/12/11 00:02:49  peter
-    + globtype,tokens,version unit splitted from globals
-
-  Revision 1.25  1998/12/10 14:39:30  florian
-    * bug with p(const a : ansistring) fixed
-    * duplicate constant ansistrings were handled wrong, fixed
-
-  Revision 1.24  1998/11/28 15:36:02  michael
-  Fixed generation of constant ansistrings
-
-  Revision 1.23  1998/11/26 14:39:12  peter
-    * ansistring -> pchar fixed
-    * ansistring constants fixed
-    * ansistring constants are now written once
-
-  Revision 1.22  1998/11/24 13:40:59  peter
-    * release smallsetord, so small sets constant are handled like longints
-
-  Revision 1.21  1998/11/24 12:52:41  peter
-    * sets are not written twice anymore
-    * optimize for emptyset+single element which uses a new routine from
-      set.inc FPC_SET_CREATE_ELEMENT
-
-  Revision 1.20  1998/11/16 12:11:29  peter
-    * fixed ansistring crash
-
-  Revision 1.19  1998/11/05 23:40:45  pierre
-   * fix for const strings
-
-  Revision 1.18  1998/11/05 15:26:38  pierre
-   * fix for missing zero after string const
-
-  Revision 1.17  1998/11/05 12:02:32  peter
-    * released useansistring
-    * removed -Sv, its now available in fpc modes
-
-  Revision 1.16  1998/11/04 21:07:43  michael
-  * undid peters change. Constant ansistrings should end on null too cd ..
-
-  Revision 1.15  1998/11/04 10:11:36  peter
-    * ansistring fixes
-
-  Revision 1.14  1998/09/17 09:42:13  peter
-    + pass_2 for cg386
-    * Message() -> CGMessage() for pass_1/pass_2
-
-  Revision 1.13  1998/09/07 18:45:53  peter
-    * update smartlinking, uses getdatalabel
-    * renamed ptree.value vars to value_str,value_real,value_set
-
-  Revision 1.12  1998/08/28 10:56:57  peter
-    * removed warnings
-
-  Revision 1.11  1998/08/14 18:18:39  peter
-    + dynamic set contruction
-    * smallsets are now working (always longint size)
-
-  Revision 1.10  1998/08/04 13:22:46  pierre
-    * weird bug fixed :
-      a pchar ' ' (simple space or any other letter) was found to
-      be equal to a string of length zero !!!
-      thus printing out non sense
-      found that out while checking Control-C !!
-    + added column info also in RHIDE format as
-      it might be usefull later
-
-  Revision 1.9  1998/07/20 18:40:10  florian
-    * handling of ansi string constants should now work
-
-  Revision 1.8  1998/07/20 10:23:00  florian
-    * better ansi string assignement
-
-  Revision 1.7  1998/07/18 22:54:25  florian
-    * some ansi/wide/longstring support fixed:
-       o parameter passing
-       o returning as result from functions
-
-  Revision 1.6  1998/07/18 17:11:07  florian
-    + ansi string constants fixed
-    + switch $H partial implemented
-
-  Revision 1.5  1998/06/25 08:48:07  florian
-    * first version of rtti support
-
-  Revision 1.4  1998/06/08 13:13:31  pierre
-    + temporary variables now in temp_gen.pas unit
-      because it is processor independent
-    * mppc68k.bat modified to undefine i386 and support_mmx
-      (which are defaults for i386)
-
-  Revision 1.3  1998/06/05 17:44:11  peter
-    * splitted cgi386
-
-  Revision 1.2  1998/06/05 16:13:31  pierre
-    * fix for real and string consts inside inlined procs
-
-  Revision 1.1  1998/05/23 01:21:02  peter
-    + aktasmmode, aktoptprocessor, aktoutputformat
-    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
-    + $LIBNAME to set the library name where the unit will be put in
-    * splitted cgi386 a bit (codeseg to large for bp7)
-    * nasm, tasm works again. nasm moved to ag386nsm.pas
-
-}
+
+  Revision 1.34  1999/05/12 00:19:41  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.33  1999/05/06 09:05:12  peter
+    * generic write_float and str_float
+    * fixed constant float conversions
+
+  Revision 1.32  1999/05/01 13:24:06  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.31  1999/04/07 15:16:43  pierre
+   * zero length string were generated multiple times
+
+  Revision 1.30  1999/03/31 13:51:49  peter
+    * shortstring reuse fixed
+
+  Revision 1.29  1999/02/25 21:02:25  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.28  1999/02/22 02:15:08  peter
+    * updates for ag386bin
+
+  Revision 1.27  1999/01/19 14:21:59  peter
+    * shortstring truncated after 255 chars
+
+  Revision 1.26  1998/12/11 00:02:49  peter
+    + globtype,tokens,version unit splitted from globals
+
+  Revision 1.25  1998/12/10 14:39:30  florian
+    * bug with p(const a : ansistring) fixed
+    * duplicate constant ansistrings were handled wrong, fixed
+
+  Revision 1.24  1998/11/28 15:36:02  michael
+  Fixed generation of constant ansistrings
+
+  Revision 1.23  1998/11/26 14:39:12  peter
+    * ansistring -> pchar fixed
+    * ansistring constants fixed
+    * ansistring constants are now written once
+
+  Revision 1.22  1998/11/24 13:40:59  peter
+    * release smallsetord, so small sets constant are handled like longints
+
+  Revision 1.21  1998/11/24 12:52:41  peter
+    * sets are not written twice anymore
+    * optimize for emptyset+single element which uses a new routine from
+      set.inc FPC_SET_CREATE_ELEMENT
+
+  Revision 1.20  1998/11/16 12:11:29  peter
+    * fixed ansistring crash
+
+  Revision 1.19  1998/11/05 23:40:45  pierre
+   * fix for const strings
+
+  Revision 1.18  1998/11/05 15:26:38  pierre
+   * fix for missing zero after string const
+
+  Revision 1.17  1998/11/05 12:02:32  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.16  1998/11/04 21:07:43  michael
+  * undid peters change. Constant ansistrings should end on null too cd ..
+
+  Revision 1.15  1998/11/04 10:11:36  peter
+    * ansistring fixes
+
+  Revision 1.14  1998/09/17 09:42:13  peter
+    + pass_2 for cg386
+    * Message() -> CGMessage() for pass_1/pass_2
+
+  Revision 1.13  1998/09/07 18:45:53  peter
+    * update smartlinking, uses getdatalabel
+    * renamed ptree.value vars to value_str,value_real,value_set
+
+  Revision 1.12  1998/08/28 10:56:57  peter
+    * removed warnings
+
+  Revision 1.11  1998/08/14 18:18:39  peter
+    + dynamic set contruction
+    * smallsets are now working (always longint size)
+
+  Revision 1.10  1998/08/04 13:22:46  pierre
+    * weird bug fixed :
+      a pchar ' ' (simple space or any other letter) was found to
+      be equal to a string of length zero !!!
+      thus printing out non sense
+      found that out while checking Control-C !!
+    + added column info also in RHIDE format as
+      it might be usefull later
+
+  Revision 1.9  1998/07/20 18:40:10  florian
+    * handling of ansi string constants should now work
+
+  Revision 1.8  1998/07/20 10:23:00  florian
+    * better ansi string assignement
+
+  Revision 1.7  1998/07/18 22:54:25  florian
+    * some ansi/wide/longstring support fixed:
+       o parameter passing
+       o returning as result from functions
+
+  Revision 1.6  1998/07/18 17:11:07  florian
+    + ansi string constants fixed
+    + switch $H partial implemented
+
+  Revision 1.5  1998/06/25 08:48:07  florian
+    * first version of rtti support
+
+  Revision 1.4  1998/06/08 13:13:31  pierre
+    + temporary variables now in temp_gen.pas unit
+      because it is processor independent
+    * mppc68k.bat modified to undefine i386 and support_mmx
+      (which are defaults for i386)
+
+  Revision 1.3  1998/06/05 17:44:11  peter
+    * splitted cgi386
+
+  Revision 1.2  1998/06/05 16:13:31  pierre
+    * fix for real and string consts inside inlined procs
+
+  Revision 1.1  1998/05/23 01:21:02  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+}

compiler/cg386flw.pas

@@ -1,941 +1,941 @@
-{
-    $Id$
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Generate i386 assembler for nodes that influence the flow
-
-    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 cg386flw;
-interface
-
-    uses
-      tree;
-
-    procedure second_while_repeatn(var p : ptree);
-    procedure secondifn(var p : ptree);
-    procedure secondfor(var p : ptree);
-    procedure secondexitn(var p : ptree);
-    procedure secondbreakn(var p : ptree);
-    procedure secondcontinuen(var p : ptree);
-    procedure secondgoto(var p : ptree);
-    procedure secondlabel(var p : ptree);
-    procedure secondraise(var p : ptree);
-    procedure secondtryexcept(var p : ptree);
-    procedure secondtryfinally(var p : ptree);
-    procedure secondon(var p : ptree);
-    procedure secondfail(var p : ptree);
-
-
-implementation
-
-    uses
-      cobjects,verbose,globals,systems,
-      symtable,aasm,types,
-      hcodegen,temp_gen,pass_2,
-{$ifndef OLDASM}
-      i386base,i386asm,
-{$else}
-      i386,
-{$endif}
-      cgai386,tgeni386;
-
-{*****************************************************************************
-                         Second_While_RepeatN
-*****************************************************************************}
-
-    procedure second_while_repeatn(var p : ptree);
-      var
-         lcont,lbreak,lloop,
-         oldclabel,oldblabel : plabel;
-         otlabel,oflabel : plabel;
-
-      begin
-         getlabel(lloop);
-         getlabel(lcont);
-         getlabel(lbreak);
-         { arrange continue and breaklabels: }
-         oldclabel:=aktcontinuelabel;
-         oldblabel:=aktbreaklabel;
-
-         { handling code at the end as it is much more efficient, and makes
-           while equal to repeat loop, only the end true/false is swapped (PFV) }
-         if p^.treetype=whilen then
-          emitjmp(C_None,lcont);
-
-         emitlab(lloop);
-
-         aktcontinuelabel:=lcont;
-         aktbreaklabel:=lbreak;
-         cleartempgen;
-         if assigned(p^.right) then
-           secondpass(p^.right);
-         emitlab(lcont);
-         otlabel:=truelabel;
-         oflabel:=falselabel;
-         if p^.treetype=whilen then
-          begin
-            truelabel:=lloop;
-            falselabel:=lbreak;
-          end
-         { repeatn }
-         else
-          begin
-            truelabel:=lbreak;
-            falselabel:=lloop;
-          end;
-         cleartempgen;
-         secondpass(p^.left);
-         maketojumpbool(p^.left);
-         emitlab(lbreak);
-         freelabel(lloop);
-         freelabel(lcont);
-         freelabel(lbreak);
-         truelabel:=otlabel;
-         falselabel:=oflabel;
-
-         aktcontinuelabel:=oldclabel;
-         aktbreaklabel:=oldblabel;
-      end;
-
-
-{*****************************************************************************
-                               SecondIfN
-*****************************************************************************}
-
-    procedure secondifn(var p : ptree);
-
-      var
-         hl,otlabel,oflabel : plabel;
-
-      begin
-         otlabel:=truelabel;
-         oflabel:=falselabel;
-         getlabel(truelabel);
-         getlabel(falselabel);
-         cleartempgen;
-         secondpass(p^.left);
-         maketojumpbool(p^.left);
-         if assigned(p^.right) then
-           begin
-              emitlab(truelabel);
-              cleartempgen;
-              secondpass(p^.right);
-           end;
-         if assigned(p^.t1) then
-           begin
-              if assigned(p^.right) then
-                begin
-                   getlabel(hl);
-                   { do go back to if line !! }
-                   aktfilepos:=exprasmlist^.getlasttaifilepos^;
-                   emitjmp(C_None,hl);
-                end;
-              emitlab(falselabel);
-              cleartempgen;
-              secondpass(p^.t1);
-              if assigned(p^.right) then
-                emitlab(hl);
-           end
-         else
-           begin
-              emitlab(falselabel);
-           end;
-         if not(assigned(p^.right)) then
-           begin
-              emitlab(truelabel);
-           end;
-         freelabel(truelabel);
-         freelabel(falselabel);
-         truelabel:=otlabel;
-         falselabel:=oflabel;
-      end;
-
-
-{*****************************************************************************
-                              SecondFor
-*****************************************************************************}
-
-    procedure secondfor(var p : ptree);
-      var
-         l3,oldclabel,oldblabel : plabel;
-         omitfirstcomp,temptovalue : boolean;
-         hs : byte;
-         temp1 : treference;
-         hop : tasmop;
-         hcond : tasmcond;
-         cmpreg,cmp32 : tregister;
-         opsize : topsize;
-         count_var_is_signed : boolean;
-
-      begin
-         oldclabel:=aktcontinuelabel;
-         oldblabel:=aktbreaklabel;
-         getlabel(aktcontinuelabel);
-         getlabel(aktbreaklabel);
-         getlabel(l3);
-
-         { could we spare the first comparison ? }
-             omitfirstcomp:=false;
-         if p^.right^.treetype=ordconstn then
-           if p^.left^.right^.treetype=ordconstn then
-             omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
-               or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));
-
-         { only calculate reference }
-         cleartempgen;
-         secondpass(p^.t2);
-{$ifndef OLDFORVER}
-         hs:=p^.t2^.resulttype^.size;
-         cmp32:=getregister32;
-             case hs of
-            1 : begin
-                   opsize:=S_B;
-                   cmpreg:=reg32toreg8(cmp32);
-                end;
-            2 : begin
-                   opsize:=S_W;
-                   cmpreg:=reg32toreg16(cmp32);
-                end;
-            4 : begin
-                   opsize:=S_L;
-                   cmpreg:=cmp32;
-                end;
-         end;
-         (*
-         if not(simple_loadn) then
-          CGMessage(cg_e_illegal_count_var);
-         already done in firstfor !! *)
-
-         { first set the to value
-           because the count var can be in the expression !! }
-         cleartempgen;
-         secondpass(p^.right);
-         { calculate pointer value and check if changeable and if so }
-         { load into temporary variable                              }
-         if p^.right^.treetype<>ordconstn then
-           begin
-              temp1.symbol:=nil;
-              gettempofsizereference(hs,temp1);
-              temptovalue:=true;
-              if (p^.right^.location.loc=LOC_REGISTER) or
-                 (p^.right^.location.loc=LOC_CREGISTER) then
-                begin
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,p^.right^.location.register,
-                      newreference(temp1))));
-                 end
-              else
-                 concatcopy(p^.right^.location.reference,temp1,hs,false,false);
-           end
-         else temptovalue:=false;
-{$endif OLDFORVER}
-
-         { produce start assignment }
-         cleartempgen;
-         secondpass(p^.left);
-         count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
-{$ifdef OLDFORVER}
-         hs:=p^.t2^.resulttype^.size;
-         cmp32:=getregister32;
-             case hs of
-            1 : begin
-                   opsize:=S_B;
-                   cmpreg:=reg32toreg8(cmp32);
-                end;
-            2 : begin
-                   opsize:=S_W;
-                   cmpreg:=reg32toreg16(cmp32);
-                end;
-            4 : begin
-                   opsize:=S_L;
-                   cmpreg:=cmp32;
-                end;
-         end;
-         cleartempgen;
-         secondpass(p^.right);
-         { calculate pointer value and check if changeable and if so }
-         { load into temporary variable                              }
-         if p^.right^.treetype<>ordconstn then
-           begin
-              temp1.symbol:=nil;
-              gettempofsizereference(hs,temp1);
-              temptovalue:=true;
-              if (p^.right^.location.loc=LOC_REGISTER) or
-                 (p^.right^.location.loc=LOC_CREGISTER) then
-                begin
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,p^.right^.location.register,
-                      newreference(temp1))));
-                 end
-              else
-                 concatcopy(p^.right^.location.reference,temp1,hs,false,false);
-           end
-         else temptovalue:=false;
-
-{$endif OLDFORVER}
-         if temptovalue then
-             begin
-              if p^.t2^.location.loc=LOC_CREGISTER then
-                begin
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
-                     p^.t2^.location.register)));
-                end
-              else
-                begin
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
-                     cmpreg)));
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
-                     cmpreg)));
-                end;
-           end
-         else
-             begin
-              if not(omitfirstcomp) then
-                begin
-                   if p^.t2^.location.loc=LOC_CREGISTER then
-                     exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^.right^.value,
-                       p^.t2^.location.register)))
-                   else
-                     exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,opsize,p^.right^.value,
-                 newreference(p^.t2^.location.reference))));
-                end;
-           end;
-         if p^.backward then
-           if count_var_is_signed then
-             hcond:=C_L
-           else
-             hcond:=C_B
-         else
-           if count_var_is_signed then
-             hcond:=C_G
-           else
-             hcond:=C_A;
-
-         if not(omitfirstcomp) or temptovalue then
-           emitjmp(hcond,aktbreaklabel);
-
-         emitlab(l3);
-
-         { help register must not be in instruction block }
-         cleartempgen;
-         if assigned(p^.t1) then
-           secondpass(p^.t1);
-
-         emitlab(aktcontinuelabel);
-
-         { makes no problems there }
-         cleartempgen;
-
-         { demand help register again }
-         cmp32:=getregister32;
-         case hs of
-            1 : begin
-                   opsize:=S_B;
-                   cmpreg:=reg32toreg8(cmp32);
-                end;
-            2 : begin
-                   opsize:=S_W;
-                   cmpreg:=reg32toreg16(cmp32);
-                end;
-            4 : opsize:=S_L;
-         end;
-
-          { produce comparison and the corresponding }
-         { jump                                     }
-         if temptovalue then
-           begin
-              if p^.t2^.location.loc=LOC_CREGISTER then
-                begin
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
-                     p^.t2^.location.register)));
-                end
-              else
-                begin
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
-                     cmpreg)));
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
-                     cmpreg)));
-                    end;
-           end
-         else
-           begin
-              if p^.t2^.location.loc=LOC_CREGISTER then
-                exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^.right^.value,
-                  p^.t2^.location.register)))
-              else
-                 exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,opsize,p^.right^.value,
-                   newreference(p^.t2^.location.reference))));
-           end;
-         if p^.backward then
-           if count_var_is_signed then
-             hcond:=C_LE
-           else
-             hcond:=C_BE
-          else
-            if count_var_is_signed then
-              hcond:=C_GE
-            else
-              hcond:=C_AE;
-         emitjmp(hcond,aktbreaklabel);
-         { according to count direction DEC or INC... }
-         { must be after the test because of 0to 255 for bytes !! }
-         if p^.backward then
-           hop:=A_DEC
-         else
-           hop:=A_INC;
-
-         if p^.t2^.location.loc=LOC_CREGISTER then
-           exprasmlist^.concat(new(pai386,op_reg(hop,opsize,p^.t2^.location.register)))
-         else
-             exprasmlist^.concat(new(pai386,op_ref(hop,opsize,newreference(p^.t2^.location.reference))));
-         emitjmp(C_None,l3);
-
-           { this is the break label: }
-         emitlab(aktbreaklabel);
-         ungetregister32(cmp32);
-
-         if temptovalue then
-           ungetiftemp(temp1);
-
-         freelabel(aktcontinuelabel);
-         freelabel(aktbreaklabel);
-         freelabel(l3);
-         aktcontinuelabel:=oldclabel;
-         aktbreaklabel:=oldblabel;
-      end;
-
-
-{*****************************************************************************
-                              SecondExitN
-*****************************************************************************}
-
-    procedure secondexitn(var p : ptree);
-      var
-         is_mem : boolean;
-         {op : tasmop;
-         s : topsize;}
-         otlabel,oflabel : plabel;
-      label
-         do_jmp;
-      begin
-         if assigned(p^.left) then
-           begin
-              otlabel:=truelabel;
-              oflabel:=falselabel;
-              getlabel(truelabel);
-              getlabel(falselabel);
-              secondpass(p^.left);
-              case p^.left^.location.loc of
-                 LOC_FPU : goto do_jmp;
-                 LOC_MEM,
-           LOC_REFERENCE : is_mem:=true;
-           LOC_CREGISTER,
-            LOC_REGISTER : is_mem:=false;
-               LOC_FLAGS : begin
-                             emit_flag2reg(p^.left^.location.resflags,R_AL);
-                             goto do_jmp;
-                           end;
-                LOC_JUMP : begin
-                             emitlab(truelabel);
-                             exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,1,R_AL)));
-                             emitjmp(C_None,aktexit2label);
-                             emitlab(falselabel);
-                             exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,R_AL,R_AL)));
-                             goto do_jmp;
-                           end;
-              else
-                internalerror(2001);
-              end;
-              case procinfo.retdef^.deftype of
-               orddef,
-              enumdef : begin
-                          case procinfo.retdef^.size of
-                           4 : if is_mem then
-                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                   newreference(p^.left^.location.reference),R_EAX)))
-                               else
-                                 emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
-                           2 : if is_mem then
-                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
-                                   newreference(p^.left^.location.reference),R_AX)))
-                               else
-                                 emit_reg_reg(A_MOV,S_W,makereg16(p^.left^.location.register),R_AX);
-                           1 : if is_mem then
-                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
-                                   newreference(p^.left^.location.reference),R_AL)))
-                               else
-                                 emit_reg_reg(A_MOV,S_B,makereg8(p^.left^.location.register),R_AL);
-                          end;
-                        end;
-           pointerdef,
-           procvardef : begin
-                          if is_mem then
-                            exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                              newreference(p^.left^.location.reference),R_EAX)))
-                          else
-                            exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
-                              p^.left^.location.register,R_EAX)));
-                        end;
-             floatdef : begin
-                          if pfloatdef(procinfo.retdef)^.typ=f32bit then
-                           begin
-                             if is_mem then
-                               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                 newreference(p^.left^.location.reference),R_EAX)))
-                             else
-                               emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
-                           end
-                          else
-                           if is_mem then
-                            floatload(pfloatdef(procinfo.retdef)^.typ,p^.left^.location.reference);
-                        end;
-              end;
-do_jmp:
-              freelabel(truelabel);
-              freelabel(falselabel);
-              truelabel:=otlabel;
-              falselabel:=oflabel;
-              emitjmp(C_None,aktexit2label);
-           end
-         else
-           begin
-              emitjmp(C_None,aktexitlabel);
-           end;
-       end;
-
-
-{*****************************************************************************
-                              SecondBreakN
-*****************************************************************************}
-
-    procedure secondbreakn(var p : ptree);
-      begin
-         if aktbreaklabel<>nil then
-           emitjmp(C_None,aktbreaklabel)
-         else
-           CGMessage(cg_e_break_not_allowed);
-      end;
-
-
-{*****************************************************************************
-                              SecondContinueN
-*****************************************************************************}
-
-    procedure secondcontinuen(var p : ptree);
-      begin
-         if aktcontinuelabel<>nil then
-           emitjmp(C_None,aktcontinuelabel)
-         else
-           CGMessage(cg_e_continue_not_allowed);
-      end;
-
-
-{*****************************************************************************
-                             SecondGoto
-*****************************************************************************}
-
-    procedure secondgoto(var p : ptree);
-
-       begin
-         emitjmp(C_None,p^.labelnr);
-       end;
-
-
-{*****************************************************************************
-                             SecondLabel
-*****************************************************************************}
-
-    procedure secondlabel(var p : ptree);
-      begin
-         emitlab(p^.labelnr);
-         cleartempgen;
-         secondpass(p^.left);
-      end;
-
-
-{*****************************************************************************
-                             SecondRaise
-*****************************************************************************}
-
-    procedure secondraise(var p : ptree);
-
-      var
-         a : plabel;
-
-      begin
-         if assigned(p^.left) then
-           begin
-              { generate the address }
-              if assigned(p^.right) then
-                begin
-                   secondpass(p^.right);
-                   if codegenerror then
-                     exit;
-                end
-              else
-                begin
-                   getlabel(a);
-                   emitlab(a);
-                   exprasmlist^.concat(new(pai386,
-                     op_sym(A_PUSH,S_L,newasmsymbol(lab2str(a)))));
-                end;
-              secondpass(p^.left);
-              if codegenerror then
-                exit;
-
-              case p^.left^.location.loc of
-                 LOC_MEM,LOC_REFERENCE:
-                   exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,
-                       newreference(p^.left^.location.reference))));
-                 LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
-                       p^.left^.location.register)));
-                 else CGMessage(type_e_mismatch);
-              end;
-              emitcall('FPC_RAISEEXCEPTION',true);
-             end
-           else
-             begin
-                emitcall('FPC_RERAISE',true);
-             end;
-       end;
-
-
-{*****************************************************************************
-                             SecondTryExcept
-*****************************************************************************}
-
-    var
-       endexceptlabel : plabel;
-
-    procedure secondtryexcept(var p : ptree);
-
-      var
-         exceptlabel,doexceptlabel,oldendexceptlabel,
-         lastonlabel : plabel;
-
-      begin
-         { this can be called recursivly }
-         oldendexceptlabel:=endexceptlabel;
-         { we modify EAX }
-         usedinproc:=usedinproc or ($80 shr byte(R_EAX));
-
-         getlabel(exceptlabel);
-         getlabel(doexceptlabel);
-         getlabel(endexceptlabel);
-         getlabel(lastonlabel);
-         push_int (1); { push type of exceptionframe }
-         emitcall('FPC_PUSHEXCEPTADDR',true);
-         exprasmlist^.concat(new(pai386,
-           op_reg(A_PUSH,S_L,R_EAX)));
-         emitcall('FPC_SETJMP',true);
-         exprasmlist^.concat(new(pai386,
-           op_reg(A_PUSH,S_L,R_EAX)));
-         exprasmlist^.concat(new(pai386,
-           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-         emitjmp(C_NE,exceptlabel);
-
-         { try code }
-         secondpass(p^.left);
-         if codegenerror then
-           exit;
-
-         emitlab(exceptlabel);
-         exprasmlist^.concat(new(pai386,
-           op_reg(A_POP,S_L,R_EAX)));
-         exprasmlist^.concat(new(pai386,
-           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-         emitjmp(C_NE,doexceptlabel);
-         emitcall('FPC_POPADDRSTACK',true);
-         emitjmp(C_None,endexceptlabel);
-         emitlab(doexceptlabel);
-
-         if assigned(p^.right) then
-           secondpass(p^.right);
-
-         emitlab(lastonlabel);
-         { default handling }
-         if assigned(p^.t1) then
-           begin
-              { FPC_CATCHES must be called with
-                'default handler' flag (=-1)
-              }
-              push_int (-1);
-              emitcall('FPC_CATCHES',true);
-              secondpass(p^.t1);
-           end
-         else
-           emitcall('FPC_RERAISE',true);
-         emitlab(endexceptlabel);
-         freelabel(exceptlabel);
-         freelabel(doexceptlabel);
-         freelabel(endexceptlabel);
-         freelabel(lastonlabel);
-         endexceptlabel:=oldendexceptlabel;
-      end;
-
-    procedure secondon(var p : ptree);
-
-      var
-         nextonlabel : plabel;
-         ref : treference;
-
-      begin
-         getlabel(nextonlabel);
-
-         { push the vmt }
-         exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
-           newasmsymbol(p^.excepttype^.vmt_mangledname))));
-{$ifndef NEWLAB}
-         maybe_concat_external(p^.excepttype^.owner,
-           p^.excepttype^.vmt_mangledname);
-{$endif}
-         emitcall('FPC_CATCHES',true);
-         exprasmlist^.concat(new(pai386,
-           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-         emitjmp(C_E,nextonlabel);
-         ref.symbol:=nil;
-         gettempofsizereference(4,ref);
-
-         { what a hack ! }
-         if assigned(p^.exceptsymtable) then
-           pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset;
-
-         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
-           R_EAX,newreference(ref))));
-
-         if assigned(p^.right) then
-           secondpass(p^.right);
-         exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,
-           newreference(ref))));
-         emitcall('FPC_DESTROYEXCEPTION',true);
-
-         { clear some stuff }
-         ungetiftemp(ref);
-         emitjmp(C_None,endexceptlabel);
-         emitlab(nextonlabel);
-         { next on node }
-         if assigned(p^.left) then
-           secondpass(p^.left);
-      end;
-
-{*****************************************************************************
-                             SecondTryFinally
-*****************************************************************************}
-
-    procedure secondtryfinally(var p : ptree);
-
-      var
-         finallylabel,noreraiselabel : plabel;
-
-      begin
-         { we modify EAX }
-         usedinproc:=usedinproc or ($80 shr byte(R_EAX));
-
-         getlabel(finallylabel);
-         getlabel(noreraiselabel);
-         push_int(1); { Type of stack-frame must be pushed}
-         emitcall('FPC_PUSHEXCEPTADDR',true);
-         exprasmlist^.concat(new(pai386,
-           op_reg(A_PUSH,S_L,R_EAX)));
-         emitcall('FPC_SETJMP',true);
-         exprasmlist^.concat(new(pai386,
-           op_reg(A_PUSH,S_L,R_EAX)));
-         exprasmlist^.concat(new(pai386,
-           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-         emitjmp(C_NE,finallylabel);
-
-         { try code }
-         secondpass(p^.left);
-         if codegenerror then
-           exit;
-
-         emitlab(finallylabel);
-
-         { finally code }
-         secondpass(p^.right);
-         if codegenerror then
-           exit;
-         exprasmlist^.concat(new(pai386,
-           op_reg(A_POP,S_L,R_EAX)));
-         exprasmlist^.concat(new(pai386,
-           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
-         emitjmp(C_E,noreraiselabel);
-         emitcall('FPC_RERAISE',true);
-         emitlab(noreraiselabel);
-         emitcall('FPC_POPADDRSTACK',true);
-      end;
-
-
-{*****************************************************************************
-                             SecondFail
-*****************************************************************************}
-
-    procedure secondfail(var p : ptree);
-      var
-        hp : preference;
-      begin
-         exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
-         { also reset to zero in the stack }
-         new(hp);
-         reset_reference(hp^);
-         hp^.offset:=procinfo.ESI_offset;
-         hp^.base:=procinfo.framepointer;
-         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_ESI,hp)));
-         emitjmp(C_None,quickexitlabel);
-      end;
-
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 assembler for nodes that influence the flow
+
+    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 cg386flw;
+interface
+
+    uses
+      tree;
+
+    procedure second_while_repeatn(var p : ptree);
+    procedure secondifn(var p : ptree);
+    procedure secondfor(var p : ptree);
+    procedure secondexitn(var p : ptree);
+    procedure secondbreakn(var p : ptree);
+    procedure secondcontinuen(var p : ptree);
+    procedure secondgoto(var p : ptree);
+    procedure secondlabel(var p : ptree);
+    procedure secondraise(var p : ptree);
+    procedure secondtryexcept(var p : ptree);
+    procedure secondtryfinally(var p : ptree);
+    procedure secondon(var p : ptree);
+    procedure secondfail(var p : ptree);
+
+
+implementation
+
+    uses
+      cobjects,verbose,globals,systems,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,
+      i386base,i386asm,
+      cgai386,tgeni386;
+
+{*****************************************************************************
+                         Second_While_RepeatN
+*****************************************************************************}
+
+    procedure second_while_repeatn(var p : ptree);
+      var
+         lcont,lbreak,lloop,
+         oldclabel,oldblabel : pasmlabel;
+         otlabel,oflabel : pasmlabel;
+
+      begin
+         getlabel(lloop);
+         getlabel(lcont);
+         getlabel(lbreak);
+         { arrange continue and breaklabels: }
+         oldclabel:=aktcontinuelabel;
+         oldblabel:=aktbreaklabel;
+
+         { handling code at the end as it is much more efficient, and makes
+           while equal to repeat loop, only the end true/false is swapped (PFV) }
+         if p^.treetype=whilen then
+          emitjmp(C_None,lcont);
+
+         emitlab(lloop);
+
+         aktcontinuelabel:=lcont;
+         aktbreaklabel:=lbreak;
+         cleartempgen;
+         if assigned(p^.right) then
+           secondpass(p^.right);
+         emitlab(lcont);
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         if p^.treetype=whilen then
+          begin
+            truelabel:=lloop;
+            falselabel:=lbreak;
+          end
+         { repeatn }
+         else
+          begin
+            truelabel:=lbreak;
+            falselabel:=lloop;
+          end;
+         cleartempgen;
+         secondpass(p^.left);
+         maketojumpbool(p^.left);
+         emitlab(lbreak);
+         freelabel(lloop);
+         freelabel(lcont);
+         freelabel(lbreak);
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+
+         aktcontinuelabel:=oldclabel;
+         aktbreaklabel:=oldblabel;
+      end;
+
+
+{*****************************************************************************
+                               SecondIfN
+*****************************************************************************}
+
+    procedure secondifn(var p : ptree);
+
+      var
+         hl,otlabel,oflabel : pasmlabel;
+
+      begin
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         cleartempgen;
+         secondpass(p^.left);
+         maketojumpbool(p^.left);
+         if assigned(p^.right) then
+           begin
+              emitlab(truelabel);
+              cleartempgen;
+              secondpass(p^.right);
+           end;
+         if assigned(p^.t1) then
+           begin
+              if assigned(p^.right) then
+                begin
+                   getlabel(hl);
+                   { do go back to if line !! }
+                   aktfilepos:=exprasmlist^.getlasttaifilepos^;
+                   emitjmp(C_None,hl);
+                end;
+              emitlab(falselabel);
+              cleartempgen;
+              secondpass(p^.t1);
+              if assigned(p^.right) then
+                emitlab(hl);
+           end
+         else
+           begin
+              emitlab(falselabel);
+           end;
+         if not(assigned(p^.right)) then
+           begin
+              emitlab(truelabel);
+           end;
+         freelabel(truelabel);
+         freelabel(falselabel);
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+      end;
+
+
+{*****************************************************************************
+                              SecondFor
+*****************************************************************************}
+
+    procedure secondfor(var p : ptree);
+      var
+         l3,oldclabel,oldblabel : pasmlabel;
+         omitfirstcomp,temptovalue : boolean;
+         hs : byte;
+         temp1 : treference;
+         hop : tasmop;
+         hcond : tasmcond;
+         cmpreg,cmp32 : tregister;
+         opsize : topsize;
+         count_var_is_signed : boolean;
+
+      begin
+         oldclabel:=aktcontinuelabel;
+         oldblabel:=aktbreaklabel;
+         getlabel(aktcontinuelabel);
+         getlabel(aktbreaklabel);
+         getlabel(l3);
+
+         { could we spare the first comparison ? }
+             omitfirstcomp:=false;
+         if p^.right^.treetype=ordconstn then
+           if p^.left^.right^.treetype=ordconstn then
+             omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
+               or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));
+
+         { only calculate reference }
+         cleartempgen;
+         secondpass(p^.t2);
+{$ifndef OLDFORVER}
+         hs:=p^.t2^.resulttype^.size;
+         cmp32:=getregister32;
+             case hs of
+            1 : begin
+                   opsize:=S_B;
+                   cmpreg:=reg32toreg8(cmp32);
+                end;
+            2 : begin
+                   opsize:=S_W;
+                   cmpreg:=reg32toreg16(cmp32);
+                end;
+            4 : begin
+                   opsize:=S_L;
+                   cmpreg:=cmp32;
+                end;
+         end;
+         (*
+         if not(simple_loadn) then
+          CGMessage(cg_e_illegal_count_var);
+         already done in firstfor !! *)
+
+         { first set the to value
+           because the count var can be in the expression !! }
+         cleartempgen;
+         secondpass(p^.right);
+         { calculate pointer value and check if changeable and if so }
+         { load into temporary variable                       }
+         if p^.right^.treetype<>ordconstn then
+           begin
+              temp1.symbol:=nil;
+              gettempofsizereference(hs,temp1);
+              temptovalue:=true;
+              if (p^.right^.location.loc=LOC_REGISTER) or
+                 (p^.right^.location.loc=LOC_CREGISTER) then
+                begin
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,p^.right^.location.register,
+                      newreference(temp1))));
+                 end
+              else
+                 concatcopy(p^.right^.location.reference,temp1,hs,false,false);
+           end
+         else temptovalue:=false;
+{$endif OLDFORVER}
+
+         { produce start assignment }
+         cleartempgen;
+         secondpass(p^.left);
+         count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
+{$ifdef OLDFORVER}
+         hs:=p^.t2^.resulttype^.size;
+         cmp32:=getregister32;
+             case hs of
+            1 : begin
+                   opsize:=S_B;
+                   cmpreg:=reg32toreg8(cmp32);
+                end;
+            2 : begin
+                   opsize:=S_W;
+                   cmpreg:=reg32toreg16(cmp32);
+                end;
+            4 : begin
+                   opsize:=S_L;
+                   cmpreg:=cmp32;
+                end;
+         end;
+         cleartempgen;
+         secondpass(p^.right);
+         { calculate pointer value and check if changeable and if so }
+         { load into temporary variable                       }
+         if p^.right^.treetype<>ordconstn then
+           begin
+              temp1.symbol:=nil;
+              gettempofsizereference(hs,temp1);
+              temptovalue:=true;
+              if (p^.right^.location.loc=LOC_REGISTER) or
+                 (p^.right^.location.loc=LOC_CREGISTER) then
+                begin
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,p^.right^.location.register,
+                      newreference(temp1))));
+                 end
+              else
+                 concatcopy(p^.right^.location.reference,temp1,hs,false,false);
+           end
+         else temptovalue:=false;
+
+{$endif OLDFORVER}
+         if temptovalue then
+             begin
+              if p^.t2^.location.loc=LOC_CREGISTER then
+                begin
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
+                     p^.t2^.location.register)));
+                end
+              else
+                begin
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
+                     cmpreg)));
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
+                     cmpreg)));
+                end;
+           end
+         else
+             begin
+              if not(omitfirstcomp) then
+                begin
+                   if p^.t2^.location.loc=LOC_CREGISTER then
+                     exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^.right^.value,
+                       p^.t2^.location.register)))
+                   else
+                     exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,opsize,p^.right^.value,
+                 newreference(p^.t2^.location.reference))));
+                end;
+           end;
+         if p^.backward then
+           if count_var_is_signed then
+             hcond:=C_L
+           else
+             hcond:=C_B
+         else
+           if count_var_is_signed then
+             hcond:=C_G
+           else
+             hcond:=C_A;
+
+         if not(omitfirstcomp) or temptovalue then
+           emitjmp(hcond,aktbreaklabel);
+
+         emitlab(l3);
+
+         { help register must not be in instruction block }
+         cleartempgen;
+         if assigned(p^.t1) then
+           secondpass(p^.t1);
+
+         emitlab(aktcontinuelabel);
+
+         { makes no problems there }
+         cleartempgen;
+
+         { demand help register again }
+         cmp32:=getregister32;
+         case hs of
+            1 : begin
+                   opsize:=S_B;
+                   cmpreg:=reg32toreg8(cmp32);
+                end;
+            2 : begin
+                   opsize:=S_W;
+                   cmpreg:=reg32toreg16(cmp32);
+                end;
+            4 : opsize:=S_L;
+         end;
+
+          { produce comparison and the corresponding }
+         { jump                              }
+         if temptovalue then
+           begin
+              if p^.t2^.location.loc=LOC_CREGISTER then
+                begin
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
+                     p^.t2^.location.register)));
+                end
+              else
+                begin
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.t2^.location.reference),
+                     cmpreg)));
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_CMP,opsize,newreference(temp1),
+                     cmpreg)));
+                    end;
+           end
+         else
+           begin
+              if p^.t2^.location.loc=LOC_CREGISTER then
+                exprasmlist^.concat(new(pai386,op_const_reg(A_CMP,opsize,p^.right^.value,
+                  p^.t2^.location.register)))
+              else
+                 exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,opsize,p^.right^.value,
+                   newreference(p^.t2^.location.reference))));
+           end;
+         if p^.backward then
+           if count_var_is_signed then
+             hcond:=C_LE
+           else
+             hcond:=C_BE
+          else
+            if count_var_is_signed then
+              hcond:=C_GE
+            else
+              hcond:=C_AE;
+         emitjmp(hcond,aktbreaklabel);
+         { according to count direction DEC or INC... }
+         { must be after the test because of 0to 255 for bytes !! }
+         if p^.backward then
+           hop:=A_DEC
+         else
+           hop:=A_INC;
+
+         if p^.t2^.location.loc=LOC_CREGISTER then
+           exprasmlist^.concat(new(pai386,op_reg(hop,opsize,p^.t2^.location.register)))
+         else
+             exprasmlist^.concat(new(pai386,op_ref(hop,opsize,newreference(p^.t2^.location.reference))));
+         emitjmp(C_None,l3);
+
+           { this is the break label: }
+         emitlab(aktbreaklabel);
+         ungetregister32(cmp32);
+
+         if temptovalue then
+           ungetiftemp(temp1);
+
+         freelabel(aktcontinuelabel);
+         freelabel(aktbreaklabel);
+         freelabel(l3);
+         aktcontinuelabel:=oldclabel;
+         aktbreaklabel:=oldblabel;
+      end;
+
+
+{*****************************************************************************
+                              SecondExitN
+*****************************************************************************}
+
+    procedure secondexitn(var p : ptree);
+      var
+         is_mem : boolean;
+         {op : tasmop;
+         s : topsize;}
+         otlabel,oflabel : pasmlabel;
+      label
+         do_jmp;
+      begin
+         if assigned(p^.left) then
+           begin
+              otlabel:=truelabel;
+              oflabel:=falselabel;
+              getlabel(truelabel);
+              getlabel(falselabel);
+              secondpass(p^.left);
+              case p^.left^.location.loc of
+                 LOC_FPU : goto do_jmp;
+                 LOC_MEM,
+           LOC_REFERENCE : is_mem:=true;
+           LOC_CREGISTER,
+            LOC_REGISTER : is_mem:=false;
+               LOC_FLAGS : begin
+                             emit_flag2reg(p^.left^.location.resflags,R_AL);
+                             goto do_jmp;
+                           end;
+                LOC_JUMP : begin
+                             emitlab(truelabel);
+                             exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,1,R_AL)));
+                             emitjmp(C_None,aktexit2label);
+                             emitlab(falselabel);
+                             exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,R_AL,R_AL)));
+                             goto do_jmp;
+                           end;
+              else
+                internalerror(2001);
+              end;
+              case procinfo.retdef^.deftype of
+               orddef,
+              enumdef : begin
+                          case procinfo.retdef^.size of
+                           4 : if is_mem then
+                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                   newreference(p^.left^.location.reference),R_EAX)))
+                               else
+                                 emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
+                           2 : if is_mem then
+                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
+                                   newreference(p^.left^.location.reference),R_AX)))
+                               else
+                                 emit_reg_reg(A_MOV,S_W,makereg16(p^.left^.location.register),R_AX);
+                           1 : if is_mem then
+                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
+                                   newreference(p^.left^.location.reference),R_AL)))
+                               else
+                                 emit_reg_reg(A_MOV,S_B,makereg8(p^.left^.location.register),R_AL);
+                          end;
+                        end;
+           pointerdef,
+           procvardef : begin
+                          if is_mem then
+                            exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                              newreference(p^.left^.location.reference),R_EAX)))
+                          else
+                            exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
+                              p^.left^.location.register,R_EAX)));
+                        end;
+             floatdef : begin
+                          if pfloatdef(procinfo.retdef)^.typ=f32bit then
+                           begin
+                             if is_mem then
+                               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                 newreference(p^.left^.location.reference),R_EAX)))
+                             else
+                               emit_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EAX);
+                           end
+                          else
+                           if is_mem then
+                            floatload(pfloatdef(procinfo.retdef)^.typ,p^.left^.location.reference);
+                        end;
+              end;
+do_jmp:
+              freelabel(truelabel);
+              freelabel(falselabel);
+              truelabel:=otlabel;
+              falselabel:=oflabel;
+              emitjmp(C_None,aktexit2label);
+           end
+         else
+           begin
+              emitjmp(C_None,aktexitlabel);
+           end;
+       end;
+
+
+{*****************************************************************************
+                              SecondBreakN
+*****************************************************************************}
+
+    procedure secondbreakn(var p : ptree);
+      begin
+         if aktbreaklabel<>nil then
+           emitjmp(C_None,aktbreaklabel)
+         else
+           CGMessage(cg_e_break_not_allowed);
+      end;
+
+
+{*****************************************************************************
+                              SecondContinueN
+*****************************************************************************}
+
+    procedure secondcontinuen(var p : ptree);
+      begin
+         if aktcontinuelabel<>nil then
+           emitjmp(C_None,aktcontinuelabel)
+         else
+           CGMessage(cg_e_continue_not_allowed);
+      end;
+
+
+{*****************************************************************************
+                             SecondGoto
+*****************************************************************************}
+
+    procedure secondgoto(var p : ptree);
+
+       begin
+         emitjmp(C_None,p^.labelnr);
+       end;
+
+
+{*****************************************************************************
+                             SecondLabel
+*****************************************************************************}
+
+    procedure secondlabel(var p : ptree);
+      begin
+         emitlab(p^.labelnr);
+         cleartempgen;
+         secondpass(p^.left);
+      end;
+
+
+{*****************************************************************************
+                             SecondRaise
+*****************************************************************************}
+
+    procedure secondraise(var p : ptree);
+
+      var
+         a : pasmlabel;
+
+      begin
+         if assigned(p^.left) then
+           begin
+              { generate the address }
+              if assigned(p^.right) then
+                begin
+                   secondpass(p^.right);
+                   if codegenerror then
+                     exit;
+                end
+              else
+                begin
+                   getlabel(a);
+                   emitlab(a);
+                   exprasmlist^.concat(new(pai386,
+                     op_sym(A_PUSH,S_L,a)));
+                end;
+              secondpass(p^.left);
+              if codegenerror then
+                exit;
+
+              case p^.left^.location.loc of
+                 LOC_MEM,LOC_REFERENCE:
+                   exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,
+                       newreference(p^.left^.location.reference))));
+                 LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
+                       p^.left^.location.register)));
+                 else CGMessage(type_e_mismatch);
+              end;
+              emitcall('FPC_RAISEEXCEPTION');
+             end
+           else
+             begin
+                emitcall('FPC_RERAISE');
+             end;
+       end;
+
+
+{*****************************************************************************
+                             SecondTryExcept
+*****************************************************************************}
+
+    var
+       endexceptlabel : pasmlabel;
+
+    procedure secondtryexcept(var p : ptree);
+
+      var
+         exceptlabel,doexceptlabel,oldendexceptlabel,
+         lastonlabel : pasmlabel;
+
+      begin
+         { this can be called recursivly }
+         oldendexceptlabel:=endexceptlabel;
+         { we modify EAX }
+         usedinproc:=usedinproc or ($80 shr byte(R_EAX));
+
+         getlabel(exceptlabel);
+         getlabel(doexceptlabel);
+         getlabel(endexceptlabel);
+         getlabel(lastonlabel);
+         push_int (1); { push type of exceptionframe }
+         emitcall('FPC_PUSHEXCEPTADDR');
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_PUSH,S_L,R_EAX)));
+         emitcall('FPC_SETJMP');
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_PUSH,S_L,R_EAX)));
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitjmp(C_NE,exceptlabel);
+
+         { try code }
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+
+         emitlab(exceptlabel);
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_POP,S_L,R_EAX)));
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitjmp(C_NE,doexceptlabel);
+         emitcall('FPC_POPADDRSTACK');
+         emitjmp(C_None,endexceptlabel);
+         emitlab(doexceptlabel);
+
+         if assigned(p^.right) then
+           secondpass(p^.right);
+
+         emitlab(lastonlabel);
+         { default handling }
+         if assigned(p^.t1) then
+           begin
+              { FPC_CATCHES must be called with
+                'default handler' flag (=-1)
+              }
+              push_int (-1);
+              emitcall('FPC_CATCHES');
+              secondpass(p^.t1);
+           end
+         else
+           emitcall('FPC_RERAISE');
+         emitlab(endexceptlabel);
+         freelabel(exceptlabel);
+         freelabel(doexceptlabel);
+         freelabel(endexceptlabel);
+         freelabel(lastonlabel);
+         endexceptlabel:=oldendexceptlabel;
+      end;
+
+    procedure secondon(var p : ptree);
+
+      var
+         nextonlabel : pasmlabel;
+         ref : treference;
+
+      begin
+         getlabel(nextonlabel);
+
+         { push the vmt }
+         exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
+           newasmsymbol(p^.excepttype^.vmt_mangledname))));
+         emitcall('FPC_CATCHES');
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitjmp(C_E,nextonlabel);
+         ref.symbol:=nil;
+         gettempofsizereference(4,ref);
+
+         { what a hack ! }
+         if assigned(p^.exceptsymtable) then
+           pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset;
+
+         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+           R_EAX,newreference(ref))));
+
+         if assigned(p^.right) then
+           secondpass(p^.right);
+         exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,
+           newreference(ref))));
+         emitcall('FPC_DESTROYEXCEPTION');
+
+         { clear some stuff }
+         ungetiftemp(ref);
+         emitjmp(C_None,endexceptlabel);
+         emitlab(nextonlabel);
+         { next on node }
+         if assigned(p^.left) then
+           secondpass(p^.left);
+      end;
+
+{*****************************************************************************
+                             SecondTryFinally
+*****************************************************************************}
+
+    procedure secondtryfinally(var p : ptree);
+
+      var
+         finallylabel,noreraiselabel : pasmlabel;
+
+      begin
+         { we modify EAX }
+         usedinproc:=usedinproc or ($80 shr byte(R_EAX));
+
+         getlabel(finallylabel);
+         getlabel(noreraiselabel);
+         push_int(1); { Type of stack-frame must be pushed}
+         emitcall('FPC_PUSHEXCEPTADDR');
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_PUSH,S_L,R_EAX)));
+         emitcall('FPC_SETJMP');
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_PUSH,S_L,R_EAX)));
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitjmp(C_NE,finallylabel);
+
+         { try code }
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+
+         emitlab(finallylabel);
+
+         { finally code }
+         secondpass(p^.right);
+         if codegenerror then
+           exit;
+         exprasmlist^.concat(new(pai386,
+           op_reg(A_POP,S_L,R_EAX)));
+         exprasmlist^.concat(new(pai386,
+           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
+         emitjmp(C_E,noreraiselabel);
+         emitcall('FPC_RERAISE');
+         emitlab(noreraiselabel);
+         emitcall('FPC_POPADDRSTACK');
+      end;
+
+
+{*****************************************************************************
+                             SecondFail
+*****************************************************************************}
+
+    procedure secondfail(var p : ptree);
+      var
+        hp : preference;
+      begin
+         exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
+         { also reset to zero in the stack }
+         new(hp);
+         reset_reference(hp^);
+         hp^.offset:=procinfo.ESI_offset;
+         hp^.base:=procinfo.framepointer;
+         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_ESI,hp)));
+         emitjmp(C_None,quickexitlabel);
+      end;
+
+
+end.
+{
   $Log$
-  Revision 1.38  1999-05-21 13:54:48  peter
+  Revision 1.39  1999-05-27 19:44:12  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.38  1999/05/21 13:54:48  peter
     * NEWLAB for label as symbol
-
-  Revision 1.37  1999/05/17 21:57:01  florian
-    * new temporary ansistring handling
-
-  Revision 1.36  1999/05/13 21:59:21  peter
-    * removed oldppu code
-    * warning if objpas is loaded from uses
-    * first things for new deref writing
-
-  Revision 1.35  1999/05/01 13:24:07  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.34  1999/04/26 13:31:25  peter
-    * release storenumber,double_checksum
-
-  Revision 1.33  1999/04/21 09:43:29  peter
-    * storenumber works
-    * fixed some typos in double_checksum
-    + incompatible types type1 and type2 message (with storenumber)
-
-  Revision 1.32  1999/04/17 13:10:58  peter
-    * fixed exit()
-
-  Revision 1.31  1999/04/14 09:14:46  peter
-    * first things to store the symbol/def number in the ppu
-
-  Revision 1.30  1999/03/05 16:14:59  peter
-    * fixed exit() with word/byte return
-
-  Revision 1.29  1999/02/25 21:02:26  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.28  1999/02/22 02:15:09  peter
-    * updates for ag386bin
-
-  Revision 1.27  1999/01/26 11:26:21  pierre
-   * bug0152 for i:=1 to i-5 do (i-5) evaluated first
-
-  Revision 1.26  1998/12/19 00:23:44  florian
-    * ansistring memory leaks fixed
-
-  Revision 1.25  1998/11/30 09:43:03  pierre
-    * some range check bugs fixed (still not working !)
-    + added DLL writing support for win32 (also accepts variables)
-    + TempAnsi for code that could be used for Temporary ansi strings
-      handling
-
-  Revision 1.24  1998/11/18 15:44:09  peter
-    * VALUEPARA for tp7 compatible value parameters
-
-  Revision 1.23  1998/11/12 16:43:32  florian
-    * functions with ansi strings as result didn't work, solved
-
-  Revision 1.22  1998/10/29 15:42:44  florian
-    + partial disposing of temp. ansistrings
-
-  Revision 1.21  1998/10/26 22:58:16  florian
-    * new introduded problem with classes fix, the parent class wasn't set
-      correct, if the class was defined forward before
-
-  Revision 1.20  1998/10/06 17:16:42  pierre
-    * some memory leaks fixed (thanks to Peter for heaptrc !)
-
-  Revision 1.19  1998/09/28 12:13:53  peter
-    * fixed repeat continue until true;
-
-  Revision 1.18  1998/09/26 15:03:04  florian
-    * small problems with DOM and excpetions fixed (code generation
-      of raise was wrong and self was sometimes destroyed :()
-
-  Revision 1.17  1998/09/17 09:42:14  peter
-    + pass_2 for cg386
-    * Message() -> CGMessage() for pass_1/pass_2
-
-  Revision 1.16  1998/09/14 10:43:48  peter
-    * all internal RTL functions start with FPC_
-
-  Revision 1.15  1998/09/04 08:41:39  peter
-    * updated some error CGMessages
-
-  Revision 1.14  1998/09/03 17:08:39  pierre
-    * better lines for stabs
-      (no scroll back to if before else part
-      no return to case line at jump outside case)
-    + source lines also if not in order
-
-  Revision 1.13  1998/09/01 12:47:58  peter
-    * use pdef^.size instead of orddef^.typ
-
-  Revision 1.12  1998/08/28 10:56:58  peter
-    * removed warnings
-
-  Revision 1.11  1998/08/05 16:00:10  florian
-    * some fixes for ansi strings
-
-  Revision 1.10  1998/08/04 16:26:26  jonas
-    * converted // comment to TP comment
-
-  Revision 1.9  1998/07/31 11:36:34  michael
-  Default exception handler also needs to call FPC_CATCHES
-
-  Revision 1.8  1998/07/30 13:30:32  florian
-    * final implemenation of exception support, maybe it needs
-      some fixes :)
-
-  Revision 1.7  1998/07/30 11:18:13  florian
-    + first implementation of try ... except on .. do end;
-    * limitiation of 65535 bytes parameters for cdecl removed
-
-  Revision 1.6  1998/07/29 13:29:11  michael
-  + Corrected try.. code. Type of exception fram is pushed
-
-  Revision 1.5  1998/07/28 21:52:49  florian
-    + implementation of raise and try..finally
-    + some misc. exception stuff
-
-  Revision 1.4  1998/07/24 22:16:53  florian
-    * internal error 10 together with array access fixed. I hope
-      that's the final fix.
-
-  Revision 1.3  1998/06/25 08:48:08  florian
-    * first version of rtti support
-
-  Revision 1.2  1998/06/08 13:13:33  pierre
-    + temporary variables now in temp_gen.pas unit
-      because it is processor independent
-    * mppc68k.bat modified to undefine i386 and support_mmx
-      (which are defaults for i386)
-
-  Revision 1.1  1998/06/05 17:44:12  peter
-    * splitted cgi386
-
-}
-
+
+  Revision 1.37  1999/05/17 21:57:01  florian
+    * new temporary ansistring handling
+
+  Revision 1.36  1999/05/13 21:59:21  peter
+    * removed oldppu code
+    * warning if objpas is loaded from uses
+    * first things for new deref writing
+
+  Revision 1.35  1999/05/01 13:24:07  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.34  1999/04/26 13:31:25  peter
+    * release storenumber,double_checksum
+
+  Revision 1.33  1999/04/21 09:43:29  peter
+    * storenumber works
+    * fixed some typos in double_checksum
+    + incompatible types type1 and type2 message (with storenumber)
+
+  Revision 1.32  1999/04/17 13:10:58  peter
+    * fixed exit()
+
+  Revision 1.31  1999/04/14 09:14:46  peter
+    * first things to store the symbol/def number in the ppu
+
+  Revision 1.30  1999/03/05 16:14:59  peter
+    * fixed exit() with word/byte return
+
+  Revision 1.29  1999/02/25 21:02:26  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.28  1999/02/22 02:15:09  peter
+    * updates for ag386bin
+
+  Revision 1.27  1999/01/26 11:26:21  pierre
+   * bug0152 for i:=1 to i-5 do (i-5) evaluated first
+
+  Revision 1.26  1998/12/19 00:23:44  florian
+    * ansistring memory leaks fixed
+
+  Revision 1.25  1998/11/30 09:43:03  pierre
+    * some range check bugs fixed (still not working !)
+    + added DLL writing support for win32 (also accepts variables)
+    + TempAnsi for code that could be used for Temporary ansi strings
+      handling
+
+  Revision 1.24  1998/11/18 15:44:09  peter
+    * VALUEPARA for tp7 compatible value parameters
+
+  Revision 1.23  1998/11/12 16:43:32  florian
+    * functions with ansi strings as result didn't work, solved
+
+  Revision 1.22  1998/10/29 15:42:44  florian
+    + partial disposing of temp. ansistrings
+
+  Revision 1.21  1998/10/26 22:58:16  florian
+    * new introduded problem with classes fix, the parent class wasn't set
+      correct, if the class was defined forward before
+
+  Revision 1.20  1998/10/06 17:16:42  pierre
+    * some memory leaks fixed (thanks to Peter for heaptrc !)
+
+  Revision 1.19  1998/09/28 12:13:53  peter
+    * fixed repeat continue until true;
+
+  Revision 1.18  1998/09/26 15:03:04  florian
+    * small problems with DOM and excpetions fixed (code generation
+      of raise was wrong and self was sometimes destroyed :()
+
+  Revision 1.17  1998/09/17 09:42:14  peter
+    + pass_2 for cg386
+    * Message() -> CGMessage() for pass_1/pass_2
+
+  Revision 1.16  1998/09/14 10:43:48  peter
+    * all internal RTL functions start with FPC_
+
+  Revision 1.15  1998/09/04 08:41:39  peter
+    * updated some error CGMessages
+
+  Revision 1.14  1998/09/03 17:08:39  pierre
+    * better lines for stabs
+      (no scroll back to if before else part
+      no return to case line at jump outside case)
+    + source lines also if not in order
+
+  Revision 1.13  1998/09/01 12:47:58  peter
+    * use pdef^.size instead of orddef^.typ
+
+  Revision 1.12  1998/08/28 10:56:58  peter
+    * removed warnings
+
+  Revision 1.11  1998/08/05 16:00:10  florian
+    * some fixes for ansi strings
+
+  Revision 1.10  1998/08/04 16:26:26  jonas
+    * converted // comment to TP comment
+
+  Revision 1.9  1998/07/31 11:36:34  michael
+  Default exception handler also needs to call FPC_CATCHES
+
+  Revision 1.8  1998/07/30 13:30:32  florian
+    * final implemenation of exception support, maybe it needs
+      some fixes :)
+
+  Revision 1.7  1998/07/30 11:18:13  florian
+    + first implementation of try ... except on .. do end;
+    * limitiation of 65535 bytes parameters for cdecl removed
+
+  Revision 1.6  1998/07/29 13:29:11  michael
+  + Corrected try.. code. Type of exception fram is pushed
+
+  Revision 1.5  1998/07/28 21:52:49  florian
+    + implementation of raise and try..finally
+    + some misc. exception stuff
+
+  Revision 1.4  1998/07/24 22:16:53  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.3  1998/06/25 08:48:08  florian
+    * first version of rtti support
+
+  Revision 1.2  1998/06/08 13:13:33  pierre
+    + temporary variables now in temp_gen.pas unit
+      because it is processor independent
+    * mppc68k.bat modified to undefine i386 and support_mmx
+      (which are defaults for i386)
+
+  Revision 1.1  1998/06/05 17:44:12  peter
+    * splitted cgi386
+
+}
+

compiler/cg386inl.pas

@@ -36,11 +36,7 @@ implementation
       cobjects,verbose,globals,files,
       symtable,aasm,types,
       hcodegen,temp_gen,pass_1,pass_2,
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
       cgai386,tgeni386,cg386cal;
 
 
@@ -97,55 +93,55 @@ implementation
                    emit_movq_reg_loc(R_EDX,R_EAX,dest^.location);
                 end
               else
-                begin
-                   Case dest^.resulttype^.size of
-                     1 : hreg:=regtoreg8(accumulator);
-                     2 : hreg:=regtoreg16(accumulator);
-                     4 : hreg:=accumulator;
-                   End;
-                   emit_mov_reg_loc(hreg,dest^.location);
-                   If (cs_check_range in aktlocalswitches) and
-                      {no need to rangecheck longints or cardinals on 32bit processors}
-                       not((porddef(dest^.resulttype)^.typ = s32bit) and
-                           (porddef(dest^.resulttype)^.low = $80000000) and
-                           (porddef(dest^.resulttype)^.high = $7fffffff)) and
-                       not((porddef(dest^.resulttype)^.typ = u32bit) and
-                           (porddef(dest^.resulttype)^.low = 0) and
-                           (porddef(dest^.resulttype)^.high = $ffffffff)) then
-                     Begin
-                       {do not register this temporary def}
-                       OldRegisterDef := RegisterDef;
-                       RegisterDef := False;
-                       hdef:=nil;
-                       Case PordDef(dest^.resulttype)^.typ of
-                         u8bit,u16bit,u32bit:
-                           begin
-                             new(hdef,init(u32bit,0,$ffffffff));
-                             hreg:=accumulator;
-                           end;
-                         s8bit,s16bit,s32bit:
-                           begin
-                             new(hdef,init(s32bit,$80000000,$7fffffff));
-                             hreg:=accumulator;
-                           end;
-                       end;
-                       { create a fake node }
-                       hp := genzeronode(nothingn);
-                       hp^.location.loc := LOC_REGISTER;
-                       hp^.location.register := hreg;
-                       if assigned(hdef) then
-                         hp^.resulttype:=hdef
-                       else
-                         hp^.resulttype:=dest^.resulttype;
-                       { emit the range check }
-                       emitrangecheck(hp,dest^.resulttype);
-                       hp^.right := nil;
-                       if assigned(hdef) then
-                         Dispose(hdef, Done);
-                       RegisterDef := OldRegisterDef;
-                       disposetree(hp);
-                     End;
-                end;
+               begin
+                 Case dest^.resulttype^.size of
+                  1 : hreg:=regtoreg8(accumulator);
+                  2 : hreg:=regtoreg16(accumulator);
+                  4 : hreg:=accumulator;
+                 End;
+                 emit_mov_reg_loc(hreg,dest^.location);
+                 If (cs_check_range in aktlocalswitches) and
+                    {no need to rangecheck longints or cardinals on 32bit processors}
+                    not((porddef(dest^.resulttype)^.typ = s32bit) and
+                        (porddef(dest^.resulttype)^.low = $80000000) and
+                        (porddef(dest^.resulttype)^.high = $7fffffff)) and
+                    not((porddef(dest^.resulttype)^.typ = u32bit) and
+                        (porddef(dest^.resulttype)^.low = 0) and
+                        (porddef(dest^.resulttype)^.high = $ffffffff)) then
+                  Begin
+                    {do not register this temporary def}
+                    OldRegisterDef := RegisterDef;
+                    RegisterDef := False;
+                    hdef:=nil;
+                    Case PordDef(dest^.resulttype)^.typ of
+                      u8bit,u16bit,u32bit:
+                        begin
+                          new(hdef,init(u32bit,0,$ffffffff));
+                          hreg:=accumulator;
+                        end;
+                      s8bit,s16bit,s32bit:
+                        begin
+                          new(hdef,init(s32bit,$80000000,$7fffffff));
+                          hreg:=accumulator;
+                        end;
+                    end;
+                    { create a fake node }
+                    hp := genzeronode(nothingn);
+                    hp^.location.loc := LOC_REGISTER;
+                    hp^.location.register := hreg;
+                    if assigned(hdef) then
+                      hp^.resulttype:=hdef
+                    else
+                      hp^.resulttype:=dest^.resulttype;
+                    { emit the range check }
+                    emitrangecheck(hp,dest^.resulttype);
+                    hp^.right := nil;
+                    if assigned(hdef) then
+                      Dispose(hdef, Done);
+                    RegisterDef := OldRegisterDef;
+                    disposetree(hp);
+                  End;
+               end;
             End;
           else
             internalerror(66766766);
@@ -156,7 +152,7 @@ implementation
     procedure secondinline(var p : ptree);
        const
          {tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
-{         float_name: array[tfloattype] of string[8]=
+{        float_name: array[tfloattype] of string[8]=
            ('S32REAL','S64REAL','S80REAL','S64BIT','F16BIT','F32BIT'); }
          incdecop:array[in_inc_x..in_dec_x] of tasmop=(A_INC,A_DEC);
          addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
@@ -184,9 +180,6 @@ implementation
             new(r);
             reset_reference(r^);
             r^.symbol:=newasmsymbol('U_'+upper(target_info.system_unit)+io[doread]);
-{$ifndef NEWLAB}
-            concat_external(r^.symbol^.name,EXT_NEAR);
-{$endif}
             exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
           end;
 
@@ -200,7 +193,7 @@ implementation
            orgfloattype : tfloattype;
            has_length : boolean;
            dummycoll  : tdefcoll;
-           iolabel    : plabel;
+           iolabel    : pasmlabel;
            npara      : longint;
         begin
            { I/O check }
@@ -284,7 +277,7 @@ implementation
 
                 while assigned(node) do
                   begin
-                     pushusedregisters(exprasmlist,pushed,$ff);
+                     pushusedregisters(pushed,$ff);
                      hp:=node;
                      node:=node^.right;
                      hp^.right:=nil;
@@ -334,17 +327,17 @@ implementation
                           { we have to call blockread or blockwrite }
                           { but the real problem is that            }
                           { reset and rewrite should have set       }
-                          { the type size                           }
-                          { as recordsize for that file !!!!        }
+                          { the type size                          }
+                          { as recordsize for that file !!!!    }
                           { how can we make that                    }
                           { I think that is only possible by adding }
-                          { reset and rewrite to the inline list a call        }
+                          { reset and rewrite to the inline list a call }
                           { allways read only one record by element }
                             push_int(typedtyp^.size);
                             if doread then
-                              emitcall('FPC_TYPED_READ',true)
+                              emitcall('FPC_TYPED_READ')
                             else
-                              emitcall('FPC_TYPED_WRITE',true);
+                              emitcall('FPC_TYPED_WRITE');
                        end
                      else
                        begin
@@ -396,21 +389,21 @@ implementation
                           case pararesult^.deftype of
                             stringdef :
                               begin
-                                emitcall(rdwrprefix[doread]+pstringdef(pararesult)^.stringtypname,true);
+                                emitcall(rdwrprefix[doread]+pstringdef(pararesult)^.stringtypname);
                               end;
                             pointerdef :
                               begin
                                 if is_pchar(pararesult) then
-                                  emitcall(rdwrprefix[doread]+'PCHAR_AS_POINTER',true)
+                                  emitcall(rdwrprefix[doread]+'PCHAR_AS_POINTER')
                               end;
                             arraydef :
                               begin
                                 if is_chararray(pararesult) then
-                                  emitcall(rdwrprefix[doread]+'PCHAR_AS_ARRAY',true)
+                                  emitcall(rdwrprefix[doread]+'PCHAR_AS_ARRAY')
                               end;
                             floatdef :
                               begin
-                                emitcall(rdwrprefix[doread]+'FLOAT',true);
+                                emitcall(rdwrprefix[doread]+'FLOAT');
                                 if doread then
                                   StoreDirectFuncResult(destpara);
                               end;
@@ -418,58 +411,57 @@ implementation
                               begin
                                 case porddef(pararesult)^.typ of
                                   s8bit,s16bit,s32bit :
-                                    emitcall(rdwrprefix[doread]+'SINT',true);
+                                    emitcall(rdwrprefix[doread]+'SINT');
                                   u8bit,u16bit,u32bit :
-                                    emitcall(rdwrprefix[doread]+'UINT',true);
+                                    emitcall(rdwrprefix[doread]+'UINT');
                                   uchar :
-                                    emitcall(rdwrprefix[doread]+'CHAR',true);
+                                    emitcall(rdwrprefix[doread]+'CHAR');
                                   s64bitint:
-                                    emitcall(rdwrprefix[doread]+'INT64',true);
+                                    emitcall(rdwrprefix[doread]+'INT64');
                                   u64bit :
-                                    emitcall(rdwrprefix[doread]+'QWORD',true);
+                                    emitcall(rdwrprefix[doread]+'QWORD');
                                   bool8bit,
                                   bool16bit,
                                   bool32bit :
-                                    emitcall(rdwrprefix[doread]+'BOOLEAN',true);
-                                end;
-                                if doread then
+                                    emitcall(rdwrprefix[doread]+'BOOLEAN');
+                                end;                                                                 if doread then
                                  StoreDirectFuncResult(destpara);
                               end;
                           end;
                        end;
                    { load ESI in methods again }
-                     popusedregisters(exprasmlist,pushed);
+                     popusedregisters(pushed);
                      maybe_loadesi;
                   end;
              end;
          { Insert end of writing for textfiles }
            if ft=ft_text then
              begin
-               pushusedregisters(exprasmlist,pushed,$ff);
+               pushusedregisters(pushed,$ff);
                emit_push_mem(aktfile);
                if doread then
                 begin
                   if doln then
-                    emitcall('FPC_READLN_END',true)
+                    emitcall('FPC_READLN_END')
                   else
-                    emitcall('FPC_READ_END',true);
+                    emitcall('FPC_READ_END');
                 end
                else
                 begin
                   if doln then
-                    emitcall('FPC_WRITELN_END',true)
+                    emitcall('FPC_WRITELN_END')
                   else
-                    emitcall('FPC_WRITE_END',true);
+                    emitcall('FPC_WRITE_END');
                 end;
-               popusedregisters(exprasmlist,pushed);
+               popusedregisters(pushed);
                maybe_loadesi;
              end;
          { Insert IOCheck if set }
            if assigned(iolabel) then
              begin
                 { registers are saved in the procedure }
-                exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(lab2str(iolabel)))));
-                emitcall('FPC_IOCHECK',true);
+                exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,iolabel)));
+                emitcall('FPC_IOCHECK');
              end;
          { Freeup all used temps }
            ungetiftemp(aktfile);
@@ -499,7 +491,7 @@ implementation
            procedureprefix : string;
 
           begin
-           pushusedregisters(exprasmlist,pushed,$ff);
+           pushusedregisters(pushed,$ff);
            node:=p^.left;
            is_real:=false;
            has_length:=false;
@@ -596,24 +588,24 @@ implementation
              exit;
 
            if is_real then
-             emitcall(procedureprefix+'FLOAT',true)
+             emitcall(procedureprefix+'FLOAT')
            else
              case porddef(hp^.resulttype)^.typ of
                 u32bit:
-                  emitcall(procedureprefix+'CARDINAL',true);
+                  emitcall(procedureprefix+'CARDINAL');
 
                 u64bit:
-                  emitcall(procedureprefix+'QWORD',true);
+                  emitcall(procedureprefix+'QWORD');
 
                 s64bitint:
-                  emitcall(procedureprefix+'INT64',true);
+                  emitcall(procedureprefix+'INT64');
 
                 else
-                  emitcall(procedureprefix+'LONGINT',true);
+                  emitcall(procedureprefix+'LONGINT');
              end;
            disposetree(hp);
 
-           popusedregisters(exprasmlist,pushed);
+           popusedregisters(pushed);
         end;
 
 {$IfnDef OLDVAL}
@@ -665,7 +657,7 @@ implementation
              exit;
 
           {save the regvars}
-           pushusedregisters(exprasmlist,pushed,$ff);
+           pushusedregisters(pushed,$ff);
 
           {now that we've already pushed the addres of dest_para^.left on the
            stack, we can put the real parameters on the stack}
@@ -683,7 +675,7 @@ implementation
              Begin
            {only 32bit code parameter is supported, so fake one}
                GetTempOfSizeReference(4,hr);
-               emitpushreferenceaddr(exprasmlist,hr);
+               emitpushreferenceaddr(hr);
              End;
 
           {node = first parameter = string}
@@ -708,7 +700,7 @@ implementation
                else
                  procedureprefix := 'FPC_VAL_UINT_';
            End;
-           emitcall(procedureprefix+pstringdef(node^.resulttype)^.stringtypname,true);
+           emitcall(procedureprefix+pstringdef(node^.resulttype)^.stringtypname);
            { before disposing node we need to ungettemp !! PM }
            if node^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
              ungetiftemp(node^.left^.location.reference);
@@ -730,7 +722,7 @@ implementation
 
            { restore the register vars}
 
-           popusedregisters(exprasmlist,pushed);
+           popusedregisters(pushed);
 
            If has_code and Not(has_32bit_code) Then
              {only 16bit code is possible}
@@ -810,7 +802,7 @@ implementation
          l : longint;
          ispushed : boolean;
          hregister : tregister;
-         otlabel,oflabel   : plabel;
+         otlabel,oflabel   : pasmlabel;
          oldpushedparasize : longint;
 
       begin
@@ -838,13 +830,13 @@ implementation
                       secondpass(hp);
                       if codegenerror then
                        exit;
-                      emitpushreferenceaddr(exprasmlist,hp^.location.reference);
+                      emitpushreferenceaddr(hp^.location.reference);
                       disposetree(hp);
                       { push msg }
                       secondpass(p^.left^.right^.left);
-                      emitpushreferenceaddr(exprasmlist,p^.left^.right^.left^.location.reference);
+                      emitpushreferenceaddr(p^.left^.right^.left^.location.reference);
                       { call }
-                      emitcall('FPC_ASSERT',true);
+                      emitcall('FPC_ASSERT');
                       emitlab(truelabel);
                    end;
                  freelabel(truelabel);
@@ -1132,15 +1124,15 @@ implementation
               end;
              in_reset_typedfile,in_rewrite_typedfile :
                begin
-                  pushusedregisters(exprasmlist,pushed,$ff);
+                  pushusedregisters(pushed,$ff);
                   exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size)));
                   secondpass(p^.left);
-                  emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                  emitpushreferenceaddr(p^.left^.location.reference);
                   if p^.inlinenumber=in_reset_typedfile then
-                    emitcall('FPC_RESET_TYPED',true)
+                    emitcall('FPC_RESET_TYPED')
                   else
-                    emitcall('FPC_REWRITE_TYPED',true);
-                  popusedregisters(exprasmlist,pushed);
+                    emitcall('FPC_REWRITE_TYPED');
+                  popusedregisters(pushed);
                end;
             in_write_x :
               handlereadwrite(false,false);
@@ -1228,12 +1220,11 @@ implementation
                         begin
                            pushsetelement(p^.left^.right^.left);
                            { normset is allways a ref }
-                           emitpushreferenceaddr(exprasmlist,
-                             p^.left^.left^.location.reference);
+                           emitpushreferenceaddr(p^.left^.left^.location.reference);
                            if p^.inlinenumber=in_include_x_y then
-                             emitcall('FPC_SET_SET_BYTE',true)
+                             emitcall('FPC_SET_SET_BYTE')
                            else
-                             emitcall('FPC_SET_UNSET_BYTE',true);
+                             emitcall('FPC_SET_UNSET_BYTE');
                            {CGMessage(cg_e_include_not_implemented);}
                         end;
                    end;
@@ -1247,7 +1238,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  1999-05-23 19:55:11  florian
+  Revision 1.55  1999-05-27 19:44:13  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.54  1999/05/23 19:55:11  florian
     * qword/int64 multiplication fixed
     + qword/int64 subtraction
 

compiler/cg386ld.pas

@@ -39,11 +39,7 @@ implementation
       cobjects,verbose,globals,
       symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
       cgai386,tgeni386,cg386cnv;
 
 {*****************************************************************************
@@ -75,9 +71,6 @@ implementation
                      end
                     else
                      p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
-{$ifndef NEWLAB}
-                    maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
-{$endif}
                  end;
               varsym :
                  begin
@@ -86,10 +79,6 @@ implementation
                     if (pvarsym(p^.symtableentry)^.var_options and vo_is_C_var)<>0 then
                       begin
                          p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
-{$ifndef NEWLAB}
-                         if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
-                           concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
-{$endif}
                       end
                     { DLL variable }
                     else if (pvarsym(p^.symtableentry)^.var_options and vo_is_dll_var)<>0 then
@@ -104,9 +93,6 @@ implementation
                     else if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
                       begin
                          p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
-{$ifndef NEWLAB}
-                         concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
-{$endif}
                       end
                     { thread variable }
                     else if (pvarsym(p^.symtableentry)^.var_options and vo_is_thread_var)<>0 then
@@ -115,14 +101,10 @@ implementation
                          if popeax then
                            exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
                          p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
-{$ifndef NEWLAB}
-                         if p^.symtable^.symtabletype=unitsymtable then
-                           concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
-{$endif}
                          exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,newreference(p^.location.reference))));
                          { the called procedure isn't allowed to change }
-                         { any register except EAX                      }
-                         emitcall('FPC_RELOCATE_THREADVAR',true);
+                         { any register except EAX                    }
+                         emitcall('FPC_RELOCATE_THREADVAR');
 
                          reset_reference(p^.location.reference);
                          p^.location.reference.base:=getregister32;
@@ -180,10 +162,6 @@ implementation
                                    staticsymtable :
                                      begin
                                        p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
-{$ifndef NEWLAB}
-                                       if symtabletype=unitsymtable then
-                                        concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
-{$endif}
                                      end;
                                    stt_exceptsymtable:
                                      begin
@@ -195,10 +173,6 @@ implementation
                                         if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then
                                           begin
                                              p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
-{$ifndef NEWLAB}
-                                             if p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then
-                                               concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
-{$endif}
                                           end
                                         else
                                           begin
@@ -212,7 +186,7 @@ implementation
                                         { symtable datasize field
                                           contains the offset of the temp
                                           stored }
-{                                        hp:=new_reference(procinfo.framepointer,
+{                                       hp:=new_reference(procinfo.framepointer,
                                           p^.symtable^.datasize);
 
                                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));}
@@ -346,26 +320,17 @@ implementation
                               s:=newasmsymbol(pprocsym(p^.symtableentry)^.definition^.mangledname);
                               exprasmlist^.concat(new(pai386,op_sym_ofs_ref(A_MOV,S_L,s,0,
                                 newreference(p^.location.reference))));
-{$ifndef NEWLAB}
-                              maybe_concat_external(p^.symtable,p^.symtableentry^.mangledname);
-{$endif}
                            end;
                       end
                     else
                       begin
                          {!!!!! Be aware, work on virtual methods too }
                          p^.location.reference.symbol:=newasmsymbol(pprocsym(p^.symtableentry)^.definition^.mangledname);
-{$ifndef NEWLAB}
-                         maybe_concat_external(p^.symtable,p^.symtableentry^.mangledname);
-{$endif}
                       end;
                  end;
               typedconstsym :
                  begin
                     p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
-{$ifndef NEWLAB}
-                    maybe_concat_external(p^.symtable,p^.symtableentry^.mangledname);
-{$endif}
                  end;
               else internalerror(4);
          end;
@@ -379,13 +344,11 @@ implementation
     procedure secondassignment(var p : ptree);
       var
          opsize : topsize;
-         otlabel,hlabel,oflabel : plabel;
+         otlabel,hlabel,oflabel : pasmlabel;
          hregister : tregister;
          loc : tloc;
          r : preference;
-{$ifndef OLDASM}
          ai : pai386;
-{$endif}
       begin
          otlabel:=truelabel;
          oflabel:=falselabel;
@@ -429,10 +392,10 @@ implementation
                   exit;
                end;
          end;
-         { lets try to optimize this (PM)             }
+         { lets try to optimize this (PM)            }
          { define a dest_loc that is the location      }
          { and a ptree to verify that it is the right }
-         { place to insert it                         }
+         { place to insert it                    }
 {$ifdef test_dest_loc}
          if (aktexprlevel<4) then
            begin
@@ -547,29 +510,20 @@ implementation
                                    { increment source reference counter }
                                    new(r);
                                    reset_reference(r^);
-                                   r^.symbol:=newasmsymbol(lab2str(p^.right^.resulttype^.get_inittable_label));
-                                   emitpushreferenceaddr(exprasmlist,r^);
+                                   r^.symbol:=p^.right^.resulttype^.get_inittable_label;
+                                   emitpushreferenceaddr(r^);
 
-                                   emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                                   emitpushreferenceaddr(p^.right^.location.reference);
                                    exprasmlist^.concat(new(pai386,
                                      op_sym(A_CALL,S_NO,newasmsymbol('FPC_ADDREF'))));
-{$ifndef NEWLAB}
-                                   if not (cs_compilesystem in aktmoduleswitches) then
-                                     concat_external('FPC_ADDREF',EXT_NEAR);
-{$endif}
                                    { decrement destination reference counter }
                                    new(r);
                                    reset_reference(r^);
-                                   r^.symbol:=newasmsymbol(lab2str(p^.left^.resulttype^.get_inittable_label));
-                                   emitpushreferenceaddr(exprasmlist,r^);
-
-                                   emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                                   r^.symbol:=p^.left^.resulttype^.get_inittable_label;
+                                   emitpushreferenceaddr(r^);
+                                   emitpushreferenceaddr(p^.left^.location.reference);
                                    exprasmlist^.concat(new(pai386,
                                      op_sym(A_CALL,S_NO,newasmsymbol('FPC_DECREF'))));
-{$ifndef NEWLAB}
-                                   if not(cs_compilesystem in aktmoduleswitches) then
-                                     concat_external('FPC_DECREF',EXT_NEAR);
-{$endif}
                                 end;
 
 {$ifdef regallocfix}
@@ -603,7 +557,7 @@ implementation
                                  4 : opsize:=S_L;
                                  8 : opsize:=S_L;
                               end;
-                              { simplified with op_reg_loc         }
+                              { simplified with op_reg_loc       }
                               if loc=LOC_CREGISTER then
                                 begin
                                   exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
@@ -625,7 +579,7 @@ implementation
                                 end;
                               if is_64bitint(p^.right^.resulttype) then
                                 begin
-                                   { simplified with op_reg_loc         }
+                                   { simplified with op_reg_loc  }
                                    if loc=LOC_CREGISTER then
                                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
                                        p^.right^.location.registerhigh,
@@ -640,7 +594,7 @@ implementation
                                 end;
                               {exprasmlist^.concat(new(pai386,op_reg_loc(A_MOV,opsize,
                                   p^.right^.location.register,
-                                  p^.left^.location)));             }
+                                  p^.left^.location)));      }
 
                            end;
             LOC_FPU : begin
@@ -681,16 +635,11 @@ implementation
                               if loc=LOC_CREGISTER then
                                 emit_flag2reg(p^.right^.location.resflags,p^.left^.location.register)
                               else
-{$ifndef OLDASM}
                                 begin
                                   ai:=new(pai386,op_ref(A_Setcc,S_B,newreference(p^.left^.location.reference)));
                                   ai^.SetCondition(flag_2_cond[p^.right^.location.resflags]);
                                   exprasmlist^.concat(ai);
                                 end;
-{$else}
-                                exprasmlist^.concat(new(pai386,op_ref(flag_2_set[p^.right^.location.resflags],S_B,
-                                  newreference(p^.left^.location.reference))));
-{$endif}
 {$IfDef regallocfix}
                               del_reference(p^.left^.location.reference);
 {$EndIf regallocfix}
@@ -781,13 +730,13 @@ implementation
       begin
         if not p^.cargs then
          begin
-            reset_reference(p^.location.reference);
+           reset_reference(p^.location.reference);
             if parraydef(p^.resulttype)^.highrange=-1 then
               begin
               end
             else
               gettempofsizereference((parraydef(p^.resulttype)^.highrange+1)*8,p^.location.reference);
-            href:=p^.location.reference;
+           href:=p^.location.reference;
          end;
         hp:=p;
         while assigned(hp) do
@@ -876,7 +825,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.58  1999-05-23 18:42:02  florian
+  Revision 1.59  1999-05-27 19:44:14  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.58  1999/05/23 18:42:02  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/cg386mat.pas

@@ -39,11 +39,7 @@ implementation
       cobjects,verbose,globals,
       symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
       cgai386,tgeni386;
 
 {*****************************************************************************
@@ -56,7 +52,7 @@ implementation
          shrdiv, andmod, pushed,popeax,popedx : boolean;
 
          power : longint;
-         hl : plabel;
+         hl : pasmlabel;
 
       begin
          shrdiv := false;
@@ -123,7 +119,7 @@ implementation
                  { bring denominator to EDI }
                  { EDI is always free, it's }
                  { only used for temporary  }
-                 { purposes                 }
+                 { purposes              }
               if (p^.right^.location.loc<>LOC_REGISTER) and
                  (p^.right^.location.loc<>LOC_CREGISTER) then
                 begin
@@ -244,7 +240,7 @@ implementation
          pushed,popecx : boolean;
          op : tasmop;
          hr : preference;
-         l1,l2,l3 : plabel;
+         l1,l2,l3 : pasmlabel;
 
       begin
          popecx:=false;
@@ -698,12 +694,12 @@ implementation
                    end;
               end;
            end;
-{ Here was a problem...            }
+{ Here was a problem...     }
 { Operand to be negated always     }
 { seems to be converted to signed  }
-{ 32-bit before doing neg!!        }
-{ So this is useless...            }
-{         emitoverflowcheck(p);}
+{ 32-bit before doing neg!!     }
+{ So this is useless...     }
+{        emitoverflowcheck(p);}
       end;
 
 
@@ -717,7 +713,7 @@ implementation
             (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
              F_A,F_AE,F_B,F_BE);
       var
-         hl : plabel;
+         hl : pasmlabel;
          opsize : topsize;
          hr : preference;
 
@@ -890,14 +886,20 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  1999-05-25 20:36:13  florian
+  Revision 1.25  1999-05-27 19:44:16  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.24  1999/05/25 20:36:13  florian
     * some bugs in the qword code generation fixed
 
   Revision 1.23  1999/05/08 20:41:08  jonas
     + positive number MOD power of 2 now done with AND instruction
-
     * fix to division of positive numbers by power of 2
-
     * the result of a MOD is left in EDX if possible
 
   Revision 1.22  1999/05/01 13:24:11  peter

compiler/cg386mem.pas

@@ -47,11 +47,7 @@ implementation
       cobjects,verbose,globals,
       symtable,aasm,types,
       hcodegen,temp_gen,pass_2,pass_1,
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
       cgai386,tgeni386;
 
 {*****************************************************************************
@@ -64,10 +60,6 @@ implementation
          exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,
             S_L,newasmsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname),0,
             p^.location.register)));
-{$ifndef NEWLAB}
-         maybe_concat_external(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.owner,
-            pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname);
-{$endif}
       end;
 
 
@@ -96,28 +88,28 @@ implementation
            end
          else
            begin
-              pushusedregisters(exprasmlist,pushed,$ff);
+              pushusedregisters(pushed,$ff);
 
               { code copied from simplenewdispose PM }
               { determines the size of the mem block }
               push_int(ppointerdef(p^.resulttype)^.definition^.size);
 
               gettempofsizereference(target_os.size_of_pointer,p^.location.reference);
-              emitpushreferenceaddr(exprasmlist,p^.location.reference);
+              emitpushreferenceaddr(p^.location.reference);
 
-              emitcall('FPC_GETMEM',true);
+              emitcall('FPC_GETMEM');
               if ppointerdef(p^.resulttype)^.definition^.needs_inittable then
                 begin
                    new(r);
                    reset_reference(r^);
-                   r^.symbol:=newasmsymbol(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
-                   emitpushreferenceaddr(exprasmlist,r^);
+                   r^.symbol:=ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label;
+                   emitpushreferenceaddr(r^);
                    { push pointer adress }
-                   emitpushreferenceaddr(exprasmlist,p^.location.reference);
+                   emitpushreferenceaddr(p^.location.reference);
                    dispose(r);
-                   emitcall('FPC_INITIALIZE',true);
+                   emitcall('FPC_INITIALIZE');
                 end;
-              popusedregisters(exprasmlist,pushed);
+              popusedregisters(pushed);
               { may be load ESI }
               maybe_loadesi;
            end;
@@ -171,7 +163,7 @@ implementation
          if codegenerror then
            exit;
 
-         pushusedregisters(exprasmlist,pushed,$ff);
+         pushusedregisters(pushed,$ff);
          { determines the size of the mem block }
          push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
 
@@ -180,7 +172,7 @@ implementation
             LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
               p^.left^.location.register)));
             LOC_REFERENCE:
-              emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+              emitpushreferenceaddr(p^.left^.location.reference);
          end;
 
          { call the mem handling procedures }
@@ -191,42 +183,42 @@ implementation
                   begin
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=newasmsymbol(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
-                     emitpushreferenceaddr(exprasmlist,r^);
+                     r^.symbol:=ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label;
+                     emitpushreferenceaddr(r^);
                      { push pointer adress }
                      case p^.left^.location.loc of
                         LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
                           p^.left^.location.register)));
                         LOC_REFERENCE:
-                          emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                          emitpushreferenceaddr(p^.left^.location.reference);
                      end;
                      dispose(r);
-                     emitcall('FPC_FINALIZE',true);
+                     emitcall('FPC_FINALIZE');
                   end;
-                emitcall('FPC_FREEMEM',true);
+                emitcall('FPC_FREEMEM');
              end;
            simplenewn:
              begin
-                emitcall('FPC_GETMEM',true);
+                emitcall('FPC_GETMEM');
                 if ppointerdef(p^.left^.resulttype)^.definition^.needs_inittable then
                   begin
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=newasmsymbol(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
-                     emitpushreferenceaddr(exprasmlist,r^);
+                     r^.symbol:=ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label;
+                     emitpushreferenceaddr(r^);
                      { push pointer adress }
                      case p^.left^.location.loc of
                         LOC_CREGISTER : exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,
                           p^.left^.location.register)));
                         LOC_REFERENCE:
-                          emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                          emitpushreferenceaddr(p^.left^.location.reference);
                      end;
                      dispose(r);
-                     emitcall('FPC_INITIALIZE',true);
+                     emitcall('FPC_INITIALIZE');
                   end;
              end;
          end;
-         popusedregisters(exprasmlist,pushed);
+         popusedregisters(pushed);
          { may be load ESI }
          maybe_loadesi;
       end;
@@ -322,7 +314,7 @@ implementation
               begin
                  exprasmlist^.concat(new(pai386,op_reg(
                    A_PUSH,S_L,p^.location.reference.base)));
-                 emitcall('FPC_CHECKPOINTER',true);
+                 emitcall('FPC_CHECKPOINTER');
               end;
       end;
 
@@ -412,9 +404,9 @@ implementation
       var
          extraoffset : longint;
          { rl stores the resulttype of the left node, this is necessary }
-         { to detect if it is an ansistring                             }
-         { because in constant nodes which constant index               }
-         { the left tree is removed                                     }
+         { to detect if it is an ansistring                          }
+         { because in constant nodes which constant index              }
+         { the left tree is removed                                  }
          rl : pdef;
          t   : ptree;
          hp  : preference;
@@ -440,14 +432,14 @@ implementation
                         CGMessage(cg_e_illegal_expression);
                         exit;
                      end;
-                   pushusedregisters(exprasmlist,pushed,$ff);
-                   emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                   pushusedregisters(pushed,$ff);
+                   emitpushreferenceaddr(p^.left^.location.reference);
                    if is_ansistring(p^.left^.resulttype) then
-                     emitcall('FPC_ANSISTR_UNIQUE',true)
+                     emitcall('FPC_ANSISTR_UNIQUE')
                    else
-                     emitcall('FPC_WIDESTR_UNIQUE',true);
+                     emitcall('FPC_WIDESTR_UNIQUE');
                    maybe_loadesi;
-                   popusedregisters(exprasmlist,pushed);
+                   popusedregisters(pushed);
                 end;
 
               if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
@@ -467,11 +459,11 @@ implementation
                 we can use the ansistring routine here }
               if (cs_check_range in aktlocalswitches) then
                 begin
-                   pushusedregisters(exprasmlist,pushed,$ff);
+                   pushusedregisters(pushed,$ff);
                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.location.reference.base)));
-                   emitcall('FPC_ANSISTR_CHECKZERO',true);
+                   emitcall('FPC_ANSISTR_CHECKZERO');
                    maybe_loadesi;
-                   popusedregisters(exprasmlist,pushed);
+                   popusedregisters(pushed);
                 end;
 
               if is_ansistring(p^.left^.resulttype) then
@@ -532,13 +524,13 @@ implementation
                         st_widestring,
                         st_ansistring:
                           begin
-                             pushusedregisters(exprasmlist,pushed,$ff);
+                             pushusedregisters(pushed,$ff);
                              push_int(p^.right^.value);
                              hp:=newreference(p^.location.reference);
                              dec(hp^.offset,7);
                              exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,hp)));
-                             emitcall('FPC_ANSISTR_RANGECHECK',true);
-                             popusedregisters(exprasmlist,pushed);
+                             emitcall('FPC_ANSISTR_RANGECHECK');
+                             popusedregisters(pushed);
                              maybe_loadesi;
                           end;
 
@@ -713,13 +705,13 @@ implementation
                          st_widestring,
                          st_ansistring:
                            begin
-                              pushusedregisters(exprasmlist,pushed,$ff);
+                              pushusedregisters(pushed,$ff);
                               exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,ind)));
                               hp:=newreference(p^.location.reference);
                               dec(hp^.offset,7);
                               exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,hp)));
-                              emitcall('FPC_ANSISTR_RANGECHECK',true);
-                              popusedregisters(exprasmlist,pushed);
+                              emitcall('FPC_ANSISTR_RANGECHECK');
+                              popusedregisters(pushed);
                               maybe_loadesi;
                            end;
                          st_shortstring:
@@ -758,9 +750,9 @@ implementation
                       A_LEA,S_L,newreference(p^.location.reference),
                       p^.location.reference.index)));
                     ungetregister32(p^.location.reference.base);
-                    { the symbol offset is loaded,               }
+                    { the symbol offset is loaded,             }
                     { so release the symbol name and set symbol  }
-                    { to nil                                     }
+                    { to nil                                 }
                     p^.location.reference.symbol:=nil;
                     p^.location.reference.offset:=0;
                     calc_emit_mul;
@@ -857,7 +849,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.45  1999-05-23 18:42:04  florian
+  Revision 1.46  1999-05-27 19:44:17  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.45  1999/05/23 18:42:04  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/cg386set.pas

@@ -38,11 +38,7 @@ implementation
       cobjects,verbose,globals,
       symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
       cgai386,tgeni386;
 
      const
@@ -93,7 +89,7 @@ implementation
          setparts   : array[1..8] of Tsetpart;
          i,numparts : byte;
          {href,href2 : Treference;}
-         l,l2       : plabel;
+         l,l2       : pasmlabel;
 
          function analizeset(Aset:pconstset;is_small:boolean):boolean;
            type
@@ -223,19 +219,14 @@ implementation
             else
               p^.location.resflags:=F_E;
 
-            {reset_reference(href);}
             getlabel(l);
-            {href.symbol:=newasmsymbol(lab2str(l));}
 
             for i:=1 to numparts do
              if setparts[i].range then
               begin
                 { Check if left is in a range }
                 { Get a label to jump over the check }
-                {reset_reference(href2);}
                 getlabel(l2);
-                {shouldn't it be href2 here ??
-                href.symbol:=newasmsymbol(lab2str(l2));}
                 if setparts[i].start=setparts[i].stop-1 then
                  begin
                    case p^.left^.location.loc of
@@ -375,7 +366,7 @@ implementation
                     begin
                       { the set element isn't never samller than a byte  }
                       { and because it's a small set we need only 5 bits }
-                      { but 8 bits are easier to load                    }
+                      { but 8 bits are easier to load               }
                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,
                         newreference(p^.left^.location.reference),R_EDI)));
                       hr:=R_EDI;
@@ -425,11 +416,11 @@ implementation
                else
                 begin
                   pushsetelement(p^.left);
-                  emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
+                  emitpushreferenceaddr(p^.right^.location.reference);
                   del_reference(p^.right^.location.reference);
                   { registers need not be save. that happens in SET_IN_BYTE }
                   { (EDI is changed) }
-                  emitcall('FPC_SET_IN_BYTE',true);
+                  emitcall('FPC_SET_IN_BYTE');
                   { ungetiftemp(p^.right^.location.reference); }
                   p^.location.loc:=LOC_FLAGS;
                   p^.location.resflags:=F_C;
@@ -453,7 +444,7 @@ implementation
          hp : ptree;
          { register with case expression }
          hregister : tregister;
-         endlabel,elselabel : plabel;
+         endlabel,elselabel : pasmlabel;
 
          { true, if we can omit the range check of the jump table }
          jumptable_no_range : boolean;
@@ -463,7 +454,7 @@ implementation
       procedure gentreejmp(p : pcaserecord);
 
         var
-           lesslabel,greaterlabel : plabel;
+           lesslabel,greaterlabel : pasmlabel;
 
        begin
          emitlab(p^._at);
@@ -537,7 +528,7 @@ implementation
                begin
                   { it begins with the smallest label, if the value }
                   { is even smaller then jump immediately to the    }
-                  { ELSE-label                                      }
+                  { ELSE-label                                }
                   if first then
                     begin
                        { have we to ajust the first value ? }
@@ -550,20 +541,11 @@ implementation
                               exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,
                                 t^._low,hregister)));
                          end;
-                       { work around: if the lower range=0 and we
-                         do the subtraction we have to take care
-                         of the sign!
-                       this isn't necessary, this is tested before now (FK)
-                       if t^._low=0 then
-                         emitl(A_JBE,elselabel)
-                       else
-                       emitl(jmp_lee,elselabel);
-                       }
                     end
                   else
                   { if there is no unused label between the last and the }
                   { present label then the lower limit can be checked    }
-                  { immediately. else check the range in between:        }
+                  { immediately. else check the range in between:       }
                   if (t^._low-last>1) then
                     begin
                        exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
@@ -591,7 +573,7 @@ implementation
       procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
 
         var
-           table : plabel;
+           table : pasmlabel;
            last : longint;
            hr : preference;
 
@@ -605,9 +587,9 @@ implementation
                genitem(t^.less);
              { fill possible hole }
              for i:=last+1 to t^._low-1 do
-               jumpsegment^.concat(new(pai_const_symbol,initname(lab2str(elselabel))));
+               jumpsegment^.concat(new(pai_const_symbol,init(elselabel)));
              for i:=t^._low to t^._high do
-               jumpsegment^.concat(new(pai_const_symbol,initname(lab2str(t^.statement))));
+               jumpsegment^.concat(new(pai_const_symbol,init(t^.statement)));
               last:=t^._high;
              if assigned(t^.greater) then
                genitem(t^.greater);
@@ -638,7 +620,7 @@ implementation
              end;
            new(hr);
            reset_reference(hr^);
-           hr^.symbol:=newasmsymbol(lab2str(table));
+           hr^.symbol:=table;
            hr^.offset:=(-min_)*4;
            hr^.index:=hregister;
            hr^.scalefactor:=4;
@@ -729,10 +711,10 @@ implementation
               { procedures are empirically passed on }
               { consumption can also be calculated   }
               { but does it pay on the different     }
-              { processors?                          }
+              { processors?                       }
               { moreover can the size only be appro- }
               { ximated as it is not known if rel8,  }
-              { rel16 or rel32 jumps are used        }
+              { rel16 or rel32 jumps are used   }
               min_label:=case_get_min(p^.nodes);
               max_label:=case_get_max(p^.nodes);
               labels:=case_count_labels(p^.nodes);
@@ -740,7 +722,7 @@ implementation
               getrange(p^.left^.resulttype,lv,hv);
               jumptable_no_range:=(lv=min_label) and (hv=max_label);
               { hack a little bit, because the range can be greater }
-              { than the positive range of a longint                }
+              { than the positive range of a longint            }
 
               if (min_label<0) and (max_label>0) then
                 begin
@@ -834,7 +816,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  1999-05-21 13:54:54  peter
+  Revision 1.32  1999-05-27 19:44:19  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.31  1999/05/21 13:54:54  peter
     * NEWLAB for label as symbol
 
   Revision 1.30  1999/05/05 08:09:24  michael

compiler/cobjects.pas

@@ -29,6 +29,8 @@
 
 unit cobjects;
 
+{ define OLDSPEEDVALUE}
+
   interface
 
     uses
@@ -40,9 +42,13 @@ unit cobjects;
 {$endif}
       ;
 
-    const   hasharraysize = 253; {The size of a hasharray should be a prime
-                                  number for better spreading of nodes in
-                                  the array!! (DM)}
+    const
+       { the real size will be [-hasharray..hasharray] ! }
+{$ifdef TP}
+       hasharraysize = 127;
+{$else}
+       hasharraysize = 2047;
+{$endif}
 
     type
        pstring = ^string;
@@ -178,7 +184,7 @@ unit cobjects;
        end;
 
        Pdictionaryhasharray=^Tdictionaryhasharray;
-       Tdictionaryhasharray=array[0..hasharraysize-1] of Pnamedindexobject;
+       Tdictionaryhasharray=array[-hasharraysize..hasharraysize] of Pnamedindexobject;
 
        Tnamedindexcallback = procedure(p:Pnamedindexobject);
 
@@ -340,6 +346,8 @@ unit cobjects;
        end;
 {$endif BUFFEREDFILE}
 
+    function getspeedvalue(const s : string) : longint;
+
     { releases the string p and assignes nil to p }
     { if p=nil then freemem isn't called          }
     procedure stringdispose(var p : pstring);
@@ -367,6 +375,66 @@ unit cobjects;
 
   implementation
 
+{$ifndef OLDSPEEDVALUE}
+
+{*****************************************************************************
+                                   Crc 32
+*****************************************************************************}
+
+var
+{$ifdef Delphi}
+  Crc32Tbl : array[0..255] of longword;
+{$else Delphi}
+  Crc32Tbl : array[0..255] of longint;
+{$endif Delphi}
+
+procedure MakeCRC32Tbl;
+var
+{$ifdef Delphi}
+  crc : longword;
+{$else Delphi}
+  crc : longint;
+{$endif Delphi}
+  i,n : byte;
+begin
+  for i:=0 to 255 do
+   begin
+     crc:=i;
+     for n:=1 to 8 do
+      if odd(crc) then
+       crc:=(crc shr 1) xor $edb88320
+      else
+       crc:=crc shr 1;
+     Crc32Tbl[i]:=crc;
+   end;
+end;
+
+
+{$ifopt R+}
+  {$define Range_check_on}
+{$endif opt R+}
+
+{$R- needed here }
+{CRC 32}
+Function GetSpeedValue(Const s:String):longint;
+var
+  i,InitCrc : longint;
+begin
+  if Crc32Tbl[1]=0 then
+   MakeCrc32Tbl;
+  InitCrc:=$ffffffff;
+  for i:=1to Length(s) do
+   InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
+  GetSpeedValue:=InitCrc;
+end;
+
+{$ifdef Range_check_on}
+  {$R+}
+  {$undef Range_check_on}
+{$endif Range_check_on}
+
+{$else}
+
 {$ifndef TP}
     function getspeedvalue(const s : string) : longint;
       var
@@ -380,7 +448,7 @@ unit cobjects;
         i:=0;
         while p1<>p2 do
          begin
-           inc(i,p1^);
+           i:=i + ord(p1^);
            inc(longint(p1));
          end;
         getspeedvalue:=i;
@@ -402,13 +470,16 @@ unit cobjects;
         l:=0;
         while p1<>p2 do
          begin
-           l:=l+p1^;
+           l:=l + ord(p1^);
            inc(p1);
          end;
         getspeedvalue:=l;
       end;
 {$endif}
 
+{$endif OLDSPEEDVALUE}
+
+
     function pchar2pstring(p : pchar) : pstring;
       var
          w,i : longint;
@@ -1044,7 +1115,7 @@ end;
         if assigned(root) then
           cleartree(root);
         if assigned(hasharray) then
-         for w:=0 to hasharraysize-1 do
+         for w:=-hasharraysize to hasharraysize do
           if assigned(hasharray^[w]) then
            cleartree(hasharray^[w]);
       end;
@@ -1057,7 +1128,7 @@ end;
         if assigned(hasharray) then
          begin
            empty:=false;
-           for w:=0 to hasharraysize-1 do
+           for w:=-hasharraysize to hasharraysize do
             if assigned(hasharray^[w]) then
              exit;
            empty:=true;
@@ -1083,7 +1154,7 @@ end;
       begin
         if assigned(hasharray) then
          begin
-           for i:=0 to hasharraysize-1 do
+           for i:=-hasharraysize to hasharraysize do
             if assigned(hasharray^[i]) then
              a(hasharray^[i]);
          end
@@ -1941,7 +2012,15 @@ end;
 end.
 {
   $Log$
-  Revision 1.31  1999-05-21 13:54:59  peter
+  Revision 1.32  1999-05-27 19:44:23  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.31  1999/05/21 13:54:59  peter
     * NEWLAB for label as symbol
 
   Revision 1.30  1999/05/21 10:38:59  peter

compiler/daopt386.pas

@@ -79,7 +79,7 @@ Function DFAPass2(
                                       BlockStart, BlockEnd: Pai): Boolean;
 Procedure ShutDownDFA;
 
-Function FindLabel(L: PLabel; Var hp: Pai): Boolean;
+Function FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
 
 {******************************* Constants *******************************}
 
@@ -607,10 +607,10 @@ Begin
           Then
             Begin
               LabelFound := True;
-              If (Pai_Label(p)^.l^.nb < LowLabel) Then
-                LowLabel := Pai_Label(p)^.l^.nb;
-              If (Pai_Label(p)^.l^.nb > HighLabel) Then
-                HighLabel := Pai_Label(p)^.l^.nb;
+              If (Pai_Label(p)^.l^.labelnr < LowLabel) Then
+                LowLabel := Pai_Label(p)^.l^.labelnr;
+              If (Pai_Label(p)^.l^.labelnr > HighLabel) Then
+                HighLabel := Pai_Label(p)^.l^.labelnr;
             End
 {          Else
             Begin
@@ -678,7 +678,7 @@ Begin
                 Case p^.typ Of
                   ait_Label:
                     If Pai_Label(p)^.l^.is_used Then
-                      LabelTable^[Pai_Label(p)^.l^.nb-LowLabel].PaiObj := p;
+                      LabelTable^[Pai_Label(p)^.l^.labelnr-LowLabel].PaiObj := p;
                   ait_regAlloc:
                      begin
                        if PairegAlloc(p)^.Allocation then
@@ -732,7 +732,7 @@ End;
 
 {************************ Search the Label table ************************}
 
-Function FindLabel(L: PLabel; Var hp: Pai): Boolean;
+Function FindLabel(L: PasmLabel; Var hp: Pai): Boolean;
 
 {searches for the specified label starting from hp as long as the
  encountered instructions are labels, to be able to optimize constructs like
@@ -1647,7 +1647,7 @@ Begin
 {$Else JumpAnal}
           Begin
            If (Pai_Label(p)^.is_used) Then
-             With LTable^[Pai_Label(p)^.l^.nb-LoLab] Do
+             With LTable^[Pai_Label(p)^.l^.labelnr-LoLab] Do
 {$IfDef AnalyzeLoops}
               If (RefsFound = Pai_Label(p)^.l^.RefCount)
 {$Else AnalyzeLoops}
@@ -1662,9 +1662,8 @@ Begin
  {we've processed at least one jump to this label}
                       Begin
                         If (GetLastInstruction(p, hp) And
-                           Not(((hp^.typ = ait_labeled_instruction) or
-                                (hp^.typ = ait_instruction)) And
-                                (pai386_labeled(hp)^.opcode = A_JMP))
+                           Not(((hp^.typ = ait_instruction)) And
+                                (pai386_labeled(hp)^.is_jmp))
                           Then
   {previous instruction not a JMP -> the contents of the registers after the
    previous intruction has been executed have to be taken into account as well}
@@ -1680,7 +1679,7 @@ Begin
  {a label from a backward jump (e.g. a loop), no jump to this label has
   already been processed}
                       If GetLastInstruction(p, hp) And
-                         Not(hp^.typ = ait_labeled_instruction) And
+                         Not(hp^.typ = ait_instruction) And
                             (pai386_labeled(hp)^.opcode = A_JMP))
                         Then
   {previous instruction not a jmp, so keep all the registers' contents from the
@@ -1697,12 +1696,13 @@ Begin
      {continue until we find a jump to the label or a label which has already
       been processed}
                             While GetNextInstruction(hp, hp) And
-                                  Not((hp^.typ = ait_labeled_instruction) And
-                                      (pai386_labeled(hp)^.lab^.nb = Pai_Label(p)^.l^.nb)) And
+                                  Not((hp^.typ = ait_instruction) And
+                                      (pai386(hp)^.is_jmp) and
+                                      (pasmlabel(pai386(hp)^.oper[0].sym)^.labelnr = Pai_Label(p)^.l^.labelnr)) And
                                   Not((hp^.typ = ait_label) And
-                                      (LTable^[Pai_Label(hp)^.l^.nb-LoLab].RefsFound
+                                      (LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].RefsFound
                                        = Pai_Label(hp)^.l^.RefCount) And
-                                      (LTable^[Pai_Label(hp)^.l^.nb-LoLab].JmpsProcessed > 0)) Do
+                                      (LTable^[Pai_Label(hp)^.l^.labelnr-LoLab].JmpsProcessed > 0)) Do
                               Inc(Cnt);
                             If (hp^.typ = ait_label)
                               Then
@@ -1732,12 +1732,20 @@ Begin
                   End;
           End;
 {$EndIf JumpAnal}
-        ait_labeled_instruction:
+
+{$ifdef GDB}
+        ait_stabs, ait_stabn, ait_stab_function_name:;
+{$endif GDB}
+
+        ait_instruction:
+          Begin
+            if pai386(p)^.is_jmp then
+             begin
 {$IfNDef JumpAnal}
   ;
 {$Else JumpAnal}
-          With LTable^[pai386_labeled(p)^.lab^.nb-LoLab] Do
-            If (RefsFound = pai386_labeled(p)^.lab^.RefCount) Then
+          With LTable^[pasmlabel(pai386(p)^.oper[0].sym)^.labelnr-LoLab] Do
+            If (RefsFound = pasmlabel(pai386(p)^.oper[0].sym)^.RefCount) Then
               Begin
                 If (InstrCnt < InstrNr)
                   Then
@@ -1818,11 +1826,9 @@ Begin
 {$endif AnalyzeLoops}
           End;
 {$EndIf JumpAnal}
-{$ifdef GDB}
-        ait_stabs, ait_stabn, ait_stab_function_name:;
-{$endif GDB}
-        ait_instruction:
-          Begin
+          end
+          else
+           begin
             InstrProp := AsmInstr[Pai386(p)^.opcode];
             Case Pai386(p)^.opcode Of
               A_MOV, A_MOVZX, A_MOVSX:
@@ -1990,6 +1996,7 @@ Begin
                       Inc(Cnt);
                     End
                 End;
+              end;
             End;
           End
         Else
@@ -2017,17 +2024,20 @@ Begin
     Begin
 {$IfDef JumpAnal}
       Case P^.Typ Of
-        ait_labeled_instruction:
-          begin
-            If (pai386_labeled(P)^.lab^.nb >= LoLab) And
-               (pai386_labeled(P)^.lab^.nb <= HiLab) Then
-            Inc(LTable^[pai386_labeled(P)^.lab^.nb-LoLab].RefsFound);
-          end;
         ait_label:
           Begin
             If (Pai_Label(p)^.l^.is_used) Then
-              LTable^[Pai_Label(P)^.l^.nb-LoLab].InstrNr := NrOfPaiObjs
+              LTable^[Pai_Label(P)^.l^.labelnr-LoLab].InstrNr := NrOfPaiObjs
           End;
+        ait_instruction:
+          begin
+            if pai386(p)^.is_jmp then
+             begin
+               If (pasmlabel(pai386(P)^.oper[0].sym)^.labelnr >= LoLab) And
+                  (pasmlabel(pai386(P)^.oper[0].sym)^.labelnr <= HiLab) Then
+                 Inc(LTable^[pasmlabel(pai386(P)^.oper[0].sym)^.labelnr-LoLab].RefsFound);
+             end;
+          end;
 {        ait_instruction:
           Begin
            If (Pai386(p)^.opcode = A_PUSH) And
@@ -2095,8 +2105,16 @@ End.
 
 {
  $Log$
- Revision 1.46  1999-05-08 20:40:02  jonas
-   * seperate OPTimizer INFO pointer field in tai object
+ Revision 1.47  1999-05-27 19:44:24  peter
+   * removed oldasm
+   * plabel -> pasmlabel
+   * -a switches to source writing automaticly
+   * assembler readers OOPed
+   * asmsymbol automaticly external
+   * jumptables and other label fixes for asm readers
+
+ Revision 1.46  1999/05/08 20:40:02  jonas
+   * seperate OPTimizer INFO pointer field in tai object
    * fix to GetLastInstruction that sometimes caused a crash
 
  Revision 1.45  1999/05/01 13:48:37  peter

compiler/gdb.pas

@@ -27,11 +27,7 @@ unit gdb;
     uses
       globtype,
 {$ifdef i386}
-   {$ifndef OLDASM}
-       i386base,
-   {$else}
-       i386,
-   {$endif}
+      i386base,
 {$endif i386}
       strings,cobjects,globals,aasm;
 
@@ -96,11 +92,9 @@ Const
           0,1,2,3,4,5,6,7,0,1,2,3,4,5,7,0,1,2,3,0,1,2,3,
           -1,10,12,13,14,15,11,
           -1,-1,-1,-1,-1,-1,-1,-1,-1,
-{$ifndef OLDASM}
           -1,-1,-1,-1,-1,-1,
           -1,-1,-1,-1,
           -1,-1,-1,-1,-1,
-{$endif}
           { I think, GDB doesn't know MMX (FK) }
           -1,-1,-1,-1,-1,-1,-1,-1,
           -1,-1,-1,-1,-1,-1,-1,-1
@@ -263,7 +257,15 @@ end.
 
 {
   $Log$
-  Revision 1.10  1999-05-12 00:19:48  peter
+  Revision 1.11  1999-05-27 19:44:27  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.10  1999/05/12 00:19:48  peter
     * removed R_DEFAULT_SEG
     * uniform float names
 

compiler/globals.pas

@@ -177,8 +177,6 @@ unit globals;
     const
        parser_current_file : string = '';
 
-    function getspeedvalue(const s : string) : longint;
-
 {$ifdef debug}
     { if the pointer don't point to the heap then write an error }
     function assigned(p : pointer) : boolean;
@@ -241,45 +239,6 @@ unit globals;
            end;
       end;
 
-{$ifdef FPC}
-    function getspeedvalue(const s : string) : longint;
-      var
-        p1,p2:^byte;
-      begin
-        p1:=@s;
-        longint(p2):=longint(p1)+p1^+1;
-        inc(longint(p1));
-        getspeedvalue:=0;
-        while p1<>p2 do
-         begin
-           inc(getspeedvalue,p1^);
-           inc(longint(p1));
-         end;
-      end;
-{$else}
-    function getspeedvalue(const s : string) : longint;
-      type
-        ptrrec=record
-          ofs,seg:word;
-        end;
-      var
-        l,w   : longint;
-        p1,p2 : ^byte;
-      begin
-        p1:=@s;
-        ptrrec(p2).seg:=ptrrec(p1).seg;
-        ptrrec(p2).ofs:=ptrrec(p1).ofs+p1^+1;
-        inc(p1);
-        l:=0;
-        while p1<>p2 do
-         begin
-           l:=l+p1^;
-           inc(p1);
-         end;
-        getspeedvalue:=l;
-      end;
-{$endif}
-
 
     function ngraphsearchvalue(const s1,s2 : string) : double;
       const
@@ -1203,7 +1162,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  1999-05-13 21:59:26  peter
+  Revision 1.8  1999-05-27 19:44:29  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.7  1999/05/13 21:59:26  peter
     * removed oldppu code
     * warning if objpas is loaded from uses
     * first things for new deref writing

compiler/hcgdata.pas

@@ -28,8 +28,8 @@ interface
        symtable,aasm;
 
     { generates the message tables for a class }
-    function genstrmsgtab(_class : pobjectdef) : plabel;
-    function genintmsgtab(_class : pobjectdef) : plabel;
+    function genstrmsgtab(_class : pobjectdef) : pasmlabel;
+    function genintmsgtab(_class : pobjectdef) : pasmlabel;
 
     { generates a VMT for _class }
     procedure genvmt(_class : pobjectdef);
@@ -52,7 +52,7 @@ implementation
        pprocdeftree = ^tprocdeftree;
        tprocdeftree = record
           p   : pprocdef;
-          nl  : plabel;
+          nl  : pasmlabel;
           l,r : pprocdeftree;
        end;
 
@@ -186,21 +186,18 @@ implementation
            writestrentry(p^.l);
 
          { write name label }
-         datasegment^.concat(new(pai_const_symbol,initname(lab2str(p^.nl))));
+         datasegment^.concat(new(pai_const_symbol,init(p^.nl)));
          datasegment^.concat(new(pai_const_symbol,initname(p^.p^.mangledname)));
-{$ifndef NEWLAB}
-         maybe_concat_external(p^.p^.owner,p^.p^.mangledname);
-{$endif}
 
          if assigned(p^.r) then
            writestrentry(p^.r);
       end;
 
-    function genstrmsgtab(_class : pobjectdef) : plabel;
+    function genstrmsgtab(_class : pobjectdef) : pasmlabel;
 
 
       var
-         r : plabel;
+         r : pasmlabel;
 
       begin
          root:=nil;
@@ -234,18 +231,15 @@ implementation
          { write name label }
          datasegment^.concat(new(pai_const,init_32bit(p^.p^.messageinf.i)));
          datasegment^.concat(new(pai_const_symbol,initname(p^.p^.mangledname)));
-{$ifndef NEWLAB}
-         maybe_concat_external(p^.p^.owner,p^.p^.mangledname);
-{$endif}
 
          if assigned(p^.r) then
            writeintentry(p^.r);
       end;
 
-    function genintmsgtab(_class : pobjectdef) : plabel;
+    function genintmsgtab(_class : pobjectdef) : pasmlabel;
 
       var
-         r : plabel;
+         r : pasmlabel;
 
       begin
          root:=nil;
@@ -538,10 +532,6 @@ implementation
                                     begin
                                       datasegment^.concat(new(pai_const_symbol,
                                         initname(procdefcoll^.data^.mangledname)));
-{$ifndef NEWLAB}
-                                      maybe_concat_external(procdefcoll^.data^.owner,
-                                        procdefcoll^.data^.mangledname);
-{$endif}
                                     end;
                                end;
                           end;
@@ -572,7 +562,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  1999-05-21 13:55:00  peter
+  Revision 1.7  1999-05-27 19:44:30  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.6  1999/05/21 13:55:00  peter
     * NEWLAB for label as symbol
 
   Revision 1.5  1999/05/17 21:57:07  florian

compiler/hcodegen.pas

@@ -29,11 +29,7 @@ unit hcodegen;
       tokens,verbose,
       aasm,symtable
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
       ,m68k
@@ -47,11 +43,11 @@ unit hcodegen;
        pi_operator  = $8;       { set, if the procedure is an operator   }
        pi_C_import  = $10;      { set, if the procedure is an external C function }
        pi_uses_exceptions = $20;{ set, if the procedure has a try statement => }
-                                { no register variables                        }
+                                { no register variables                 }
        pi_is_assembler = $40;   { set if the procedure is declared as ASSEMBLER
                                   => don't optimize}
        pi_needs_implicit_finally = $80; { set, if the procedure contains data which }
-                                        { needs to be finalized                     }
+                                        { needs to be finalized              }
     type
        pprocinfo = ^tprocinfo;
        tprocinfo = record
@@ -84,7 +80,7 @@ unit hcodegen;
           call_offset : longint;
 
           { some collected informations about the procedure }
-          { see pi_xxxx above                               }
+          { see pi_xxxx above                          }
           flags : longint;
 
           { register used as frame pointer }
@@ -104,7 +100,7 @@ unit hcodegen;
 
        { some kind of temp. types needs to be destructed }
        { for example ansistring, this is done using this }
-       { list                                            }
+       { list                                       }
        ptemptodestroy = ^ttemptodestroy;
        ttemptodestroy = object(tlinkedlist_item)
           typ : pdef;
@@ -117,19 +113,19 @@ unit hcodegen;
        procinfo : tprocinfo;
 
        { labels for BREAK and CONTINUE }
-       aktbreaklabel,aktcontinuelabel : plabel;
+       aktbreaklabel,aktcontinuelabel : pasmlabel;
 
        { label when the result is true or false }
-       truelabel,falselabel : plabel;
+       truelabel,falselabel : pasmlabel;
 
        { label to leave the sub routine }
-       aktexitlabel : plabel;
+       aktexitlabel : pasmlabel;
 
        { also an exit label, only used we need to clear only the stack }
-       aktexit2label : plabel;
+       aktexit2label : pasmlabel;
 
        { only used in constructor for fail or if getmem fails }
-       quickexitlabel : plabel;
+       quickexitlabel : pasmlabel;
 
        { Boolean, wenn eine loadn kein Assembler erzeugt hat }
        simple_loadn : boolean;
@@ -151,13 +147,8 @@ unit hcodegen;
     procedure cgmessage2(const t : tmsgconst;const s1,s2 : string);
     procedure cgmessage3(const t : tmsgconst;const s1,s2,s3 : string);
 
-{$ifndef NEWLAB}
-    { helpers }
-    procedure maybe_concat_external(symt : psymtable;const name : string);
-{$endif}
-
     { initialize respectively terminates the code generator }
-    { for a new module or procedure                         }
+    { for a new module or procedure                      }
     procedure codegen_doneprocedure;
     procedure codegen_donemodule;
     procedure codegen_newmodule;
@@ -222,25 +213,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                                    Helpers
-*****************************************************************************}
-
-{$ifndef NEWLAB}
-
-    procedure maybe_concat_external(symt : psymtable;const name : string);
-      begin
-         if (symt^.symtabletype=unitsymtable) or
-            ((symt^.symtabletype in [recordsymtable,objectsymtable]) and
-             (symt^.defowner^.owner^.symtabletype=unitsymtable)) or
-            ((symt^.symtabletype=withsymtable) and
-             (symt^.defowner^.owner^.symtabletype=unitsymtable)) then
-           concat_external(name,EXT_NEAR);
-      end;
-
-{$endif}
-
-
 {*****************************************************************************
          initialize/terminate the codegen for procedure and modules
 *****************************************************************************}
@@ -253,7 +225,7 @@ implementation
            so it must not be reset to zero before this storage !}
          { the type of this lists isn't important }
          { because the code of this lists is      }
-         { copied to the code segment             }
+         { copied to the code segment        }
          procinfo.aktentrycode:=new(paasmoutput,init);
          procinfo.aktexitcode:=new(paasmoutput,init);
          procinfo.aktproccode:=new(paasmoutput,init);
@@ -279,8 +251,6 @@ implementation
          codesegment:=new(paasmoutput,init);
          bsssegment:=new(paasmoutput,init);
          debuglist:=new(paasmoutput,init);
-         externals:=new(paasmoutput,init);
-         internals:=new(paasmoutput,init);
          consts:=new(paasmoutput,init);
          rttilist:=new(paasmoutput,init);
          importssection:=nil;
@@ -299,8 +269,6 @@ implementation
          dispose(bsssegment,done);
          dispose(datasegment,done);
          dispose(debuglist,done);
-         dispose(externals,done);
-         dispose(internals,done);
          dispose(consts,done);
          dispose(rttilist,done);
          if assigned(importssection) then
@@ -328,7 +296,15 @@ end.
 
 {
   $Log$
-  Revision 1.32  1999-05-21 13:55:01  peter
+  Revision 1.33  1999-05-27 19:44:31  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.32  1999/05/21 13:55:01  peter
     * NEWLAB for label as symbol
 
   Revision 1.31  1999/05/17 21:57:08  florian

compiler/i386asm.pas

@@ -45,20 +45,6 @@ const
   MaxPrefixes=4;
 
 type
-  { this is for quicker determination of the operand type instead of
-    using opertype and OT ... etc. }
-  toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
-
-  toper=record
-    ot  : longint;
-    case typ : toptype of
-     top_none   : ();
-     top_reg    : (reg:tregister);
-     top_ref    : (ref:preference);
-     top_const  : (val:longint);
-     top_symbol : (sym:pasmsymbol;symofs:longint);
-  end;
-
   pairegalloc = ^tairegalloc;
   tairegalloc = object(tai)
      allocation : boolean;
@@ -78,6 +64,7 @@ type
 
   pai386 = ^tai386;
   tai386 = object(tai)
+     is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
      opcode    : tasmop;
      opsize    : topsize;
      condition : TAsmCond;
@@ -126,6 +113,7 @@ type
      destructor done;virtual;
      function  getcopy:plinkedlist_item;virtual;
      function  GetString:string;
+     procedure SwapOperands;
   private
      segprefix : tregister;
      procedure init(op : tasmop;_size : topsize); { this need to be called by all constructor }
@@ -148,20 +136,6 @@ type
 {$endif NOAG386BIN}
   end;
 
-{$ifndef NEWLAB}
-  pai386_labeled = ^tai386_labeled;
-  tai386_labeled = object(tai386)
-     lab : plabel;
-     constructor op_lab(op : tasmop; l : plabel);
-     constructor op_cond_lab(op : tasmop; cond:tasmcond;l : plabel);
-     destructor  done;virtual;
-{$ifndef NOAG386BIN}
-     function  Pass1(offset:longint):longint;virtual;
-     procedure Pass2;virtual;
-{$endif}
-  end;
-{$endif}
-
 
 implementation
 uses
@@ -242,6 +216,8 @@ uses
            symofs:=sofs;
            typ:=top_symbol;
          end;
+        { Mark the symbol as used }
+        inc(s^.refs);
       end;
 
     procedure tai386.loadref(opidx:longint;p:preference);
@@ -267,6 +243,9 @@ uses
                if not(ref^.segment in [R_DS,R_NO]) then
                  segprefix:=ref^.segment;
                typ:=top_ref;
+               { mark symbol as used }
+               if assigned(ref^.symbol) then
+                 inc(ref^.symbol^.refs);
              end;
          end;
       end;
@@ -306,6 +285,7 @@ uses
     procedure tai386.init(op : tasmop;_size : topsize);
       begin
          typ:=ait_instruction;
+         is_jmp:=false;
          segprefix:=R_NO;
          opcode:=op;
          opsize:=_size;
@@ -678,8 +658,8 @@ begin
              inc(l,sym^.address);
             { instruction size will then always become 2 (PFV) }
             relsize:=InsOffset+2-l;
-            if (l<>-1) and
-               (not assigned(sym) or (sym^.typ<>AS_EXTERNAL)) and
+            if (not assigned(sym) or
+                ((sym^.typ<>AS_EXTERNAL) and (sym^.address<>0))) and
                (relsize>=-128) and (relsize<=127) then
              ot:=OT_IMM32 or OT_SHORT
             else
@@ -696,6 +676,28 @@ begin
 end;
 
 
+procedure tai386.SwapOperands;
+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;
+
+
 function tai386.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
@@ -796,7 +798,6 @@ end;
 function tai386.Pass1(offset:longint):longint;
 var
   m,i,size_prob : longint;
-  p : toper;
 begin
   Pass1:=0;
 { Save the old offset and set the new offset }
@@ -808,21 +809,8 @@ begin
      { Check if error last time then InsSize=-1 }
      if InsSize=-1 then
       exit;
-     { 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;
+     { We need intel style operands }
+     SwapOperands;
      { create the .ot fields }
      create_ot;
      { set the file postion }
@@ -1529,72 +1517,18 @@ begin
 end;
 {$endif NOAG386BIN}
 
-
-{$ifndef NEWLAB}
-
-{*****************************************************************************
-                               Tai_Labeled
-*****************************************************************************}
-
-    constructor tai386_labeled.op_lab(op : tasmop; l : plabel);
-      begin
-         inherited op_none(op,S_NO);
-         typ:=ait_labeled_instruction;
-         lab:=l;
-         lab^.is_used:=true;
-         inc(lab^.refcount);
-      end;
-
-    constructor tai386_labeled.op_cond_lab(op : tasmop; cond:tasmcond;l : plabel);
-      begin
-         inherited op_none(op,S_NO);
-         condition:=cond;
-         typ:=ait_labeled_instruction;
-         lab:=l;
-         lab^.is_used:=true;
-         inc(lab^.refcount);
-      end;
-
-
-    destructor tai386_labeled.done;
-      begin
-         dec(lab^.refcount);
-         if lab^.refcount=0 then
-           Begin
-             lab^.is_used := False;
-             If Not(lab^.is_set) Then
-               Dispose(lab);
-           End;
-        inherited done;
-      end;
-
-
-{$ifndef NOAG386BIN}
-   function tai386_labeled.Pass1(offset:longint):longint;
-      begin
-         { Only create the Operand if it's not set yet }
-         ops:=1;
-         loadsymbol(0,nil,lab^.address);
-         Pass1:=inherited Pass1(offset);
-      end;
-
-
-   procedure tai386_labeled.Pass2;
-      begin
-         { update the address which can be changed if it was
-           a forward reference }
-         oper[0].symofs:=lab^.address;
-         inherited Pass2;
-      end;
-{$endif}
-
-{$endif}
-
-
 end.
 {
   $Log$
-  Revision 1.9  1999-05-21 13:55:02  peter
+  Revision 1.10  1999-05-27 19:44:33  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.9  1999/05/21 13:55:02  peter
     * NEWLAB for label as symbol
 
   Revision 1.8  1999/05/17 21:57:09  florian

compiler/i386base.pas

@@ -581,7 +581,7 @@ type
 
   { immediate/reference record }
   preference = ^treference;
-  treference = record
+  treference = packed record
      is_immediate : boolean; { is this used as reference or immediate }
      segment,
      base,
@@ -594,6 +594,24 @@ type
   end;
 
 
+{*****************************************************************************
+                                Operand
+*****************************************************************************}
+
+type
+  toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
+
+  toper=record
+    ot  : longint;
+    case typ : toptype of
+     top_none   : ();
+     top_reg    : (reg:tregister);
+     top_ref    : (ref:preference);
+     top_const  : (val:longint);
+     top_symbol : (sym:pasmsymbol;symofs:longint);
+  end;
+
+
 {*****************************************************************************
                                Generic Location
 *****************************************************************************}
@@ -731,6 +749,8 @@ var
 
     function reg2str(r : tregister) : string;
 
+    function is_calljmp(o:tasmop):boolean;
+
 
 implementation
 
@@ -771,6 +791,22 @@ implementation
       end;
 
 
+    function is_calljmp(o:tasmop):boolean;
+      begin
+        case o of
+          A_CALL,
+          A_JCXZ,
+          A_JECXZ,
+          A_JMP,
+          A_LOOP,
+          A_Jcc :
+            is_calljmp:=true;
+          else
+            is_calljmp:=false;
+        end;
+      end;
+
+
     procedure disposereference(var r : preference);
       begin
          dispose(r);
@@ -921,7 +957,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  1999-05-17 14:33:50  pierre
+  Revision 1.5  1999-05-27 19:44:34  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.4  1999/05/17 14:33:50  pierre
    uses heaptrc need for extrainfo with heaptrc
 
   Revision 1.3  1999/05/12 00:19:51  peter

compiler/msgidx.inc

@@ -330,8 +330,7 @@ type tmsgconst=(
   asmr_h_direct_global_to_mangled,
   asmr_w_direct_global_is_overloaded_func,
   asmr_e_cannot_use_SELF_outside_a_method,
-  asmr_e_cannot_use___SELF_outside_methode,
-  asmr_e_cannot_use___OLDEBP_outside_nested_procedure,
+  asmr_e_cannot_use_OLDEBP_outside_nested_procedure,
   asmr_e_void_function,
   asmr_e_SEG_not_supported,
   asmr_e_size_suffix_and_dest_dont_match,
@@ -460,6 +459,7 @@ type tmsgconst=(
   option_no_debug_support_recompile_fpc,
   option_obsolete_switch,
   option_obsolete_switch_use_new,
+  option_switch_bin_to_src_assembler,
   option_logo_start,
   option_logo_end,
   option_info_start,

compiler/msgtxt.inc

@@ -349,83 +349,82 @@ const msgtxt : array[0..000095,1..240] of char=(
   'H_$1 translated to $2'#000+
   'W_$1 is associated to an overloaded function'#000+
   'E_Cannot use SELF outside a method'#000+
-  'E_Cannot use __','SELF outside a method'#000+
-  'E_Cannot use __OLDEBP outside a nested procedure'#000+
+  'E_Cannot use OL','DEBP outside a nested procedure'#000+
   'W_Functions with void return value can'#039't return any value in asm c'+
   'ode'#000+
   'E_SEG not supported'#000+
   'E_Size suffix and destination or source size do not match'#000+
-  'W_Size suffix and des','tination or source size do not match'#000+
-  'E_Assembler syntax error'#000+
+  'W_Size suffix and destination or source size do not match'#000+
+  'E_','Assembler syntax error'#000+
   'E_Invalid combination of opcode and operands'#000+
   'E_Assemler syntax error in operand'#000+
   'E_Assemler syntax error in constant'#000+
   'E_Invalid String expression'#000+
-  '32bit constant created for address',#000+
+  '32bit constant created for address'#000+
   'E_Invalid or missing opcode'#000+
-  'E_Invalid combination of prefix and opcode: $1'#000+
+  'E_Invalid ','combination of prefix and opcode: $1'#000+
   'E_Invalid combination of override and opcode: $1'#000+
   'E_Too many operands on line'#000+
   'W_NEAR ignored'#000+
   'W_FAR ignored'#000+
   'E_Duplicate local symbol $1'#000+
   'E_Undefined local symbol $1'#000+
-  'E_','Unknown label identifier $1'#000+
-  'E_Invalid floating point register name'#000+
+  'E_Unknown label identifier $1'#000+
+  'E_Invalid f','loating point register name'#000+
   'E_NOR not supported'#000+
   'W_Modulo not supported'#000+
   'E_Invalid floating point constant $1'#000+
   'E_Invalid floating point expression'#000+
   'E_Wrong symbol type'#000+
-  'E_Cannot index a local var or paramet','er with a register'#000+
-  'E_Invalid segment override expression'#000+
+  'E_Cannot index a local var or parameter with a register'#000+
+  'E_Invalid segment ov','erride expression'#000+
   'W_Identifier $1 supposed external'#000+
   'E_Strings not allowed as constants'#000+
   'No type of variable specified'#000+
   'E_assembler code not returned to text section'#000+
   'E_Not a directive or local symbol $1'#000+
-  'E','_Using a defined name as a local label'#000+
+  'E_Using a defined name as a local label'#000,
   'F_Too many assembler files'#000+
   'F_Selected assembler output not supported'#000+
   'F_Comp not supported'#000+
   'F_Direct not support for binary writers'#000+
   'E_Allocating of data is only allowed in bss section'#000+
-  'F_No binary writer ','selected'#000+
-  'E_Asm: Opcode $1 not in table'#000+
+  'F_No binary writer selected'#000+
+  'E_Asm: Opcode $1 not in table'#000,
   'E_Asm: $1 invalid combination of opcode and operands'#000+
   'E_Asm: 16 Bit references not supported'#000+
   'E_Asm: Invalid effective address'#000+
   'E_Asm: Immediate or reference expected'#000+
   'E_Asm: $1 value exceeds bounds $2'#000+
-  'E_A','sm: Short jump is out of range $1'#000+
-  'W_Source operating system redefined'#000+
+  'E_Asm: Short jump is out of range $1'#000+
+  'W_Sou','rce operating system redefined'#000+
   'I_Assembling (pipe) $1'#000+
   'E_Can'#039't create assember file $1'#000+
   'W_Assembler $1 not found, switching to external assembling'#000+
   'T_Using assembler: $1'#000+
-  'W_Error while assembling exitcode ','$1'#000+
-  'W_Can'#039't call the assembler, error $1 switching to external assembl'+
-  'ing'#000+
+  'W_Error while assembling exitcode $1'#000+
+  'W_Can'#039't call the assembler, error $1',' switching to external assem'+
+  'bling'#000+
   'I_Assembling $1'#000+
   'W_Linker $1 not found, switching to external linking'#000+
   'T_Using linker: $1'#000+
   'W_Object $1 not found, Linking may fail !'#000+
-  'W_Library $1 not found, Linking may f','ail !'#000+
+  'W_Library $1 not found, Linking may fail !'#000+
   'W_Error while linking'#000+
-  'W_Can'#039't call the linker, switching to external linking'#000+
+  'W_Can'#039't cal','l the linker, switching to external linking'#000+
   'I_Linking $1'#000+
   'W_binder not found, switching to external binding'#000+
   'W_ar not found, switching to external ar'#000+
   'E_Dynamic Libraries not supported'#000+
-  'I_Closing script $1',#000+
-  'W_resource compiler not found, switching to external mode'#000+
+  'I_Closing script $1'#000+
+  'W_resource compiler not found, switchi','ng to external mode'#000+
   'I_Compiling resource $1'#000+
   'F_Can'#039't post process executable $1'#000+
   'F_Can'#039't open executable $1'#000+
   'X_Size of Code: $1 bytes'#000+
   'X_Size of initialized data: $1 bytes'#000+
-  'X_Size of uninitialized data: $1 ','bytes'#000+
-  'X_Stack space reserved: $1 bytes'#000+
+  'X_Size of uninitialized data: $1 bytes'#000+
+  'X_Stack space reserved: $1 bytes'#000,
   'X_Stack space commited: $1 bytes'#000+
   'T_Unitsearch: $1'#000+
   'T_PPU Loading $1'#000+
@@ -435,8 +434,8 @@ const msgtxt : array[0..000095,1..240] of char=(
   'U_PPU Time: $1'#000+
   'U_PPU File too short'#000+
   'U_PPU Invalid Header (no PPU at the begin)'#000+
-  'U_PPU Inva','lid Version $1'#000+
-  'U_PPU is compiled for an other processor'#000+
+  'U_PPU Invalid Version $1'#000+
+  'U_PPU is compiled for an',' other processor'#000+
   'U_PPU is compiled for an other target'#000+
   'U_PPU Source: $1'#000+
   'U_Writing $1'#000+
@@ -444,45 +443,46 @@ const msgtxt : array[0..000095,1..240] of char=(
   'F_reading PPU-File'#000+
   'F_unexpected end of PPU-File'#000+
   'F_Invalid PPU-File entry: $1'#000+
-  'F_PPU Dbx count ','problem'#000+
+  'F_PPU Dbx count problem'#000+
   'E_Illegal unit name: $1'#000+
-  'F_Too much units'#000+
+  'F_Too m','uch units'#000+
   'F_Circular unit reference between $1 and $2'#000+
   'F_Can'#039't compile unit $1, no sources available'#000+
   'W_Compiling the system unit requires the -Us switch'#000+
-  'F_There were $1 errors compiling module, stopping',#000+
+  'F_There were $1 errors compiling module, stopping'#000+
   'U_Load from $1 ($2) unit $3'#000+
-  'U_Recompiling $1, checksum changed for $2'#000+
+  'U_Recompil','ing $1, checksum changed for $2'#000+
   'U_Recompiling $1, source found only'#000+
   'U_Recompiling unit, static lib is older than ppufile'#000+
   'U_Recompiling unit, shared lib is older than ppufile'#000+
-  'U_Recompiling unit, obj and',' asm are older than ppufile'#000+
-  'U_Recompiling unit, obj is older than asm'#000+
+  'U_Recompiling unit, obj and asm are older than ppufile'#000+
+  'U_Recompili','ng unit, obj is older than asm'#000+
   'U_Parsing interface of $1'#000+
   'U_Parsing implementation of $1'#000+
   'U_Second load for unit $1'#000+
   'U_PPU Check file $1 time $2'#000+
   '$1 [options] <inputfile> [options]'#000+
-  'W_Only one source file s','upported'#000+
-  'W_DEF file can be created only for OS/2'#000+
+  'W_Only one source file supported'#000+
+  'W_DEF file can be created only',' for OS/2'#000+
   'E_nested response files are not supported'#000+
   'F_No source file name in command line'#000+
   'E_Illegal parameter: $1'#000+
   'H_-? writes help pages'#000+
   'F_Too many config files nested'#000+
   'F_Unable to open file $1'#000+
-  'N_Readin','g further options from $1'#000+
-  'W_Target is already set to: $1'#000+
+  'N_Reading further options from $1'#000+
+  'W_Target is a','lready set to: $1'#000+
   'W_Shared libs not supported on DOS platform, reverting to static'#000+
   'F_too many IF(N)DEFs'#000+
   'F_too many ENDIFs'#000+
   'F_open conditional at the end of the file'#000+
-  'W_Debug information generation is not',' supported by this executable'#000+
-  'H_Try recompiling with -dGDB'#000+
+  'W_Debug information generation is not supported by this executable'#000+
+  'H_Try rec','ompiling with -dGDB'#000+
   'E_You are using the obsolete switch $1'#000+
   'E_You are using the obsolete switch $1, please use $2'#000+
+  'N_Switching assembler to default source writing assembler'#000+
   'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
-  'Copyright (c) 1993-98 by ','Florian Klaempfl'#000+
+  'Copyri','ght (c) 1993-98 by Florian Klaempfl'#000+
   'Free Pascal Compiler version $FPCVER'#000+
   #000+
   'Compiler Date  : $FPCDATE'#000+
@@ -491,27 +491,27 @@ const msgtxt : array[0..000095,1..240] of char=(
   'This program comes under the GNU General Public Licence'#000+
   'For more information read COPYING.FPC'#000+
   #000+
-  'Report bugs,suggestions etc to:'#000+
-  '   ','              [email protected]'#000+
+  'Report bugs,sugg','estions etc to:'#000+
+  '                 [email protected]'#000+
   '**0*_put + after a boolean switch option to enable it, - to disable it'+
   #000+
   '**1a_the compiler doesn'#039't delete the generated assembler file'#000+
-  '**2al_list sourcecode lines in assembler file'#000+
-  '**2ar_list re','gister allocation/release info in assembler file'#000+
+  '**2al_list sourcecode lines in assembler',' file'#000+
+  '**2ar_list register allocation/release info in assembler file'#000+
   '**2at_list temp allocation/release info in assembler file'#000+
   '**1b_generate browser info'#000+
   '**2bl_generate local symbol info'#000+
   '**1B_build all modules'#000+
-  '**1C<x>_code generation options:'#000+
-  '3*2CD_create dyna','mic library'#000+
+  '**1C<x>_code generation options',':'#000+
+  '3*2CD_create dynamic library'#000+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
   '**2Ci_IO-checking'#000+
   '**2Cn_omit linking stage'#000+
   '**2Co_check overflow of integer operations'#000+
   '**2Cr_range checking'#000+
   '**2Cs<n>_set stack size to <n>'#000+
-  '**2Ct_stack checking'#000+
-  '3*2CS_create stat','ic library'#000+
+  '**2Ct_stack checkin','g'#000+
+  '3*2CS_create static library'#000+
   '3*2Cx_use smartlinking'#000+
   '**1d<x>_defines the symbol <x>'#000+
   '*O1D_generate a DEF file'#000+
@@ -519,21 +519,21 @@ const msgtxt : array[0..000095,1..240] of char=(
   '*O2Dw_PM application'#000+
   '**1e<x>_set path to executable'#000+
   '**1E_same as -Cn'#000+
-  '**1F<x>_set file names and paths:'#000+
-  '**2FD<x>_sets t','he directory where to search for compiler utilities'#000+
+  '**1F<x>_set file names and pat','hs:'#000+
+  '**2FD<x>_sets the directory where to search for compiler utilities'#000+
   '**2Fe<x>_redirect error output to <x>'#000+
   '**2FE<x>_set exe/unit output path to <x>'#000+
   '**2Fi<x>_adds <x> to include path'#000+
   '**2Fl<x>_adds <x> to library path'#000+
-  '*L2FL<x>_uses <x> as dynamic linker'#000+
-  '**2Fo','<x>_adds <x> to object path'#000+
+  '*L2FL<x>_uses <x> as d','ynamic linker'#000+
+  '**2Fo<x>_adds <x> to object path'#000+
   '**2Fr<x>_load error message file <x>'#000+
   '**2Fu<x>_adds <x> to unit path'#000+
   '**2FU<x>_set unit output path to <x>, overrides -FE'#000+
   '*g1g<x>_generate debugger information:'#000+
   '*g2gg_use gsym'#000+
   '*g2gd_use dbx'#000+
-  '*g2gh_use heap trace uni','t'#000+
+  '*g2gh','_use heap trace unit'#000+
   '**1i_information'#000+
   '**2iD_return compiler date'#000+
   '**2iV_return compiler version'#000+
@@ -541,78 +541,78 @@ const msgtxt : array[0..000095,1..240] of char=(
   '**2iSP_return compiler processor'#000+
   '**2iTO_return target OS'#000+
   '**2iTP_return target processor'#000+
-  '**1I<x>_adds <x> to include path'#000+
-  '**1k<x>_Pass <x> ','to the linker'#000+
+  '**1I<x>_adds <x> to include pat','h'#000+
+  '**1k<x>_Pass <x> to the linker'#000+
   '**1l_write logo'#000+
   '**1n_don'#039't read the default config file'#000+
   '**1o<x>_change the name of the executable produced to <x>'#000+
   '**1pg_generate profile code for gprof'#000+
-  '*L1P_use pipes instead of creating temporary assembler files'#000+
-  '**1S<x>_synta','x options:'#000+
+  '*L1P_use pipes instead of creating temporary assembler ','files'#000+
+  '**1S<x>_syntax options:'#000+
   '**2S2_switch some Delphi 2 extensions on'#000+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
   '**2Sd_tries to be Delphi compatible'#000+
   '**2Se_compiler stops after the first error'#000+
   '**2Sg_allow LABEL and GOTO'#000+
-  '**2Sh_Use ansistrings'#000+
-  '**2Si_supp','ort C++ styled INLINE'#000+
+  '**2Sh_Use ans','istrings'#000+
+  '**2Si_support C++ styled INLINE'#000+
   '**2Sm_support macros like C (global)'#000+
   '**2So_tries to be TP/BP 7.0 compatible'#000+
   '**2Sp_tries to be gpc compatible'#000+
   '**2Ss_constructor name must be init (destructor must be done)'#000+
-  '**2St_allow static keyword in objects'#000+
-  '**1s_don'#039,'t call assembler and linker (only with -a)'#000+
+  '**2St_allow static keyword i','n objects'#000+
+  '**1s_don'#039't call assembler and linker (only with -a)'#000+
   '**1u<x>_undefines the symbol <x>'#000+
   '**1U_unit options:'#000+
   '**2Un_don'#039't check the unit name'#000+
   '**2Us_compile a system unit'#000+
-  '**1v<x>_Be verbose. <x> is a combination of the following letters:'#000+
-  '**2*_e : Show erro','rs (default)       d : Show debug info'#000+
+  '**1v<x>_Be verbose. <x> is a combination of the following letters:',#000+
+  '**2*_e : Show errors (default)       d : Show debug info'#000+
   '**2*_w : Show warnings               u : Show unit info'#000+
   '**2*_n : Show notes                  t : Show tried/used files'#000+
   '**2*_h : Show hints                  m : Show defined macros'#000+
-  '**2*_i : Show general',' info           p : Show compiled procedures'#000+
+  '**','2*_i : Show general info           p : Show compiled procedures'#000+
   '**2*_l : Show linenumbers            c : Show conditionals'#000+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#000+
-  '**2*_b : Show all procedure          r : Rhide/GCC compatibility m','od'+
+  '**2*_b : Show all procedure          r : Rhide/','GCC compatibility mod'+
   'e'#000+
   '**2*_    declarations if an error    x : Executable info (Win32 only)'#000+
   '**2*_    occurs'#000+
   '**1X_executable options:'#000+
   '*L2Xc_link with the c library'#000+
   '**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
-  '**2Xs_strip all symbols from execu','table'#000+
+  '**2Xs_strip all',' symbols from executable'#000+
   '**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+
   '**0*_Processor specific options:'#000+
   '3*1A<x>_output format:'#000+
   '3*2Ao_coff file using GNU AS'#000+
   '3*2Anasmcoff_coff file using Nasm'#000+
-  '3*2Anasmelf_elf32 (Linux) file using Nasm'#000+
-  '3*2Anasmobj_ob','j file using Nasm'#000+
+  '3*2Anasmelf_elf32 (Linux) file using ','Nasm'#000+
+  '3*2Anasmobj_obj file using Nasm'#000+
   '3*2Amasm_obj file using Masm (Microsoft)'#000+
   '3*2Atasm_obj file using Tasm (Borland)'#000+
   '3*1R<x>_assembler reading style:'#000+
   '3*2Ratt_read AT&T style assembler'#000+
   '3*2Rintel_read Intel style assembler'#000+
-  '3*2Rdirect_copy assembler text directl','y to assembler file'#000+
+  '3*2Rdirect_copy ass','embler text directly to assembler file'#000+
   '3*1O<x>_optimizations:'#000+
   '3*2Og_generate smaller code'#000+
   '3*2OG_generate faster code (default)'#000+
   '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
   '3*2Ou_enable uncertain optimizations (see docs)'#000+
-  '3*2O1_level 1 optimizatio','ns (quick optimizations)'#000+
+  '3*2O1_','level 1 optimizations (quick optimizations)'#000+
   '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
   '3*2O3_level 3 optimizations (same as -O2u)'#000+
   '3*2Op<x>_target processor:'#000+
   '3*3Op1_set target processor to 386/486'#000+
-  '3*3Op2_set target processor to Pentium/PentiumMMX',' (tm)'#000+
+  '3*3Op2_set target processor to',' Pentium/PentiumMMX (tm)'#000+
   '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
   '3*1T<x>_Target operating system:'#000+
   '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
   '3*2TLINUX_Linux'#000+
-  '3*2TOS2_OS/2 2.x'#000+
-  '3*2TWin32_Windows ','32 Bit'#000+
+  '3*2TOS2_OS/2 2.x',#000+
+  '3*2TWin32_Windows 32 Bit'#000+
   '6*1A<x>_output format'#000+
   '6*2Ao_Unix o-file using GNU AS'#000+
   '6*2Agas_GNU Motorola assembler'#000+
@@ -620,14 +620,14 @@ const msgtxt : array[0..000095,1..240] of char=(
   '6*2Amot_Standard Motorola assembler'#000+
   '6*1O_optimizations:'#000+
   '6*2Oa_turn on the optimizer'#000+
-  '6*2Og_generate smaller code'#000+
-  '6*2OG_ge','nerate faster code (default)'#000+
+  '6*2Og_generate sm','aller code'#000+
+  '6*2OG_generate faster code (default)'#000+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#000+
   '6*2O2_set target processor to a MC68020+'#000+
   '6*1R<x>_assembler reading style:'#000+
   '6*2RMOT_read motorola style assembler'#000+
   '6*1T<x>_Target operating system:'#000+
-  '6*2TAMIGA_Commodore Amiga'#000,
+  '6*2TAMI','GA_Commodore Amiga'#000+
   '6*2TATARI_Atari ST/STe/TT'#000+
   '6*2TMACOS_Macintosh m68k'#000+
   '6*2TLINUX_Linux-68k'#000+

compiler/parser.pas

@@ -174,8 +174,6 @@ unit parser;
          oldcodesegment,
          oldexprasmlist,
          olddebuglist,
-         oldinternals,
-         oldexternals,
          oldconsts     : paasmoutput;
          oldasmsymbollist : pasmsymbollist;
        { akt.. things }
@@ -223,8 +221,6 @@ unit parser;
          oldbsssegment:=bsssegment;
          oldcodesegment:=codesegment;
          olddebuglist:=debuglist;
-         oldexternals:=externals;
-         oldinternals:=internals;
          oldconsts:=consts;
          oldrttilist:=rttilist;
          oldexprasmlist:=exprasmlist;
@@ -386,8 +382,6 @@ unit parser;
               codesegment:=oldcodesegment;
               consts:=oldconsts;
               debuglist:=olddebuglist;
-              externals:=oldexternals;
-              internals:=oldinternals;
               importssection:=oldimports;
               exportssection:=oldexports;
               resourcesection:=oldresource;
@@ -462,7 +456,15 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.73  1999-05-18 22:35:52  pierre
+  Revision 1.74  1999-05-27 19:44:41  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.73  1999/05/18 22:35:52  pierre
    * double dispose of aktprocsym removed
 
   Revision 1.72  1999/04/26 13:31:36  peter

compiler/pass_1.pas

@@ -43,11 +43,7 @@ implementation
       tcadd,tccal,tccnv,tccon,tcflw,
       tcinl,tcld,tcmat,tcmem,tcset
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base,i386asm
-{$else}
-      ,i386
-{$endif}
       ,tgeni386
 {$endif}
 {$ifdef m68k}
@@ -200,31 +196,31 @@ implementation
     procedure firstpass(var p : ptree);
       const
          procedures : array[ttreetyp] of firstpassproc =
-            (firstadd,         {addn}
-             firstadd,         {muln}
-             firstadd,         {subn}
+            (firstadd,   {addn}
+             firstadd,   {muln}
+             firstadd,   {subn}
              firstmoddiv,      {divn}
-             firstadd,         {symdifn}
+             firstadd,   {symdifn}
              firstmoddiv,      {modn}
              firstassignment,  {assignn}
-             firstload,        {loadn}
+             firstload, {loadn}
              firstrange,       {range}
-             firstadd,         {ltn}
-             firstadd,         {lten}
-             firstadd,         {gtn}
-             firstadd,         {gten}
-             firstadd,         {equaln}
-             firstadd,         {unequaln}
-             firstin,          {inn}
-             firstadd,         {orn}
-             firstadd,         {xorn}
+             firstadd,   {ltn}
+             firstadd,   {lten}
+             firstadd,   {gtn}
+             firstadd,   {gten}
+             firstadd,   {equaln}
+             firstadd,   {unequaln}
+             firstin,     {inn}
+             firstadd,   {orn}
+             firstadd,   {xorn}
              firstshlshr,      {shrn}
              firstshlshr,      {shln}
-             firstadd,         {slashn}
-             firstadd,         {andn}
+             firstadd,   {slashn}
+             firstadd,   {andn}
              firstsubscript,   {subscriptn}
              firstderef,       {derefn}
-             firstaddr,        {addrn}
+             firstaddr, {addrn}
              firstdoubleaddr,  {doubleaddrn}
              firstordconst,    {ordconstn}
              firsttypeconv,    {typeconvn}
@@ -233,47 +229,47 @@ implementation
              firstrealconst,   {realconstn}
              firstfixconst,    {fixconstn}
              firstumminus,     {umminusn}
-             firstasm,         {asmn}
-             firstvec,         {vecn}
+             firstasm,   {asmn}
+             firstvec,   {vecn}
              firststringconst, {stringconstn}
              firstfuncret,     {funcretn}
-             firstself,        {selfn}
-             firstnot,         {notn}
+             firstself, {selfn}
+             firstnot,   {notn}
              firstinline,      {inlinen}
-             firstniln,        {niln}
+             firstniln, {niln}
              firsterror,       {errorn}
-             firsttype,        {typen}
-             firsthnew,        {hnewn}
+             firsttype, {typen}
+             firsthnew, {hnewn}
              firsthdispose,    {hdisposen}
-             firstnew,         {newn}
+             firstnew,   {newn}
              firstsimplenewdispose, {simpledisposen}
              firstsetelement,  {setelementn}
              firstsetconst,    {setconstn}
              firstblock,       {blockn}
              firststatement,   {statementn}
              firstnothing,     {loopn}
-             firstif,          {ifn}
+             firstif,     {ifn}
              firstnothing,     {breakn}
              firstnothing,     {continuen}
              first_while_repeat, {repeatn}
              first_while_repeat, {whilen}
-             firstfor,         {forn}
-             firstexit,        {exitn}
-             firstwith,        {withn}
-             firstcase,        {casen}
+             firstfor,   {forn}
+             firstexit, {exitn}
+             firstwith, {withn}
+             firstcase, {casen}
              firstlabel,       {labeln}
-             firstgoto,        {goton}
+             firstgoto, {goton}
              firstsimplenewdispose, {simplenewn}
              firsttryexcept,   {tryexceptn}
              firstraise,       {raisen}
              firstnothing,     {switchesn}
              firsttryfinally,  {tryfinallyn}
-             firston,          {onn}
-             firstis,          {isn}
-             firstas,          {asn}
+             firston,     {onn}
+             firstis,     {isn}
+             firstas,     {asn}
              firsterror,       {caretn}
              firstnothing,     {failn}
-             firstadd,         {starstarn}
+             firstadd,   {starstarn}
              firstprocinline,  {procinlinen}
              firstarrayconstruct, {arrayconstructn}
              firstarrayconstructrange, {arrayconstructrangen}
@@ -283,7 +279,7 @@ implementation
       var
          oldcodegenerror  : boolean;
          oldlocalswitches : tlocalswitches;
-         oldpos           : tfileposinfo;
+         oldpos    : tfileposinfo;
 {$ifdef extdebug}
          str1,str2 : string;
          oldp      : ptree;
@@ -372,7 +368,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.101  1999-05-01 13:24:26  peter
+  Revision 1.102  1999-05-27 19:44:42  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.101  1999/05/01 13:24:26  peter
     * merged nasm compiler
     * old asm moved to oldasm/
 

compiler/pass_2.pas

@@ -30,7 +30,7 @@ uses
   tree;
 
 { produces assembler for the expression in variable p }
-{ and produces an assembler node at the end           }
+{ and produces an assembler node at the end        }
 procedure generatecode(var p : ptree);
 
 { produces the actual code }
@@ -49,11 +49,7 @@ implementation
      ,gdb
 {$endif}
 {$ifdef i386}
-{$ifndef OLDASM}
      ,i386base,i386asm
-{$else}
-     ,i386
-{$endif}
      ,tgeni386,cgai386
      ,cg386con,cg386mat,cg386cnv,cg386set,cg386add
      ,cg386mem,cg386cal,cg386ld,cg386flw,cg386inl
@@ -122,15 +118,12 @@ implementation
 
 
     procedure secondasm(var p : ptree);
-{$ifndef OLDASM}
       var
         hp,hp2 : pai;
         localfixup,parafixup,
         i : longint;
         r : preference;
-{$endif}
       begin
-{$ifndef OLDASM}
          if (aktprocsym^.definition^.options and poinline)<>0 then
            begin
              localfixup:=aktprocsym^.definition^.localst^.address_fixup;
@@ -169,7 +162,6 @@ implementation
               end
            end
          else
-{$endif}
            exprasmlist^.concatlist(p^.p_asm);
          if not p^.object_preserved then
           begin
@@ -186,28 +178,28 @@ implementation
      procedure secondpass(var p : ptree);
        const
          procedures : array[ttreetyp] of secondpassproc =
-            (secondadd,         {addn}
-             secondadd,         {muln}
-             secondadd,         {subn}
+            (secondadd,  {addn}
+             secondadd,  {muln}
+             secondadd,  {subn}
              secondmoddiv,      {divn}
-             secondadd,         {symdifn}
+             secondadd,  {symdifn}
              secondmoddiv,      {modn}
              secondassignment,  {assignn}
              secondload,        {loadn}
              secondnothing,     {range}
-             secondadd,         {ltn}
-             secondadd,         {lten}
-             secondadd,         {gtn}
-             secondadd,         {gten}
-             secondadd,         {equaln}
-             secondadd,         {unequaln}
-             secondin,          {inn}
-             secondadd,         {orn}
-             secondadd,         {xorn}
+             secondadd,  {ltn}
+             secondadd,  {lten}
+             secondadd,  {gtn}
+             secondadd,  {gten}
+             secondadd,  {equaln}
+             secondadd,  {unequaln}
+             secondin,    {inn}
+             secondadd,  {orn}
+             secondadd,  {xorn}
              secondshlshr,      {shrn}
              secondshlshr,      {shln}
-             secondadd,         {slashn}
-             secondadd,         {andn}
+             secondadd,  {slashn}
+             secondadd,  {andn}
              secondsubscriptn,  {subscriptn}
              secondderef,       {derefn}
              secondaddr,        {addrn}
@@ -219,12 +211,12 @@ implementation
              secondrealconst,   {realconstn}
              secondfixconst,    {fixconstn}
              secondumminus,     {umminusn}
-             secondasm,         {asmn}
+             secondasm,  {asmn}
              secondvecn,        {vecn}
              secondstringconst, {stringconstn}
              secondfuncret,     {funcretn}
              secondselfn,       {selfn}
-             secondnot,         {notn}
+             secondnot,  {notn}
              secondinline,      {inlinen}
              secondniln,        {niln}
              seconderror,       {errorn}
@@ -238,12 +230,12 @@ implementation
              secondblockn,      {blockn}
              secondstatement,   {statementn}
              secondnothing,     {loopn}
-             secondifn,         {ifn}
+             secondifn,  {ifn}
              secondbreakn,      {breakn}
              secondcontinuen,   {continuen}
              second_while_repeatn, {repeatn}
              second_while_repeatn, {whilen}
-             secondfor,         {forn}
+             secondfor,  {forn}
              secondexitn,       {exitn}
              secondwith,        {withn}
              secondcase,        {casen}
@@ -254,12 +246,12 @@ implementation
              secondraise,       {raisen}
              secondnothing,     {switchesn}
              secondtryfinally,  {tryfinallyn}
-             secondon,          {onn}
-             secondis,          {isn}
-             secondas,          {asn}
+             secondon,    {onn}
+             secondis,    {isn}
+             secondas,    {asn}
              seconderror,       {caretn}
              secondfail,        {failn}
-             secondadd,         {starstarn}
+             secondadd,  {starstarn}
              secondprocinline,  {procinlinen}
              secondarrayconstruct, {arrayconstructn}
              secondnothing,     {arrayconstructrangen}
@@ -269,7 +261,7 @@ implementation
       var
          oldcodegenerror  : boolean;
          oldlocalswitches : tlocalswitches;
-         oldpos           : tfileposinfo;
+         oldpos    : tfileposinfo;
       begin
          if not(p^.error) then
           begin
@@ -448,9 +440,9 @@ implementation
                                     end;
 
                                   { register is no longer available for }
-                                  { expressions                         }
+                                  { expressions                  }
                                   { search the register which is the most }
-                                  { unused                                }
+                                  { unused                              }
                                   usableregs:=usableregs-[varregs[i]];
                                   is_reg_var[varregs[i]]:=true;
                                   dec(c_usableregs);
@@ -492,7 +484,7 @@ implementation
                                     begin
                                        { procinfo is there actual,      }
                                        { because we can't never be in a }
-                                       { nested procedure               }
+                                       { nested procedure              }
                                        { when loading parameter to reg  }
                                        new(hr);
                                        reset_reference(hr^);
@@ -555,7 +547,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  1999-05-18 14:15:50  peter
+  Revision 1.23  1999-05-27 19:44:43  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.22  1999/05/18 14:15:50  peter
     * containsself fixes
     * checktypes()
 

compiler/pdecl.pas

@@ -29,11 +29,11 @@ unit pdecl;
 
     var
        { pointer to the last read type symbol, (for "forward" }
-       { types)                                               }
+       { types)                                        }
        lasttypesym : ptypesym;
 
        { hack, which allows to use the current parsed }
-       { object type as function argument type        }
+       { object type as function argument type  }
        testcurobject : byte;
        curobjectname : stringid;
 
@@ -43,7 +43,7 @@ unit pdecl;
     function stringtype : pdef;
 
     { reads a string, file type or a type id and returns a name and }
-    { pdef                                                          }
+    { pdef                                                        }
     function single_type(var s : string) : pdef;
 
     { reads the declaration blocks }
@@ -64,11 +64,7 @@ unit pdecl;
        ,pbase,ptconst,pexpr,psub,pexports
        { processor specific stuff }
 {$ifdef i386}
-{$ifndef OLDASM}
        ,i386base
-{$else}
-       ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
        ,m68k
@@ -222,7 +218,7 @@ unit pdecl;
     procedure label_dec;
 
       var
-         hl : plabel;
+         hl : pasmlabel;
 
       begin
          consume(_LABEL);
@@ -245,11 +241,11 @@ unit pdecl;
 
     procedure read_var_decs(is_record,is_object,is_threadvar:boolean);
     { reads the filed of a record into a        }
-    { symtablestack, if record=false            }
+    { symtablestack, if record=false        }
     { variants are forbidden, so this procedure }
-    { can be used to read object fields         }
+    { can be used to read object fields  }
     { if absolute is true, ABSOLUTE and file    }
-    { types are allowed                         }
+    { types are allowed                  }
     { => the procedure is also used to read     }
     { a sequence of variable declaration        }
       var
@@ -317,9 +313,6 @@ unit pdecl;
                   dispose(sc,done);
                   aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,p));
                   aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
-{$ifndef NEWLAB}
-                  concat_external(aktvarsym^.mangledname,EXT_NEAR);
-{$endif}
                   symtablestack^.insert(aktvarsym);
                   tokenpos:=storetokenpos;
                   symdone:=true;
@@ -512,10 +505,6 @@ unit pdecl;
                           end;
                          importlib^.importvariable(aktvarsym^.mangledname,dll_name,C_name)
                        end
-{$ifndef NEWLAB}
-                      else
-                       concat_external(aktvarsym^.mangledname,EXT_NEAR);
-{$endif}
                     end;
                    symdone:=true;
                  end
@@ -639,7 +628,7 @@ unit pdecl;
     function id_type(var s : string) : pdef;
     { reads a type definition and returns a pointer }
     { to a appropriating pdef, s gets the name of   }
-    { the type to allow name mangling               }
+    { the type to allow name mangling          }
       begin
          s:=pattern;
          consume(ID);
@@ -683,7 +672,7 @@ unit pdecl;
 
     function single_type(var s : string) : pdef;
     { reads a string, file type or a type id and returns a name and }
-    { pdef                                                          }
+    { pdef                                                        }
        var
           hs : string;
        begin
@@ -876,7 +865,7 @@ unit pdecl;
                      dec(testcurobject);
                      consume(RECKKLAMMER);
                   end;
-                { overriden property ?                                       }
+                { overriden property ?                                 }
                 { force property interface, if there is a property parameter }
                 if (token=COLON) or assigned(propertyparas) then
                   begin
@@ -1125,12 +1114,12 @@ unit pdecl;
         end;
 
       var
-         hs         : string;
+         hs      : string;
          pcrd       : pclassrefdef;
-         hp1        : pdef;
+         hp1    : pdef;
          oldprocsym : pprocsym;
          oldparse_only : boolean;
-         intmessagetable,strmessagetable,classnamelabel : plabel;
+         intmessagetable,strmessagetable,classnamelabel : pasmlabel;
          storetypeforwardsallowed : boolean;
          pt : ptree;
 
@@ -1269,7 +1258,7 @@ unit pdecl;
          { if no parent class, then a class get tobject as parent }
          else if is_a_class then
            begin
-              { is the current class tobject?        }
+              { is the current class tobject?   }
               { so you could define your own tobject }
               if n='TOBJECT' then
                 begin
@@ -1550,7 +1539,7 @@ unit pdecl;
 
               { table for string messages }
               if (aktclass^.options and oo_hasmsgstr)<>0 then
-                datasegment^.concat(new(pai_const_symbol,initname(lab2str(strmessagetable))))
+                datasegment^.concat(new(pai_const_symbol,init(strmessagetable)))
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
 
@@ -1562,7 +1551,7 @@ unit pdecl;
 
               { inittable for con-/destruction }
               if aktclass^.needs_inittable then
-                datasegment^.concat(new(pai_const_symbol,initname(lab2str(aktclass^.get_inittable_label))))
+                datasegment^.concat(new(pai_const_symbol,init(aktclass^.get_inittable_label)))
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
 
@@ -1579,12 +1568,12 @@ unit pdecl;
 
               { pointer to dynamic table }
               if (aktclass^.options and oo_hasmsgint)<>0 then
-                datasegment^.concat(new(pai_const_symbol,initname(lab2str(intmessagetable))))
+                datasegment^.concat(new(pai_const_symbol,init(intmessagetable)))
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
 
               { pointer to class name string }
-              datasegment^.concat(new(pai_const_symbol,initname(lab2str(classnamelabel))));
+              datasegment^.concat(new(pai_const_symbol,init(classnamelabel)));
            end;
 {$ifdef GDB}
          { generate the VMT }
@@ -1602,7 +1591,7 @@ unit pdecl;
               datasegment^.concat(new(pai_symbol,initname_global(aktclass^.vmt_mangledname)));
 
               { determine the size with publicsyms^.datasize, because }
-              { size gives back 4 for classes                         }
+              { size gives back 4 for classes                    }
               datasegment^.concat(new(pai_const,init_32bit(aktclass^.publicsyms^.datasize)));
               datasegment^.concat(new(pai_const,init_32bit(-aktclass^.publicsyms^.datasize)));
 
@@ -1614,10 +1603,6 @@ unit pdecl;
                  ((aktclass^.childof^.options and oo_hasvmt)<>0) then
                 begin
                    datasegment^.concat(new(pai_const_symbol,initname(aktclass^.childof^.vmt_mangledname)));
-{$ifndef NEWLAB}
-                   if aktclass^.childof^.owner^.symtabletype=unitsymtable then
-                     concat_external(aktclass^.childof^.vmt_mangledname,EXT_NEAR);
-{$endif}
                 end
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
@@ -1930,7 +1915,7 @@ unit pdecl;
                         consume(ASSIGNMENT);
                         v:=get_intconst;
                         { please leave that a note, allows type save }
-                        { declarations in the win32 units !          }
+                        { declarations in the win32 units !       }
                         if v<=l then
                          Message(parser_n_duplicate_enum);
                         l:=v;
@@ -2136,7 +2121,7 @@ unit pdecl;
 
     procedure var_dec;
     { parses varaible declarations and inserts them in }
-    { the top symbol table of symtablestack            }
+    { the top symbol table of symtablestack         }
       begin
         consume(_VAR);
         read_var_decs(false,false,false);
@@ -2144,7 +2129,7 @@ unit pdecl;
 
     procedure threadvar_dec;
     { parses thread variable declarations and inserts them in }
-    { the top symbol table of symtablestack                   }
+    { the top symbol table of symtablestack                }
       begin
         consume(_THREADVAR);
         if not(symtablestack^.symtabletype in [staticsymtable,globalsymtable]) then
@@ -2239,7 +2224,15 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.122  1999-05-21 20:08:22  florian
+  Revision 1.123  1999-05-27 19:44:45  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.122  1999/05/21 20:08:22  florian
     * hopefully the default property bug fixed
 
   Revision 1.121  1999/05/21 13:55:04  peter

compiler/pexpr.pas

@@ -53,11 +53,7 @@ unit pexpr;
        ,pbase,pdecl
        { processor specific stuff }
 {$ifdef i386}
-{$ifndef OLDASM}
        ,i386base
-{$else}
-       ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
        ,m68k
@@ -504,7 +500,7 @@ unit pexpr;
          prevafterassn:=afterassignment;
          afterassignment:=false;
          { want we only determine the address of }
-         { a subroutine ?                        }
+         { a subroutine ?                       }
          if not(getaddr) then
            begin
               if token=LKLAMMER then
@@ -517,7 +513,7 @@ unit pexpr;
               else p1^.left:=nil;
 
               { do firstpass because we need the  }
-              { result type                       }
+              { result type                    }
               do_firstpass(p1);
            end
          else
@@ -613,7 +609,7 @@ unit pexpr;
                         if (p2^.treetype<>errorn) and getprocvar then
                           handle_procvar(pprocvardef(ppropertysym(sym)^.proptype),p2);
                         p1^.left:=gencallparanode(p2,p1^.left);
-{                        firstcallparan(p1^.left,nil); }
+{                       firstcallparan(p1^.left,nil); }
                         getprocvar:=false;
                      end
                    else if ppropertysym(sym)^.writeaccesssym^.typ=varsym then
@@ -708,7 +704,7 @@ unit pexpr;
            begin
               isclassref:=pd^.deftype=classrefdef;
 
-              { check protected and private members        }
+              { check protected and private members     }
               { please leave this code as it is,           }
               { it has now the same behaviaor as TP/Delphi }
               if ((sym^.properties and sp_private)<>0) and
@@ -729,7 +725,7 @@ unit pexpr;
                 end;
 
               { we assume, that only procsyms and varsyms are in an object }
-              { symbol table, for classes, properties are allowed          }
+              { symbol table, for classes, properties are allowed         }
               case sym^.typ of
                  procsym:
                    begin
@@ -739,7 +735,7 @@ unit pexpr;
                         proc_to_procvar_equal(getprocvardef,pprocsym(sym)^.definition))
                         ,again,p1,pd);
                       { now we know the real method e.g. we can check for }
-                      { a class method                                    }
+                      { a class method                              }
                       if isclassref and ((p1^.procdefinition^.options and (poclassmethod or poconstructor))=0) then
                         Message(parser_e_only_class_methods_via_class_ref);
                    end;
@@ -778,7 +774,7 @@ unit pexpr;
 
     function factor(getaddr : boolean) : ptree;
       var
-         l        : longint;
+         l      : longint;
          oldp1,
          p1,p2,p3 : ptree;
          code     : integer;
@@ -788,7 +784,7 @@ unit pexpr;
          again    : boolean;
          sym      : pvarsym;
          classh   : pobjectdef;
-         d        : bestreal;
+         d      : bestreal;
          static_name : string;
          propsym  : ppropertysym;
          filepos  : tfileposinfo;
@@ -942,7 +938,7 @@ unit pexpr;
                               else
                               { if we read a type declaration  }
                               { we have to return the type and }
-                              { nothing else                   }
+                              { nothing else               }
                                if block_type=bt_type then
                                 begin
                                   p1:=gentypenode(pd);
@@ -1712,7 +1708,7 @@ unit pexpr;
                  consume(LKLAMMER);
                  p1:=comp_expr(true);
                  consume(RKLAMMER);
-                 { it's not a good solution        }
+                 { it's not a good solution     }
                  { but (a+b)^ makes some problems  }
                  if token in [CARET,POINT,LECKKLAMMER] then
                   begin
@@ -1989,7 +1985,15 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.108  1999-05-18 14:15:54  peter
+  Revision 1.109  1999-05-27 19:44:46  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.108  1999/05/18 14:15:54  peter
     * containsself fixes
     * checktypes()
 

compiler/pmodules.pas

@@ -38,10 +38,7 @@ unit pmodules;
        symtable,aasm,hcodegen,
        link,assemble,import,export,gendef,ppu,comprsrc
 {$ifdef i386}
-{$ifndef OLDASM}
        ,i386base,i386asm
-{$else}       ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
        ,m68k
@@ -146,18 +143,12 @@ unit pmodules;
               if (hp^.u^.flags and uf_init)<>0 then
                begin
                  unitinits.concat(new(pai_const_symbol,initname('INIT$$'+hp^.u^.modulename^)));
-{$ifndef NEWLAB}
-                 concat_external('INIT$$'+hp^.u^.modulename^,EXT_NEAR);
-{$endif}
                end
               else
                unitinits.concat(new(pai_const,init_32bit(0)));
               if (hp^.u^.flags and uf_finalize)<>0 then
                begin
                  unitinits.concat(new(pai_const_symbol,initname('FINALIZE$$'+hp^.u^.modulename^)));
-{$ifndef NEWLAB}
-                 concat_external('FINALIZE$$'+hp^.u^.modulename^,EXT_NEAR);
-{$endif}
                end
               else
                unitinits.concat(new(pai_const,init_32bit(0)));
@@ -271,7 +262,7 @@ unit pmodules;
 
     procedure load_usedunits(compile_system:boolean);
       var
-        pu           : pused_unit;
+        pu         : pused_unit;
         loaded_unit  : pmodule;
         load_refs    : boolean;
         nextmapentry : longint;
@@ -892,9 +883,9 @@ unit pmodules;
          current_module^.localsymtable:=st;
 
          { the unit name must be usable as a unit specifier }
-         { inside the unit itself (PM)                      }
-         { this also forbids to have another symbol         }
-         { with the same name as the unit                   }
+         { inside the unit itself (PM)                }
+         { this also forbids to have another symbol      }
+         { with the same name as the unit                  }
          refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst)));
 
          { a unit compiled at command line must be inside the loaded_unit list }
@@ -1216,7 +1207,7 @@ unit pmodules;
          current_module^.in_implementation:=true;
 
          { insert after the unit symbol tables the static symbol table }
-         { of the program                                              }
+         { of the program                                             }
          st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
          current_module^.localsymtable:=st;
          symtablestack:=st;
@@ -1345,7 +1336,15 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.123  1999-05-21 13:55:06  peter
+  Revision 1.124  1999-05-27 19:44:48  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.123  1999/05/21 13:55:06  peter
     * NEWLAB for label as symbol
 
   Revision 1.122  1999/05/18 22:36:29  pierre

compiler/popt386.pas

@@ -55,7 +55,7 @@ Var
 
   UsedRegs, TmpUsedRegs: TRegSet;
 
-  Procedure GetFinalDestination(hp: pai386_labeled);
+  Procedure GetFinalDestination(hp: pai386);
   {traces sucessive jumps to their final destination and sets it, e.g.
    je l1                je l3
    <code>               <code>
@@ -80,25 +80,22 @@ Var
     End;
 
   Begin
-    If (hp^.lab^.nb >= LoLab) and
-       (hp^.lab^.nb <= HiLab) and   {range check, a jump can go past an assembler block!}
-       Assigned(LTable^[hp^.lab^.nb-LoLab].PaiObj) Then
+    If (pasmlabel(hp^.oper[0].sym)^.labelnr >= LoLab) and
+       (pasmlabel(hp^.oper[0].sym)^.labelnr <= HiLab) and   {range check, a jump can go past an assembler block!}
+       Assigned(LTable^[pasmlabel(hp^.oper[0].sym)^.labelnr-LoLab].PaiObj) Then
       Begin
-        p1 := LTable^[hp^.lab^.nb-LoLab].PaiObj; {the jump's destination}
+        p1 := LTable^[pasmlabel(hp^.oper[0].sym)^.labelnr-LoLab].PaiObj; {the jump's destination}
         p1 := SkipLabels(p1);
-        If (pai(p1)^.typ = ait_labeled_instruction) and
-           ((pai386_labeled(p1)^.opcode = A_JMP) or
-            ((pai386_labeled(p1)^.opcode = A_Jcc) and (pai386_labeled(p1)^.condition = hp^.condition)))
-          Then
-            Begin
-              GetFinalDestination(pai386_labeled(p1));
-              Dec(hp^.lab^.refcount);
-              If (hp^.lab^.refcount = 0) Then
-                hp^.lab^.is_used := False;
-              hp^.lab := pai386_labeled(p1)^.lab;
-              Inc(hp^.lab^.refcount);
-            End
-      End
+        If (pai(p1)^.typ = ait_instruction) and
+           (pai386(p1)^.is_jmp) and
+           (pai386(p1)^.condition = hp^.condition) Then
+          Begin
+            GetFinalDestination(pai386(p1));
+            Dec(pasmlabel(hp^.oper[0].sym)^.refs);
+            hp^.oper[0].sym:=pai386(p1)^.oper[0].sym;
+            inc(pasmlabel(hp^.oper[0].sym)^.refs);
+          End;
+      End;
   End;
 
 Begin
@@ -108,63 +105,68 @@ Begin
     Begin
       UpDateUsedRegs(UsedRegs, Pai(p^.next));
       Case P^.Typ Of
-        Ait_Labeled_Instruction:
-          Begin
-  {the following if-block removes all code between a jmp and the next label,
-   because it can never be executed}
-            If (pai386_labeled(p)^.opcode = A_JMP) Then
-              Begin
-                hp1 := pai(p^.next);
-                While GetNextInstruction(p, hp1) and
-                      ((hp1^.typ <> ait_label) or
-                { skip unused labels, they're not referenced anywhere }
-                       Not(Pai_Label(hp1)^.l^.is_used)) Do
-                  If (hp1^.typ <> ait_label) Then
-                    Begin
-                      AsmL^.Remove(hp1);
-                      Dispose(hp1, done);
-                    End;
-               End;
-            If GetNextInstruction(p, hp1) then
-              Begin
-                If (pai(hp1)^.typ=ait_labeled_instruction) and
-                   (pai386_labeled(hp1)^.opcode=A_JMP) and
-                   GetNextInstruction(hp1, hp2) And
-                   FindLabel(pai386_labeled(p)^.lab, hp2)
-                  Then
-                    Begin
-                      if pai386_labeled(p)^.opcode=A_Jcc then
-                       pai386_labeled(p)^.condition:=inverse_cond[pai386_labeled(p)^.condition]
-                      else
-                       begin
-                         If (LabDif <> 0) Then
-                           GetFinalDestination(pai386_labeled(p));
-                         p:=pai(p^.next);
-                         continue;
-                       end;
-                      Dec(pai_label(hp2)^.l^.refcount);
-                      If (pai_label(hp2)^.l^.refcount = 0) Then
-                        pai_label(hp2)^.l^.is_used := False;
-                      pai386_labeled(p)^.lab:=pai386_labeled(hp1)^.lab;
-                      Inc(pai386_labeled(p)^.lab^.refcount);
-                      asml^.remove(hp1);
-                      dispose(hp1,done);
-                      If (LabDif <> 0) Then GetFinalDestination(pai386_labeled(p));
-                    end
-                  else
-                    if FindLabel(pai386_labeled(p)^.lab, hp1) then
-                      Begin
-                        hp2:=pai(hp1^.next);
-                        asml^.remove(p);
-                        dispose(p,done);
-                        p:=hp2;
-                        continue;
-                      end
-                    Else If (LabDif <> 0) Then GetFinalDestination(pai386_labeled(p));
-              end
-          end;
         ait_instruction:
           Begin
+            { Handle Jmp Optimizations }
+            if Pai386(p)^.is_jmp then
+             begin
+     {the following if-block removes all code between a jmp and the next label,
+      because it can never be executed}
+               If (pai386(p)^.opcode = A_JMP) Then
+                 Begin
+                   hp1 := pai(p^.next);
+                   While GetNextInstruction(p, hp1) and
+                         ((hp1^.typ <> ait_label) or
+                   { skip unused labels, they're not referenced anywhere }
+                          Not(Pai_Label(hp1)^.l^.is_used)) Do
+                     If (hp1^.typ <> ait_label) Then
+                       Begin
+                         AsmL^.Remove(hp1);
+                         Dispose(hp1, done);
+                       End;
+                  End;
+               If GetNextInstruction(p, hp1) then
+                 Begin
+                   If (pai(hp1)^.typ=ait_instruction) and
+                      (pai386(hp1)^.opcode=A_JMP) and
+                      GetNextInstruction(hp1, hp2) And
+                      FindLabel(PAsmLabel(pai386(p)^.oper[0].sym), hp2)
+                     Then
+                       Begin
+                         if pai386(p)^.opcode=A_Jcc then
+                          pai386(p)^.condition:=inverse_cond[pai386(p)^.condition]
+                         else
+                          begin
+                            If (LabDif <> 0) Then
+                              GetFinalDestination(pai386(p));
+                            p:=pai(p^.next);
+                            continue;
+                          end;
+                         Dec(pai_label(hp2)^.l^.refs);
+                         pai386(p)^.oper[0].sym:=pai386(hp1)^.oper[0].sym;
+                         Inc(pai386(p)^.oper[0].sym^.refs);
+                         asml^.remove(hp1);
+                         dispose(hp1,done);
+                         If (LabDif <> 0) Then
+                           GetFinalDestination(pai386(p));
+                       end
+                     else
+                       if FindLabel(pasmlabel(pai386(p)^.oper[0].sym), hp1) then
+                         Begin
+                           hp2:=pai(hp1^.next);
+                           asml^.remove(p);
+                           dispose(p,done);
+                           p:=hp2;
+                           continue;
+                         end
+                       Else
+                         If (LabDif <> 0) Then
+                           GetFinalDestination(pai386(p));
+                 end
+             end
+            else
+            { All other optimizes }
+             begin
             If (Pai386(p)^.oper[0].typ = top_ref) Then
               With Pai386(p)^.oper[0].ref^ Do
                 Begin
@@ -211,7 +213,8 @@ Begin
  jump}
                       If (Pai386(p)^.oper[1].typ = top_reg) And
                          GetNextInstruction(p, hp1) And
-                         (hp1^.typ = ait_labeled_instruction) And
+                         (hp1^.typ = ait_instruction) And
+                         (Pai386(hp1)^.is_jmp) and
                          Not(Pai386(p)^.oper[1].reg in UsedRegs) Then
                         Pai386(p)^.opcode := A_TEST;
                 End;
@@ -369,8 +372,8 @@ Begin
                      Not(CS_LittleSize in aktglobalswitches) And
                      (Not(GetNextInstruction(p, hp1)) Or
                        {GetNextInstruction(p, hp1) And}
-                       Not((Pai(hp1)^.typ = ait_labeled_instruction) And
-                           ((pai386_labeled(hp1)^.opcode = A_Jcc) and (pai386_labeled(hp1)^.condition in [C_O,C_NO]))))
+                       Not((Pai(hp1)^.typ = ait_instruction) And
+                           ((pai386(hp1)^.opcode=A_Jcc) and (pai386(hp1)^.condition in [C_O,C_NO]))))
                     Then
                       Begin
                         New(TmpRef);
@@ -662,7 +665,8 @@ Begin
                                 Begin
                                   TmpUsedRegs := UsedRegs;
                                   If GetNextInstruction(hp1, hp2) And
-                                     (hp2^.typ = ait_labeled_instruction) And
+                                     (hp2^.typ = ait_instruction) And
+                                     pai386(hp2)^.is_jmp and
                                      Not(RegUsedAfterInstruction(Pai386(hp1)^.oper[0].reg, hp1, TmpUsedRegs))
                                     Then
                    {change "mov %reg1, %reg2; test/or %reg2, %reg2; jxx" to
@@ -1387,6 +1391,7 @@ Begin
                      End;
                  End;
             End;
+            end; { if is_jmp }
           End;
 {        ait_label:
           Begin
@@ -1420,11 +1425,11 @@ Begin
               A_CALL:
                 If (AktOptProcessor < ClassP6) And
                    GetNextInstruction(p, hp1) And
-                   (hp1^.typ = ait_labeled_instruction) And
-                   (pai386_labeled(hp1)^.opcode = A_JMP) Then
+                   (hp1^.typ = ait_instruction) And
+                   (pai386(hp1)^.opcode = A_JMP) Then
                   Begin
-                    Inc(pai386_labeled(hp1)^.lab^.refcount);
-                    hp2 := New(Pai386,op_sym(A_PUSH,S_L,NewAsmSymbol(Lab2Str(pai386_labeled(hp1)^.lab))));
+                    Inc(pai386(hp1)^.oper[0].sym^.refs);
+                    hp2 := New(Pai386,op_sym(A_PUSH,S_L,pai386(hp1)^.oper[0].sym));
                     hp2^.fileinfo := p^.fileinfo;
                     InsertLLItem(AsmL, p^.previous, p, hp2);
                     Pai386(p)^.opcode := A_JMP;
@@ -1514,7 +1519,15 @@ End.
 
 {
  $Log$
- Revision 1.53  1999-05-12 00:19:52  peter
+ Revision 1.54  1999-05-27 19:44:49  peter
+   * removed oldasm
+   * plabel -> pasmlabel
+   * -a switches to source writing automaticly
+   * assembler readers OOPed
+   * asmsymbol automaticly external
+   * jumptables and other label fixes for asm readers
+
+ Revision 1.53  1999/05/12 00:19:52  peter
    * removed R_DEFAULT_SEG
    * uniform float names
 

compiler/pstatmnt.pas

@@ -44,11 +44,7 @@ unit pstatmnt;
        symtable,aasm,pass_1,types,scanner,hcodegen,ppu
        ,pbase,pexpr,pdecl
 {$ifdef i386}
-{$ifndef OLDASM}
        ,i386base,i386asm
-{$else}
-       ,i386
-{$endif}
        ,tgeni386
   {$ifndef NoRa386Int}
        ,ra386int
@@ -126,7 +122,7 @@ unit pstatmnt;
 
       var
          { contains the label number of currently parsed case block }
-         aktcaselabel : plabel;
+         aktcaselabel : pasmlabel;
          firstlabel : boolean;
          root : pcaserecord;
 
@@ -690,6 +686,8 @@ unit pstatmnt;
       begin
          Inside_asm_statement:=true;
          case aktasmmode of
+           asmmode_none : ; { just be there to allow to a compile without
+                              any assembler readers }
 {$ifdef i386}
   {$ifndef NoRA386Att}
            asmmode_i386_att:
@@ -821,7 +819,7 @@ unit pstatmnt;
 
   {var o:Pobject;
            begin
-               new(o,init);        (*Also a valid new statement*)
+               new(o,init);     (*Also a valid new statement*)
            end;}
 
           if try_to_consume(COMMA) then
@@ -866,7 +864,7 @@ unit pstatmnt;
                    { search cons-/destructor, also in parent classes }
                    sym:=search_class_member(classh,pattern);
                    { the second parameter of new/dispose must be a call }
-                   { to a cons-/destructor                                }
+                   { to a cons-/destructor                              }
                    if (not assigned(sym)) or (sym^.typ<>procsym) then
                          begin
                             Message(parser_e_expr_have_to_be_destructor_call);
@@ -993,7 +991,7 @@ unit pstatmnt;
       var
          p : ptree;
          code : ptree;
-         labelnr : plabel;
+         labelnr : pasmlabel;
          filepos : tfileposinfo;
 
       label
@@ -1225,7 +1223,7 @@ unit pstatmnt;
                 begin
                    { in assembler code the result should be directly in %eax
                    procinfo.retoffset:=procinfo.firsttemp-procinfo.retdef^.size;
-                   procinfo.firsttemp:=procinfo.retoffset;                   }
+                   procinfo.firsttemp:=procinfo.retoffset;                 }
 
 {$ifdef i386}
                    usedinproc:=usedinproc or ($80 shr byte(R_EAX))
@@ -1242,8 +1240,8 @@ unit pstatmnt;
               }
             end;
            { set the framepointer to esp for assembler functions }
-           { but only if the are no local variables              }
-           { added no parameter also (PM)                        }
+           { but only if the are no local variables           }
+           { added no parameter also (PM)                       }
            if ((aktprocsym^.definition^.options and poassembler)<>0) and
                (aktprocsym^.definition^.localst^.datasize=0) and
                (aktprocsym^.definition^.parast^.datasize=0) and
@@ -1267,7 +1265,15 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.86  1999-05-21 13:55:08  peter
+  Revision 1.87  1999-05-27 19:44:50  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.86  1999/05/21 13:55:08  peter
     * NEWLAB for label as symbol
 
   Revision 1.85  1999/05/17 23:51:40  peter

compiler/ptconst.pas

@@ -41,11 +41,7 @@ unit ptconst;
        ,pbase,pexpr
        { processor specific stuff }
 {$ifdef i386}
-{$ifndef OLDASM}
        ,i386base
-{$else}
-       ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
        ,m68k
@@ -67,11 +63,11 @@ unit ptconst;
          i,l,offset,
          strlength : longint;
          curconstsegment : paasmoutput;
-         ll        : plabel;
-         s         : string;
-         ca        : pchar;
+         ll     : pasmlabel;
+         s       : string;
+         ca     : pchar;
          aktpos    : longint;
-         pd        : pprocdef;
+         pd     : pprocdef;
          obj       : pobjectdef;
          symt      : psymtable;
          hp1,hp2   : pdefcoll;
@@ -217,7 +213,7 @@ unit ptconst;
                    (p^.treetype<>addrn) then
                   begin
                     getdatalabel(ll);
-                    curconstsegment^.concat(new(pai_const_symbol,initname(lab2str(ll))));
+                    curconstsegment^.concat(new(pai_const_symbol,init(ll)));
                     consts^.concat(new(pai_label,init(ll)));
                     if p^.treetype=stringconstn then
                       begin
@@ -304,10 +300,6 @@ unit ptconst;
                              curconstsegment^.concat(new(pai_const,init_symbol(
                                strpnew(p^.left^.symtableentry^.mangledname))));
                           end;   *)
-{$ifndef NEWLAB}
-                        maybe_concat_external(hp^.symtableentry^.owner,
-                          hp^.symtableentry^.mangledname);
-{$endif}
                       end
                     else
                       Message(cg_e_illegal_expression);
@@ -321,10 +313,6 @@ unit ptconst;
                       begin
                         curconstsegment^.concat(new(pai_const_symbol,
                           initname(pobjectdef(p^.left^.resulttype)^.vmt_mangledname)));
-{$ifndef NEWLAB}
-                        if pobjectdef(p^.left^.resulttype)^.owner^.symtabletype=unitsymtable then
-                          concat_external(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,EXT_NEAR);
-{$endif}
                       end
                     else
                       Message(cg_e_illegal_expression);
@@ -351,7 +339,7 @@ unit ptconst;
 {$ifdef m68k}
                         j:=0;
                         for l:=0 to ((def^.savesize-1) div 4) do
-                        { HORRIBLE HACK because of endian        }
+                        { HORRIBLE HACK because of endian       }
                         { now use intel endian for constant sets }
                          begin
                            curconstsegment^.concat(new(pai_const,init_8bit(p^.value_set^[j+3])));
@@ -414,7 +402,7 @@ unit ptconst;
                         begin
                            getmem(ca,def^.size-strlength);
                            { def^.size contains also the leading length, so we }
-                           { we have to subtract one                           }
+                           { we have to subtract one                       }
                            fillchar(ca[0],def^.size-strlength-1,' ');
                            ca[def^.size-strlength-1]:=#0;
                            { this can also handle longer strings }
@@ -459,7 +447,7 @@ unit ptconst;
                            else
                             strlength:=p^.length;
                            getdatalabel(ll);
-                           curconstsegment^.concat(new(pai_const_symbol,initname(lab2str(ll))));
+                           curconstsegment^.concat(new(pai_const_symbol,init(ll)));
                            { first write the maximum size }
                            consts^.concat(new(pai_const,init_32bit(strlength)));
                            { second write the real length }
@@ -603,10 +591,6 @@ unit ptconst;
                    else
                      Message(type_e_mismatch);
                    curconstsegment^.concat(new(pai_const_symbol,initname(pd^.mangledname)));
-{$ifndef NEWLAB}
-                   if pd^.owner^.symtabletype=unitsymtable then
-                     concat_external(pd^.mangledname,EXT_NEAR);
-{$endif}
                 end;
            end;
          { reads a typed constant record }
@@ -729,7 +713,15 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.45  1999-05-23 18:42:13  florian
+  Revision 1.46  1999-05-27 19:44:54  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.45  1999/05/23 18:42:13  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/ra386.pas

@@ -1,447 +1,399 @@
-{
-    $Id$
-    Copyright (c) 1997-98 by Carl Eric Codere
-
-    Handles the common i386 assembler reader routines
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-Unit Ra386;
-interface
-
-uses
-  aasm,
-  i386base,
-  RAUtils;
-
-{ Parser helpers }
-function is_prefix(t:tasmop):boolean;
-function is_override(t:tasmop):boolean;
-Function CheckPrefix(prefixop,op:tasmop): Boolean;
-Function CheckOverride(overrideop,op:tasmop): Boolean;
-Procedure InitAsmRef(var instr: TInstruction;operandnum:byte);
-
-{ Operand sizes }
-procedure AddReferenceSizes(var instr:TInstruction);
-procedure SetInstructionOpsize(var instr:TInstruction);
-procedure CheckOperandSizes(var instr:TInstruction);
-
-{ opcode adding }
-procedure ConcatInstruction(p : paasmoutput;var instr:TInstruction);
-
-
-implementation
-
-uses
-  globtype,globals,verbose,
-  i386asm;
-
-
-{*****************************************************************************
-                              Parser Helpers
-*****************************************************************************}
-
-function is_prefix(t:tasmop):boolean;
-var
-  i : longint;
-Begin
-  is_prefix:=false;
-  for i:=1 to AsmPrefixes do
-   if t=AsmPrefix[i-1] then
-    begin
-      is_prefix:=true;
-      exit;
-    end;
-end;
-
-
-function is_override(t:tasmop):boolean;
-var
-  i : longint;
-Begin
-  is_override:=false;
-  for i:=1 to AsmOverrides do
-   if t=AsmOverride[i-1] then
-    begin
-      is_override:=true;
-      exit;
-    end;
-end;
-
-
-Function CheckPrefix(prefixop,op:tasmop): Boolean;
-{ Checks if the prefix is valid with the following opcode }
-{ return false if not, otherwise true                          }
-Begin
-  CheckPrefix := TRUE;
-(*  Case prefix of
-    A_REP,A_REPNE,A_REPE:
-      Case opcode Of
-        A_SCASB,A_SCASW,A_SCASD,
-        A_INS,A_OUTS,A_MOVS,A_CMPS,A_LODS,A_STOS:;
-        Else
-          Begin
-            CheckPrefix := FALSE;
-            exit;
-          end;
-      end; { case }
-    A_LOCK:
-      Case opcode Of
-        A_BT,A_BTS,A_BTR,A_BTC,A_XCHG,A_ADD,A_OR,A_ADC,A_SBB,A_AND,A_SUB,
-        A_XOR,A_NOT,A_NEG,A_INC,A_DEC:;
-        Else
-          Begin
-            CheckPrefix := FALSE;
-            Exit;
-          end;
-      end; { case }
-    A_NONE: exit; { no prefix here }
-    else
-      CheckPrefix := FALSE;
-   end; { end case } *)
-end;
-
-
-Function CheckOverride(overrideop,op:tasmop): Boolean;
-{ Check if the override is valid, and if so then }
-{ update the instr variable accordingly.         }
-Begin
-  CheckOverride := true;
-{     Case instr.getinstruction of
-    A_MOVS,A_XLAT,A_CMPS:
-      Begin
-        CheckOverride := TRUE;
-        Message(assem_e_segment_override_not_supported);
-      end
-  end }
-end;
-
-
-Procedure InitAsmRef(var instr: TInstruction;operandnum:byte);
-{*********************************************************************}
-{  Description: This routine first check if the opcode is of     }
-{  type OPR_NONE, or OPR_REFERENCE , if not it gives out an error.    }
-{  If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up  }
-{  the operand type to OPR_REFERENCE, as well as setting up the ref   }
-{  to point to the default segment.                                   }
-{*********************************************************************}
-Begin
-  With instr do
-  Begin
-     case operands[operandnum].operandtype of
-       OPR_REFERENCE: exit;
-       OPR_NONE: ;
-     else
-       Message(asmr_e_invalid_operand_type);
-     end;
-     operands[operandnum].operandtype := OPR_REFERENCE;
-     operands[operandnum].ref.segment := R_NO;
-  end;
-end;
-
-
-{*****************************************************************************
-                                Operand Sizes
-*****************************************************************************}
-
-procedure AddReferenceSizes(var instr:TInstruction);
-{ this will add the sizes for references like [esi] which do not
-  have the size set yet, it will take only the size if the other
-  operand is a register }
-var
-  operand2,i : longint;
-  s : pasmsymbol;
-  so : longint;
-begin
-  with instr do
-   begin
-     for i:=1to ops do
-      if (operands[i].size=S_NO) then
-       begin
-         case operands[i].operandtype of
-           OPR_REFERENCE :
-             begin
-               if i=2 then
-                operand2:=1
-               else
-                operand2:=2;
-               { Only allow register as operand to take the size from }
-               if operands[operand2].operandtype=OPR_REGISTER then
-                operands[i].size:=operands[operand2].size
-               else
-                begin
-                  { if no register then take the opsize (which is available with ATT) }
-                  operands[i].size:=opsize;
-                end;
-             end;
-           OPR_SYMBOL :
-             begin
-               { Fix lea which need a reference }
-               if opcode=A_LEA then
-                begin
-                  s:=operands[i].symbol;
-                  so:=operands[i].symofs;
-                  operands[i].operandtype:=OPR_REFERENCE;
-                  reset_reference(operands[i].ref);
-                  operands[i].ref.symbol:=s;
-                  operands[i].ref.offset:=so;
-                end;
-               operands[i].size:=S_L;
-             end;
-         end;
-       end;
-   end;
-end;
-
-
-procedure SetInstructionOpsize(var instr:TInstruction);
-begin
-  with instr do
-   begin
-     if opsize<>S_NO then
-      exit;
-     case ops of
-       0 : ;
-       1 :
-         opsize:=operands[1].size;
-       2 :
-         begin
-           case opcode of
-             A_MOVZX,A_MOVSX :
-               begin
-                 case operands[1].size of
-                   S_W :
-                     case operands[2].size of
-                       S_L :
-                         opsize:=S_WL;
-                     end;
-                   S_B :
-                     case operands[2].size of
-                       S_W :
-                         opsize:=S_BW;
-                       S_L :
-                         opsize:=S_BL;
-                     end;
-                 end;
-               end;
-             A_OUT :
-               opsize:=operands[1].size;
-             else
-               opsize:=operands[2].size;
-           end;
-         end;
-       3 :
-         opsize:=operands[3].size;
-     end;
-   end;
-end;
-
-
-procedure CheckOperandSizes(var instr:TInstruction);
-var
-  sizeerr : boolean;
-  i : longint;
-begin
-  with instr do
-   begin
-     { don't check labeled instructions }
-     if labeled then
-      exit;
-     { Check only the most common opcodes here, the others are done in
-       the assembler pass }
-     case opcode of
-       A_PUSH,A_DEC,A_INC,A_NOT,A_NEG,
-       A_CMP,A_MOV,
-       A_ADD,A_SUB,A_ADC,A_SBB,
-       A_AND,A_OR,A_TEST,A_XOR: ;
-     else
-       exit;
-     end;
-     { Handle the BW,BL,WL separatly }
-     sizeerr:=false;
-     if opsize in [S_BW,S_BL,S_WL] then
-      begin
-        if ops<>2 then
-         sizeerr:=true
-        else
-         begin
-           case opsize of
-             S_BW :
-               sizeerr:=(operands[1].size<>S_B) or (operands[2].size<>S_W);
-             S_BL :
-               sizeerr:=(operands[1].size<>S_B) or (operands[2].size<>S_L);
-             S_WL :
-               sizeerr:=(operands[1].size<>S_W) or (operands[2].size<>S_L);
-           end;
-         end;
-      end
-     else
-      begin
-        for i:=1to ops do
-         begin
-           if (operands[i].operandtype<>OPR_CONSTANT) and
-              (operands[i].size<>opsize) then
-            sizeerr:=true;
-         end;
-      end;
-     if sizeerr then
-      begin
-        { if range checks are on then generate an error }
-        if (cs_compilesystem in aktmoduleswitches) or
-           not (cs_check_range in aktlocalswitches) then
-          Message(asmr_w_size_suffix_and_dest_dont_match)
-        else
-          Message(asmr_e_size_suffix_and_dest_dont_match);
-      end;
-   end;
-end;
-
-
-{*****************************************************************************
-                              opcode Adding
-*****************************************************************************}
-
-procedure ConcatInstruction(p : paasmoutput;var instr:TInstruction);
-var
-  siz  : topsize;
-  i    : longint;
-{$ifndef NEWLAB}
-  hlab : plabel;
-{$endif}
-  ai   : pai386;
-begin
-  with instr do
-   begin
-{$ifndef NEWLAB}
-   { Handle a labeled opcode first to see if it needs conversion }
-     if labeled then
-      begin
-        { check if it's a jmp or call to a label, then issue a pai386_labeled }
-        if (Ops=1) then
-         begin
-           case opcode of
-             A_CALL,A_JMP,A_Jcc,A_JCXZ, A_JECXZ,
-             A_LOOP, A_LOOPE, A_LOOPNE, A_LOOPNZ, A_LOOPZ :
-               begin
-                 p^.concat(new(pai386_labeled,op_cond_lab(opcode,condition,operands[1].hl)));
-                 exit;
-               end;
-           end;
-         end;
-        { convert all labinstr to references }
-        for i:=1to Ops do
-         if operands[i].operandtype=OPR_LABINSTR then
-          begin
-            hlab:=operands[i].hl;
-            operands[i].operandtype:=OPR_REFERENCE;
-            reset_reference(operands[i].ref);
-            operands[i].ref.symbol:=newasmsymbol(lab2str(hlab));
-          end;
-      end;
-{$endif}
-
-    { Get Opsize }
-      if (opsize<>S_NO) or (Ops=0) then
-       siz:=opsize
-      else
-       begin
-         if (Ops=2) and (instr.operands[1].operandtype=OPR_REGISTER) then
-          siz:=operands[1].size
-         else
-          siz:=operands[Ops].size;
-       end;
-
-     ai:=new(pai386,op_none(opcode,siz));
-     ai^.Ops:=Ops;
-     for i:=1to Ops do
-      begin
-        case instr.operands[i].operandtype of
-          OPR_CONSTANT :
-            ai^.loadconst(i-1,instr.operands[i].val);
-          OPR_REGISTER:
-            ai^.loadreg(i-1,instr.operands[i].reg);
-          OPR_SYMBOL:
-            ai^.loadsymbol(i-1,instr.operands[i].symbol,instr.operands[i].symofs);
-          OPR_REFERENCE:
-            ai^.loadref(i-1,newreference(instr.operands[i].ref));
-        end;
-      end;
-
-   { Condition ? }
-     if condition<>C_None then
-      ai^.SetCondition(condition);
-
-   { Concat the opcode or give an error }
-     if assigned(ai) then
-      p^.concat(ai)
-     else
-      Message(asmr_e_invalid_opcode_and_operand);
-
-   end;
-end;
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1997-98 by Carl Eric Codere
+
+    Handles the common i386 assembler reader routines
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+Unit Ra386;
+interface
+
+uses
+  aasm,
+  i386base,
+  RAUtils;
+
+{ Parser helpers }
+function is_prefix(t:tasmop):boolean;
+function is_override(t:tasmop):boolean;
+Function CheckPrefix(prefixop,op:tasmop): Boolean;
+Function CheckOverride(overrideop,op:tasmop): Boolean;
+Procedure FWaitWarning;
+
+type
+  P386Operand=^T386Operand;
+  T386Operand=object(TOperand)
+  end;
+
+  P386Instruction=^T386Instruction;
+  T386Instruction=object(TInstruction)
+    { Operand sizes }
+    procedure AddReferenceSizes;
+    procedure SetInstructionOpsize;
+    procedure CheckOperandSizes;
+    { opcode adding }
+    procedure ConcatInstruction(p : paasmoutput);virtual;
+  end;
+
+
+implementation
+
+uses
+  globtype,systems,globals,verbose,
+  i386asm;
+
+
+{*****************************************************************************
+                              Parser Helpers
+*****************************************************************************}
+
+function is_prefix(t:tasmop):boolean;
+var
+  i : longint;
+Begin
+  is_prefix:=false;
+  for i:=1 to AsmPrefixes do
+   if t=AsmPrefix[i-1] then
+    begin
+      is_prefix:=true;
+      exit;
+    end;
+end;
+
+
+function is_override(t:tasmop):boolean;
+var
+  i : longint;
+Begin
+  is_override:=false;
+  for i:=1 to AsmOverrides do
+   if t=AsmOverride[i-1] then
+    begin
+      is_override:=true;
+      exit;
+    end;
+end;
+
+
+Function CheckPrefix(prefixop,op:tasmop): Boolean;
+{ Checks if the prefix is valid with the following opcode }
+{ return false if not, otherwise true                          }
+Begin
+  CheckPrefix := TRUE;
+(*  Case prefix of
+    A_REP,A_REPNE,A_REPE:
+      Case opcode Of
+        A_SCASB,A_SCASW,A_SCASD,
+        A_INS,A_OUTS,A_MOVS,A_CMPS,A_LODS,A_STOS:;
+        Else
+          Begin
+            CheckPrefix := FALSE;
+            exit;
+          end;
+      end; { case }
+    A_LOCK:
+      Case opcode Of
+        A_BT,A_BTS,A_BTR,A_BTC,A_XCHG,A_ADD,A_OR,A_ADC,A_SBB,A_AND,A_SUB,
+        A_XOR,A_NOT,A_NEG,A_INC,A_DEC:;
+        Else
+          Begin
+            CheckPrefix := FALSE;
+            Exit;
+          end;
+      end; { case }
+    A_NONE: exit; { no prefix here }
+    else
+      CheckPrefix := FALSE;
+   end; { end case } *)
+end;
+
+
+Function CheckOverride(overrideop,op:tasmop): Boolean;
+{ Check if the override is valid, and if so then }
+{ update the instr variable accordingly.         }
+Begin
+  CheckOverride := true;
+{     Case instr.getinstruction of
+    A_MOVS,A_XLAT,A_CMPS:
+      Begin
+        CheckOverride := TRUE;
+        Message(assem_e_segment_override_not_supported);
+      end
+  end }
+end;
+
+
+Procedure FWaitWarning;
+begin
+  if (target_info.target=target_i386_GO32V2) and (cs_fp_emulation in aktmoduleswitches) then
+   Message(asmr_w_fwait_emu_prob);
+end;
+
+
+{*****************************************************************************
+                              T386Instruction
+*****************************************************************************}
+
+procedure T386Instruction.AddReferenceSizes;
+{ this will add the sizes for references like [esi] which do not
+  have the size set yet, it will take only the size if the other
+  operand is a register }
+var
+  operand2,i : longint;
+  s : pasmsymbol;
+  so : longint;
+begin
+  for i:=1to ops do
+   if (operands[i]^.size=S_NO) then
+    begin
+      case operands[i]^.Opr.Typ of
+        OPR_REFERENCE :
+          begin
+            if i=2 then
+             operand2:=1
+            else
+             operand2:=2;
+            { Only allow register as operand to take the size from }
+            if operands[operand2]^.opr.typ=OPR_REGISTER then
+             operands[i]^.size:=operands[operand2]^.size
+            else
+             begin
+               { if no register then take the opsize (which is available with ATT) }
+               operands[i]^.size:=opsize;
+             end;
+          end;
+        OPR_SYMBOL :
+          begin
+            { Fix lea which need a reference }
+            if opcode=A_LEA then
+             begin
+               s:=operands[i]^.opr.symbol;
+               so:=operands[i]^.opr.symofs;
+               operands[i]^.opr.typ:=OPR_REFERENCE;
+               reset_reference(operands[i]^.opr.ref);
+               operands[i]^.opr.ref.symbol:=s;
+               operands[i]^.opr.ref.offset:=so;
+             end;
+            operands[i]^.size:=S_L;
+          end;
+      end;
+    end;
+end;
+
+
+procedure T386Instruction.SetInstructionOpsize;
+begin
+  if opsize<>S_NO then
+   exit;
+  case ops of
+    0 : ;
+    1 :
+      opsize:=operands[1]^.size;
+    2 :
+      begin
+        case opcode of
+          A_MOVZX,A_MOVSX :
+            begin
+              case operands[1]^.size of
+                S_W :
+                  case operands[2]^.size of
+                    S_L :
+                      opsize:=S_WL;
+                  end;
+                S_B :
+                  case operands[2]^.size of
+                    S_W :
+                      opsize:=S_BW;
+                    S_L :
+                      opsize:=S_BL;
+                  end;
+              end;
+            end;
+          A_OUT :
+            opsize:=operands[1]^.size;
+          else
+            opsize:=operands[2]^.size;
+        end;
+      end;
+    3 :
+      opsize:=operands[3]^.size;
+  end;
+end;
+
+
+procedure T386Instruction.CheckOperandSizes;
+var
+  sizeerr : boolean;
+  i : longint;
+begin
+  { Check only the most common opcodes here, the others are done in
+    the assembler pass }
+  case opcode of
+    A_PUSH,A_DEC,A_INC,A_NOT,A_NEG,
+    A_CMP,A_MOV,
+    A_ADD,A_SUB,A_ADC,A_SBB,
+    A_AND,A_OR,A_TEST,A_XOR: ;
+  else
+    exit;
+  end;
+  { Handle the BW,BL,WL separatly }
+  sizeerr:=false;
+  if opsize in [S_BW,S_BL,S_WL] then
+   begin
+     if ops<>2 then
+      sizeerr:=true
+     else
+      begin
+        case opsize of
+          S_BW :
+            sizeerr:=(operands[1]^.size<>S_B) or (operands[2]^.size<>S_W);
+          S_BL :
+            sizeerr:=(operands[1]^.size<>S_B) or (operands[2]^.size<>S_L);
+          S_WL :
+            sizeerr:=(operands[1]^.size<>S_W) or (operands[2]^.size<>S_L);
+        end;
+      end;
+   end
+  else
+   begin
+     for i:=1to ops do
+      begin
+        if (operands[i]^.opr.typ<>OPR_CONSTANT) and
+           (operands[i]^.size<>opsize) then
+         sizeerr:=true;
+      end;
+   end;
+  if sizeerr then
+   begin
+     { if range checks are on then generate an error }
+     if (cs_compilesystem in aktmoduleswitches) or
+        not (cs_check_range in aktlocalswitches) then
+       Message(asmr_w_size_suffix_and_dest_dont_match)
+     else
+       Message(asmr_e_size_suffix_and_dest_dont_match);
+   end;
+end;
+
+
+{*****************************************************************************
+                              opcode Adding
+*****************************************************************************}
+
+procedure T386Instruction.ConcatInstruction(p : paasmoutput);
+var
+  siz  : topsize;
+  i    : longint;
+  ai   : pai386;
+begin
+{ Get Opsize }
+  if (opsize<>S_NO) or (Ops=0) then
+   siz:=opsize
+  else
+   begin
+     if (Ops=2) and (operands[1]^.opr.typ=OPR_REGISTER) then
+      siz:=operands[1]^.size
+     else
+      siz:=operands[Ops]^.size;
+   end;
+
+  ai:=new(pai386,op_none(opcode,siz));
+  ai^.Ops:=Ops;
+  for i:=1to Ops do
+   begin
+     case operands[i]^.opr.typ of
+       OPR_CONSTANT :
+         ai^.loadconst(i-1,operands[i]^.opr.val);
+       OPR_REGISTER:
+         ai^.loadreg(i-1,operands[i]^.opr.reg);
+       OPR_SYMBOL:
+         ai^.loadsymbol(i-1,operands[i]^.opr.symbol,operands[i]^.opr.symofs);
+       OPR_REFERENCE:
+         ai^.loadref(i-1,newreference(operands[i]^.opr.ref));
+     end;
+   end;
+
+ { Condition ? }
+  if condition<>C_None then
+   ai^.SetCondition(condition);
+
+ { Concat the opcode or give an error }
+  if assigned(ai) then
+   p^.concat(ai)
+  else
+   Message(asmr_e_invalid_opcode_and_operand);
+end;
+
+end.
+{
   $Log$
-  Revision 1.6  1999-05-21 13:55:12  peter
+  Revision 1.7  1999-05-27 19:44:55  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.6  1999/05/21 13:55:12  peter
     * NEWLAB for label as symbol
-
-  Revision 1.5  1999/05/13 21:59:40  peter
-    * removed oldppu code
-    * warning if objpas is loaded from uses
-    * first things for new deref writing
-
-  Revision 1.4  1999/05/12 00:19:55  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.3  1999/05/05 22:21:59  peter
-    * updated messages
-
-  Revision 1.2  1999/05/02 14:24:26  peter
-    * translate opr_symbol to reference for lea
-
-  Revision 1.1  1999/05/01 13:24:40  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.7  1999/04/26 23:26:16  peter
-    * redesigned record offset parsing to support nested records
-    * normal compiler uses the redesigned createvarinstr()
-
-  Revision 1.6  1999/04/14 09:07:44  peter
-    * asm reader improvements
-
-  Revision 1.5  1999/03/29 16:05:52  peter
-    * optimizer working for ag386bin
-
-  Revision 1.4  1999/03/26 00:01:16  peter
-    * first things for optimizer (compiles but cycle crashes)
-
-  Revision 1.3  1999/03/06 17:24:25  peter
-    * rewritten intel parser a lot, especially reference reading
-    * size checking added for asm parsers
-
-  Revision 1.2  1999/03/02 02:56:29  peter
-    + stabs support for binary writers
-    * more fixes and missing updates from the previous commit :(
-
-  Revision 1.1  1999/03/01 15:46:26  peter
-    * ag386bin finally make cycles correct
-    * prefixes are now also normal opcodes
-
-}
+
+  Revision 1.5  1999/05/13 21:59:40  peter
+    * removed oldppu code
+    * warning if objpas is loaded from uses
+    * first things for new deref writing
+
+  Revision 1.4  1999/05/12 00:19:55  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.3  1999/05/05 22:21:59  peter
+    * updated messages
+
+  Revision 1.2  1999/05/02 14:24:26  peter
+    * translate opr_symbol to reference for lea
+
+  Revision 1.1  1999/05/01 13:24:40  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.7  1999/04/26 23:26:16  peter
+    * redesigned record offset parsing to support nested records
+    * normal compiler uses the redesigned createvarinstr()
+
+  Revision 1.6  1999/04/14 09:07:44  peter
+    * asm reader improvements
+
+  Revision 1.5  1999/03/29 16:05:52  peter
+    * optimizer working for ag386bin
+
+  Revision 1.4  1999/03/26 00:01:16  peter
+    * first things for optimizer (compiles but cycle crashes)
+
+  Revision 1.3  1999/03/06 17:24:25  peter
+    * rewritten intel parser a lot, especially reference reading
+    * size checking added for asm parsers
+
+  Revision 1.2  1999/03/02 02:56:29  peter
+    + stabs support for binary writers
+    * more fixes and missing updates from the previous commit :(
+
+  Revision 1.1  1999/03/01 15:46:26  peter
+    * ag386bin finally make cycles correct
+    * prefixes are now also normal opcodes
+
+}

compiler/ra386dir.pas

@@ -33,12 +33,9 @@ unit Ra386dir;
 
      uses
         files,hcodegen,globals,scanner,aasm
-{$ifndef OLDASM}
         ,i386base,i386asm
-{$else}
-        ,i386
-{$endif}
-        ,cobjects,symtable,types,verbose,rautils;
+        ,cobjects,symtable,types,verbose,
+        rautils,ra386;
 
     function assemble : ptree;
 
@@ -125,11 +122,8 @@ unit Ra386dir;
                                 if srsym<>nil then
                                   if (srsym^.typ = labelsym) then
                                     Begin
-                                       hs:=lab2str(plabelsym(srsym)^.lab);
-{$ifndef NEWLAB}
-                                       {label is set !! }
+                                       hs:=plabelsym(srsym)^.lab^.name;
                                        plabelsym(srsym)^.lab^.is_set:=true;
-{$endif}
                                     end
                                   else
                                     Message(asmr_w_using_defined_as_local);
@@ -160,7 +154,7 @@ unit Ra386dir;
                                         begin
                                            if (sym^.typ = labelsym) then
                                              Begin
-                                                hs:=lab2str(plabelsym(sym)^.lab);
+                                                hs:=plabelsym(sym)^.lab^.name;
                                              end
                                            else if sym^.typ=varsym then
                                              begin
@@ -257,7 +251,7 @@ unit Ra386dir;
                                                   hs:=tostr(procinfo.framepointer_offset)+
                                                     '('+att_reg2str[procinfo.framepointer]+')'
                                                 else
-                                                  Message(asmr_e_cannot_use___OLDEBP_outside_nested_procedure);
+                                                  Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
                                              end;
                                            end;
                                         end;
@@ -297,7 +291,15 @@ unit Ra386dir;
 end.
 {
   $Log$
-  Revision 1.20  1999-05-21 13:55:15  peter
+  Revision 1.21  1999-05-27 19:44:57  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.20  1999/05/21 13:55:15  peter
     * NEWLAB for label as symbol
 
   Revision 1.19  1999/05/05 22:22:02  peter

compiler/ra386int.pas

@@ -97,7 +97,6 @@ const
 const
   newline = #10;
   firsttoken : boolean = TRUE;
-  operandnum : byte = 0;
 var
   _asmsorted     : boolean;
   inexpression   : boolean;
@@ -110,8 +109,6 @@ var
   actopcode      : tasmop;
   actopsize      : topsize;
   actcondition   : tasmcond;
-  Instr          : TInstruction;
-  labellist      : TAsmLabelList;
   iasmops        : ^op2strtable;
   iasmregs       : ^reg2strtable;
 
@@ -139,12 +136,6 @@ end;
 
 
    function is_asmopcode(const s: string):boolean;
-  {*********************************************************************}
-  { FUNCTION is_asmopcode(s: string):Boolean                            }
-  { Description: Determines if the s string is a valid opcode          }
-  { It sets also actopcode and actcondition }
-  { if so returns TRUE otherwise returns FALSE.                        }
-  {*********************************************************************}
    var
      i: tasmop;
      cond : string[4];
@@ -237,12 +228,13 @@ Begin
 end;
 
 
+function is_locallabel(const s:string):boolean;
+begin
+  is_locallabel:=(length(s)>1) and (s[1]='@');
+end;
+
+
 Procedure GetToken;
-{*********************************************************************}
-{ FUNCTION GetToken: tasmtoken;                                     }
-{  Description: This routine returns intel assembler tokens and       }
-{  does some minor syntax error checking.                             }
-{*********************************************************************}
 var
   len : longint;
   forcelabel : boolean;
@@ -339,7 +331,7 @@ begin
             end;
            uppervar(actasmpattern);
            { after prefix we allow also a new opcode }
-           If (operandnum=0) and is_asmopcode(actasmpattern) then
+           If is_prefix(actopcode) and is_asmopcode(actasmpattern) then
             Begin
               { if we are not in a constant }
               { expression than this is an  }
@@ -672,26 +664,12 @@ end;
 
 
 Procedure BuildConstSymbolExpression(needofs:boolean;var value:longint;var asmsym:string);
-{*********************************************************************}
-{ FUNCTION BuildConstExpression(false): longint                              }
-{  Description: This routine calculates a constant expression to      }
-{  a given value. The return value is the value calculated from       }
-{  the expression.                                                    }
-{ The following tokens (not strings) are recognized:                  }
-{    (,),SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants.  }
-{*********************************************************************}
-{ ENTRY: On entry the token should be any valid expression token.     }
-{ EXIT:  On Exit the token points to any token after the closing      }
-{         RBRACKET                                                    }
-{ ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming }
-{  invalid tokens.                                                    }
-{*********************************************************************}
 var
   tempstr,expr,hs : string;
   parenlevel,l,k : longint;
   errorflag : boolean;
   prevtok : tasmtoken;
-  hl : plabel;
+  hl : PAsmLabel;
   sym : psym;
 Begin
   { reset }
@@ -802,8 +780,14 @@ Begin
           else
            begin
              hs:='';
-             if SearchLabel(tempstr,hl) then
-              hs:=lab2str(hl)
+             if is_locallabel(tempstr) then
+              begin
+                CreateLocalLabel(tempstr,hl,false);
+                hs:=hl^.name
+              end
+             else
+              if SearchLabel(tempstr,hl,false) then
+               hs:=hl^.name
              else
               begin
                 getsym(tempstr,false);
@@ -886,19 +870,22 @@ begin
 end;
 
 
+{****************************************************************************
+                               T386IntelOperand
+****************************************************************************}
 
-Procedure BuildBracketExpression(var Instr: TInstruction);
-{*********************************************************************}
-{ PROCEDURE BuildBracketExpression                                    }
-{  Description: This routine builds up an expression after a LBRACKET }
-{  token is encountered.                                              }
-{   On entry actasmtoken should be equal to AS_LBRACKET.              }
-{  var_prefix : Should be set to true if variable identifier has      }
-{    been defined, such as in ID[                                     }
-{*********************************************************************}
-{ EXIT CONDITION:  On exit the routine should point to either the     }
-{       AS_COMMA or AS_SEPARATOR token.                               }
-{*********************************************************************}
+type
+  P386IntelOperand=^T386IntelOperand;
+  T386IntelOperand=object(T386Operand)
+    Procedure BuildOperand;virtual;
+  private
+    Procedure BuildReference;
+    Procedure BuildConstant;
+  end;
+
+
+
+Procedure T386IntelOperand.BuildReference;
 var
   l : longint;
   hs : string;
@@ -908,7 +895,7 @@ var
   GotPlus,Negative : boolean;
 Begin
   Consume(AS_LBRACKET);
-  initAsmRef(instr,operandnum);
+  InitRef;
   GotPlus:=true;
   Negative:=false;
   repeat
@@ -924,42 +911,42 @@ Begin
            begin
              l:=BuildConstExpression;
              if actasmtoken=AS_STAR then
-              instr.operands[operandnum].ref.scalefactor:=l
+              opr.ref.scalefactor:=l
              else
               begin
                 if negative then
-                  Dec(instr.operands[operandnum].ref.offset,l)
+                  Dec(opr.ref.offset,l)
                 else
-                  Inc(instr.operands[operandnum].ref.offset,l);
+                  Inc(opr.ref.offset,l);
               end;
            end
           else
            Begin
-             if instr.operands[operandnum].hasvar then
+             if hasvar then
                Message(asmr_e_cant_have_multiple_relocatable_symbols);
              if negative then
                Message(asmr_e_only_add_relocatable_symbol);
-             oldbase:=instr.operands[operandnum].ref.base;
-             instr.operands[operandnum].ref.base:=R_NO;
-             if not CreateVarInstr(instr,actasmpattern,operandnum) then
+             oldbase:=opr.ref.base;
+             opr.ref.base:=R_NO;
+             if not SetupVar(actasmpattern) then
                Message1(sym_e_unknown_id,actasmpattern);
              { is the base register loaded by the var ? }
-             if (instr.operands[operandnum].ref.base<>R_NO) then
+             if (opr.ref.base<>R_NO) then
               begin
                 { check if we can move the old base to the index register }
-                if (instr.operands[operandnum].ref.index<>R_NO) then
+                if (opr.ref.index<>R_NO) then
                  Message(asmr_e_wrong_base_index)
                 else
-                 instr.operands[operandnum].ref.index:=oldbase;
+                 opr.ref.index:=oldbase;
               end
              else
-              instr.operands[operandnum].ref.base:=oldbase;
+              opr.ref.base:=oldbase;
              { we can't have a Constant here so add the constant value to the
                offset }
-             if instr.operands[operandnum].operandtype=OPR_CONSTANT then
+             if opr.typ=OPR_CONSTANT then
               begin
-                instr.operands[operandnum].operandtype:=OPR_REFERENCE;
-                inc(instr.operands[operandnum].ref.offset,instr.operands[operandnum].val);
+                opr.typ:=OPR_REFERENCE;
+                inc(opr.ref.offset,opr.val);
               end;
              Consume(AS_ID);
            end;
@@ -995,7 +982,7 @@ Begin
               end;
             AS_REGISTER :
               begin
-                if instr.operands[operandnum].ref.scalefactor=0 then
+                if opr.ref.scalefactor=0 then
                  Message(asmr_e_wrong_scale_factor);
               end;
             else
@@ -1005,7 +992,7 @@ Begin
            begin
              if hs<>'' then
               val(hs,l,code);
-             instr.operands[operandnum].ref.scalefactor:=l
+             opr.ref.scalefactor:=l
            end;
           GotPlus:=false;
         end;
@@ -1018,14 +1005,14 @@ Begin
           Consume(AS_REGISTER);
           { this register will be the index }
           if (actasmtoken=AS_STAR) or
-             (instr.operands[operandnum].ref.base<>R_NO) then
+             (opr.ref.base<>R_NO) then
            begin
-             if (instr.operands[operandnum].ref.index<>R_NO) then
+             if (opr.ref.index<>R_NO) then
               Message(asmr_e_multiple_index);
-             instr.operands[operandnum].ref.index:=hreg;
+             opr.ref.index:=hreg;
            end
           else
-           instr.operands[operandnum].ref.base:=hreg;
+           opr.ref.base:=hreg;
           GotPlus:=false;
         end;
 
@@ -1037,13 +1024,13 @@ Begin
             Message(asmr_e_invalid_reference_syntax);
           l:=BuildConstExpression;
           if actasmtoken=AS_STAR then
-           instr.operands[operandnum].ref.scalefactor:=l
+           opr.ref.scalefactor:=l
           else
            begin
              if negative then
-               Dec(instr.operands[operandnum].ref.offset,l)
+               Dec(opr.ref.offset,l)
              else
-               Inc(instr.operands[operandnum].ref.offset,l);
+               Inc(opr.ref.offset,l);
            end;
           GotPlus:=false;
         end;
@@ -1067,24 +1054,39 @@ Begin
 end;
 
 
-Procedure BuildOperand(var instr: TInstruction);
+Procedure T386IntelOperand.BuildConstant;
+var
+  l : longint;
+  tempstr : string;
+begin
+  BuildConstSymbolExpression(true,l,tempstr);
+  if tempstr<>'' then
+   begin
+     opr.typ:=OPR_SYMBOL;
+     opr.symofs:=l;
+     opr.symbol:=newasmsymbol(tempstr);
+   end
+  else
+   begin
+     opr.typ:=OPR_CONSTANT;
+     opr.val:=l;
+   end;
+end;
 
-  Procedure BuildConstOperand(var instr: TInstruction);
-  var
-    l : longint;
-    tempstr : string;
+
+Procedure T386IntelOperand.BuildOperand;
+
+  procedure AddLabelOperand(hl:pasmlabel);
   begin
-    BuildConstSymbolExpression(true,l,tempstr);
-    if tempstr<>'' then
+    if is_calljmp(actopcode) then
      begin
-       instr.operands[operandnum].operandtype:=OPR_SYMBOL;
-       instr.operands[operandnum].symofs:=l;
-       instr.operands[operandnum].symbol:=newasmsymbol(tempstr);
+       opr.typ:=OPR_SYMBOL;
+       opr.symbol:=hl;
      end
     else
      begin
-       instr.operands[operandnum].operandtype:=OPR_CONSTANT;
-       instr.operands[operandnum].val:=l;
+       InitRef;
+       opr.ref.symbol:=hl;
      end;
   end;
 
@@ -1092,11 +1094,10 @@ var
   expr,
   tempstr : string;
   tempreg : tregister;
-  lab     : PAsmLabelRec;
   l,
   toffset,
   tsize   : longint;
-  hl      : plabel;
+  hl      : PAsmLabel;
 Begin
   tempstr:='';
   expr:='';
@@ -1109,20 +1110,20 @@ Begin
     AS_NOT,
     AS_LPAREN :
       Begin
-        if not (instr.operands[operandnum].operandtype in [OPR_NONE,OPR_CONSTANT]) then
+        if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then
           Message(asmr_e_invalid_operand_type);
-        BuildConstOperand(instr);
+        BuildConstant;
       end;
 
     AS_STRING :
       Begin
-        if not (instr.operands[operandnum].operandtype in [OPR_NONE]) then
+        if not (opr.typ in [OPR_NONE]) then
           Message(asmr_e_invalid_operand_type);
-        instr.operands[operandnum].operandtype:=OPR_CONSTANT;
         if not PadZero(actasmpattern,4) then
           Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
-        instr.operands[operandnum].val:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
-                                        Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
+        opr.typ:=OPR_CONSTANT;
+        opr.val:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
+                 Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
         Consume(AS_STRING);
       end;
 
@@ -1134,52 +1135,28 @@ Begin
          Begin
            if actasmpattern = '@RESULT' then
             Begin
-              initAsmRef(instr,operandnum);
-              SetUpResult(instr,operandnum);
+              InitRef;
+              SetupResult;
             end
            else
             if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
               Message(asmr_w_CODE_and_DATA_not_supported)
            else
-            Begin
-              delete(actasmpattern,1,1);
-              if actasmpattern = '' then
-                Message(asmr_e_null_label_ref_not_allowed);
-              lab:=labellist.search(actasmpattern);
-              { check if the label is already defined   }
-              { if so, we then check if the plabel is   }
-              { non-nil, if so we add it to instruction }
-              if assigned(lab) then
-               Begin
-                 if assigned(lab^.lab) then
-                   Begin
-                     instr.operands[operandnum].operandtype:=OPR_LABINSTR;
-                     instr.operands[operandnum].hl:=lab^.lab;
-                     instr.labeled:=TRUE;
-                   end;
-               end
-              else
-              { the label does not exist, create it }
-              { emit the opcode, but set that the   }
-              { label has not been emitted          }
-               Begin
-                 getlabel(hl);
-                 labellist.insert(actasmpattern,hl,FALSE);
-                 instr.operands[operandnum].operandtype:=OPR_LABINSTR;
-                 instr.operands[operandnum].hl:=hl;
-                 instr.labeled:=TRUE;
-               end;
+            { Local Label }
+            begin
+              CreateLocalLabel(actasmpattern,hl,false);
+              Consume(AS_ID);
+              AddLabelOperand(hl);
+              if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
+               Message(asmr_e_syntax_error);
             end;
-           Consume(AS_ID);
-           if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
-             Message(asmr_e_syntax_error);
          end
         else
         { support result for delphi modes }
          if (m_objpas in aktmodeswitches) and (actasmpattern='RESULT') then
           begin
-            initAsmRef(instr,operandnum);
-            SetUpResult(instr,operandnum);
+            InitRef;
+            SetUpResult;
             Consume(AS_ID);
           end
         { probably a variable or normal expression }
@@ -1189,39 +1166,28 @@ Begin
            { is it a constant ? }
            if SearchIConstant(actasmpattern,l) then
             Begin
-              if not (instr.operands[operandnum].operandtype in [OPR_NONE,OPR_CONSTANT]) then
+              if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then
                Message(asmr_e_invalid_operand_type);
-              BuildConstOperand(instr);
+              BuildConstant;
             end
            else
-           { is it a label variable ? }
-            if SearchLabel(actasmpattern,hl) then
-             Begin
-               instr.operands[operandnum].operandtype:=OPR_LABINSTR;
-               instr.operands[operandnum].hl:=hl;
-               instr.labeled:=TRUE;
+            { Check for pascal label }
+            if SearchLabel(actasmpattern,hl,false) then
+             begin
                Consume(AS_ID);
+               AddLabelOperand(hl);
                if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
                 Message(asmr_e_syntax_error);
              end
             else
             { is it a normal variable ? }
              Begin
-               initAsmRef(instr,operandnum);
-               if not CreateVarInstr(instr,actasmpattern,operandnum) then
+               InitRef;
+               if not SetupVar(actasmpattern) then
                 Begin
-                  { not a variable.. }
-                  { check special variables.. }
+                  { not a variable, check special variables.. }
                   if actasmpattern = 'SELF' then
-                   Begin
-                     if assigned(procinfo._class) then
-                      Begin
-                        instr.operands[operandnum].ref.offset:=procinfo.ESI_offset;
-                        instr.operands[operandnum].ref.base:=procinfo.framepointer;
-                      end
-                     else
-                      Message(asmr_e_cannot_use_SELF_outside_a_method);
-                   end
+                   SetupSelf
                   else
                    Message1(sym_e_unknown_id,actasmpattern);
                 end;
@@ -1230,9 +1196,9 @@ Begin
                Consume(AS_ID);
                if actasmtoken=AS_LBRACKET then
                 begin
-                  instr.operands[operandnum].operandtype:=OPR_REFERENCE;
-                  reset_reference(Instr.Operands[OperandNum].Ref);
-                  BuildBracketExpression(instr);
+                  opr.typ:=OPR_REFERENCE;
+                  reset_reference(opr.Ref);
+                  BuildReference;
                 end;
                if actasmtoken=AS_DOT then
                 begin
@@ -1242,15 +1208,15 @@ Begin
                    begin
                      BuildRecordOffsetSize(expr,toffset,tsize);
                      inc(l,toffset);
-                     SetOperandSize(instr,operandnum,tsize);
+                     SetSize(tsize);
                    end;
                 end;
                if actasmtoken in [AS_PLUS,AS_MINUS] then
                 inc(l,BuildConstExpression);
-               if instr.operands[operandnum].operandtype=OPR_REFERENCE then
-                inc(instr.operands[operandnum].ref.offset,l)
+               if opr.typ=OPR_REFERENCE then
+                inc(opr.ref.offset,l)
                else
-                inc(instr.operands[operandnum].val,l);
+                inc(opr.val,l);
              end;
          end;
       end;
@@ -1263,24 +1229,24 @@ Begin
         if actasmtoken = AS_COLON then
          Begin
            Consume(AS_COLON);
-           initAsmRef(instr,operandnum);
-           instr.operands[operandnum].ref.segment:=tempreg;
-           BuildBracketExpression(instr);
+           InitRef;
+           opr.ref.segment:=tempreg;
+           BuildReference;
          end
         else
         { Simple register }
          begin
-           if not (instr.operands[operandnum].operandtype in [OPR_NONE,OPR_REGISTER]) then
+           if not (opr.typ in [OPR_NONE,OPR_REGISTER]) then
             Message(asmr_e_invalid_operand_type);
-           instr.operands[operandnum].operandtype:=OPR_REGISTER;
-           instr.operands[operandnum].reg:=tempreg;
-           instr.operands[operandnum].size:=reg_2_opsize[instr.operands[operandnum].reg];
+           opr.typ:=OPR_REGISTER;
+           opr.reg:=tempreg;
+           size:=reg_2_opsize[opr.reg];
          end;
       end;
 
     AS_LBRACKET: { a variable reference, register ref. or a constant reference }
       Begin
-        BuildBracketExpression(instr);
+        BuildReference;
       end;
 
     AS_SEG :
@@ -1303,95 +1269,32 @@ Begin
 end;
 
 
-Procedure BuildConstant(maxvalue: longint);
-{*********************************************************************}
-{ PROCEDURE BuildConstant                                             }
-{  Description: This routine takes care of parsing a DB,DD,or DW      }
-{  line and adding those to the assembler node. Expressions, range-   }
-{  checking are fullly taken care of.                                 }
-{   maxvalue: $ff -> indicates that this is a DB node.                }
-{             $ffff -> indicates that this is a DW node.              }
-{             $ffffffff -> indicates that this is a DD node.          }
-{*********************************************************************}
-{ EXIT CONDITION:  On exit the routine should point to AS_SEPARATOR.  }
-{*********************************************************************}
+{*****************************************************************************
+                                T386IntelInstruction
+*****************************************************************************}
+
+type
+  P386IntelInstruction=^T386IntelInstruction;
+  T386IntelInstruction=object(T386Instruction)
+    procedure InitOperands;virtual;
+    procedure BuildOpcode;virtual;
+  end;
+
+procedure T386IntelInstruction.InitOperands;
 var
- strlength: byte;
- asmsym,
- expr: string;
- value : longint;
-Begin
-  strlength:=0; { assume it is a DB }
-  Repeat
-    Case actasmtoken of
-      AS_STRING:
-        Begin
-          if maxvalue = $ffff then
-            strlength:=2
-          else
-            if maxvalue = $ffffffff then
-              strlength:=4;
-          { DD and DW cases }
-          if strlength <> 0 then
-           Begin
-             if Not PadZero(actasmpattern,strlength) then
-              Message(scan_f_string_exceeds_line);
-           end;
-          expr:=actasmpattern;
-          Consume(AS_STRING);
-          Case actasmtoken of
-            AS_COMMA:
-              Consume(AS_COMMA);
-            AS_SEPARATOR: ;
-            else
-              Message(asmr_e_invalid_string_expression);
-          end;
-          ConcatString(curlist,expr);
-        end;
-      AS_PLUS,
-      AS_MINUS,
-      AS_LPAREN,
-      AS_NOT,
-      AS_INTNUM,
-      AS_ID :
-        Begin
-          BuildConstSymbolExpression(false,value,asmsym);
-          if asmsym<>'' then
-           begin
-             if maxvalue<>$ffffffff then
-               Message(asmr_w_const32bit_for_address);
-             ConcatConstSymbol(curlist,asmsym,value)
-           end
-          else
-           ConcatConstant(curlist,value,maxvalue);
-        end;
-      AS_COMMA:
-        Consume(AS_COMMA);
-      AS_SEPARATOR:
-        break;
-      else
-        begin
-          Message(asmr_e_syn_constant);
-          RecoverConsume(false);
-        end
-    end;
-  Until false;
+  i : longint;
+begin
+  for i:=1to 3 do
+   Operands[i]:=new(P386IntelOperand,Init);
 end;
 
 
-Procedure BuildOpCode;
-{*********************************************************************}
-{ PROCEDURE BuildOpcode;                                              }
-{  Description: Parses the intel opcode and operands, and writes it   }
-{  in the TInstruction object.                                        }
-{*********************************************************************}
-{ EXIT CONDITION:  On exit the routine should point to AS_SEPARATOR.  }
-{ On ENTRY: Token should point to AS_OPCODE                           }
-{*********************************************************************}
+Procedure T386IntelInstruction.BuildOpCode;
 var
   PrefixOp,OverrideOp: tasmop;
   expr : string;
   size : topsize;
+  operandnum : longint;
 Begin
   expr:='';
   PrefixOp:=A_None;
@@ -1401,20 +1304,20 @@ Begin
     if is_prefix(actopcode) then
      begin
        PrefixOp:=ActOpcode;
-       instr.opcode:=ActOpcode;
-       instr.condition:=ActCondition;
-       instr.opsize:=ActOpsize;
-       ConcatInstruction(curlist,instr);
+       opcode:=ActOpcode;
+       condition:=ActCondition;
+       opsize:=ActOpsize;
+       ConcatInstruction(curlist);
        Consume(AS_OPCODE);
      end
     else
      if is_override(actopcode) then
       begin
         OverrideOp:=ActOpcode;
-        instr.opcode:=ActOpcode;
-        instr.condition:=ActCondition;
-        instr.opsize:=ActOpsize;
-        ConcatInstruction(curlist,instr);
+        opcode:=ActOpcode;
+        condition:=ActCondition;
+        opsize:=ActOpsize;
+        ConcatInstruction(curlist);
         Consume(AS_OPCODE);
       end
     else
@@ -1428,9 +1331,9 @@ Begin
      exit;
    end;
   { Fill the instr object with the current state }
-  instr.Opcode:=ActOpcode;
-  instr.condition:=ActCondition;
-  instr.opsize:=ActOpsize;
+  Opcode:=ActOpcode;
+  condition:=ActCondition;
+  opsize:=ActOpsize;
   { Valid combination of prefix/override and instruction ?  }
   if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then
     Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern);
@@ -1481,41 +1384,14 @@ Begin
             AS_TBYTE : size:=S_FX;
           end;
           Consume(actasmtoken);
-          Case actasmtoken of
-            { Reference }
-            AS_PTR :
-              Begin
-                Consume(AS_PTR);
-                BuildOperand(instr);
-              end;
-            { Possibly a typecast or a constant }
-            { expression.                       }
-            AS_LPAREN :
-              Begin
-                if actasmtoken = AS_ID then
-                 Begin
-                   { Case vartype of                }
-                   {  LOCAL: Replace by offset and  }
-                   {         BP in treference.      }
-                   {  GLOBAL: Replace by mangledname}
-                   {    in symbol of treference     }
-                   { Check if next token = RPAREN   }
-                   { otherwise syntax error.        }
-                   initAsmRef(instr,operandnum);
-                   if not CreateVarInstr(instr,actasmpattern,operandnum) then
-                     Message1(sym_e_unknown_id,actasmpattern);
-                 end
-                else
-                 begin
-                   instr.operands[operandnum].operandtype:=OPR_CONSTANT;
-                   instr.operands[operandnum].val:=BuildConstExpression;
-                 end;
-              end;
-            else
-              BuildOperand(instr);
-          end;
+          if actasmtoken=AS_PTR then
+           begin
+             Consume(AS_PTR);
+             Operands[operandnum]^.InitRef;
+           end;
+          Operands[operandnum]^.BuildOperand;
           { now set the size which was specified by the override }
-          instr.operands[operandnum].size:=size;
+          Operands[operandnum]^.size:=size;
         end;
 
       { Type specifier }
@@ -1527,43 +1403,95 @@ Begin
           else
             Message(asmr_w_far_ignored);
           Consume(actasmtoken);
-          if actasmtoken = AS_PTR then
+          if actasmtoken=AS_PTR then
            begin
-             initAsmRef(instr,operandnum);
              Consume(AS_PTR);
+             Operands[operandnum]^.InitRef;
            end;
-          BuildOperand(instr);
-        end;
-
-      { Constant expression }
-      AS_LPAREN :
-        Begin
-          instr.operands[operandnum].operandtype:=OPR_CONSTANT;
-          instr.operands[operandnum].val:=BuildConstExpression;
+          Operands[operandnum]^.BuildOperand;
         end;
 
       else
-        BuildOperand(instr);
+        Operands[operandnum]^.BuildOperand;
     end; { end case }
   until false;
+  Ops:=operandnum;
 end;
 
 
+Procedure BuildConstant(maxvalue: longint);
+var
+ strlength: byte;
+ asmsym,
+ expr: string;
+ value : longint;
+Begin
+  strlength:=0; { assume it is a DB }
+  Repeat
+    Case actasmtoken of
+      AS_STRING:
+        Begin
+          if maxvalue = $ffff then
+            strlength:=2
+          else
+            if maxvalue = $ffffffff then
+              strlength:=4;
+          { DD and DW cases }
+          if strlength <> 0 then
+           Begin
+             if Not PadZero(actasmpattern,strlength) then
+              Message(scan_f_string_exceeds_line);
+           end;
+          expr:=actasmpattern;
+          Consume(AS_STRING);
+          Case actasmtoken of
+            AS_COMMA:
+              Consume(AS_COMMA);
+            AS_SEPARATOR: ;
+            else
+              Message(asmr_e_invalid_string_expression);
+          end;
+          ConcatString(curlist,expr);
+        end;
+      AS_PLUS,
+      AS_MINUS,
+      AS_LPAREN,
+      AS_NOT,
+      AS_INTNUM,
+      AS_ID :
+        Begin
+          BuildConstSymbolExpression(false,value,asmsym);
+          if asmsym<>'' then
+           begin
+             if maxvalue<>$ffffffff then
+               Message(asmr_w_const32bit_for_address);
+             ConcatConstSymbol(curlist,asmsym,value)
+           end
+          else
+           ConcatConstant(curlist,value,maxvalue);
+        end;
+      AS_COMMA:
+        Consume(AS_COMMA);
+      AS_SEPARATOR:
+        break;
+      else
+        begin
+          Message(asmr_e_syn_constant);
+          RecoverConsume(false);
+        end
+    end;
+  Until false;
+end;
+
 
 Function Assemble: Ptree;
-{*********************************************************************}
-{ PROCEDURE Assemble;                                                 }
-{  Description: Parses the intel assembler syntax, parsing is done    }
-{  according to the rules in the Turbo Pascal manual.                 }
-{*********************************************************************}
 Var
-  hl : plabel;
-  labelptr : PAsmLabelRec;
+  hl : PAsmLabel;
+  instr : T386IntelInstruction;
 Begin
   Message1(asmr_d_start_reading,'intel');
   inexpression:=FALSE;
   firsttoken:=TRUE;
-  operandnum:=0;
   if assigned(procinfo.retdef) and
      (is_fpu(procinfo.retdef) or
      ret_in_acc(procinfo.retdef)) then
@@ -1576,46 +1504,26 @@ Begin
    end;
   curlist:=new(paasmoutput,init);
   { setup label linked list }
-  labellist.init;
+  new(LocalLabelList,Init);
+  { start tokenizer }
   c:=current_scanner^.asmgetchar;
   gettoken;
-
+  { main loop }
   repeat
     case actasmtoken of
-      AS_LLABEL :
+      AS_LLABEL:
         Begin
-          labelptr:=labellist.search(actasmpattern);
-          if not assigned(labelptr) then
-           Begin
-             getlabel(hl);
-             labellist.insert(actasmpattern,hl,TRUE);
-             ConcatLabel(curlist,hl);
-           end
-          else
-           { the label has already been inserted into the  }
-           { label list, either as an intruction label (in }
-           { this case it has not been emitted), or as a   }
-           { duplicate local symbol (in this case it has   }
-           { already been emitted).                        }
-           Begin
-              if labelptr^.emitted then
-               Message1(asmr_e_dup_local_sym,'@'+labelptr^.name^)
-              else
-               Begin
-                 if assigned(labelptr^.lab) then
-                   ConcatLabel(curlist,labelptr^.lab);
-                 labelptr^.emitted:=TRUE;
-               end;
-           end;
+          if CreateLocalLabel(actasmpattern,hl,true) then
+            ConcatLabel(curlist,hl);
           Consume(AS_LLABEL);
         end;
 
-      AS_LABEL :
+      AS_LABEL:
         Begin
-          if SearchLabel(actasmpattern,hl) then
-            ConcatLabel(curlist,hl)
+          if SearchLabel(upper(actasmpattern),hl,true) then
+           ConcatLabel(curlist,hl)
           else
-            Message1(asmr_e_unknown_label_identifier,actasmpattern);
+           Message1(asmr_e_unknown_label_identifier,actasmpattern);
           Consume(AS_LABEL);
         end;
 
@@ -1646,23 +1554,19 @@ Begin
       AS_OPCODE :
         Begin
           instr.init;
-          BuildOpcode;
-          instr.ops:=operandnum;
+          instr.BuildOpcode;
           { We need AT&T style operands }
-          SwapOperands(instr);
-          AddReferenceSizes(instr);
-          SetInstructionOpsize(instr);
-          CheckOperandSizes(instr);
-          ConcatInstruction(curlist,instr);
+          instr.SwapOperands;
+          instr.AddReferenceSizes;
+          instr.SetInstructionOpsize;
+          instr.CheckOperandSizes;
+          instr.ConcatInstruction(curlist);
           instr.done;
-          operandnum:=0;
         end;
 
       AS_SEPARATOR :
         Begin
           Consume(AS_SEPARATOR);
-          { let us go back to the first operand }
-          operandnum:=0;
         end;
 
       AS_END :
@@ -1676,29 +1580,11 @@ Begin
         end;
     end; { end case }
   until false;
-
-  { check if there were undefined symbols.   }
-  { if so, then list each of those undefined }
-  { labels.                                  }
-  if assigned(labellist.First) then
-   Begin
-     labelptr:=labellist.First;
-     if labellist.First <> nil then
-      Begin
-        { first label }
-        if not labelptr^.emitted then
-          Message1(asmr_e_unknown_local_sym,'@'+labelptr^.name^);
-        { other labels ... }
-        While (labelptr^.Next <> nil) do
-         Begin
-           labelptr:=labelptr^.Next;
-           if not labelptr^.emitted then
-            Message1(asmr_e_unknown_local_sym,'@'+labelptr^.name^);
-         end;
-      end;
-   end;
+  { Check LocalLabelList }
+  LocalLabelList^.CheckEmitted;
+  dispose(LocalLabelList,Done);
+  { Return the list in an asmnode }
   assemble:=genasmnode(curlist);
-  labellist.done;
   Message1(asmr_d_finish_reading,'intel');
 end;
 
@@ -1726,7 +1612,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.34  1999-05-21 13:55:16  peter
+  Revision 1.35  1999-05-27 19:44:59  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.34  1999/05/21 13:55:16  peter
     * NEWLAB for label as symbol
 
   Revision 1.33  1999/05/05 22:22:03  peter

compiler/symdef.inc

@@ -385,11 +385,7 @@
          has_rtti:=true;
          getdatalabel(rtti_label);
          write_child_rtti_data;
-{$ifdef NEWLAB}
          rttilist^.concat(new(pai_symbol,init(rtti_label)));
-{$else}
-         rttilist^.concat(new(pai_label,init(rtti_label)));
-{$endif}
          write_rtti_data;
       end;
 
@@ -398,11 +394,7 @@
       begin
          if not(has_rtti) then
            generate_rtti;
-{$ifdef NEWLAB}
          get_rtti_label:=rtti_label^.name;
-{$else}
-         get_rtti_label:=lab2str(rtti_label);
-{$endif}
       end;
 
 
@@ -435,7 +427,7 @@
       end;
 
 
-    function tdef.get_inittable_label : plabel;
+    function tdef.get_inittable_label : pasmlabel;
       begin
          if not(has_inittable) then
            generate_inittable;
@@ -2015,11 +2007,7 @@
          if (psym(sym)^.typ=varsym) and
             pvarsym(sym)^.definition^.needs_inittable then
            begin
-{$ifdef NEWLAB}
               rttilist^.concat(new(pai_const_symbol,init(pvarsym(sym)^.definition^.get_inittable_label)));
-{$else}
-              rttilist^.concat(new(pai_const_symbol,initname(lab2str(pvarsym(sym)^.definition^.get_inittable_label))));
-{$endif}
               rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
            end;
       end;
@@ -3507,7 +3495,15 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.122  1999-05-23 18:42:14  florian
+  Revision 1.123  1999-05-27 19:45:02  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.122  1999/05/23 18:42:14  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/symdefh.inc

@@ -38,11 +38,11 @@
 
           has_inittable : boolean;
           { adress of init informations }
-          inittable_label : plabel;
+          inittable_label : pasmlabel;
 
           has_rtti   : boolean;
           { address of rtti }
-          rtti_label : plabel;
+          rtti_label : pasmlabel;
 
           nextglobal,
           previousglobal : pdef;
@@ -72,7 +72,7 @@
           { init. tables }
           function  needs_inittable : boolean;virtual;
           procedure generate_inittable;
-          function  get_inittable_label : plabel;
+          function  get_inittable_label : pasmlabel;
           { the default implemenation calls write_rtti_data     }
           { if init and rtti data is different these procedures }
           { must be overloaded                                  }
@@ -517,7 +517,15 @@
 
 {
   $Log$
-  Revision 1.29  1999-05-23 18:42:15  florian
+  Revision 1.30  1999-05-27 19:45:04  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.29  1999/05/23 18:42:15  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/symsym.inc

@@ -204,17 +204,12 @@
                                  TLABELSYM
 ****************************************************************************}
 
-    constructor tlabelsym.init(const n : string; l : plabel);
+    constructor tlabelsym.init(const n : string; l : pasmlabel);
 
       begin
          inherited init(n);
          typ:=labelsym;
          lab:=l;
-{$ifndef NEWLAB}
-         lab^.is_used:=false;
-         lab^.is_set:=true;
-         lab^.refcount:=0;
-{$endif}
          defined:=false;
       end;
 
@@ -235,17 +230,13 @@
          inherited done;
       end;
 
-    function tlabelsym.mangledname : string;
 
+    function tlabelsym.mangledname : string;
       begin
-{$ifdef NEWLAB}
          mangledname:=lab^.name;
-{$else}
-         { this also sets the is_used field }
-         mangledname:=lab2str(lab);
-{$endif}
       end;
 
+
     procedure tlabelsym.write;
       begin
          if owner^.symtabletype in [unitsymtable,globalsymtable] then
@@ -2017,7 +2008,15 @@
 
 {
   $Log$
-  Revision 1.92  1999-05-21 13:55:21  peter
+  Revision 1.93  1999-05-27 19:45:06  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.92  1999/05/21 13:55:21  peter
     * NEWLAB for label as symbol
 
   Revision 1.91  1999/05/20 22:22:44  pierre

compiler/symsymh.inc

@@ -65,9 +65,9 @@
 
        plabelsym = ^tlabelsym;
        tlabelsym = object(tsym)
-          lab : plabel;
+          lab : pasmlabel;
           defined : boolean;
-          constructor init(const n : string; l : plabel);
+          constructor init(const n : string; l : pasmlabel);
           destructor done;virtual;
           constructor load;
           function mangledname : string;virtual;
@@ -331,7 +331,15 @@
 
 {
   $Log$
-  Revision 1.25  1999-05-21 13:55:23  peter
+  Revision 1.26  1999-05-27 19:45:07  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.25  1999/05/21 13:55:23  peter
     * NEWLAB for label as symbol
 
   Revision 1.24  1999/05/20 22:22:45  pierre

compiler/symtable.pas

@@ -34,11 +34,7 @@ unit symtable;
        globtype,globals,tokens,systems,verbose,
        aasm
 {$ifdef i386}
-  {$ifndef OLDASM}
        ,i386base
-  {$else}
-       ,i386
-  {$endif}
 {$endif}
 {$ifdef m68k}
        ,m68k
@@ -144,7 +140,7 @@ unit symtable;
 
        tsymtable = object
           symtabletype : tsymtabletype;
-          unitid    : word;           { each symtable gets a number }
+          unitid    : word;        { each symtable gets a number }
           name      : pstring;
           datasize  : longint;
           symindex,
@@ -206,7 +202,7 @@ unit symtable;
 
        tunitsymtable = object(tsymtable)
           unittypecount  : word;
-          unitsym        : punitsym;
+          unitsym       : punitsym;
 {$ifdef GDB}
           dbx_count : longint;
           prev_dbx_counter : plongint;
@@ -243,8 +239,8 @@ unit symtable;
 ****************************************************************************}
 
     const
-       systemunit            : punitsymtable = nil; { pointer to the system unit }
-       objpasunit            : punitsymtable = nil; { pointer to the objpas unit }
+       systemunit           : punitsymtable = nil; { pointer to the system unit }
+       objpasunit           : punitsymtable = nil; { pointer to the objpas unit }
        current_object_option : symprop = sp_public;
 
     var
@@ -258,7 +254,7 @@ unit symtable;
                                      have been loaded }
        symtablestack : psymtable;  { linked list of symtables }
 
-       srsym : psym;               { result of the last search }
+       srsym : psym;           { result of the last search }
        srsymtable : psymtable;
        lastsrsym : psym;           { last sym found in statement }
        lastsrsymtable : psymtable;
@@ -274,21 +270,21 @@ unit symtable;
        charpointerdef : ppointerdef; { pointer for Char-Pointerdef      }
        voidfarpointerdef : ppointerdef;
 
-       cformaldef : pformaldef;    { unique formal definition          }
-       voiddef   : porddef;        { Pointer to Void (procedure)       }
-       cchardef  : porddef;        { Pointer to Char                   }
-       booldef   : porddef;        { pointer to boolean type           }
-       u8bitdef  : porddef;        { Pointer to 8-Bit unsigned         }
-       u16bitdef : porddef;        { Pointer to 16-Bit unsigned        }
-       u32bitdef : porddef;        { Pointer to 32-Bit unsigned        }
-       s32bitdef : porddef;        { Pointer to 32-Bit signed          }
+       cformaldef : pformaldef;    { unique formal definition     }
+       voiddef   : porddef;     { Pointer to Void (procedure)       }
+       cchardef  : porddef;     { Pointer to Char                  }
+       booldef   : porddef;     { pointer to boolean type          }
+       u8bitdef  : porddef;     { Pointer to 8-Bit unsigned      }
+       u16bitdef : porddef;     { Pointer to 16-Bit unsigned    }
+       u32bitdef : porddef;     { Pointer to 32-Bit unsigned    }
+       s32bitdef : porddef;     { Pointer to 32-Bit signed        }
 
        cu64bitdef : porddef;       { pointer to 64 bit unsigned def }
        cs64bitintdef : porddef;    { pointer to 64 bit signed def, }
                                    { calculated by the int unit on i386 }
 
-       s32floatdef : pfloatdef;    { pointer for realconstn            }
-       s64floatdef : pfloatdef;    { pointer for realconstn            }
+       s32floatdef : pfloatdef;    { pointer for realconstn         }
+       s64floatdef : pfloatdef;    { pointer for realconstn         }
        s80floatdef : pfloatdef;    { pointer to type of temp. floats   }
        s32fixeddef : pfloatdef;    { pointer to type of temp. fixed    }
 
@@ -304,11 +300,11 @@ unit symtable;
        cfiledef : pfiledef;       { get the same definition for all file }
                                   { uses for stabs }
 
-       firstglobaldef,         { linked list of all globals defs }
+       firstglobaldef,   { linked list of all globals defs }
        lastglobaldef : pdef;   { used to reset stabs/ranges }
 
        class_tobject : pobjectdef; { pointer to the anchestor of all   }
-                                   { clases                            }
+                                   { clases                         }
 
        aktprocsym : pprocsym;      { pointer to the symbol for the
                                      currently be parsed procedure }
@@ -317,17 +313,17 @@ unit symtable;
                                      currently be called procedure,
                                      only set/unset in firstcall }
 
-       aktvarsym : pvarsym;        { pointer to the symbol for the
+       aktvarsym : pvarsym;     { pointer to the symbol for the
                                      currently read var, only used
                                      for variable directives }
 
-       procprefix : string;        { eindeutige Namen bei geschachtel- }
+       procprefix : string;     { eindeutige Namen bei geschachtel- }
                                    { ten Unterprogrammen erzeugen      }
 
-       lexlevel : longint;         { level of code                     }
-                                   { 1 for main procedure              }
+       lexlevel : longint;       { level of code                     }
+                                   { 1 for main procedure             }
                                    { 2 for normal function or proc     }
-                                   { higher for locals                 }
+                                   { higher for locals           }
     const
        main_program_level = 1;
        unit_init_level = 1;
@@ -343,18 +339,18 @@ unit symtable;
 
     var
 
-       macros : psymtable;         { pointer for die Symboltabelle mit  }
-                                   { Makros                            }
+       macros : psymtable;       { pointer for die Symboltabelle mit  }
+                                   { Makros                         }
 
        read_member : boolean;      { true, wenn Members aus einer PPU-  }
                                    { Datei gelesen werden, d.h. ein     }
                                    { varsym seine Adresse einlesen soll }
 
-       generrorsym : psym;         { Jokersymbol, wenn das richtige    }
-                                   { Symbol nicht gefunden wird        }
+       generrorsym : psym;       { Jokersymbol, wenn das richtige    }
+                                   { Symbol nicht gefunden wird }
 
-       generrordef : pdef;         { Jokersymbol for eine fehlerhafte  }
-                                   { Typdefinition                     }
+       generrordef : pdef;       { Jokersymbol for eine fehlerhafte  }
+                                   { Typdefinition                   }
 
        aktobjectdef : pobjectdef;  { used for private functions check !! }
 
@@ -756,8 +752,8 @@ const localsymtablestack : psymtable = nil;
       begin
          if psym(sym)^.typ=procsym then
            pprocsym(sym)^.check_forward
-         { check also object method table             }
-         { we needn't to test the def list            }
+         { check also object method table            }
+         { we needn't to test the def list          }
          { because each object has to have a type sym }
          else
           if (psym(sym)^.typ=typesym) and
@@ -785,7 +781,7 @@ const localsymtablestack : psymtable = nil;
          if (psym(p)^.typ=varsym) and
             ((psym(p)^.owner^.symtabletype in [parasymtable,localsymtable,staticsymtable])) then
            { unused symbol should be reported only if no }
-           { error is reported                           }
+           { error is reported                     }
            { if the symbol is in a register it is used   }
            { also don't count the value parameters which have local copies }
            { also don't claim for high param of open parameters (PM) }
@@ -1413,7 +1409,7 @@ const localsymtablestack : psymtable = nil;
            chainprocsym(sym);
 {$endif CHAINPROCSYMS}
          { writes the symbol in data segment if required }
-         { also sets the datasize of owner               }
+         { also sets the datasize of owner             }
          if not in_loading then
            sym^.insert_in_data;
          if (symtabletype in [staticsymtable,globalsymtable]) then
@@ -1892,7 +1888,7 @@ const localsymtablestack : psymtable = nil;
 
     procedure tunitsymtable.writeasunit;
       var
-         pu           : pused_unit;
+         pu        : pused_unit;
       begin
       { first the unitname }
         current_ppu^.putstring(name^);
@@ -2232,7 +2228,7 @@ const localsymtablestack : psymtable = nil;
          p:=symtablestack;
          symtablestack:=p^.next;
          { symbol tables of unit interfaces are never disposed }
-         { this is handle by the unit unitm                    }
+         { this is handle by the unit unitm                 }
          if not(p^.symtabletype in [unitsymtable,globalsymtable,stt_exceptsymtable]) or dispose_global then
           dispose(p,done);
       end;
@@ -2345,7 +2341,15 @@ const localsymtablestack : psymtable = nil;
 end.
 {
   $Log$
-  Revision 1.16  1999-05-23 18:42:16  florian
+  Revision 1.17  1999-05-27 19:45:08  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.16  1999/05/23 18:42:16  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/systems.pas

@@ -76,11 +76,16 @@ unit systems;
             as_i386_dbg,as_i386_coff,as_i386_pecoff
             ,as_m68k_as,as_m68k_gas,as_m68k_mit,as_m68k_mot,as_m68k_mpw
        );
+       { binary assembler writers, needed to test for -a }
      const
        {$ifdef i386} i386asmcnt=11; {$else} i386asmcnt=0; {$endif}
        {$ifdef m68k} m68kasmcnt=5; {$else} m68kasmcnt=0; {$endif}
        asmcnt=i386asmcnt+m68kasmcnt+1;
 
+       binassem : set of tasm = [
+         as_i386_dbg,as_i386_coff,as_i386_pecoff
+       ];
+
      type
        tlink = (link_none
             ,link_i386_ld,link_i386_ldgo32v1,
@@ -126,7 +131,7 @@ unit systems;
 
    type
        tosinfo = packed record
-          id        : tos;
+          id    : tos;
           name      : string[30];
           shortname : string[8];
           sharedlibext : string[10];
@@ -148,7 +153,7 @@ unit systems;
        end;
 
        tasminfo = packed record
-          id          : tasm;
+          id      : tasm;
           idtxt       : string[8];
           asmbin      : string[8];
           asmcmd      : string[50];
@@ -161,7 +166,7 @@ unit systems;
        end;
 
        tlinkinfo = packed record
-          id            : tlink;
+          id        : tlink;
           linkbin       : string[8];
           linkcmd       : string[127];
           binders       : word;
@@ -192,7 +197,7 @@ unit systems;
        ttargetinfo = packed record
           target      : ttarget;
           flags       : set of ttargetflags;
-          cpu         : ttargetcpu;
+          cpu    : ttargetcpu;
           short_name  : string[8];
           unit_env    : string[12];
           system_unit : string[8];
@@ -204,11 +209,12 @@ unit systems;
           resext,
           resobjext,
           exeext      : string[4];
-          os          : tos;
-          link        : tlink;
+          os      : tos;
+          link  : tlink;
           assem       : tasm;
-          ar          : tar;
-          res         : tres;
+          assemsrc    : tasm; { default source writing assembler }
+          ar      : tar;
+          res    : tres;
           heapsize,
           maxheapsize,
           stacksize   : longint;
@@ -229,6 +235,13 @@ unit systems;
        target_res  : tresinfo;
        source_os   : tosinfo;
 
+    function set_target_os(t:tos):boolean;
+    function set_target_asm(t:tasm):boolean;
+    function set_target_link(t:tlink):boolean;
+    function set_target_ar(t:tar):boolean;
+    function set_target_res(t:tres):boolean;
+    function set_target_info(t:ttarget):boolean;
+
     function set_string_target(s : string) : boolean;
     function set_string_asm(s : string) : boolean;
     function set_string_asmmode(s:string;var t:tasmmode):boolean;
@@ -245,12 +258,12 @@ implementation
 ****************************************************************************}
        os_infos : array[1..oscnt] of tosinfo = (
           (
-            id           : os_none;
+            id     : os_none;
             name         : 'No operating system';
             shortname    : 'none'
           ),
           (
-            id           : os_i386_go32v1;
+            id     : os_i386_go32v1;
             name         : 'GO32 V1 DOS extender';
             shortname    : 'go32v1';
             sharedlibext : '.dll';
@@ -271,7 +284,7 @@ implementation
             use_function_relative_addresses : true
           ),
           (
-            id           : os_i386_go32v2;
+            id     : os_i386_go32v2;
             name         : 'GO32 V2 DOS extender';
             shortname    : 'go32v2';
             sharedlibext : '.dll';
@@ -292,7 +305,7 @@ implementation
             use_function_relative_addresses : true
           ),
           (
-            id           : os_i386_linux;
+            id     : os_i386_linux;
             name         : 'Linux for i386';
             shortname    : 'linux';
             sharedlibext : '.so';
@@ -313,7 +326,7 @@ implementation
             use_function_relative_addresses : true
           ),
           (
-            id           : os_i386_os2;
+            id     : os_i386_os2;
             name         : 'OS/2 via EMX';
             shortname    : 'os2';
             sharedlibext : '.ao2';
@@ -334,7 +347,7 @@ implementation
             use_function_relative_addresses : false
           ),
           (
-            id           : os_i386_win32;
+            id     : os_i386_win32;
             name         : 'Win32 for i386';
             shortname    : 'win32';
             sharedlibext : '.dll';
@@ -355,7 +368,7 @@ implementation
             use_function_relative_addresses : true
           ),
           (
-            id           : os_m68k_amiga;
+            id     : os_m68k_amiga;
             name         : 'Commodore Amiga';
             shortname    : 'amiga';
             sharedlibext : '.library';
@@ -376,7 +389,7 @@ implementation
             use_function_relative_addresses : false
           ),
           (
-            id           : os_m68k_atari;
+            id     : os_m68k_atari;
             name         : 'Atari ST/STE';
             shortname    : 'atari';
             sharedlibext : '.dll';
@@ -397,7 +410,7 @@ implementation
             use_function_relative_addresses : false
           ),
           (
-            id           : os_m68k_mac;
+            id     : os_m68k_mac;
             name         : 'Macintosh m68k';
             shortname    : 'mac';
             sharedlibext : '.dll';
@@ -418,7 +431,7 @@ implementation
             use_function_relative_addresses : false
           ),
           (
-            id           : os_m68k_linux;
+            id     : os_m68k_linux;
             name         : 'Linux for m68k';
             shortname    : 'linux';
             sharedlibext : '.so';
@@ -439,7 +452,7 @@ implementation
             use_function_relative_addresses : true
           ),
           (
-            id           : os_m68k_palmos;
+            id     : os_m68k_palmos;
             name         : 'PalmOS';
             shortname    : 'palmos';
             sharedlibext : '.so';
@@ -883,14 +896,14 @@ implementation
           (
             target      : target_none;
             flags       : [];
-            cpu         : no_cpu;
+            cpu  : no_cpu;
             short_name  : 'notarget'
           )
 {$ifdef i386}
           ,(
             target      : target_i386_GO32V1;
             flags       : [];
-            cpu         : i386;
+            cpu  : i386;
             short_name  : 'GO32V1';
             unit_env    : 'GO32V1UNITS';
             system_unit : 'SYSTEM';
@@ -902,11 +915,12 @@ implementation
             resext      : '.res';
             resobjext   : '.o1r';
             exeext      : ''; { The linker produces a.out }
-            os          : os_i386_GO32V1;
+            os    : os_i386_GO32V1;
             link        : link_i386_ldgo32v1;
             assem       : as_i386_as;
-            ar          : ar_i386_ar;
-            res         : res_none;
+            assemsrc    : as_i386_as;
+            ar    : ar_i386_ar;
+            res  : res_none;
             heapsize    : 2048*1024;
             maxheapsize : 32768*1024;
             stacksize   : 16384
@@ -914,7 +928,7 @@ implementation
           (
             target      : target_i386_GO32V2;
             flags       : [];
-            cpu         : i386;
+            cpu  : i386;
             short_name  : 'GO32V2';
             unit_env    : 'GO32V2UNITS';
             system_unit : 'SYSTEM';
@@ -926,15 +940,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '.exe';
-            os          : os_i386_GO32V2;
+            os    : os_i386_GO32V2;
             link        : link_i386_ldgo32v2;
-{$ifndef OLDASM}
             assem       : as_i386_coff;
-{$else}
-            assem       : as_i386_as;
-{$endif}
-            ar          : ar_i386_ar;
-            res         : res_none;
+            assemsrc    : as_i386_as;
+            ar    : ar_i386_ar;
+            res  : res_none;
             heapsize    : 2048*1024;
             maxheapsize : 32768*1024;
             stacksize   : 16384
@@ -942,7 +953,7 @@ implementation
           (
             target      : target_i386_LINUX;
             flags       : [];
-            cpu         : i386;
+            cpu  : i386;
             short_name  : 'LINUX';
             unit_env    : 'LINUXUNITS';
             system_unit : 'syslinux';
@@ -954,11 +965,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '';
-            os          : os_i386_Linux;
+            os    : os_i386_Linux;
             link        : link_i386_ld;
             assem       : as_i386_as;
-            ar          : ar_i386_ar;
-            res         : res_none;
+            assemsrc    : as_i386_as;
+            ar    : ar_i386_ar;
+            res  : res_none;
             heapsize    : 2048*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -966,7 +978,7 @@ implementation
           (
             target      : target_i386_OS2;
             flags       : [];
-            cpu         : i386;
+            cpu  : i386;
             short_name  : 'OS2';
             unit_env    : 'OS2UNITS';
             system_unit : 'SYSOS2';
@@ -978,11 +990,12 @@ implementation
             resext      : '.res';
             resobjext   : '.oor';
             exeext      : ''; { The linker produces a.out }
-            os          : os_i386_OS2;
+            os    : os_i386_OS2;
             link        : link_i386_ldos2;
             assem       : as_i386_as_aout;
-            ar          : ar_i386_ar;
-            res         : res_none;
+            assemsrc    : as_i386_as_aout;
+            ar    : ar_i386_ar;
+            res  : res_none;
             heapsize    : 256*1024;
             maxheapsize : 32768*1024;
             stacksize   : 32768
@@ -990,7 +1003,7 @@ implementation
           (
             target      : target_i386_WIN32;
             flags       : [];
-            cpu         : i386;
+            cpu  : i386;
             short_name  : 'WIN32';
             unit_env    : 'WIN32UNITS';
             system_unit : 'SYSWIN32';
@@ -1002,11 +1015,12 @@ implementation
             resext      : '.rc';
             resobjext   : '.owr';
             exeext      : '.exe';
-            os          : os_i386_Win32;
+            os    : os_i386_Win32;
             link        : link_i386_ldw;
             assem       : as_i386_pecoff;
-            ar          : ar_i386_arw;
-            res         : res_i386_windres;
+            assemsrc    : as_i386_asw;
+            ar    : ar_i386_arw;
+            res  : res_i386_windres;
             heapsize    : 2048*1024;
             maxheapsize : 32*1024*1024;
             stacksize   : 32*1024*1024
@@ -1016,7 +1030,7 @@ implementation
           ,(
             target      : target_m68k_Amiga;
             flags       : [];
-            cpu         : m68k;
+            cpu  : m68k;
             short_name  : 'AMIGA';
             unit_env    : '';
             system_unit : 'sysamiga';
@@ -1028,11 +1042,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '';
-            os          : os_m68k_Amiga;
+            os    : os_m68k_Amiga;
             link        : link_m68k_ld;
             assem       : as_m68k_as;
-            ar          : ar_m68k_ar;
-            res         : res_none;
+            assemsrc    : as_m68k_as;
+            ar    : ar_m68k_ar;
+            res  : res_none;
             heapsize    : 128*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -1040,7 +1055,7 @@ implementation
           (
             target      : target_m68k_Atari;
             flags       : [];
-            cpu         : m68k;
+            cpu  : m68k;
             short_name  : 'ATARI';
             unit_env    : '';
             system_unit : 'SYSATARI';
@@ -1052,11 +1067,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '.ttp';
-            os          : os_m68k_Atari;
+            os    : os_m68k_Atari;
             link        : link_m68k_ld;
             assem       : as_m68k_as;
-            ar          : ar_m68k_ar;
-            res         : res_none;
+            assemsrc    : as_m68k_as;
+            ar    : ar_m68k_ar;
+            res  : res_none;
             heapsize    : 16*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -1064,7 +1080,7 @@ implementation
           (
             target      : target_m68k_Mac;
             flags       : [];
-            cpu         : m68k;
+            cpu  : m68k;
             short_name  : 'MACOS';
             unit_env    : '';
             system_unit : 'sysmac';
@@ -1076,11 +1092,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '';
-            os          : os_m68k_Mac;
+            os    : os_m68k_Mac;
             link        : link_m68k_ld;
             assem       : as_m68k_mpw;
-            ar          : ar_m68k_ar;
-            res         : res_none;
+            assemsrc    : as_m68k_mpw;
+            ar    : ar_m68k_ar;
+            res  : res_none;
             heapsize    : 128*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -1088,7 +1105,7 @@ implementation
           (
             target      : target_m68k_linux;
             flags       : [];
-            cpu         : m68k;
+            cpu  : m68k;
             short_name  : 'LINUX';
             unit_env    : 'LINUXUNITS';
             system_unit : 'syslinux';
@@ -1100,11 +1117,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '';
-            os          : os_m68k_Linux;
+            os    : os_m68k_Linux;
             link        : link_m68k_ld;
             assem       : as_m68k_as;
-            ar          : ar_m68k_ar;
-            res         : res_none;
+            assemsrc    : as_m68k_as;
+            ar    : ar_m68k_ar;
+            res  : res_none;
             heapsize    : 128*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -1112,7 +1130,7 @@ implementation
           (
             target      : target_m68k_PalmOS;
             flags       : [];
-            cpu         : m68k;
+            cpu  : m68k;
             short_name  : 'PALMOS';
             unit_env    : 'PALMUNITS';
             system_unit : 'syspalm';
@@ -1124,11 +1142,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '';
-            os          : os_m68k_PalmOS;
+            os    : os_m68k_PalmOS;
             link        : link_m68k_ld;
             assem       : as_m68k_as;
-            ar          : ar_m68k_ar;
-            res         : res_none;
+            assemsrc    : as_m68k_as;
+            ar    : ar_m68k_ar;
+            res  : res_none;
             heapsize    : 128*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -1473,7 +1492,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.76  1999-05-18 09:30:10  michael
+  Revision 1.77  1999-05-27 19:45:10  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.76  1999/05/18 09:30:10  michael
   + changes by thomas hajt
 
   Revision 1.74  1999/05/17 13:02:12  pierre

compiler/tcadd.pas

@@ -37,11 +37,7 @@ implementation
       symtable,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
       ,m68k
@@ -725,7 +721,7 @@ implementation
                    p^.location.loc:=LOC_MEM;
                 end;
               { only if there is a type cast we need to do again }
-              { the first pass                                   }
+              { the first pass                             }
               if p^.left^.treetype=typeconvn then
                 firstpass(p^.left);
               if p^.right^.treetype=typeconvn then
@@ -1097,7 +1093,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  1999-05-23 18:42:18  florian
+  Revision 1.33  1999-05-27 19:45:12  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.32  1999/05/23 18:42:18  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/tccal.pas

@@ -42,12 +42,7 @@ implementation
       aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
-{$ifndef OLDASM}
-      ,i386base
-{$else}
-      ,i386
-{$endif}
-      ,tgeni386
+      ,i386base,tgeni386
 {$endif}
 {$ifdef m68k}
       ,m68k,tgen68k
@@ -168,7 +163,7 @@ implementation
               p^.resulttype:=p^.left^.resulttype;
            end
          { if we know the routine which is called, then the type }
-         { conversions are inserted                              }
+         { conversions are inserted                           }
          else
            begin
               { Do we need arrayconstructor -> set conversion, then insert
@@ -368,7 +363,7 @@ implementation
            is_equal:=(def^.deftype=formaldef) or
              (types.is_equal(p^.resulttype,def))
            { to support ansi/long/wide strings in a proper way }
-           { string and string[10] are assumed as equal        }
+           { string and string[10] are assumed as equal }
            { when searching the correct overloaded procedure   }
              or
              (
@@ -720,13 +715,13 @@ implementation
                      end;
 
                    { if there are several choices left then for orddef }
-                   { if a type is totally included in the other        }
+                   { if a type is totally included in the other }
                    { we don't fear an overflow ,                       }
-                   { so we can do as if it is an exact match           }
-                   { this will convert integer to longint              }
-                   { rather than to words                              }
-                   { conversion of byte to integer or longint          }
-                   {would still not be solved                          }
+                   { so we can do as if it is an exact match       }
+                   { this will convert integer to longint             }
+                   { rather than to words                             }
+                   { conversion of byte to integer or longint     }
+                   {would still not be solved                     }
                    if assigned(procs) and assigned(procs^.next) then
                      begin
                         hp:=procs;
@@ -1123,7 +1118,7 @@ implementation
          if inlined then
            p^.right:=inlinecode;
          { determine the registers of the procedure variable }
-         { is this OK for inlined procs also ?? (PM)         }
+         { is this OK for inlined procs also ?? (PM)     }
          if assigned(p^.right) then
            begin
               p^.registersfpu:=max(p^.right^.registersfpu,p^.registersfpu);
@@ -1167,7 +1162,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  1999-05-23 18:42:19  florian
+  Revision 1.48  1999-05-27 19:45:13  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.47  1999/05/23 18:42:19  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/tccnv.pas

@@ -44,11 +44,7 @@ implementation
       symtable,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
       ,m68k
@@ -65,7 +61,7 @@ implementation
         constp,
         buildp,
         p2,p3,p4    : ptree;
-        pd          : pdef;
+        pd        : pdef;
         constset    : pconstset;
         constsetlo,
         constsethi  : longint;
@@ -274,7 +270,7 @@ implementation
                 begin
                    p^.left^.stringtype:=pstringdef(p^.resulttype)^.string_typ;
                    { we don't have to do anything, the const }
-                   { node generates an ansistring            }
+                   { node generates an ansistring           }
                    p^.convtyp:=tc_equal;
                 end
               else
@@ -428,8 +424,8 @@ implementation
     procedure first_chararray_to_string(var p : ptree);
       begin
          { the only important information is the location of the }
-         { result                                                }
-         { other stuff is done by firsttypeconv                  }
+         { result                                               }
+         { other stuff is done by firsttypeconv           }
          p^.location.loc:=LOC_MEM;
       end;
 
@@ -755,7 +751,7 @@ implementation
                      { do common tc_equal cast }
                      p^.convtyp:=tc_equal;
                      { wenn Aufz„hltyp nach Ordinal konvertiert werden soll }
-                     { dann Aufz„hltyp=s32bit                               }
+                     { dann Aufz„hltyp=s32bit                          }
                      if (p^.left^.resulttype^.deftype=enumdef) and
                         is_ordinal(p^.resulttype) then
                        begin
@@ -825,7 +821,7 @@ implementation
                              ) then
                          CGMessage(cg_e_illegal_type_conversion);
                      { the conversion into a strutured type is only }
-                     { possible, if the source is no register         }
+                     { possible, if the source is no register    }
                      if ((p^.resulttype^.deftype in [recorddef,stringdef,arraydef]) or
                          ((p^.resulttype^.deftype=objectdef) and not(pobjectdef(p^.resulttype)^.isclass))
                         ) and (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and
@@ -931,7 +927,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  1999-05-20 14:58:28  peter
+  Revision 1.33  1999-05-27 19:45:15  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.32  1999/05/20 14:58:28  peter
     * fixed arrayconstruct->set conversion which didn't work for enum sets
 
   Revision 1.31  1999/05/13 21:59:52  peter

compiler/tccon.pas

@@ -41,11 +41,7 @@ implementation
       symtable,aasm,types,
       hcodegen,pass_1
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
       ,m68k
@@ -88,7 +84,7 @@ implementation
 
     procedure firststringconst(var p : ptree);
       begin
-{         if cs_ansistrings in aktlocalswitches then
+{        if cs_ansistrings in aktlocalswitches then
           p^.resulttype:=cansistringdef
          else
           p^.resulttype:=cshortstringdef; }
@@ -130,7 +126,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  1999-05-01 13:24:50  peter
+  Revision 1.6  1999-05-27 19:45:16  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.5  1999/05/01 13:24:50  peter
     * merged nasm compiler
     * old asm moved to oldasm/
 

compiler/tcflw.pas

@@ -47,11 +47,7 @@ implementation
       symtable,aasm,types,
       hcodegen,htypechk,temp_gen,pass_1
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
       ,tgeni386
 {$endif}
 {$ifdef m68k}
@@ -500,7 +496,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  1999-05-01 13:24:52  peter
+  Revision 1.10  1999-05-27 19:45:18  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.9  1999/05/01 13:24:52  peter
     * merged nasm compiler
     * old asm moved to oldasm/
 

compiler/tcinl.pas

@@ -38,11 +38,7 @@ implementation
       hcodegen,htypechk,pass_1,
       tccal
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
       ,tgeni386
 {$endif}
 {$ifdef m68k}
@@ -538,7 +534,7 @@ implementation
                            { two paras ? }
                            if assigned(p^.left^.right) then
                              begin
-                                { insert a type conversion         }
+                                { insert a type conversion       }
                                 { the second param is always longint }
                                 p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,s32bitdef);
                                 { check the type conversion }
@@ -581,7 +577,7 @@ implementation
                        while assigned(hp^.right) do
                          hp:=hp^.right;
                        { if resulttype is not assigned, then automatically }
-                       { file is not typed.                                }
+                       { file is not typed.                             }
                        if assigned(hp) and assigned(hp^.resulttype) then
                          Begin
                            if (hp^.resulttype^.deftype=filedef) and
@@ -965,7 +961,7 @@ implementation
                            { two paras ? }
                            if assigned(p^.left^.right) then
                              begin
-                                { insert a type conversion         }
+                                { insert a type conversion       }
                                 { to the type of the set elements  }
                                 p^.left^.right^.left:=gentypeconvnode(
                                   p^.left^.right^.left,
@@ -1105,7 +1101,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  1999-05-23 18:42:20  florian
+  Revision 1.35  1999-05-27 19:45:19  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.34  1999/05/23 18:42:20  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/tcld.pas

@@ -42,11 +42,7 @@ implementation
       hcodegen,htypechk,pass_1,
       tccnv
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
       ,tgeni386
 {$endif}
 {$ifdef m68k}
@@ -432,7 +428,7 @@ implementation
             end;
          end;
         calcregisters(p,0,0,0);
-        { looks a little bit dangerous to me                }
+        { looks a little bit dangerous to me            }
         { len-1 gives problems with is_open_array if len=0, }
         { is_open_array checks now for isconstructor (FK)   }
         p^.resulttype:=new(parraydef,init(0,len-1,s32bitdef));
@@ -457,7 +453,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  1999-05-23 18:42:22  florian
+  Revision 1.33  1999-05-27 19:45:21  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.32  1999/05/23 18:42:22  florian
     * better error recovering in typed constants
     * some problems with arrays of const fixed, some problems
       due my previous

compiler/tcmat.pas

@@ -40,11 +40,7 @@ implementation
       symtable,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
       ,m68k
@@ -377,7 +373,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  1999-05-06 09:05:38  peter
+  Revision 1.15  1999-05-27 19:45:22  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.14  1999/05/06 09:05:38  peter
     * generic write_float and str_float
     * fixed constant float conversions
 

compiler/tcmem.pas

@@ -48,11 +48,7 @@ implementation
       symtable,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
 {$endif}
 {$ifdef m68k}
       ,m68k
@@ -469,7 +465,7 @@ implementation
          else
            begin
               { this rules are suboptimal, but they should give }
-              { good results                                    }
+              { good results                                }
               p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
 
               { for ansi/wide strings, we need at least one register }
@@ -481,7 +477,7 @@ implementation
               if (p^.left^.registers32<=p^.right^.registers32) and
               { only if the node needs less than 3 registers }
               { two for the right node and one for the       }
-              { left address                                 }
+              { left address                             }
                 (p^.registers32<3) then
                 inc(p^.registers32);
 
@@ -569,7 +565,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  1999-05-18 09:52:21  peter
+  Revision 1.17  1999-05-27 19:45:24  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.16  1999/05/18 09:52:21  peter
     * procedure of object and addrn fixes
 
   Revision 1.15  1999/05/17 23:51:46  peter

compiler/tcset.pas

@@ -41,11 +41,7 @@ implementation
       hcodegen,htypechk,pass_1,
       tccnv
 {$ifdef i386}
-{$ifndef OLDASM}
       ,i386base
-{$else}
-      ,i386
-{$endif}
       ,tgeni386
 {$endif}
 {$ifdef m68k}
@@ -259,7 +255,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  1999-05-01 13:24:58  peter
+  Revision 1.10  1999-05-27 19:45:25  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.9  1999/05/01 13:24:58  peter
     * merged nasm compiler
     * old asm moved to oldasm/
 

compiler/temp_gen.pas

@@ -26,11 +26,7 @@ unit temp_gen;
 
     uses
 {$ifdef i386}
-{$ifndef OLDASM}
       i386base,i386asm,
-{$else}
-      i386,
-{$endif}
 {$endif i386}
 {$ifdef m68k}
       m68k,
@@ -44,7 +40,7 @@ unit temp_gen;
       ptemprecord = ^ttemprecord;
       ttemprecord = record
          temptype   : ttemptype;
-         pos        : longint;
+         pos    : longint;
          size       : longint;
          next       : ptemprecord;
          nextfree   : ptemprecord; { for faster freeblock checking }
@@ -530,7 +526,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.28  1999-05-21 17:23:47  peter
+  Revision 1.29  1999-05-27 19:45:26  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.28  1999/05/21 17:23:47  peter
     * align tempsize also on stackalignment
 
   Revision 1.27  1999/05/21 11:46:28  pierre

compiler/tgeni386.pas

@@ -27,11 +27,7 @@ unit tgeni386;
     uses
        cobjects,globals,tree,hcodegen,verbose,files,aasm
 {$ifdef i386}
-{$ifndef OLDASM}
        ,i386base,i386asm
-{$else}
-       ,i386
-{$endif}
 {$endif}
        ;
 
@@ -66,12 +62,12 @@ unit tgeni386;
     procedure del_locref(const location : tlocation);
 
     { pushs and restores registers }
-    procedure pushusedregisters(list : paasmoutput;var pushed : tpushed;b : byte);
-    procedure popusedregisters(list : paasmoutput;const pushed : tpushed);
+    procedure pushusedregisters(var pushed : tpushed;b : byte);
+    procedure popusedregisters(const pushed : tpushed);
 
     { saves and restores used registers to temp. values }
-    procedure saveusedregisters(list : paasmoutput;var saved : tsaved;b : byte);
-    procedure restoreusedregisters(list : paasmoutput;const saved : tsaved);
+    procedure saveusedregisters(var saved : tsaved;b : byte);
+    procedure restoreusedregisters(const saved : tsaved);
 
     procedure clearregistercount;
     procedure resetusableregisters;
@@ -84,7 +80,7 @@ unit tgeni386;
        usedinproc : byte;
 
        { count, how much a register must be pushed if it is used as register }
-       { variable                                                            }
+       { variable                                                           }
 {$ifdef SUPPORT_MMX}
        reg_pushes : array[R_EAX..R_MM6] of longint;
        is_reg_var : array[R_EAX..R_MM6] of boolean;
@@ -99,7 +95,7 @@ implementation
     uses
       globtype,temp_gen;
 
-    procedure pushusedregisters(list : paasmoutput;var pushed : tpushed;b : byte);
+    procedure pushusedregisters(var pushed : tpushed;b : byte);
 
       var
          r : tregister;
@@ -117,7 +113,7 @@ implementation
                    if not(r in unused) then
                      begin
                         { then save it }
-                        list^.concat(new(pai386,op_reg(A_PUSH,S_L,r)));
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r)));
 
                         { here was a big problem  !!!!!}
                         { you cannot do that for a register that is
@@ -138,12 +134,12 @@ implementation
               { if the mmx register is in use, save it }
               if not(r in unused) then
                 begin
-                   list^.concat(new(pai386,op_const_reg(
+                   exprasmlist^.concat(new(pai386,op_const_reg(
                      A_SUB,S_L,8,R_ESP)));
                    new(hr);
                    reset_reference(hr^);
                    hr^.base:=R_ESP;
-                   list^.concat(new(pai386,op_reg_ref(
+                   exprasmlist^.concat(new(pai386,op_reg_ref(
                      A_MOVQ,S_NO,r,hr)));
                    if not(is_reg_var[r]) then
                      unused:=unused+[r];
@@ -153,7 +149,7 @@ implementation
 {$endif SUPPORT_MMX}
       end;
 
-    procedure saveusedregisters(list : paasmoutput;var saved : tsaved;b : byte);
+    procedure saveusedregisters(var saved : tsaved;b : byte);
 
       var
          r : tregister;
@@ -173,7 +169,7 @@ implementation
                         { then save it }
                         gettempofsizereference(4,hr);
                         saved[r]:=hr.offset;
-                        list^.concat(new(pai386,op_reg_ref(A_MOV,S_L,r,newreference(hr))));
+                        exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,r,newreference(hr))));
                         { here was a big problem  !!!!!}
                         { you cannot do that for a register that is
                         globally assigned to a var
@@ -193,7 +189,7 @@ implementation
               if not(r in unused) then
                 begin
                    gettempofsizereference(8,hr);
-                   list^.concat(new(pai386,op_reg_ref(
+                   exprasmlist^.concat(new(pai386,op_reg_ref(
                      A_MOVQ,S_NO,r,newreference(hr))));
                    if not(is_reg_var[r]) then
                      unused:=unused+[r];
@@ -203,7 +199,7 @@ implementation
 {$endif SUPPORT_MMX}
       end;
 
-    procedure popusedregisters(list : paasmoutput;const pushed : tpushed);
+    procedure popusedregisters(const pushed : tpushed);
 
       var
          r : tregister;
@@ -220,9 +216,9 @@ implementation
                    new(hr);
                    reset_reference(hr^);
                    hr^.base:=R_ESP;
-                   list^.concat(new(pai386,op_ref_reg(
+                   exprasmlist^.concat(new(pai386,op_ref_reg(
                      A_MOVQ,S_NO,hr,r)));
-                   list^.concat(new(pai386,op_const_reg(
+                   exprasmlist^.concat(new(pai386,op_const_reg(
                      A_ADD,S_L,8,R_ESP)));
                    unused:=unused-[r];
                 end;
@@ -231,12 +227,12 @@ implementation
          for r:=R_EBX downto R_EAX do
            if pushed[r] then
              begin
-                list^.concat(new(pai386,op_reg(A_POP,S_L,r)));
+                exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,r)));
                 unused:=unused-[r];
              end;
       end;
 
-    procedure restoreusedregisters(list : paasmoutput;const saved : tsaved);
+    procedure restoreusedregisters(const saved : tsaved);
       var
          r : tregister;
          hr : treference;
@@ -251,7 +247,7 @@ implementation
                    reset_reference(hr);
                    hr.base:=frame_pointer;
                    hr.offset:=saved[r];
-                   list^.concat(new(pai386,op_ref_reg(
+                   exprasmlist^.concat(new(pai386,op_ref_reg(
                      A_MOVQ,S_NO,newreference(hr),r)));
                    unused:=unused-[r];
                    ungetiftemp(hr);
@@ -264,7 +260,7 @@ implementation
                 reset_reference(hr);
                 hr.base:=frame_pointer;
                 hr.offset:=saved[r];
-                list^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(hr),r)));
+                exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(hr),r)));
                 unused:=unused-[r];
                 ungetiftemp(hr);
              end;
@@ -463,7 +459,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  1999-05-19 22:00:48  florian
+  Revision 1.26  1999-05-27 19:45:27  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.25  1999/05/19 22:00:48  florian
     * some new routines for register management:
        maybe_savetotemp,restorefromtemp, saveusedregisters,
        restoreusedregisters

compiler/tree.pas

@@ -30,10 +30,8 @@ unit tree;
 
     uses
        globtype,cobjects,symtable,aasm
-{$ifndef OLDASM}
+{$ifdef i386}
        ,i386base
-{$else}
-       ,i386
 {$endif}
 {$ifdef m68k}
        ,m68k
@@ -48,30 +46,30 @@ unit tree;
        tconstset = array[0..31] of byte;
 
        ttreetyp = (
-          addn,            {Represents the + operator.}
-          muln,            {Represents the * operator.}
-          subn,            {Represents the - operator.}
-          divn,            {Represents the div operator.}
-          symdifn,         {Represents the >< operator.}
-          modn,            {Represents the mod operator.}
-          assignn,         {Represents an assignment.}
+          addn,     {Represents the + operator.}
+          muln,     {Represents the * operator.}
+          subn,     {Represents the - operator.}
+          divn,     {Represents the div operator.}
+          symdifn,       {Represents the >< operator.}
+          modn,     {Represents the mod operator.}
+          assignn,       {Represents an assignment.}
           loadn,           {Represents the use of a variabele.}
-          rangen,          {Represents a range (i.e. 0..9).}
-          ltn,             {Represents the < operator.}
-          lten,            {Represents the <= operator.}
-          gtn,             {Represents the > operator.}
-          gten,            {Represents the >= operator.}
-          equaln,          {Represents the = operator.}
-          unequaln,        {Represents the <> operator.}
-          inn,             {Represents the in operator.}
-          orn,             {Represents the or operator.}
-          xorn,            {Represents the xor operator.}
-          shrn,            {Represents the shr operator.}
-          shln,            {Represents the shl operator.}
-          slashn,          {Represents the / operator.}
-          andn,            {Represents the and operator.}
+          rangen,         {Represents a range (i.e. 0..9).}
+          ltn,       {Represents the < operator.}
+          lten,     {Represents the <= operator.}
+          gtn,       {Represents the > operator.}
+          gten,     {Represents the >= operator.}
+          equaln,         {Represents the = operator.}
+          unequaln,     {Represents the <> operator.}
+          inn,       {Represents the in operator.}
+          orn,       {Represents the or operator.}
+          xorn,     {Represents the xor operator.}
+          shrn,     {Represents the shr operator.}
+          shln,     {Represents the shl operator.}
+          slashn,         {Represents the / operator.}
+          andn,     {Represents the and operator.}
           subscriptn,      {??? Field in a record/object?}
-          derefn,          {Dereferences a pointer.}
+          derefn,         {Dereferences a pointer.}
           addrn,           {Represents the @ operator.}
           doubleaddrn,     {Represents the @@ operator.}
           ordconstn,       {Represents an ordinal value.}
@@ -80,47 +78,47 @@ unit tree;
           callparan,       {Represents a parameter.}
           realconstn,      {Represents a real value.}
           fixconstn,       {Represents a fixed value.}
-          umminusn,        {Represents a sign change (i.e. -2).}
-          asmn,            {Represents an assembler node }
-          vecn,            {Represents array indexing.}
+          umminusn,     {Represents a sign change (i.e. -2).}
+          asmn,     {Represents an assembler node }
+          vecn,     {Represents array indexing.}
           stringconstn,    {Represents a string constant.}
-          funcretn,        {Represents the function result var.}
+          funcretn,     {Represents the function result var.}
           selfn,           {Represents the self parameter.}
-          notn,            {Represents the not operator.}
-          inlinen,         {Internal procedures (i.e. writeln).}
-          niln,            {Represents the nil pointer.}
-          errorn,          {This part of the tree could not be
+          notn,     {Represents the not operator.}
+          inlinen,       {Internal procedures (i.e. writeln).}
+          niln,     {Represents the nil pointer.}
+          errorn,         {This part of the tree could not be
                             parsed because of a compiler error.}
           typen,           {A type name. Used for i.e. typeof(obj).}
           hnewn,           {The new operation, constructor call.}
           hdisposen,       {The dispose operation with destructor call.}
-          newn,            {The new operation, constructor call.}
+          newn,     {The new operation, constructor call.}
           simpledisposen,  {The dispose operation.}
           setelementn,     {A set element(s) (i.e. [a,b] and also [a..b]).}
           setconstn,       {A set constant (i.e. [1,2]).}
-          blockn,          {A block of statements.}
+          blockn,         {A block of statements.}
           statementn,      {One statement in a block of nodes.}
           loopn,           { used in genloopnode, must be converted }
-          ifn,             {An if statement.}
-          breakn,          {A break statement.}
+          ifn,       {An if statement.}
+          breakn,         {A break statement.}
           continuen,       {A continue statement.}
-          repeatn,         {A repeat until block.}
-          whilen,          {A while do statement.}
-          forn,            {A for loop.}
+          repeatn,       {A repeat until block.}
+          whilen,         {A while do statement.}
+          forn,     {A for loop.}
           exitn,           {An exit statement.}
           withn,           {A with statement.}
           casen,           {A case statement.}
-          labeln,          {A label.}
+          labeln,         {A label.}
           goton,           {A goto statement.}
           simplenewn,      {The new operation.}
           tryexceptn,      {A try except block.}
-          raisen,          {A raise statement.}
+          raisen,         {A raise statement.}
           switchesn,       {??? Currently unused...}
           tryfinallyn,     {A try finally statement.}
-          onn,             { for an on statement in exception code }
-          isn,             {Represents the is operator.}
-          asn,             {Represents the as typecast.}
-          caretn,          {Represents the ^ operator.}
+          onn,       { for an on statement in exception code }
+          isn,       {Represents the is operator.}
+          asn,       {Represents the as typecast.}
+          caretn,         {Represents the ^ operator.}
           failn,           {Represents the fail statement.}
           starstarn,       {Represents the ** operator exponentiation }
           procinlinen,     {Procedures that can be inlined }
@@ -174,10 +172,10 @@ unit tree;
           _low,_high : longint;
 
           { only used by gentreejmp }
-          _at : plabel;
+          _at : pasmlabel;
 
           { label of instruction }
-          statement : plabel;
+          statement : pasmlabel;
 
           { is this the first of an case entry, needed to release statement
             label (PFV) }
@@ -225,28 +223,28 @@ unit tree;
                       no_check,unit_specific,
                       return_value_used,static_call : boolean);
              ordconstn : (value : longint);
-             realconstn : (value_real : bestreal;lab_real : plabel);
+             realconstn : (value_real : bestreal;lab_real : pasmlabel);
              fixconstn : (value_fix: longint);
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
              subscriptn : (vs : pvarsym);
              vecn : (memindex,memseg:boolean;callunique : boolean);
-             stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
+             stringconstn : (value_str : pchar;length : longint; lab_str : pasmlabel;stringtype : tstringtype);
              typeconvn : (convtyp : tconverttype;explizit : boolean);
              typen : (typenodetype : pdef);
              inlinen : (inlinenumber : byte;inlineconst:boolean);
              procinlinen : (inlinetree:ptree;inlineprocsym:pprocsym;retoffset,para_offset,para_size : longint);
-             setconstn : (value_set : pconstset;lab_set:plabel);
+             setconstn : (value_set : pconstset;lab_set:pasmlabel);
              loopn : (t1,t2 : ptree;backward : boolean);
              asmn : (p_asm : paasmoutput;object_preserved : boolean);
              casen : (nodes : pcaserecord;elseblock : ptree);
-             labeln,goton : (labelnr : plabel);
+             labeln,goton : (labelnr : pasmlabel);
              withn : (withsymtable : pwithsymtable;tablecount : longint;withreference:preference;islocal:boolean);
              onn : (exceptsymtable : psymtable;excepttype : pobjectdef);
              arrayconstructn : (cargs,cargswap: boolean);
            end;
 
     function gennode(t : ttreetyp;l,r : ptree) : ptree;
-    function genlabelnode(t : ttreetyp;nr : plabel) : ptree;
+    function genlabelnode(t : ttreetyp;nr : pasmlabel) : ptree;
     function genloadnode(v : pvarsym;st : psymtable) : ptree;
     function genloadcallnode(v: pprocsym;st: psymtable): ptree;
     function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
@@ -300,7 +298,7 @@ unit tree;
 {$endif extdebug}
 
     { sets the callunique flag, if the node is a vecn, }
-    { takes care of type casts etc.                    }
+    { takes care of type casts etc.                 }
     procedure set_unique(p : ptree);
 
     { gibt den ordinalen Werten der Node zurueck oder falls sie }
@@ -758,7 +756,7 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=ordconstn;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -781,7 +779,7 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=realconstn;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -804,7 +802,7 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=stringconstn;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -851,7 +849,7 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=stringconstn;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -886,7 +884,7 @@ unit tree;
          p^.treetype:=t;
          p^.left:=l;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -908,7 +906,7 @@ unit tree;
          p^.registers32:=4;
          p^.p_asm:=p_asm;
          p^.object_preserved:=false;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=8;
 {$ifdef SUPPORT_MMX}
@@ -926,7 +924,7 @@ unit tree;
       begin
          p:=getnode;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -950,7 +948,7 @@ unit tree;
       begin
          p:=getnode;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -973,7 +971,7 @@ unit tree;
       begin
          p:=getnode;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -999,7 +997,7 @@ unit tree;
       begin
          p:=getnode;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1025,7 +1023,7 @@ unit tree;
          p^.treetype:=typeconvn;
          p^.left:=node;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.convtyp:=tc_equal;
          p^.registersfpu:=0;
@@ -1048,7 +1046,7 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=typen;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1067,7 +1065,7 @@ unit tree;
       begin
          p:=getnode;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1095,7 +1093,7 @@ unit tree;
       begin
          p:=getnode;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1125,7 +1123,7 @@ unit tree;
          p^.left:=l;
          p^.registers32:=0;
          p^.vs:=varsym;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1145,7 +1143,7 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=t;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1155,7 +1153,7 @@ unit tree;
          genzeronode:=p;
       end;
 
-   function genlabelnode(t : ttreetyp;nr : plabel) : ptree;
+   function genlabelnode(t : ttreetyp;nr : pasmlabel) : ptree;
 
       var
          p : ptree;
@@ -1165,7 +1163,7 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=t;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1188,7 +1186,7 @@ unit tree;
          p^.disposetyp:=dt_nothing;
          p^.treetype:=selfn;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1211,7 +1209,7 @@ unit tree;
          p^.inlinenumber:=number;
          p^.inlineconst:=is_const;
          p^.registers32:=0;
-{         p^.registers16:=0;
+{        p^.registers16:=0;
          p^.registers8:=0; }
          p^.registersfpu:=0;
 {$ifdef SUPPORT_MMX}
@@ -1733,7 +1731,15 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.82  1999-05-18 14:15:59  peter
+  Revision 1.83  1999-05-27 19:45:29  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.82  1999/05/18 14:15:59  peter
     * containsself fixes
     * checktypes()
 

compiler/win_targ.pas

@@ -58,11 +58,7 @@ unit win_targ;
        ,gdb
 {$endif}
 {$ifdef i386}
-{$ifndef OLDASM}
        ,i386base,i386asm
-{$else}
-       ,i386
-{$endif}
 {$endif}
        ;
 
@@ -206,7 +202,7 @@ unit win_targ;
          hp1 : pimportlist;
          hp2 : pimported_item;
          lhead,lname,lcode,
-         lidata4,lidata5 : plabel;
+         lidata4,lidata5 : pasmlabel;
          r : preference;
       begin
          hp1:=pimportlist(current_module^.imports^.first);
@@ -223,14 +219,14 @@ unit win_targ;
               importssection^.concat(new(pai_section,init(sec_idata2)));
               importssection^.concat(new(pai_label,init(lhead)));
               { pointer to procedure names }
-              importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(lidata4))));
+              importssection^.concat(new(pai_const_symbol,init_rva(lidata4)));
               { two empty entries follow }
               importssection^.concat(new(pai_const,init_32bit(0)));
               importssection^.concat(new(pai_const,init_32bit(0)));
               { pointer to dll name }
-              importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(lname))));
+              importssection^.concat(new(pai_const_symbol,init_rva(lname)));
               { pointer to fixups }
-              importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(lidata5))));
+              importssection^.concat(new(pai_const_symbol,init_rva(lidata5)));
               { first write the name references }
               importssection^.concat(new(pai_section,init(sec_idata4)));
               importssection^.concat(new(pai_const,init_32bit(0)));
@@ -265,7 +261,7 @@ unit win_targ;
                      getlabel(lcode);
                      new(r);
                      reset_reference(r^);
-                     r^.symbol:=newasmsymbol(lab2str(lcode));
+                     r^.symbol:=lcode;
                      { place jump in codesegment, insert a code section in the
                        importsection to reduce the amount of .s files (PFV) }
                      importssection^.concat(new(pai_section,init(sec_code)));
@@ -279,11 +275,11 @@ unit win_targ;
                    end;
                   { create head link }
                   importssection^.concat(new(pai_section,init(sec_idata7)));
-                  importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(lhead))));
+                  importssection^.concat(new(pai_const_symbol,init_rva(lhead)));
                   { fixup }
-                  getlabel(plabel(hp2^.lab));
+                  getlabel(pasmlabel(hp2^.lab));
                   importssection^.concat(new(pai_section,init(sec_idata4)));
-                  importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(hp2^.lab))));
+                  importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)));
                   { add jump field to importsection }
                   importssection^.concat(new(pai_section,init(sec_idata5)));
                   if hp2^.is_var then
@@ -291,7 +287,7 @@ unit win_targ;
                   else
                    importssection^.concat(new(pai_label,init(lcode)));
                    if hp2^.name^<>'' then
-                     importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(hp2^.lab))))
+                     importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)))
                    else
                      importssection^.concat(new(pai_const,init_32bit($80000000 or hp2^.ordnr)));
                   { finally the import information }
@@ -311,7 +307,7 @@ unit win_targ;
       var
          hp1 : pimportlist;
          hp2 : pimported_item;
-         l1,l2,l3,l4 : plabel;
+         l1,l2,l3,l4 : pasmlabel;
          r : preference;
       begin
          if (cs_smartlink in aktmoduleswitches) then
@@ -340,14 +336,14 @@ unit win_targ;
               getlabel(l3);
               importssection^.concat(new(pai_section,init(sec_idata2)));
               { pointer to procedure names }
-              importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(l2))));
+              importssection^.concat(new(pai_const_symbol,init_rva(l2)));
               { two empty entries follow }
               importssection^.concat(new(pai_const,init_32bit(0)));
               importssection^.concat(new(pai_const,init_32bit(0)));
               { pointer to dll name }
-              importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(l1))));
+              importssection^.concat(new(pai_const_symbol,init_rva(l1)));
               { pointer to fixups }
-              importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(l3))));
+              importssection^.concat(new(pai_const_symbol,init_rva(l3)));
 
               { only create one section for each else it will
                 create a lot of idata* }
@@ -359,9 +355,9 @@ unit win_targ;
               hp2:=pimported_item(hp1^.imported_items^.first);
               while assigned(hp2) do
                 begin
-                   getlabel(plabel(hp2^.lab));
+                   getlabel(pasmlabel(hp2^.lab));
                    if hp2^.name^<>'' then
-                     importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(hp2^.lab))))
+                     importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)))
                    else
                      importssection^.concat(new(pai_const,init_32bit($80000000 or hp2^.ordnr)));
                    hp2:=pimported_item(hp2^.next);
@@ -381,7 +377,7 @@ unit win_targ;
                       { create indirect jump }
                       new(r);
                       reset_reference(r^);
-                      r^.symbol:=newasmsymbol(lab2str(l4));
+                      r^.symbol:=l4;
                       { place jump in codesegment }
                       codesegment^.concat(new(pai_align,init_op(4,$90)));
                       codesegment^.concat(new(pai_symbol,initname_global(hp2^.func^)));
@@ -393,7 +389,7 @@ unit win_targ;
                     begin
                       importssection^.concat(new(pai_symbol,initname_global(hp2^.func^)));
                     end;
-                   importssection^.concat(new(pai_const_symbol,initname_rva(lab2str(hp2^.lab))));
+                   importssection^.concat(new(pai_const_symbol,init_rva(hp2^.lab)));
                    hp2:=pimported_item(hp2^.next);
                 end;
               { finalize the addresses }
@@ -508,8 +504,8 @@ unit win_targ;
          ordinal_base,ordinal_max,ordinal_min : longint;
          current_index : longint;
          entries,named_entries : longint;
-         name_label,dll_name_label,export_address_table : plabel;
-         export_name_table_pointers,export_ordinal_table : plabel;
+         name_label,dll_name_label,export_address_table : pasmlabel;
+         export_name_table_pointers,export_ordinal_table : pasmlabel;
          hp,hp2 : pexported_item;
          tempexport : plinkedlist;
          address_table,name_table_pointers,
@@ -556,7 +552,7 @@ unit win_targ;
          { minor version }
          exportssection^.concat(new(pai_const,init_16bit(0)));
          { pointer to dll name }
-         exportssection^.concat(new(pai_const_symbol,initname_rva(lab2str(dll_name_label))));
+         exportssection^.concat(new(pai_const_symbol,init_rva(dll_name_label)));
          { ordinal base normally set to 1 }
          exportssection^.concat(new(pai_const,init_32bit(ordinal_base)));
          { number of entries }
@@ -564,11 +560,11 @@ unit win_targ;
          { number of named entries }
          exportssection^.concat(new(pai_const,init_32bit(named_entries)));
          { address of export address table }
-         exportssection^.concat(new(pai_const_symbol,initname_rva(lab2str(export_address_table))));
+         exportssection^.concat(new(pai_const_symbol,init_rva(export_address_table)));
          { address of name pointer pointers }
-         exportssection^.concat(new(pai_const_symbol,initname_rva(lab2str(export_name_table_pointers))));
+         exportssection^.concat(new(pai_const_symbol,init_rva(export_name_table_pointers)));
          { address of ordinal number pointers }
-         exportssection^.concat(new(pai_const_symbol,initname_rva(lab2str(export_ordinal_table))));
+         exportssection^.concat(new(pai_const_symbol,init_rva(export_ordinal_table)));
          { the name }
          exportssection^.concat(new(pai_label,init(dll_name_label)));
          if st='' then
@@ -595,7 +591,7 @@ unit win_targ;
               if (hp^.options and eo_name)<>0 then
                 begin
                    getlabel(name_label);
-                   name_table_pointers^.concat(new(pai_const_symbol,initname_rva(lab2str(name_label))));
+                   name_table_pointers^.concat(new(pai_const_symbol,init_rva(name_label)));
                    ordinal_table^.concat(new(pai_const,init_16bit(hp^.index-ordinal_base)));
                    name_table^.concat(new(pai_align,init_op(2,0)));
                    name_table^.concat(new(pai_label,init(name_label)));
@@ -718,7 +714,15 @@ unit win_targ;
 end.
 {
   $Log$
-  Revision 1.26  1999-05-21 13:55:24  peter
+  Revision 1.27  1999-05-27 19:45:30  peter
+    * removed oldasm
+    * plabel -> pasmlabel
+    * -a switches to source writing automaticly
+    * assembler readers OOPed
+    * asmsymbol automaticly external
+    * jumptables and other label fixes for asm readers
+
+  Revision 1.26  1999/05/21 13:55:24  peter
     * NEWLAB for label as symbol
 
   Revision 1.25  1999/05/17 13:02:13  pierre