* better error recovering in typed constants

  * some problems with arrays of const fixed, some problems
    due my previous
     - the location type of array constructor is now LOC_MEM
     - the pushing of high fixed
     - parameter copying fixed
     - zero temp. allocation removed
  * small problem in the assembler writers fixed:
    ref to nil wasn't written correctly

compiler/ag386int.pas

@@ -1,969 +1,986 @@
-{
-    $Id$
-    Copyright (c) 1996,97 by Florian Klaempfl
-
-    This unit implements an asmoutput class for Intel syntax with Intel i386+
-
-    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 ag386int;
-
-    interface
-
-    uses aasm,assemble;
-
-    type
-      pi386intasmlist=^ti386intasmlist;
-      ti386intasmlist = object(tasmlist)
-        procedure WriteTree(p:paasmoutput);virtual;
-        procedure WriteAsmList;virtual;
-      end;
-
-  implementation
-
-    uses
-      dos,strings,
-      globtype,globals,systems,cobjects,
-      files,verbose
-{$ifndef OLDASM}
-      ,i386base,i386asm
-{$else}
-      ,i386
-{$endif}
-{$ifdef GDB}
-      ,gdb
-{$endif GDB}
-      ;
-
-    const
-      line_length = 70;
-
-{$ifndef NEWLAB}
-      extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
-             ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
-              'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
-{$endif}
-
-    function single2str(d : single) : string;
-      var
-         hs : string;
-         p : byte;
-      begin
-         str(d,hs);
-      { nasm expects a lowercase e }
-         p:=pos('E',hs);
-         if p>0 then
-          hs[p]:='e';
-         p:=pos('+',hs);
-         if p>0 then
-          delete(hs,p,1);
-         single2str:=lower(hs);
-      end;
-
-    function double2str(d : double) : string;
-      var
-         hs : string;
-         p : byte;
-      begin
-         str(d,hs);
-      { nasm expects a lowercase e }
-         p:=pos('E',hs);
-         if p>0 then
-          hs[p]:='e';
-         p:=pos('+',hs);
-         if p>0 then
-          delete(hs,p,1);
-         double2str:=lower(hs);
-      end;
-
-    function extended2str(e : extended) : string;
-      var
-         hs : string;
-         p : byte;
-      begin
-         str(e,hs);
-      { nasm expects a lowercase e }
-         p:=pos('E',hs);
-         if p>0 then
-          hs[p]:='e';
-         p:=pos('+',hs);
-         if p>0 then
-          delete(hs,p,1);
-         extended2str:=lower(hs);
-      end;
-
-
-    function comp2str(d : bestreal) : string;
-      type
-        pdouble = ^double;
-      var
-        c  : comp;
-        dd : pdouble;
-      begin
-{$ifdef FPC}
-         c:=comp(d);
-{$else}
-         c:=d;
-{$endif}
-         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
-         comp2str:=double2str(dd^);
-      end;
-
-    function getreferencestring(const ref : treference) : string;
-    var
-      s     : string;
-      first : boolean;
-    begin
-      if ref.is_immediate then
-       begin
-         getreferencestring:=tostr(ref.offset);
-         exit;
-       end
-      else
-      with ref do
-        begin
-          first:=true;
-          if ref.segment<>R_NO then
-           s:=int_reg2str[segment]+':['
-          else
-           s:='[';
-         if assigned(symbol) then
-          begin
-            s:=s+symbol^.name;
-            first:=false;
-          end;
-         if (base<>R_NO) then
-          begin
-            if not(first) then
-             s:=s+'+'
-            else
-             first:=false;
-             s:=s+int_reg2str[base];
-          end;
-         if (index<>R_NO) then
-           begin
-             if not(first) then
-               s:=s+'+'
-             else
-               first:=false;
-             s:=s+int_reg2str[index];
-             if scalefactor<>0 then
-               s:=s+'*'+tostr(scalefactor);
-           end;
-         if offset<0 then
-           s:=s+tostr(offset)
-         else if (offset>0) then
-           s:=s+'+'+tostr(offset);
-         s:=s+']';
-        end;
-       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_reg2str[o.reg];
-        top_const :
-          getopstr:=tostr(o.val);
-        top_symbol :
-          begin
-            hs:='offset '+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:=hs;
-          end;
-        top_ref :
-          begin
-            hs:=getreferencestring(o.ref^);
-            if ((opcode <> A_LGS) and (opcode <> A_LSS) and
-                (opcode <> A_LFS) and (opcode <> A_LDS) and
-                (opcode <> 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;
-        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_reg2str[o.reg];
-        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;
-        top_ref :
-          getopstr_jmp:=getreferencestring(o.ref^);
-        else
-          internalerror(10001);
-      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
- ****************************************************************************}
-
-    var
-      LastSec : tsection;
-
-    const
-      ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
-        (#9'DD'#9,#9'DW'#9,#9'DB'#9);
-
-    Function PadTabs(const p:string;addch:char):string;
-    var
-      s : string;
-      i : longint;
-    begin
-      i:=length(p);
-      if addch<>#0 then
-       begin
-         inc(i);
-         s:=p+addch;
-       end
-      else
-       s:=p;
-      if i<8 then
-       PadTabs:=s+#9#9
-      else
-       PadTabs:=s+#9;
-    end;
-
-    procedure ti386intasmlist.WriteTree(p:paasmoutput);
-    type
-      twowords=record
-        word1,word2:word;
-      end;
-    var
-      s,
-      prefix,
-      suffix   : string;
-      hp       : pai;
-      counter,
-      lines,
-      i,j,l    : longint;
-      consttyp : tait;
-      found,
-      quoted   : boolean;
-{$ifndef OLDASM}
-      sep      : char;
-{$endif}
-    begin
-      if not assigned(p) then
-       exit;
-      hp:=pai(p^.first);
-      while assigned(hp) do
-       begin
-         case hp^.typ of
-       ait_comment : Begin
-                       AsmWrite(target_asm.comment);
-                       AsmWritePChar(pai_asm_comment(hp)^.str);
-                       AsmLn;
-                     End;
-       ait_regalloc,
-       ait_tempalloc : ;
-       ait_section : begin
-                       if LastSec<>sec_none then
-                        AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
-                       if pai_section(hp)^.sec<>sec_none then
-                        begin
-                          AsmLn;
-                          AsmWriteLn('_'+target_asm.secnames[pai_section(hp)^.sec]+#9#9+
-                                     'SEGMENT'#9'PARA PUBLIC USE32 '''+
-                                     target_asm.secnames[pai_section(hp)^.sec]+'''');
-                        end;
-                       LastSec:=pai_section(hp)^.sec;
-                     end;
-         ait_align : begin
-                     { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION   }
-                     { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
-                     { 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);
-                       AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
-                     end;
-   ait_const_32bit,
-    ait_const_8bit,
-   ait_const_16bit : begin
-                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
-                       consttyp:=hp^.typ;
-                       l:=0;
-                       repeat
-                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
-                         if found then
-                          begin
-                            hp:=Pai(hp^.next);
-                            s:=','+tostr(pai_const(hp)^.value);
-                            AsmWrite(s);
-                            inc(l,length(s));
-                          end;
-                       until (not found) or (l>line_length);
-                       AsmLn;
-                     end;
-  ait_const_symbol : begin
-                       AsmWriteLn(#9#9'DD'#9'offset '+pai_const_symbol(hp)^.sym^.name);
-                       if pai_const_symbol(hp)^.offset>0 then
-                         AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
-                       else if pai_const_symbol(hp)^.offset<0 then
-                         AsmWrite(tostr(pai_const_symbol(hp)^.offset));
-                       AsmLn;
-                     end;
-     ait_const_rva : begin
-                       AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
-                     end;
-        ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
-        ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
-      ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
-          ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
-        ait_string : begin
-                       counter := 0;
-                       lines := pai_string(hp)^.len div line_length;
-                     { separate lines in different parts }
-                       if pai_string(hp)^.len > 0 then
-                        Begin
-                          for j := 0 to lines-1 do
-                           begin
-                             AsmWrite(#9#9'DB'#9);
-                             quoted:=false;
-                             for i:=counter to counter+line_length do
-                                begin
-                                  { it is an ascii character. }
-                                  if (ord(pai_string(hp)^.str[i])>31) and
-                                     (ord(pai_string(hp)^.str[i])<128) and
-                                     (pai_string(hp)^.str[i]<>'"') then
-                                      begin
-                                        if not(quoted) then
-                                            begin
-                                              if i>counter then
-                                                AsmWrite(',');
-                                              AsmWrite('"');
-                                            end;
-                                        AsmWrite(pai_string(hp)^.str[i]);
-                                        quoted:=true;
-                                      end { if > 31 and < 128 and ord('"') }
-                                  else
-                                      begin
-                                          if quoted then
-                                              AsmWrite('"');
-                                          if i>counter then
-                                              AsmWrite(',');
-                                          quoted:=false;
-                                          AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
-                                      end;
-                               end; { end for i:=0 to... }
-                             if quoted then AsmWrite('"');
-                               AsmWrite(target_os.newline);
-                             counter := counter+line_length;
-                          end; { end for j:=0 ... }
-                        { do last line of lines }
-                        AsmWrite(#9#9'DB'#9);
-                        quoted:=false;
-                        for i:=counter to pai_string(hp)^.len-1 do
-                          begin
-                            { it is an ascii character. }
-                            if (ord(pai_string(hp)^.str[i])>31) and
-                               (ord(pai_string(hp)^.str[i])<128) and
-                               (pai_string(hp)^.str[i]<>'"') then
-                                begin
-                                  if not(quoted) then
-                                      begin
-                                        if i>counter then
-                                          AsmWrite(',');
-                                        AsmWrite('"');
-                                      end;
-                                  AsmWrite(pai_string(hp)^.str[i]);
-                                  quoted:=true;
-                                end { if > 31 and < 128 and " }
-                            else
-                                begin
-                                  if quoted then
-                                    AsmWrite('"');
-                                  if i>counter then
-                                      AsmWrite(',');
-                                  quoted:=false;
-                                  AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
-                                end;
-                          end; { end for i:=0 to... }
-                        if quoted then
-                          AsmWrite('"');
-                        end;
-                       AsmLn;
-                     end;
-{$ifndef NEWLAB}
-         ait_label : begin
-                       if pai_label(hp)^.l^.is_used then
-                        begin
-                          AsmWrite(lab2str(pai_label(hp)^.l));
-                          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,
-                              ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
-                           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);
-                       AsmWrite(pai_symbol(hp)^.sym^.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,
-                           ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
-                        AsmWriteLn(':')
-                     end;
-   ait_instruction : begin
-                       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
-                           (pai386(hp)^.opcode = A_LOCK) or
-                           (pai386(hp)^.opcode =  A_REPE) or
-                           (pai386(hp)^.opcode =  A_REPNZ) or
-                           (pai386(hp)^.opcode =  A_REPZ) 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:= '';
-                       if pai386(hp)^.ops<>0 then
-                        begin
-                          if pai386(hp)^.opcode=A_CALL then
-                           s:=#9+getopstr_jmp(pai386(hp)^.oper[0])
-                          else
-                           begin
-                             for i:=0to pai386(hp)^.ops-1 do
-                              begin
-                                if i=0 then
-                                 sep:=#9
-                                else
-                                 sep:=',';
-                                s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
-                              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,
-             ait_stabs,
-        ait_force_line,
-ait_stab_function_name : ;
-{$endif GDB}
-           ait_cut : begin
-                     { only reset buffer if nothing has changed }
-                       if AsmSize=AsmStartSize then
-                        AsmClear
-                       else
-                        begin
-                          if LastSec<>sec_none then
-                           AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
-                          AsmLn;
-                          AsmWriteLn(#9'END');
-                          AsmClose;
-                          DoAssemble;
-                          if pai_cut(hp)^.EndName then
-                           IsEndFile:=true;
-                          AsmCreate;
-                        end;
-                     { avoid empty files }
-                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
-                        begin
-                          if pai(hp^.next)^.typ=ait_section then
-                           begin
-                             lastsec:=pai_section(hp^.next)^.sec;
-                           end;
-                          hp:=pai(hp^.next);
-                        end;
-                       AsmWriteLn(#9'.386p');
-                       AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
-                       if lastsec<>sec_none then
-                          AsmWriteLn('_'+target_asm.secnames[lastsec]+#9#9+
-                                     'SEGMENT'#9'PARA PUBLIC USE32 '''+
-                                     target_asm.secnames[lastsec]+'''');
-                       AsmStartSize:=AsmSize;
-                     end;
-             ait_marker: ;
-         else
-          internalerror(10000);
-         end;
-         hp:=pai(hp^.next);
-       end;
-    end;
-
-
-    procedure ti386intasmlist.WriteAsmList;
-
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Start writing intel-styled assembler output for '+current_module^.mainsource^);
-{$endif}
-      LastSec:=sec_none;
-      AsmWriteLn(#9'.386p');
-      AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
-      AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
-      AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
-      AsmLn;
-
-      countlabelref:=false;
-      WriteTree(externals);
-    { INTEL ASM doesn't support stabs
-      WriteTree(debuglist);}
-
-      WriteTree(codesegment);
-      WriteTree(datasegment);
-      WriteTree(consts);
-      WriteTree(rttilist);
-      WriteTree(bsssegment);
-      countlabelref:=true;
-
-      AsmWriteLn(#9'END');
-      AsmLn;
-
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing intel-styled assembler output for '+current_module^.mainsource^);
-{$endif EXTDEBUG}
-   end;
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1996,97 by Florian Klaempfl
+
+    This unit implements an asmoutput class for Intel syntax with Intel i386+
+
+    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 ag386int;
+
+    interface
+
+    uses aasm,assemble;
+
+    type
+      pi386intasmlist=^ti386intasmlist;
+      ti386intasmlist = object(tasmlist)
+        procedure WriteTree(p:paasmoutput);virtual;
+        procedure WriteAsmList;virtual;
+      end;
+
+  implementation
+
+    uses
+      dos,strings,
+      globtype,globals,systems,cobjects,
+      files,verbose
+{$ifndef OLDASM}
+      ,i386base,i386asm
+{$else}
+      ,i386
+{$endif}
+{$ifdef GDB}
+      ,gdb
+{$endif GDB}
+      ;
+
+    const
+      line_length = 70;
+
+{$ifndef NEWLAB}
+      extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
+             ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
+              'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
+{$endif}
+
+    function single2str(d : single) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(d,hs);
+      { nasm expects a lowercase e }
+         p:=pos('E',hs);
+         if p>0 then
+          hs[p]:='e';
+         p:=pos('+',hs);
+         if p>0 then
+          delete(hs,p,1);
+         single2str:=lower(hs);
+      end;
+
+    function double2str(d : double) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(d,hs);
+      { nasm expects a lowercase e }
+         p:=pos('E',hs);
+         if p>0 then
+          hs[p]:='e';
+         p:=pos('+',hs);
+         if p>0 then
+          delete(hs,p,1);
+         double2str:=lower(hs);
+      end;
+
+    function extended2str(e : extended) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(e,hs);
+      { nasm expects a lowercase e }
+         p:=pos('E',hs);
+         if p>0 then
+          hs[p]:='e';
+         p:=pos('+',hs);
+         if p>0 then
+          delete(hs,p,1);
+         extended2str:=lower(hs);
+      end;
+
+
+    function comp2str(d : bestreal) : string;
+      type
+        pdouble = ^double;
+      var
+        c  : comp;
+        dd : pdouble;
+      begin
+{$ifdef FPC}
+         c:=comp(d);
+{$else}
+         c:=d;
+{$endif}
+         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
+         comp2str:=double2str(dd^);
+      end;
+
+    function getreferencestring(const ref : treference) : string;
+    var
+      s     : string;
+      first : boolean;
+    begin
+      if ref.is_immediate then
+       begin
+         getreferencestring:=tostr(ref.offset);
+         exit;
+       end
+      else
+      with ref do
+        begin
+          first:=true;
+          if ref.segment<>R_NO then
+           s:=int_reg2str[segment]+':['
+          else
+           s:='[';
+         if assigned(symbol) then
+          begin
+            s:=s+symbol^.name;
+            first:=false;
+          end;
+         if (base<>R_NO) then
+          begin
+            if not(first) then
+             s:=s+'+'
+            else
+             first:=false;
+             s:=s+int_reg2str[base];
+          end;
+         if (index<>R_NO) then
+           begin
+             if not(first) then
+               s:=s+'+'
+             else
+               first:=false;
+             s:=s+int_reg2str[index];
+             if scalefactor<>0 then
+               s:=s+'*'+tostr(scalefactor);
+           end;
+         if offset<0 then
+           s:=s+tostr(offset)
+         else if (offset>0) then
+           s:=s+'+'+tostr(offset);
+         s:=s+']';
+        end;
+       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_reg2str[o.reg];
+        top_const :
+          getopstr:=tostr(o.val);
+        top_symbol :
+          begin
+            if assigned(o.sym) then
+              hs:='offset '+o.sym^.name
+            else
+              hs:='offset ';
+            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 ((opcode <> A_LGS) and (opcode <> A_LSS) and
+                (opcode <> A_LFS) and (opcode <> A_LDS) and
+                (opcode <> 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;
+        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_reg2str[o.reg];
+        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;
+        top_ref :
+          getopstr_jmp:=getreferencestring(o.ref^);
+        else
+          internalerror(10001);
+      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
+ ****************************************************************************}
+
+    var
+      LastSec : tsection;
+
+    const
+      ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
+        (#9'DD'#9,#9'DW'#9,#9'DB'#9);
+
+    Function PadTabs(const p:string;addch:char):string;
+    var
+      s : string;
+      i : longint;
+    begin
+      i:=length(p);
+      if addch<>#0 then
+       begin
+         inc(i);
+         s:=p+addch;
+       end
+      else
+       s:=p;
+      if i<8 then
+       PadTabs:=s+#9#9
+      else
+       PadTabs:=s+#9;
+    end;
+
+    procedure ti386intasmlist.WriteTree(p:paasmoutput);
+    type
+      twowords=record
+        word1,word2:word;
+      end;
+    var
+      s,
+      prefix,
+      suffix   : string;
+      hp       : pai;
+      counter,
+      lines,
+      i,j,l    : longint;
+      consttyp : tait;
+      found,
+      quoted   : boolean;
+{$ifndef OLDASM}
+      sep      : char;
+{$endif}
+    begin
+      if not assigned(p) then
+       exit;
+      hp:=pai(p^.first);
+      while assigned(hp) do
+       begin
+         case hp^.typ of
+       ait_comment : Begin
+                       AsmWrite(target_asm.comment);
+                       AsmWritePChar(pai_asm_comment(hp)^.str);
+                       AsmLn;
+                     End;
+       ait_regalloc,
+       ait_tempalloc : ;
+       ait_section : begin
+                       if LastSec<>sec_none then
+                        AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
+                       if pai_section(hp)^.sec<>sec_none then
+                        begin
+                          AsmLn;
+                          AsmWriteLn('_'+target_asm.secnames[pai_section(hp)^.sec]+#9#9+
+                                     'SEGMENT'#9'PARA PUBLIC USE32 '''+
+                                     target_asm.secnames[pai_section(hp)^.sec]+'''');
+                        end;
+                       LastSec:=pai_section(hp)^.sec;
+                     end;
+         ait_align : begin
+                     { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION   }
+                     { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
+                     { 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);
+                       AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
+                     end;
+   ait_const_32bit,
+    ait_const_8bit,
+   ait_const_16bit : begin
+                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
+                       consttyp:=hp^.typ;
+                       l:=0;
+                       repeat
+                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
+                         if found then
+                          begin
+                            hp:=Pai(hp^.next);
+                            s:=','+tostr(pai_const(hp)^.value);
+                            AsmWrite(s);
+                            inc(l,length(s));
+                          end;
+                       until (not found) or (l>line_length);
+                       AsmLn;
+                     end;
+  ait_const_symbol : begin
+                       AsmWriteLn(#9#9'DD'#9'offset '+pai_const_symbol(hp)^.sym^.name);
+                       if pai_const_symbol(hp)^.offset>0 then
+                         AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
+                       else if pai_const_symbol(hp)^.offset<0 then
+                         AsmWrite(tostr(pai_const_symbol(hp)^.offset));
+                       AsmLn;
+                     end;
+     ait_const_rva : begin
+                       AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
+                     end;
+        ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
+        ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
+      ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
+          ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
+        ait_string : begin
+                       counter := 0;
+                       lines := pai_string(hp)^.len div line_length;
+                     { separate lines in different parts }
+                       if pai_string(hp)^.len > 0 then
+                        Begin
+                          for j := 0 to lines-1 do
+                           begin
+                             AsmWrite(#9#9'DB'#9);
+                             quoted:=false;
+                             for i:=counter to counter+line_length do
+                                begin
+                                  { it is an ascii character. }
+                                  if (ord(pai_string(hp)^.str[i])>31) and
+                                     (ord(pai_string(hp)^.str[i])<128) and
+                                     (pai_string(hp)^.str[i]<>'"') then
+                                      begin
+                                        if not(quoted) then
+                                            begin
+                                              if i>counter then
+                                                AsmWrite(',');
+                                              AsmWrite('"');
+                                            end;
+                                        AsmWrite(pai_string(hp)^.str[i]);
+                                        quoted:=true;
+                                      end { if > 31 and < 128 and ord('"') }
+                                  else
+                                      begin
+                                          if quoted then
+                                              AsmWrite('"');
+                                          if i>counter then
+                                              AsmWrite(',');
+                                          quoted:=false;
+                                          AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                      end;
+                               end; { end for i:=0 to... }
+                             if quoted then AsmWrite('"');
+                               AsmWrite(target_os.newline);
+                             counter := counter+line_length;
+                          end; { end for j:=0 ... }
+                        { do last line of lines }
+                        AsmWrite(#9#9'DB'#9);
+                        quoted:=false;
+                        for i:=counter to pai_string(hp)^.len-1 do
+                          begin
+                            { it is an ascii character. }
+                            if (ord(pai_string(hp)^.str[i])>31) and
+                               (ord(pai_string(hp)^.str[i])<128) and
+                               (pai_string(hp)^.str[i]<>'"') then
+                                begin
+                                  if not(quoted) then
+                                      begin
+                                        if i>counter then
+                                          AsmWrite(',');
+                                        AsmWrite('"');
+                                      end;
+                                  AsmWrite(pai_string(hp)^.str[i]);
+                                  quoted:=true;
+                                end { if > 31 and < 128 and " }
+                            else
+                                begin
+                                  if quoted then
+                                    AsmWrite('"');
+                                  if i>counter then
+                                      AsmWrite(',');
+                                  quoted:=false;
+                                  AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                end;
+                          end; { end for i:=0 to... }
+                        if quoted then
+                          AsmWrite('"');
+                        end;
+                       AsmLn;
+                     end;
+{$ifndef NEWLAB}
+         ait_label : begin
+                       if pai_label(hp)^.l^.is_used then
+                        begin
+                          AsmWrite(lab2str(pai_label(hp)^.l));
+                          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,
+                              ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
+                           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);
+                       AsmWrite(pai_symbol(hp)^.sym^.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,
+                           ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
+                        AsmWriteLn(':')
+                     end;
+   ait_instruction : begin
+                       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
+                           (pai386(hp)^.opcode = A_LOCK) or
+                           (pai386(hp)^.opcode =  A_REPE) or
+                           (pai386(hp)^.opcode =  A_REPNZ) or
+                           (pai386(hp)^.opcode =  A_REPZ) 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:= '';
+                       if pai386(hp)^.ops<>0 then
+                        begin
+                          if pai386(hp)^.opcode=A_CALL then
+                           s:=#9+getopstr_jmp(pai386(hp)^.oper[0])
+                          else
+                           begin
+                             for i:=0to pai386(hp)^.ops-1 do
+                              begin
+                                if i=0 then
+                                 sep:=#9
+                                else
+                                 sep:=',';
+                                s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
+                              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,
+             ait_stabs,
+        ait_force_line,
+ait_stab_function_name : ;
+{$endif GDB}
+           ait_cut : begin
+                     { only reset buffer if nothing has changed }
+                       if AsmSize=AsmStartSize then
+                        AsmClear
+                       else
+                        begin
+                          if LastSec<>sec_none then
+                           AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
+                          AsmLn;
+                          AsmWriteLn(#9'END');
+                          AsmClose;
+                          DoAssemble;
+                          if pai_cut(hp)^.EndName then
+                           IsEndFile:=true;
+                          AsmCreate;
+                        end;
+                     { avoid empty files }
+                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
+                        begin
+                          if pai(hp^.next)^.typ=ait_section then
+                           begin
+                             lastsec:=pai_section(hp^.next)^.sec;
+                           end;
+                          hp:=pai(hp^.next);
+                        end;
+                       AsmWriteLn(#9'.386p');
+                       AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
+                       if lastsec<>sec_none then
+                          AsmWriteLn('_'+target_asm.secnames[lastsec]+#9#9+
+                                     'SEGMENT'#9'PARA PUBLIC USE32 '''+
+                                     target_asm.secnames[lastsec]+'''');
+                       AsmStartSize:=AsmSize;
+                     end;
+             ait_marker: ;
+         else
+          internalerror(10000);
+         end;
+         hp:=pai(hp^.next);
+       end;
+    end;
+
+
+    procedure ti386intasmlist.WriteAsmList;
+
+    begin
+{$ifdef EXTDEBUG}
+      if assigned(current_module^.mainsource) then
+       comment(v_info,'Start writing intel-styled assembler output for '+current_module^.mainsource^);
+{$endif}
+      LastSec:=sec_none;
+      AsmWriteLn(#9'.386p');
+      AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
+      AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
+      AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
+      AsmLn;
+
+      countlabelref:=false;
+      WriteTree(externals);
+    { INTEL ASM doesn't support stabs
+      WriteTree(debuglist);}
+
+      WriteTree(codesegment);
+      WriteTree(datasegment);
+      WriteTree(consts);
+      WriteTree(rttilist);
+      WriteTree(bsssegment);
+      countlabelref:=true;
+
+      AsmWriteLn(#9'END');
+      AsmLn;
+
+{$ifdef EXTDEBUG}
+      if assigned(current_module^.mainsource) then
+       comment(v_info,'Done writing intel-styled assembler output for '+current_module^.mainsource^);
+{$endif EXTDEBUG}
+   end;
+
+end.
+{
   $Log$
-  Revision 1.42  1999-05-21 13:54:42  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.42  1999/05/21 13:54:42  peter
     * NEWLAB for label as symbol
-
-  Revision 1.41  1999/05/12 00:19:38  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.40  1999/05/10 15:18:14  peter
-    * fixed condition writing
-
-  Revision 1.39  1999/05/08 19:52:33  peter
-    + MessagePos() which is enhanced Message() function but also gets the
-      position info
-    * Removed comp warnings
-
-  Revision 1.38  1999/05/07 00:08:49  pierre
-   * AG386BIN cond -> OLDASM, only cosmetic
-
-  Revision 1.37  1999/05/06 09:05:09  peter
-    * generic write_float and str_float
-    * fixed constant float conversions
-
-  Revision 1.36  1999/05/04 21:44:31  florian
-    * changes to compile it with Delphi 4.0
-
-  Revision 1.35  1999/05/02 22:41:49  peter
-    * moved section names to systems
-    * fixed nasm,intel writer
-
-  Revision 1.34  1999/05/01 13:23:58  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.33  1999/04/17 22:17:05  pierre
-    * ifdef USE_OP3 released (changed into ifndef NO_OP3)
-    * SHRD and SHLD first operand (ATT syntax) can only be CL reg or immediate const
-
-  Revision 1.32  1999/04/16 11:49:39  peter
-    + tempalloc
-    + -at to show temp alloc info in .s file
-
-  Revision 1.31  1999/04/16 10:00:55  pierre
-    + ifdef USE_OP3 code :
-      added all missing op_... constructors for tai386 needed
-      for SHRD,SHLD and IMUL code in assembler readers
-      (check in tests/tbs0123.pp)
-
-  Revision 1.30  1999/03/29 16:05:43  peter
-    * optimizer working for ag386bin
-
-  Revision 1.29  1999/03/02 02:56:10  peter
-    + stabs support for binary writers
-    * more fixes and missing updates from the previous commit :(
-
-  Revision 1.28  1999/03/01 15:46:16  peter
-    * ag386bin finally make cycles correct
-    * prefixes are now also normal opcodes
-
-  Revision 1.27  1999/02/26 00:48:13  peter
-    * assembler writers fixed for ag386bin
-
-  Revision 1.26  1999/02/25 21:02:18  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.25  1999/02/22 02:14:59  peter
-    * updates for ag386bin
-
-  Revision 1.24  1998/12/20 16:21:22  peter
-    * smartlinking doesn't crash anymore
-
-  Revision 1.23  1998/12/16 00:27:17  peter
-    * removed some obsolete version checks
-
-  Revision 1.22  1998/12/01 11:19:38  peter
-    * fixed range problem with in [tasmop]
-
-  Revision 1.21  1998/11/30 09:42:55  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.20  1998/11/17 00:26:09  peter
-    * fixed for $H+
-
-  Revision 1.19  1998/11/16 12:38:05  jonas
-    + readded ait_marker support
-
-  Revision 1.18  1998/11/12 11:19:33  pierre
-   * fix for first line of function break
-
-  Revision 1.17  1998/10/12 12:20:40  pierre
-    + added tai_const_symbol_offset
-      for r : pointer = @var.field;
-    * better message for different arg names on implementation
-      of function
-
-  Revision 1.16  1998/10/06 17:16:33  pierre
-    * some memory leaks fixed (thanks to Peter for heaptrc !)
-
-  Revision 1.15  1998/10/01 20:19:06  jonas
-    + ait_marker support
-
-  Revision 1.14  1998/09/20 17:11:21  jonas
-    * released REGALLOC
-
-  Revision 1.13  1998/08/10 15:49:38  peter
-    * small fixes for 0.99.5
-
-  Revision 1.12  1998/08/08 10:19:17  florian
-    * small fixes to write the extended type correct
-
-  Revision 1.11  1998/06/05 17:46:02  peter
-    * tp doesn't like comp() typecast
-
-  Revision 1.10  1998/05/25 17:11:36  pierre
-    * firstpasscount bug fixed
-      now all is already set correctly the first time
-      under EXTDEBUG try -gp to skip all other firstpasses
-      it works !!
-    * small bug fixes
-      - for smallsets with -dTESTSMALLSET
-      - some warnings removed (by correcting code !)
-
-  Revision 1.9  1998/05/23 01:20:55  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.8  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.7  1998/05/06 08:38:32  pierre
-    * better position info with UseTokenInfo
-      UseTokenInfo greatly simplified
-    + added check for changed tree after first time firstpass
-      (if we could remove all the cases were it happen
-      we could skip all firstpass if firstpasscount > 1)
-      Only with ExtDebug
-
-  Revision 1.6  1998/05/04 17:54:24  peter
-    + smartlinking works (only case jumptable left todo)
-    * redesign of systems.pas to support assemblers and linkers
-    + Unitname is now also in the PPU-file, increased version to 14
-
-  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:41  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/08 16:58:01  pierre
-    * several bugfixes
-      ADD ADC and AND are also sign extended
-      nasm output OK (program still crashes at end
-      and creates wrong assembler files !!)
-      procsym types sym in tdef removed !!
-
-  Revision 1.2  1998/04/08 11:34:17  peter
-    * nasm works (linux only tested)
-}
+
+  Revision 1.41  1999/05/12 00:19:38  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.40  1999/05/10 15:18:14  peter
+    * fixed condition writing
+
+  Revision 1.39  1999/05/08 19:52:33  peter
+    + MessagePos() which is enhanced Message() function but also gets the
+      position info
+    * Removed comp warnings
+
+  Revision 1.38  1999/05/07 00:08:49  pierre
+   * AG386BIN cond -> OLDASM, only cosmetic
+
+  Revision 1.37  1999/05/06 09:05:09  peter
+    * generic write_float and str_float
+    * fixed constant float conversions
+
+  Revision 1.36  1999/05/04 21:44:31  florian
+    * changes to compile it with Delphi 4.0
+
+  Revision 1.35  1999/05/02 22:41:49  peter
+    * moved section names to systems
+    * fixed nasm,intel writer
+
+  Revision 1.34  1999/05/01 13:23:58  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.33  1999/04/17 22:17:05  pierre
+    * ifdef USE_OP3 released (changed into ifndef NO_OP3)
+    * SHRD and SHLD first operand (ATT syntax) can only be CL reg or immediate const
+
+  Revision 1.32  1999/04/16 11:49:39  peter
+    + tempalloc
+    + -at to show temp alloc info in .s file
+
+  Revision 1.31  1999/04/16 10:00:55  pierre
+    + ifdef USE_OP3 code :
+      added all missing op_... constructors for tai386 needed
+      for SHRD,SHLD and IMUL code in assembler readers
+      (check in tests/tbs0123.pp)
+
+  Revision 1.30  1999/03/29 16:05:43  peter
+    * optimizer working for ag386bin
+
+  Revision 1.29  1999/03/02 02:56:10  peter
+    + stabs support for binary writers
+    * more fixes and missing updates from the previous commit :(
+
+  Revision 1.28  1999/03/01 15:46:16  peter
+    * ag386bin finally make cycles correct
+    * prefixes are now also normal opcodes
+
+  Revision 1.27  1999/02/26 00:48:13  peter
+    * assembler writers fixed for ag386bin
+
+  Revision 1.26  1999/02/25 21:02:18  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.25  1999/02/22 02:14:59  peter
+    * updates for ag386bin
+
+  Revision 1.24  1998/12/20 16:21:22  peter
+    * smartlinking doesn't crash anymore
+
+  Revision 1.23  1998/12/16 00:27:17  peter
+    * removed some obsolete version checks
+
+  Revision 1.22  1998/12/01 11:19:38  peter
+    * fixed range problem with in [tasmop]
+
+  Revision 1.21  1998/11/30 09:42:55  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.20  1998/11/17 00:26:09  peter
+    * fixed for $H+
+
+  Revision 1.19  1998/11/16 12:38:05  jonas
+    + readded ait_marker support
+
+  Revision 1.18  1998/11/12 11:19:33  pierre
+   * fix for first line of function break
+
+  Revision 1.17  1998/10/12 12:20:40  pierre
+    + added tai_const_symbol_offset
+      for r : pointer = @var.field;
+    * better message for different arg names on implementation
+      of function
+
+  Revision 1.16  1998/10/06 17:16:33  pierre
+    * some memory leaks fixed (thanks to Peter for heaptrc !)
+
+  Revision 1.15  1998/10/01 20:19:06  jonas
+    + ait_marker support
+
+  Revision 1.14  1998/09/20 17:11:21  jonas
+    * released REGALLOC
+
+  Revision 1.13  1998/08/10 15:49:38  peter
+    * small fixes for 0.99.5
+
+  Revision 1.12  1998/08/08 10:19:17  florian
+    * small fixes to write the extended type correct
+
+  Revision 1.11  1998/06/05 17:46:02  peter
+    * tp doesn't like comp() typecast
+
+  Revision 1.10  1998/05/25 17:11:36  pierre
+    * firstpasscount bug fixed
+      now all is already set correctly the first time
+      under EXTDEBUG try -gp to skip all other firstpasses
+      it works !!
+    * small bug fixes
+      - for smallsets with -dTESTSMALLSET
+      - some warnings removed (by correcting code !)
+
+  Revision 1.9  1998/05/23 01:20:55  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.8  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.7  1998/05/06 08:38:32  pierre
+    * better position info with UseTokenInfo
+      UseTokenInfo greatly simplified
+    + added check for changed tree after first time firstpass
+      (if we could remove all the cases were it happen
+      we could skip all firstpass if firstpasscount > 1)
+      Only with ExtDebug
+
+  Revision 1.6  1998/05/04 17:54:24  peter
+    + smartlinking works (only case jumptable left todo)
+    * redesign of systems.pas to support assemblers and linkers
+    + Unitname is now also in the PPU-file, increased version to 14
+
+  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:41  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/08 16:58:01  pierre
+    * several bugfixes
+      ADD ADC and AND are also sign extended
+      nasm output OK (program still crashes at end
+      and creates wrong assembler files !!)
+      procsym types sym in tdef removed !!
+
+  Revision 1.2  1998/04/08 11:34:17  peter
+    * nasm works (linux only tested)
+}

compiler/ag386nsm.pas

@@ -1,908 +1,925 @@
-{
-    $Id$
-    Copyright (c) 1996,97 by Florian Klaempfl
-
-    This unit implements an asmoutput class for the Nasm assembler with
-    Intel syntax for the i386+
-
-    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 ag386nsm;
-
-    interface
-
-    uses aasm,assemble;
-
-    type
-      pi386nasmasmlist=^ti386nasmasmlist;
-      ti386nasmasmlist = object(tasmlist)
-        procedure WriteTree(p:paasmoutput);virtual;
-        procedure WriteAsmList;virtual;
-      end;
-
-  implementation
-
-    uses
-      dos,strings,
-      globtype,globals,systems,cobjects,
-      files,verbose
-{$ifndef OLDASM}
-      ,i386base,i386asm
-{$else}
-      ,i386
-{$endif}
-{$ifdef GDB}
-      ,gdb
-{$endif GDB}
-      ;
-
-    const
-      line_length = 70;
-
-{$ifndef NEWLAB}
-      extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
-             ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
-              'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
-{$endif}
-
-    function single2str(d : single) : string;
-      var
-         hs : string;
-         p : byte;
-      begin
-         str(d,hs);
-      { nasm expects a lowercase e }
-         p:=pos('E',hs);
-         if p>0 then
-          hs[p]:='e';
-         p:=pos('+',hs);
-         if p>0 then
-          delete(hs,p,1);
-         single2str:=lower(hs);
-      end;
-
-    function double2str(d : double) : string;
-      var
-         hs : string;
-         p : byte;
-      begin
-         str(d,hs);
-      { nasm expects a lowercase e }
-         p:=pos('E',hs);
-         if p>0 then
-          hs[p]:='e';
-         p:=pos('+',hs);
-         if p>0 then
-          delete(hs,p,1);
-         double2str:=lower(hs);
-      end;
-
-    function extended2str(e : extended) : string;
-      var
-         hs : string;
-         p : byte;
-      begin
-         str(e,hs);
-      { nasm expects a lowercase e }
-         p:=pos('E',hs);
-         if p>0 then
-          hs[p]:='e';
-         p:=pos('+',hs);
-         if p>0 then
-          delete(hs,p,1);
-         extended2str:=lower(hs);
-      end;
-
-
-    function comp2str(d : bestreal) : string;
-      type
-        pdouble = ^double;
-      var
-        c  : comp;
-        dd : pdouble;
-      begin
-{$ifdef FPC}
-         c:=comp(d);
-{$else}
-         c:=d;
-{$endif}
-         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
-         comp2str:=double2str(dd^);
-      end;
-
-
-    function getreferencestring(const ref : treference) : string;
-    var
-      s     : string;
-      first : boolean;
-    begin
-      if ref.is_immediate then
-       begin
-         getreferencestring:=tostr(ref.offset);
-         exit;
-       end
-      else
-      with ref do
-        begin
-          first:=true;
-          if ref.segment<>R_NO then
-           s:='['+int_reg2str[segment]+':'
-          else
-           s:='[';
-         if assigned(symbol) then
-          begin
-            s:=s+symbol^.name;
-            first:=false;
-          end;
-         if (base<>R_NO) then
-          begin
-            if not(first) then
-             s:=s+'+'
-            else
-             first:=false;
-             s:=s+int_reg2str[base];
-          end;
-         if (index<>R_NO) then
-           begin
-             if not(first) then
-               s:=s+'+'
-             else
-               first:=false;
-             s:=s+int_reg2str[index];
-             if scalefactor<>0 then
-               s:=s+'*'+tostr(scalefactor);
-           end;
-         if offset<0 then
-           s:=s+tostr(offset)
-         else if (offset>0) then
-           s:=s+'+'+tostr(offset);
-         s:=s+']';
-        end;
-       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
-            hs:='dword '+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:=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);
-      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);
-      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}
-
-
-{****************************************************************************
-                               Ti386nasmasmlist
- ****************************************************************************}
-
-    var
-      LastSec : tsection;
-
-    const
-      ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
-        (#9'DD'#9,#9'DW'#9,#9'DB'#9);
-
-    Function PadTabs(const p:string;addch:char):string;
-    var
-      s : string;
-      i : longint;
-    begin
-      i:=length(p);
-      if addch<>#0 then
-       begin
-         inc(i);
-         s:=p+addch;
-       end
-      else
-       s:=p;
-      if i<8 then
-       PadTabs:=s+#9#9
-      else
-       PadTabs:=s+#9;
-    end;
-
-
-    procedure ti386nasmasmlist.WriteTree(p:paasmoutput);
-    type
-      twowords=record
-        word1,word2:word;
-      end;
-    var
-      s,
-      prefix,
-      suffix   : string;
-      hp       : pai;
-      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;
-      hp:=pai(p^.first);
-      while assigned(hp) do
-       begin
-         case hp^.typ of
-       ait_comment : Begin
-                       AsmWrite(target_asm.comment);
-                       AsmWritePChar(pai_asm_comment(hp)^.str);
-                       AsmLn;
-                     End;
-       ait_regalloc,
-       ait_tempalloc : ;
-       ait_section : begin
-                       if pai_section(hp)^.sec<>sec_none then
-                        begin
-                          AsmLn;
-                          AsmWriteLn('SECTION '+target_asm.secnames[pai_section(hp)^.sec]);
-                        end;
-                       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);
-                       AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
-                     end;
-   ait_const_32bit,
-    ait_const_8bit,
-   ait_const_16bit : begin
-                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
-                       consttyp:=hp^.typ;
-                       l:=0;
-                       repeat
-                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
-                         if found then
-                          begin
-                            hp:=Pai(hp^.next);
-                            s:=','+tostr(pai_const(hp)^.value);
-                            AsmWrite(s);
-                            inc(l,length(s));
-                          end;
-                       until (not found) or (l>line_length);
-                       AsmLn;
-                     end;
-  ait_const_symbol : begin
-                       AsmWriteLn(#9#9'DD'#9+pai_const_symbol(hp)^.sym^.name);
-                       if pai_const_symbol(hp)^.offset>0 then
-                         AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
-                       else if pai_const_symbol(hp)^.offset<0 then
-                         AsmWrite(tostr(pai_const_symbol(hp)^.offset));
-                       AsmLn;
-                     end;
-     ait_const_rva : begin
-                       AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
-                     end;
-    ait_real_32bit     : AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
-    ait_real_64bit     : AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
-    ait_real_80bit   : AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
-          ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
-        ait_string : begin
-                       counter := 0;
-                       lines := pai_string(hp)^.len div line_length;
-                     { separate lines in different parts }
-                       if pai_string(hp)^.len > 0 then
-                        Begin
-                          for j := 0 to lines-1 do
-                           begin
-                             AsmWrite(#9#9'DB'#9);
-                             quoted:=false;
-                             for i:=counter to counter+line_length do
-                                begin
-                                  { it is an ascii character. }
-                                  if (ord(pai_string(hp)^.str[i])>31) and
-                                     (ord(pai_string(hp)^.str[i])<128) and
-                                     (pai_string(hp)^.str[i]<>'"') then
-                                      begin
-                                        if not(quoted) then
-                                            begin
-                                              if i>counter then
-                                                AsmWrite(',');
-                                              AsmWrite('"');
-                                            end;
-                                        AsmWrite(pai_string(hp)^.str[i]);
-                                        quoted:=true;
-                                      end { if > 31 and < 128 and ord('"') }
-                                  else
-                                      begin
-                                          if quoted then
-                                              AsmWrite('"');
-                                          if i>counter then
-                                              AsmWrite(',');
-                                          quoted:=false;
-                                          AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
-                                      end;
-                               end; { end for i:=0 to... }
-                             if quoted then AsmWrite('"');
-                               AsmWrite(target_os.newline);
-                             counter := counter+line_length;
-                          end; { end for j:=0 ... }
-                        { do last line of lines }
-                        AsmWrite(#9#9'DB'#9);
-                        quoted:=false;
-                        for i:=counter to pai_string(hp)^.len-1 do
-                          begin
-                            { it is an ascii character. }
-                            if (ord(pai_string(hp)^.str[i])>31) and
-                               (ord(pai_string(hp)^.str[i])<128) and
-                               (pai_string(hp)^.str[i]<>'"') then
-                                begin
-                                  if not(quoted) then
-                                      begin
-                                        if i>counter then
-                                          AsmWrite(',');
-                                        AsmWrite('"');
-                                      end;
-                                  AsmWrite(pai_string(hp)^.str[i]);
-                                  quoted:=true;
-                                end { if > 31 and < 128 and " }
-                            else
-                                begin
-                                  if quoted then
-                                    AsmWrite('"');
-                                  if i>counter then
-                                      AsmWrite(',');
-                                  quoted:=false;
-                                  AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
-                                end;
-                          end; { end for i:=0 to... }
-                        if quoted then
-                          AsmWrite('"');
-                        end;
-                       AsmLn;
-                     end;
-{$ifndef NEWLAB}
-         ait_label : begin
-                       if pai_label(hp)^.l^.is_used then
-                        AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
-                     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);
-                       AsmWrite(pai_symbol(hp)^.sym^.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,
-                           ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
-                        AsmWriteLn(':')
-                     end;
-   ait_instruction : begin
-                       suffix:='';
-                       prefix:='';
-                       s:='';
-{$ifndef OLDASM}
-                       if pai386(hp)^.ops<>0 then
-                        begin
-                          if pai386(hp)^.opcode=A_CALL then
-                           s:=#9+getopstr_jmp(pai386(hp)^.oper[0])
-                          else
-                           begin
-                             for i:=0to pai386(hp)^.ops-1 do
-                              begin
-                                if i=0 then
-                                 sep:=#9
-                                else
-                                 sep:=',';
-                                s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
-                              end;
-                           end;
-                        end;
-                       if pai386(hp)^.opcode=A_FWAIT then
-                        AsmWriteln(#9#9'DB'#9'09bh')
-                       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,
-             ait_stabs,
-        ait_force_line,
-ait_stab_function_name : ;
-{$endif GDB}
-           ait_cut : begin
-                     { only reset buffer if nothing has changed }
-                       if AsmSize=AsmStartSize then
-                        AsmClear
-                       else
-                        begin
-                          AsmClose;
-                          DoAssemble;
-                          if pai_cut(hp)^.EndName then
-                           IsEndFile:=true;
-                          AsmCreate;
-                        end;
-                     { avoid empty files }
-                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
-                        begin
-                          if pai(hp^.next)^.typ=ait_section then
-                            lastsec:=pai_section(hp^.next)^.sec;
-                          hp:=pai(hp^.next);
-                        end;
-                       if lastsec<>sec_none then
-                         AsmWriteLn('SECTION '+target_asm.secnames[lastsec]);
-                       AsmStartSize:=AsmSize;
-                     end;
-        ait_marker : ;
-         else
-          internalerror(10000);
-         end;
-         hp:=pai(hp^.next);
-       end;
-    end;
-
-
-    procedure ti386nasmasmlist.WriteAsmList;
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Start writing nasm-styled assembler output for '+current_module^.mainsource^);
-{$endif}
-      LastSec:=sec_none;
-      AsmWriteLn('BITS 32');
-      AsmLn;
-
-      countlabelref:=false;
-      WriteTree(externals);
-    { Nasm doesn't support stabs
-      WriteTree(debuglist);}
-
-      WriteTree(codesegment);
-      WriteTree(datasegment);
-      WriteTree(consts);
-      WriteTree(rttilist);
-      WriteTree(bsssegment);
-      countlabelref:=true;
-
-      AsmLn;
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing nasm-styled assembler output for '+current_module^.mainsource^);
-{$endif EXTDEBUG}
-   end;
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1996,97 by Florian Klaempfl
+
+    This unit implements an asmoutput class for the Nasm assembler with
+    Intel syntax for the i386+
+
+    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 ag386nsm;
+
+    interface
+
+    uses aasm,assemble;
+
+    type
+      pi386nasmasmlist=^ti386nasmasmlist;
+      ti386nasmasmlist = object(tasmlist)
+        procedure WriteTree(p:paasmoutput);virtual;
+        procedure WriteAsmList;virtual;
+      end;
+
+  implementation
+
+    uses
+      dos,strings,
+      globtype,globals,systems,cobjects,
+      files,verbose
+{$ifndef OLDASM}
+      ,i386base,i386asm
+{$else}
+      ,i386
+{$endif}
+{$ifdef GDB}
+      ,gdb
+{$endif GDB}
+      ;
+
+    const
+      line_length = 70;
+
+{$ifndef NEWLAB}
+      extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
+             ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
+              'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
+{$endif}
+
+    function single2str(d : single) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(d,hs);
+      { nasm expects a lowercase e }
+         p:=pos('E',hs);
+         if p>0 then
+          hs[p]:='e';
+         p:=pos('+',hs);
+         if p>0 then
+          delete(hs,p,1);
+         single2str:=lower(hs);
+      end;
+
+    function double2str(d : double) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(d,hs);
+      { nasm expects a lowercase e }
+         p:=pos('E',hs);
+         if p>0 then
+          hs[p]:='e';
+         p:=pos('+',hs);
+         if p>0 then
+          delete(hs,p,1);
+         double2str:=lower(hs);
+      end;
+
+    function extended2str(e : extended) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(e,hs);
+      { nasm expects a lowercase e }
+         p:=pos('E',hs);
+         if p>0 then
+          hs[p]:='e';
+         p:=pos('+',hs);
+         if p>0 then
+          delete(hs,p,1);
+         extended2str:=lower(hs);
+      end;
+
+
+    function comp2str(d : bestreal) : string;
+      type
+        pdouble = ^double;
+      var
+        c  : comp;
+        dd : pdouble;
+      begin
+{$ifdef FPC}
+         c:=comp(d);
+{$else}
+         c:=d;
+{$endif}
+         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
+         comp2str:=double2str(dd^);
+      end;
+
+
+    function getreferencestring(const ref : treference) : string;
+    var
+      s     : string;
+      first : boolean;
+    begin
+      if ref.is_immediate then
+       begin
+         getreferencestring:=tostr(ref.offset);
+         exit;
+       end
+      else
+      with ref do
+        begin
+          first:=true;
+          if ref.segment<>R_NO then
+           s:='['+int_reg2str[segment]+':'
+          else
+           s:='[';
+         if assigned(symbol) then
+          begin
+            s:=s+symbol^.name;
+            first:=false;
+          end;
+         if (base<>R_NO) then
+          begin
+            if not(first) then
+             s:=s+'+'
+            else
+             first:=false;
+             s:=s+int_reg2str[base];
+          end;
+         if (index<>R_NO) then
+           begin
+             if not(first) then
+               s:=s+'+'
+             else
+               first:=false;
+             s:=s+int_reg2str[index];
+             if scalefactor<>0 then
+               s:=s+'*'+tostr(scalefactor);
+           end;
+         if offset<0 then
+           s:=s+tostr(offset)
+         else if (offset>0) then
+           s:=s+'+'+tostr(offset);
+         s:=s+']';
+        end;
+       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);
+      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);
+      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}
+
+
+{****************************************************************************
+                               Ti386nasmasmlist
+ ****************************************************************************}
+
+    var
+      LastSec : tsection;
+
+    const
+      ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
+        (#9'DD'#9,#9'DW'#9,#9'DB'#9);
+
+    Function PadTabs(const p:string;addch:char):string;
+    var
+      s : string;
+      i : longint;
+    begin
+      i:=length(p);
+      if addch<>#0 then
+       begin
+         inc(i);
+         s:=p+addch;
+       end
+      else
+       s:=p;
+      if i<8 then
+       PadTabs:=s+#9#9
+      else
+       PadTabs:=s+#9;
+    end;
+
+
+    procedure ti386nasmasmlist.WriteTree(p:paasmoutput);
+    type
+      twowords=record
+        word1,word2:word;
+      end;
+    var
+      s,
+      prefix,
+      suffix   : string;
+      hp       : pai;
+      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;
+      hp:=pai(p^.first);
+      while assigned(hp) do
+       begin
+         case hp^.typ of
+       ait_comment : Begin
+                       AsmWrite(target_asm.comment);
+                       AsmWritePChar(pai_asm_comment(hp)^.str);
+                       AsmLn;
+                     End;
+       ait_regalloc,
+       ait_tempalloc : ;
+       ait_section : begin
+                       if pai_section(hp)^.sec<>sec_none then
+                        begin
+                          AsmLn;
+                          AsmWriteLn('SECTION '+target_asm.secnames[pai_section(hp)^.sec]);
+                        end;
+                       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);
+                       AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
+                     end;
+   ait_const_32bit,
+    ait_const_8bit,
+   ait_const_16bit : begin
+                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
+                       consttyp:=hp^.typ;
+                       l:=0;
+                       repeat
+                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
+                         if found then
+                          begin
+                            hp:=Pai(hp^.next);
+                            s:=','+tostr(pai_const(hp)^.value);
+                            AsmWrite(s);
+                            inc(l,length(s));
+                          end;
+                       until (not found) or (l>line_length);
+                       AsmLn;
+                     end;
+  ait_const_symbol : begin
+                       AsmWriteLn(#9#9'DD'#9+pai_const_symbol(hp)^.sym^.name);
+                       if pai_const_symbol(hp)^.offset>0 then
+                         AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
+                       else if pai_const_symbol(hp)^.offset<0 then
+                         AsmWrite(tostr(pai_const_symbol(hp)^.offset));
+                       AsmLn;
+                     end;
+     ait_const_rva : begin
+                       AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
+                     end;
+    ait_real_32bit     : AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
+    ait_real_64bit     : AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
+    ait_real_80bit   : AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
+          ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
+        ait_string : begin
+                       counter := 0;
+                       lines := pai_string(hp)^.len div line_length;
+                     { separate lines in different parts }
+                       if pai_string(hp)^.len > 0 then
+                        Begin
+                          for j := 0 to lines-1 do
+                           begin
+                             AsmWrite(#9#9'DB'#9);
+                             quoted:=false;
+                             for i:=counter to counter+line_length do
+                                begin
+                                  { it is an ascii character. }
+                                  if (ord(pai_string(hp)^.str[i])>31) and
+                                     (ord(pai_string(hp)^.str[i])<128) and
+                                     (pai_string(hp)^.str[i]<>'"') then
+                                      begin
+                                        if not(quoted) then
+                                            begin
+                                              if i>counter then
+                                                AsmWrite(',');
+                                              AsmWrite('"');
+                                            end;
+                                        AsmWrite(pai_string(hp)^.str[i]);
+                                        quoted:=true;
+                                      end { if > 31 and < 128 and ord('"') }
+                                  else
+                                      begin
+                                          if quoted then
+                                              AsmWrite('"');
+                                          if i>counter then
+                                              AsmWrite(',');
+                                          quoted:=false;
+                                          AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                      end;
+                               end; { end for i:=0 to... }
+                             if quoted then AsmWrite('"');
+                               AsmWrite(target_os.newline);
+                             counter := counter+line_length;
+                          end; { end for j:=0 ... }
+                        { do last line of lines }
+                        AsmWrite(#9#9'DB'#9);
+                        quoted:=false;
+                        for i:=counter to pai_string(hp)^.len-1 do
+                          begin
+                            { it is an ascii character. }
+                            if (ord(pai_string(hp)^.str[i])>31) and
+                               (ord(pai_string(hp)^.str[i])<128) and
+                               (pai_string(hp)^.str[i]<>'"') then
+                                begin
+                                  if not(quoted) then
+                                      begin
+                                        if i>counter then
+                                          AsmWrite(',');
+                                        AsmWrite('"');
+                                      end;
+                                  AsmWrite(pai_string(hp)^.str[i]);
+                                  quoted:=true;
+                                end { if > 31 and < 128 and " }
+                            else
+                                begin
+                                  if quoted then
+                                    AsmWrite('"');
+                                  if i>counter then
+                                      AsmWrite(',');
+                                  quoted:=false;
+                                  AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                end;
+                          end; { end for i:=0 to... }
+                        if quoted then
+                          AsmWrite('"');
+                        end;
+                       AsmLn;
+                     end;
+{$ifndef NEWLAB}
+         ait_label : begin
+                       if pai_label(hp)^.l^.is_used then
+                        AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
+                     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);
+                       AsmWrite(pai_symbol(hp)^.sym^.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,
+                           ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
+                        AsmWriteLn(':')
+                     end;
+   ait_instruction : begin
+                       suffix:='';
+                       prefix:='';
+                       s:='';
+{$ifndef OLDASM}
+                       if pai386(hp)^.ops<>0 then
+                        begin
+                          if pai386(hp)^.opcode=A_CALL then
+                           s:=#9+getopstr_jmp(pai386(hp)^.oper[0])
+                          else
+                           begin
+                             for i:=0to pai386(hp)^.ops-1 do
+                              begin
+                                if i=0 then
+                                 sep:=#9
+                                else
+                                 sep:=',';
+                                s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
+                              end;
+                           end;
+                        end;
+                       if pai386(hp)^.opcode=A_FWAIT then
+                        AsmWriteln(#9#9'DB'#9'09bh')
+                       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,
+             ait_stabs,
+        ait_force_line,
+ait_stab_function_name : ;
+{$endif GDB}
+           ait_cut : begin
+                     { only reset buffer if nothing has changed }
+                       if AsmSize=AsmStartSize then
+                        AsmClear
+                       else
+                        begin
+                          AsmClose;
+                          DoAssemble;
+                          if pai_cut(hp)^.EndName then
+                           IsEndFile:=true;
+                          AsmCreate;
+                        end;
+                     { avoid empty files }
+                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
+                        begin
+                          if pai(hp^.next)^.typ=ait_section then
+                            lastsec:=pai_section(hp^.next)^.sec;
+                          hp:=pai(hp^.next);
+                        end;
+                       if lastsec<>sec_none then
+                         AsmWriteLn('SECTION '+target_asm.secnames[lastsec]);
+                       AsmStartSize:=AsmSize;
+                     end;
+        ait_marker : ;
+         else
+          internalerror(10000);
+         end;
+         hp:=pai(hp^.next);
+       end;
+    end;
+
+
+    procedure ti386nasmasmlist.WriteAsmList;
+    begin
+{$ifdef EXTDEBUG}
+      if assigned(current_module^.mainsource) then
+       comment(v_info,'Start writing nasm-styled assembler output for '+current_module^.mainsource^);
+{$endif}
+      LastSec:=sec_none;
+      AsmWriteLn('BITS 32');
+      AsmLn;
+
+      countlabelref:=false;
+      WriteTree(externals);
+    { Nasm doesn't support stabs
+      WriteTree(debuglist);}
+
+      WriteTree(codesegment);
+      WriteTree(datasegment);
+      WriteTree(consts);
+      WriteTree(rttilist);
+      WriteTree(bsssegment);
+      countlabelref:=true;
+
+      AsmLn;
+{$ifdef EXTDEBUG}
+      if assigned(current_module^.mainsource) then
+       comment(v_info,'Done writing nasm-styled assembler output for '+current_module^.mainsource^);
+{$endif EXTDEBUG}
+   end;
+
+end.
+{
   $Log$
-  Revision 1.38  1999-05-21 13:54:43  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.38  1999/05/21 13:54:43  peter
     * NEWLAB for label as symbol
-
-  Revision 1.37  1999/05/12 00:19:39  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.36  1999/05/11 16:28:16  peter
-    * long lines fixed
-
-  Revision 1.35  1999/05/10 15:18:16  peter
-    * fixed condition writing
-
-  Revision 1.34  1999/05/08 19:52:34  peter
-    + MessagePos() which is enhanced Message() function but also gets the
-      position info
-    * Removed comp warnings
-
-  Revision 1.33  1999/05/07 00:08:48  pierre
-   * AG386BIN cond -> OLDASM, only cosmetic
-
-  Revision 1.32  1999/05/06 09:05:11  peter
-    * generic write_float and str_float
-    * fixed constant float conversions
-
-  Revision 1.31  1999/05/04 21:44:32  florian
-    * changes to compile it with Delphi 4.0
-
-  Revision 1.30  1999/05/02 22:41:50  peter
-    * moved section names to systems
-    * fixed nasm,intel writer
-
-  Revision 1.29  1999/05/01 13:23:59  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.28  1999/04/17 22:17:06  pierre
-    * ifdef USE_OP3 released (changed into ifndef NO_OP3)
-    * SHRD and SHLD first operand (ATT syntax) can only be CL reg or immediate const
-
-  Revision 1.27  1999/04/16 11:49:40  peter
-    + tempalloc
-    + -at to show temp alloc info in .s file
-
-  Revision 1.26  1999/04/16 10:00:56  pierre
-    + ifdef USE_OP3 code :
-      added all missing op_... constructors for tai386 needed
-      for SHRD,SHLD and IMUL code in assembler readers
-      (check in tests/tbs0123.pp)
-
-  Revision 1.25  1999/03/29 16:05:44  peter
-    * optimizer working for ag386bin
-
-  Revision 1.24  1999/03/10 13:25:44  pierre
-    section order changed to get closer output from coff writer
-
-  Revision 1.23  1999/03/04 13:55:39  pierre
-    * some m68k fixes (still not compilable !)
-    * new(tobj) does not give warning if tobj has no VMT !
-
-  Revision 1.22  1999/03/02 02:56:11  peter
-    + stabs support for binary writers
-    * more fixes and missing updates from the previous commit :(
-
-  Revision 1.21  1999/03/01 15:46:17  peter
-    * ag386bin finally make cycles correct
-    * prefixes are now also normal opcodes
-
-  Revision 1.20  1999/02/26 00:48:14  peter
-    * assembler writers fixed for ag386bin
-
-  Revision 1.19  1999/02/25 21:02:19  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.18  1999/02/22 02:15:00  peter
-    * updates for ag386bin
-
-  Revision 1.17  1998/12/20 16:21:23  peter
-    * smartlinking doesn't crash anymore
-
-  Revision 1.16  1998/12/16 00:27:18  peter
-    * removed some obsolete version checks
-
-  Revision 1.15  1998/12/01 11:19:39  peter
-    * fixed range problem with in [tasmop]
-
-  Revision 1.14  1998/11/30 09:42:56  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.13  1998/11/17 00:26:10  peter
-    * fixed for $H+
-
-  Revision 1.12  1998/11/12 11:19:34  pierre
-   * fix for first line of function break
-
-  Revision 1.11  1998/10/12 12:20:42  pierre
-    + added tai_const_symbol_offset
-      for r : pointer = @var.field;
-    * better message for different arg names on implementation
-      of function
-
-  Revision 1.10  1998/10/06 17:16:34  pierre
-    * some memory leaks fixed (thanks to Peter for heaptrc !)
-
-  Revision 1.9  1998/10/01 20:19:07  jonas
-    + ait_marker support
-
-  Revision 1.8  1998/09/20 17:11:22  jonas
-    * released REGALLOC
-
-  Revision 1.7  1998/08/11 14:01:43  peter
-    * fixed fwait bug using direct opcode
-
-  Revision 1.6  1998/08/10 15:49:39  peter
-    * small fixes for 0.99.5
-
-  Revision 1.5  1998/08/08 10:19:18  florian
-    * small fixes to write the extended type correct
-
-  Revision 1.4  1998/06/05 17:46:03  peter
-    * tp doesn't like comp() typecast
-
-  Revision 1.3  1998/05/28 17:24:27  peter
-    - $R- for tp to solve range errors with in[]
-
-  Revision 1.2  1998/05/25 17:11:37  pierre
-    * firstpasscount bug fixed
-      now all is already set correctly the first time
-      under EXTDEBUG try -gp to skip all other firstpasses
-      it works !!
-    * small bug fixes
-      - for smallsets with -dTESTSMALLSET
-      - some warnings removed (by correcting code !)
-
-  Revision 1.1  1998/05/23 01:20:56  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.37  1999/05/12 00:19:39  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.36  1999/05/11 16:28:16  peter
+    * long lines fixed
+
+  Revision 1.35  1999/05/10 15:18:16  peter
+    * fixed condition writing
+
+  Revision 1.34  1999/05/08 19:52:34  peter
+    + MessagePos() which is enhanced Message() function but also gets the
+      position info
+    * Removed comp warnings
+
+  Revision 1.33  1999/05/07 00:08:48  pierre
+   * AG386BIN cond -> OLDASM, only cosmetic
+
+  Revision 1.32  1999/05/06 09:05:11  peter
+    * generic write_float and str_float
+    * fixed constant float conversions
+
+  Revision 1.31  1999/05/04 21:44:32  florian
+    * changes to compile it with Delphi 4.0
+
+  Revision 1.30  1999/05/02 22:41:50  peter
+    * moved section names to systems
+    * fixed nasm,intel writer
+
+  Revision 1.29  1999/05/01 13:23:59  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.28  1999/04/17 22:17:06  pierre
+    * ifdef USE_OP3 released (changed into ifndef NO_OP3)
+    * SHRD and SHLD first operand (ATT syntax) can only be CL reg or immediate const
+
+  Revision 1.27  1999/04/16 11:49:40  peter
+    + tempalloc
+    + -at to show temp alloc info in .s file
+
+  Revision 1.26  1999/04/16 10:00:56  pierre
+    + ifdef USE_OP3 code :
+      added all missing op_... constructors for tai386 needed
+      for SHRD,SHLD and IMUL code in assembler readers
+      (check in tests/tbs0123.pp)
+
+  Revision 1.25  1999/03/29 16:05:44  peter
+    * optimizer working for ag386bin
+
+  Revision 1.24  1999/03/10 13:25:44  pierre
+    section order changed to get closer output from coff writer
+
+  Revision 1.23  1999/03/04 13:55:39  pierre
+    * some m68k fixes (still not compilable !)
+    * new(tobj) does not give warning if tobj has no VMT !
+
+  Revision 1.22  1999/03/02 02:56:11  peter
+    + stabs support for binary writers
+    * more fixes and missing updates from the previous commit :(
+
+  Revision 1.21  1999/03/01 15:46:17  peter
+    * ag386bin finally make cycles correct
+    * prefixes are now also normal opcodes
+
+  Revision 1.20  1999/02/26 00:48:14  peter
+    * assembler writers fixed for ag386bin
+
+  Revision 1.19  1999/02/25 21:02:19  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.18  1999/02/22 02:15:00  peter
+    * updates for ag386bin
+
+  Revision 1.17  1998/12/20 16:21:23  peter
+    * smartlinking doesn't crash anymore
+
+  Revision 1.16  1998/12/16 00:27:18  peter
+    * removed some obsolete version checks
+
+  Revision 1.15  1998/12/01 11:19:39  peter
+    * fixed range problem with in [tasmop]
+
+  Revision 1.14  1998/11/30 09:42:56  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.13  1998/11/17 00:26:10  peter
+    * fixed for $H+
+
+  Revision 1.12  1998/11/12 11:19:34  pierre
+   * fix for first line of function break
+
+  Revision 1.11  1998/10/12 12:20:42  pierre
+    + added tai_const_symbol_offset
+      for r : pointer = @var.field;
+    * better message for different arg names on implementation
+      of function
+
+  Revision 1.10  1998/10/06 17:16:34  pierre
+    * some memory leaks fixed (thanks to Peter for heaptrc !)
+
+  Revision 1.9  1998/10/01 20:19:07  jonas
+    + ait_marker support
+
+  Revision 1.8  1998/09/20 17:11:22  jonas
+    * released REGALLOC
+
+  Revision 1.7  1998/08/11 14:01:43  peter
+    * fixed fwait bug using direct opcode
+
+  Revision 1.6  1998/08/10 15:49:39  peter
+    * small fixes for 0.99.5
+
+  Revision 1.5  1998/08/08 10:19:18  florian
+    * small fixes to write the extended type correct
+
+  Revision 1.4  1998/06/05 17:46:03  peter
+    * tp doesn't like comp() typecast
+
+  Revision 1.3  1998/05/28 17:24:27  peter
+    - $R- for tp to solve range errors with in[]
+
+  Revision 1.2  1998/05/25 17:11:37  pierre
+    * firstpasscount bug fixed
+      now all is already set correctly the first time
+      under EXTDEBUG try -gp to skip all other firstpasses
+      it works !!
+    * small bug fixes
+      - for smallsets with -dTESTSMALLSET
+      - some warnings removed (by correcting code !)
+
+  Revision 1.1  1998/05/23 01:20:56  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/cg386cal.pas

@@ -1,1542 +1,1553 @@
-{
-    $Id$
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Generate i386 assembler for in call nodes
-
-    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 cg386cal;
-interface
-
-{ $define AnsiStrRef}
-
-    uses
-      symtable,tree;
-
-    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
-                push_from_left_to_right,inlined,dword_align : boolean;para_offset : longint);
-    procedure secondcalln(var p : ptree);
-    procedure secondprocinline(var p : ptree);
-
-
-implementation
-
-    uses
-      globtype,systems,
-      cobjects,verbose,globals,
-      aasm,types,
-{$ifdef GDB}
-      gdb,
-{$endif GDB}
-      hcodegen,temp_gen,pass_2,
-{$ifndef OLDASM}
-      i386base,i386asm,
-{$else}
-      i386,
-{$endif}
-      cgai386,tgeni386,cg386ld;
-
-{*****************************************************************************
-                             SecondCallParaN
-*****************************************************************************}
-
-    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
-                push_from_left_to_right,inlined,dword_align : boolean;para_offset : longint);
-
-      procedure maybe_push_high;
-        begin
-           { open array ? }
-           { defcoll^.data can be nil for read/write }
-           if assigned(defcoll^.data) and
-              push_high_param(defcoll^.data) then
-             begin
-               if assigned(p^.hightree) then
-                begin
-                  secondpass(p^.hightree);
-                  { this is a longint anyway ! }
-                  push_value_para(p^.hightree,inlined,para_offset,4);
-                end
-               else
-                internalerror(432645);
-             end;
-        end;
-
-      var
-         otlabel,oflabel : plabel;
-         align : longint;
-         { temporary variables: }
-         tempdeftype : tdeftype;
-         r : preference;
-      begin
-         { push from left to right if specified }
-         if push_from_left_to_right and assigned(p^.right) then
-           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,
-             inlined,dword_align,para_offset);
-         otlabel:=truelabel;
-         oflabel:=falselabel;
-         getlabel(truelabel);
-         getlabel(falselabel);
-         secondpass(p^.left);
-         { filter array constructor with c styled args }
-         if is_array_constructor(p^.left^.resulttype) and p^.left^.cargs then
-           begin
-             { nothing, everything is already pushed }
-           end
-         { in codegen.handleread.. defcoll^.data is set to nil }
-         else if assigned(defcoll^.data) and
-           (defcoll^.data^.deftype=formaldef) then
-           begin
-              { allow @var }
-              inc(pushedparasize,4);
-              if p^.left^.treetype=addrn then
-                begin
-                { always a register }
-                  if inlined then
-                    begin
-                       r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                       exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
-                         p^.left^.location.register,r)));
-                    end
-                  else
-                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
-                  ungetregister32(p^.left^.location.register);
-                end
-              else
-                begin
-                   if not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
-                     CGMessage(type_e_mismatch)
-                   else
-                     begin
-                       if inlined then
-                         begin
-                           exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
-                             newreference(p^.left^.location.reference),R_EDI)));
-                           r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                           exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                         end
-                      else
-                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                        del_reference(p^.left^.location.reference);
-                     end;
-                end;
-           end
-         { handle call by reference parameter }
-         else if (defcoll^.paratyp=vs_var) then
-           begin
-              if (p^.left^.location.loc<>LOC_REFERENCE) then
-                CGMessage(cg_e_var_must_be_reference);
-              maybe_push_high;
-              inc(pushedparasize,4);
-              if inlined then
-                begin
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
-                     newreference(p^.left^.location.reference),R_EDI)));
-                   r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
-                end
-              else
-                emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-              del_reference(p^.left^.location.reference);
-           end
-         else
-           begin
-              tempdeftype:=p^.resulttype^.deftype;
-              if tempdeftype=filedef then
-               CGMessage(cg_e_file_must_call_by_reference);
-              if push_addr_param(p^.resulttype) then
-                begin
-                   maybe_push_high;
-                   inc(pushedparasize,4);
-                   if inlined then
-                     begin
-                        exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
-                          newreference(p^.left^.location.reference),R_EDI)));
-                        r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
-                        exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
-                          R_EDI,r)));
-                     end
-                   else
-                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                   del_reference(p^.left^.location.reference);
-                end
-              else
-                begin
-                   align:=target_os.stackalignment;
-                   if dword_align then
-                     align:=4;
-                   push_value_para(p^.left,inlined,para_offset,align);
-                end;
-           end;
-         freelabel(truelabel);
-         freelabel(falselabel);
-         truelabel:=otlabel;
-         falselabel:=oflabel;
-         { push from right to left }
-         if not push_from_left_to_right and assigned(p^.right) then
-           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,
-             inlined,dword_align,para_offset);
-      end;
-
-
-{*****************************************************************************
-                             SecondCallN
-*****************************************************************************}
-
-    procedure secondcalln(var p : ptree);
-      var
-         unusedregisters : tregisterset;
-         pushed : tpushed;
-         hr,funcretref : treference;
-         hregister,hregister2 : tregister;
-         oldpushedparasize : longint;
-         { true if ESI must be loaded again after the subroutine }
-         loadesi : boolean;
-         { true if a virtual method must be called directly }
-         no_virtual_call : boolean;
-         { true if we produce a con- or destrutor in a call }
-         is_con_or_destructor : boolean;
-         { true if a constructor is called again }
-         extended_new : boolean;
-         { adress returned from an I/O-error }
-         iolabel : plabel;
-         { lexlevel count }
-         i : longint;
-         { help reference pointer }
-         r : preference;
-         hp,
-         pp,params : ptree;
-         inlined : boolean;
-         inlinecode : ptree;
-         para_offset : longint;
-         { instruction for alignement correction }
-{         corr : pai386;}
-         { we must pop this size also after !! }
-{         must_pop : boolean; }
-         pop_size : longint;
-
-      label
-         dont_call;
-
-      begin
-         reset_reference(p^.location.reference);
-         extended_new:=false;
-         iolabel:=nil;
-         inlinecode:=nil;
-         inlined:=false;
-         loadesi:=true;
-         no_virtual_call:=false;
-         unusedregisters:=unused;
-
-         if not assigned(p^.procdefinition) then
-          exit;
-         if (p^.procdefinition^.options and poinline)<>0 then
-           begin
-              inlined:=true;
-              inlinecode:=p^.right;
-              { set it to the same lexical level as the local symtable, becuase
-                the para's are stored there }
-              pprocdef(p^.procdefinition)^.parast^.symtablelevel:=aktprocsym^.definition^.localst^.symtablelevel;
-              if assigned(p^.left) then
-                inlinecode^.para_offset:=gettempofsizepersistant(inlinecode^.para_size);
-              pprocdef(p^.procdefinition)^.parast^.address_fixup:=inlinecode^.para_offset;
-{$ifdef extdebug}
-             Comment(V_debug,
-               'inlined parasymtable is at offset '
-               +tostr(pprocdef(p^.procdefinition)^.parast^.address_fixup));
-             exprasmlist^.concat(new(pai_asm_comment,init(
-               strpnew('inlined parasymtable is at offset '
-               +tostr(pprocdef(p^.procdefinition)^.parast^.address_fixup)))));
-{$endif extdebug}
-              p^.right:=nil;
-              { disable further inlining of the same proc
-                in the args }
-              p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
-           end;
-         { only if no proc var }
-         if not(assigned(p^.right)) then
-           is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
-             or ((p^.procdefinition^.options and podestructor)<>0);
-         { proc variables destroy all registers }
-         if (p^.right=nil) and
-            { virtual methods too }
-            ((p^.procdefinition^.options and povirtualmethod)=0) then
-           begin
-              if ((p^.procdefinition^.options and poiocheck)<>0) and
-                 ((aktprocsym^.definition^.options and poiocheck)=0) and
-                 (cs_check_io in aktlocalswitches) then
-                begin
-                   getlabel(iolabel);
-                   emitlab(iolabel);
-                end
-              else
-                iolabel:=nil;
-
-              { save all used registers }
-              pushusedregisters(exprasmlist,pushed,pprocdef(p^.procdefinition)^.usedregisters);
-
-              { give used registers through }
-              usedinproc:=usedinproc or pprocdef(p^.procdefinition)^.usedregisters;
-           end
-         else
-           begin
-              pushusedregisters(exprasmlist,pushed,$ff);
-              usedinproc:=$ff;
-              { no IO check for methods and procedure variables }
-              iolabel:=nil;
-           end;
-
-         { generate the code for the parameter and push them }
-         oldpushedparasize:=pushedparasize;
-         pushedparasize:=0;
-         pop_size:=0;
-         if (not inlined) then
-          begin
-          { Old pushedsize aligned on 4 ? }
-            i:=oldpushedparasize and 3;
-            if i>0 then
-             inc(pop_size,4-i);
-          { This parasize aligned on 4 ? }
-            i:=p^.procdefinition^.para_size and 3;
-            if i>0 then
-             inc(pop_size,4-i);
-          { insert the opcode and update pushedparasize }
-            if pop_size>0 then
-             begin
-               inc(pushedparasize,pop_size);
-               exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,pop_size,R_ESP)));
-{$ifdef GDB}
-               if (cs_debuginfo in aktmoduleswitches) and
-                  (exprasmlist^.first=exprasmlist^.last) then
-                 exprasmlist^.concat(new(pai_force_line,init));
-{$endif GDB}
-             end;
-          end;
-
-         if (p^.resulttype<>pdef(voiddef)) and
-            ret_in_param(p^.resulttype) then
-           begin
-              funcretref.symbol:=nil;
-{$ifdef test_dest_loc}
-              if dest_loc_known and (dest_loc_tree=p) and
-                 (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
-                begin
-                   funcretref:=dest_loc.reference;
-                   if assigned(dest_loc.reference.symbol) then
-                     funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
-                   in_dest_loc:=true;
-                end
-              else
-{$endif test_dest_loc}
-                if inlined then
-                  begin
-                     reset_reference(funcretref);
-                     funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
-                     funcretref.base:=procinfo.framepointer;
-                  end
-                else
-                  gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
-           end;
-         if assigned(p^.left) then
-           begin
-              { be found elsewhere }
-              if inlined then
-                para_offset:=pprocdef(p^.procdefinition)^.parast^.address_fixup+
-                  pprocdef(p^.procdefinition)^.parast^.datasize
-              else
-                para_offset:=0;
-              if assigned(p^.right) then
-                secondcallparan(p^.left,pabstractprocdef(p^.right^.resulttype)^.para1,
-                  (p^.procdefinition^.options and poleftright)<>0,
-                  inlined,(p^.procdefinition^.options and (pocdecl or postdcall))<>0,para_offset)
-              else
-                secondcallparan(p^.left,p^.procdefinition^.para1,
-                  (p^.procdefinition^.options and poleftright)<>0,
-                  inlined,(p^.procdefinition^.options and (pocdecl or postdcall))<>0,para_offset);
-           end;
-         params:=p^.left;
-         p^.left:=nil;
-         if inlined then
-           inlinecode^.retoffset:=gettempofsizepersistant(4);
-         if ret_in_param(p^.resulttype) then
-           begin
-              inc(pushedparasize,4);
-              if inlined then
-                begin
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
-                     newreference(funcretref),R_EDI)));
-                   r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
-                     R_EDI,r)));
-                end
-              else
-                emitpushreferenceaddr(exprasmlist,funcretref);
-           end;
-         { procedure variable ? }
-         if (p^.right=nil) then
-           begin
-              { overloaded operator have no symtable }
-              { push self }
-              if assigned(p^.symtable) and
-                (p^.symtable^.symtabletype=withsymtable) then
-                begin
-                   { dirty trick to avoid the secondcall below }
-                   p^.methodpointer:=genzeronode(callparan);
-                   p^.methodpointer^.location.loc:=LOC_REGISTER;
-                   p^.methodpointer^.location.register:=R_ESI;
-                   { ARGHHH this is wrong !!!
-                     if we can init from base class for a child
-                     class that the wrong VMT will be
-                     transfered to constructor !! }
-                   p^.methodpointer^.resulttype:=
-                     ptree(pwithsymtable(p^.symtable)^.withnode)^.left^.resulttype;
-                   { change dispose type !! }
-                   p^.disposetyp:=dt_mbleft_and_method;
-                   { make a reference }
-                   new(r);
-                   reset_reference(r^);
-                   { if assigned(ptree(pwithsymtable(p^.symtable)^.withnode)^.pref) then
-                     begin
-                        r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.pref^;
-                     end
-                   else
-                     begin
-                        r^.offset:=p^.symtable^.datasize;
-                        r^.base:=procinfo.framepointer;
-                     end; }
-                   r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^;
-                   if (not pwithsymtable(p^.symtable)^.direct_with) or
-                      pobjectdef(p^.methodpointer^.resulttype)^.isclass then
-                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)))
-                   else
-                     exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_ESI)));
-                end;
-
-              { push self }
-              if assigned(p^.symtable) and
-                ((p^.symtable^.symtabletype=objectsymtable) or
-                (p^.symtable^.symtabletype=withsymtable)) then
-                begin
-                   if assigned(p^.methodpointer) then
-                     begin
-                        {
-                        if p^.methodpointer^.resulttype=classrefdef then
-                          begin
-                              two possibilities:
-                               1. constructor
-                               2. class method
-
-                          end
-                        else }
-                          begin
-                             case p^.methodpointer^.treetype of
-                               typen:
-                                 begin
-                                    { direct call to inherited method }
-                                    if (p^.procdefinition^.options and poabstractmethod)<>0 then
-                                      begin
-                                         CGMessage(cg_e_cant_call_abstract_method);
-                                         goto dont_call;
-                                      end;
-                                    { generate no virtual call }
-                                    no_virtual_call:=true;
-
-                                    if (p^.symtableprocentry^.properties and sp_static)<>0 then
-                                      begin
-                                         { well lets put the VMT address directly into ESI }
-                                         { it is kind of dirty but that is the simplest    }
-                                         { way to accept virtual static functions (PM)     }
-                                         loadesi:=true;
-                                         { if no VMT just use $0 bug0214 PM }
-                                         if (pobjectdef(p^.methodpointer^.resulttype)^.options and oo_hasvmt)=0 then
-                                           exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,0,R_ESI)))
-                                         else
-                                           begin
-                                             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 !! }
-                                      end
-                                    else
-                                      { this is a member call, so ESI isn't modfied }
-                                      loadesi:=false;
-
-                                    { a class destructor needs a flag }
-                                    if pobjectdef(p^.methodpointer^.resulttype)^.isclass and
-                                        assigned(aktprocsym) and
-                                        ((aktprocsym^.definition^.options and
-                                        (podestructor))<>0) then
-                                        begin
-                                           push_int(0);
-                                           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
-                                        end;
-
-                                    if not(is_con_or_destructor and
-                                           pobjectdef(p^.methodpointer^.resulttype)^.isclass and
-                                           assigned(aktprocsym) and
-                                           ((aktprocsym^.definition^.options and (poconstructor or podestructor))<>0)
-                                          ) then
-                                      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                                  }
-                                    { con- and destructors need a pointer to the vmt }
-                                    if is_con_or_destructor and
-                                    not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
-                                    assigned(aktprocsym) then
-                                      begin
-                                         if not ((aktprocsym^.definition^.options
-                                           and (poconstructor or podestructor))<>0) then
-
-                                          CGMessage(cg_w_member_cd_call_from_method);
-                                      end;
-                                    { class destructors get there flag below }
-                                    if is_con_or_destructor and
-                                        not(pobjectdef(p^.methodpointer^.resulttype)^.isclass and
-                                        assigned(aktprocsym) and
-                                        ((aktprocsym^.definition^.options and
-                                        (podestructor))<>0)) then
-                                      push_int(0);
-                                 end;
-                               hnewn:
-                                 begin
-                                    { extended syntax of new }
-                                    { ESI must be zero }
-                                    exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
-                                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
-                                    { 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:
-                                 begin
-                                    secondpass(p^.methodpointer);
-
-                                    { destructor with extended syntax called from dispose }
-                                    { 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
-                                    { call to an instance member }
-                                    if (p^.symtable^.symtabletype<>withsymtable) then
-                                      begin
-                                         secondpass(p^.methodpointer);
-                                         case p^.methodpointer^.location.loc of
-                                            LOC_CREGISTER,
-                                            LOC_REGISTER:
-                                              begin
-                                                 emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
-                                                 ungetregister32(p^.methodpointer^.location.register);
-                                              end;
-                                            else
-                                              begin
-                                                 if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
-                                                    ((p^.methodpointer^.resulttype^.deftype=objectdef) and
-                                                   pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
-                                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                                     newreference(p^.methodpointer^.location.reference),R_ESI)))
-                                                 else
-                                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
-                                                     newreference(p^.methodpointer^.location.reference),R_ESI)));
-                                                 del_reference(p^.methodpointer^.location.reference);
-                                              end;
-                                         end;
-                                      end;
-                                    { when calling a class method, we have to load ESI with the VMT !
-                                      But, not for a class method via self }
-                                    if ((p^.procdefinition^.options and pocontainsself)=0) then
-                                      begin
-                                        if ((p^.procdefinition^.options and poclassmethod)<>0)
-                                           and not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
-                                          begin
-                                             { class method needs current VMT }
-                                             new(r);
-                                             reset_reference(r^);
-                                             r^.base:=R_ESI;
-                                             r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
-                                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
-                                          end;
-
-                                        { direct call to destructor: don't remove data! }
-                                        if ((p^.procdefinition^.options and podestructor)<>0) and
-                                          (p^.methodpointer^.resulttype^.deftype=objectdef) and
-                                          (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
-                                          exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,1)));
-
-                                        { direct call to class constructor, don't allocate memory }
-                                        if ((p^.procdefinition^.options and poconstructor)<>0) and
-                                          (p^.methodpointer^.resulttype^.deftype=objectdef) and
-                                          (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
-                                          exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
-                                        else
-                                          exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
-                                      end;
-
-                                    if is_con_or_destructor then
-                                      begin
-                                         { classes don't get a VMT pointer pushed }
-                                         if (p^.methodpointer^.resulttype^.deftype=objectdef) and
-                                           not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
-                                           begin
-                                              if ((p^.procdefinition^.options and poconstructor)<>0) then
-                                                begin
-                                                   { 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                                           }
-                                              else
-                                                push_int(0);
-                                           end;
-                                      end;
-                                 end;
-                             end;
-                          end;
-                     end
-                   else
-                     begin
-                        if ((p^.procdefinition^.options and poclassmethod)<>0) and
-                          not(
-                            assigned(aktprocsym) and
-                            ((aktprocsym^.definition^.options and poclassmethod)<>0)
-                          ) then
-                          begin
-                             { class method needs current VMT }
-                             new(r);
-                             reset_reference(r^);
-                             r^.base:=R_ESI;
-                             r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
-                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
-                          end
-                        else
-                          begin
-                             { member call, ESI isn't modified }
-                             loadesi:=false;
-                          end;
-                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
-                        { but a con- or destructor here would probably almost }
-                        { always be placed wrong }
-                        if is_con_or_destructor then
-                          begin
-                             CGMessage(cg_w_member_cd_call_from_method);
-                             push_int(0);
-                          end;
-                     end;
-                end;
-
-              { push base pointer ?}
-              if (lexlevel>=normal_function_level) and assigned(pprocdef(p^.procdefinition)^.parast) and
-                ((pprocdef(p^.procdefinition)^.parast^.symtablelevel)>normal_function_level) then
-                begin
-                   { if we call a nested function in a method, we must      }
-                   { push also SELF!                                        }
-                   { THAT'S NOT TRUE, we have to load ESI via frame pointer }
-                   { access                                                 }
-                   {
-                     begin
-                        loadesi:=false;
-                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
-                     end;
-                   }
-                   if lexlevel=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
-                     begin
-                        new(r);
-                        reset_reference(r^);
-                        r^.offset:=procinfo.framepointer_offset;
-                        r^.base:=procinfo.framepointer;
-                        exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
-                     end
-                     { this is only true if the difference is one !!
-                       but it cannot be more !! }
-                   else if (lexlevel=pprocdef(p^.procdefinition)^.parast^.symtablelevel-1) then
-                     begin
-                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
-                     end
-                   else if (lexlevel>pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
-                     begin
-                        hregister:=getregister32;
-                        new(r);
-                        reset_reference(r^);
-                        r^.offset:=procinfo.framepointer_offset;
-                        r^.base:=procinfo.framepointer;
-                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
-                        for i:=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
-                          begin
-                             new(r);
-                             reset_reference(r^);
-                             {we should get the correct frame_pointer_offset at each level
-                             how can we do this !!! }
-                             r^.offset:=procinfo.framepointer_offset;
-                             r^.base:=hregister;
-                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
-                          end;
-                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
-                        ungetregister32(hregister);
-                     end
-                   else
-                     internalerror(25000);
-                end;
-
-              if ((p^.procdefinition^.options and povirtualmethod)<>0) and
-                 not(no_virtual_call) then
-                begin
-                   { static functions contain the vmt_address in ESI }
-                   { also class methods                              }
-                   { Here it is quite tricky because it also depends }
-                   { on the methodpointer                         PM }
-                   if assigned(aktprocsym) then
-                     begin
-                       if ((((aktprocsym^.properties and sp_static)<>0) or
-                        ((aktprocsym^.definition^.options and poclassmethod)<>0)) and
-                        ((p^.methodpointer=nil) or (p^.methodpointer^.treetype=typen)))
-                        or
-                        ((p^.procdefinition^.options and postaticmethod)<>0) or
-                        ((p^.procdefinition^.options and poconstructor)<>0) or
-                        { ESI is loaded earlier }
-                        ((p^.procdefinition^.options and poclassmethod)<>0)then
-                         begin
-                            new(r);
-                            reset_reference(r^);
-                            r^.base:=R_ESI;
-                         end
-                       else
-                         begin
-                            new(r);
-                            reset_reference(r^);
-                            r^.base:=R_ESI;
-                            { this is one point where we need vmt_offset (PM) }
-                            r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
-                            exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
-                            new(r);
-                            reset_reference(r^);
-                            r^.base:=R_EDI;
-                         end;
-                     end
-                   else
-                     { aktprocsym should be assigned, also in main program }
-                     internalerror(12345);
-                   {
-                     begin
-                       new(r);
-                       reset_reference(r^);
-                       r^.base:=R_ESI;
-                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
-                       new(r);
-                       reset_reference(r^);
-                       r^.base:=R_EDI;
-                     end;
-                   }
-                   if pprocdef(p^.procdefinition)^.extnumber=-1 then
-                        internalerror($Da);
-                   r^.offset:=pprocdef(p^.procdefinition)^.extnumber*4+12;
-{$ifndef TESTOBJEXT}
-                   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);
-                     end;
-{$else TESTOBJEXT}
-                   if (cs_check_range in aktlocalswitches) then
-                     begin
-                        exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
-                          newasmsymbol(pprocdef(p^.procdefinition)^._class^.vmt_mangledname))));
-                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
-                        emitcall('FPC_CHECK_OBJECT_EXT',true);
-                     end;
-{$endif TESTOBJEXT}
-                   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)))
-              else { inlined proc }
-                { inlined code is in inlinecode }
-                begin
-                   { set poinline again }
-                   p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
-                   { process the inlinecode }
-                   secondpass(inlinecode);
-                   { free the args }
-                   ungetpersistanttemp(pprocdef(p^.procdefinition)^.parast^.address_fixup);
-                end;
-           end
-         else
-           { now procedure variable case }
-           begin
-              secondpass(p^.right);
-              { method pointer ? }
-              if (p^.procdefinition^.options and pomethodpointer)<>0 then
-                begin
-                   { method pointer can't be in a register }
-                   hregister:=R_NO;
-
-                   { do some hacking if we call a method pointer }
-                   { 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
-                        del_reference(p^.right^.location.reference);
-                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                          newreference(p^.right^.location.reference),R_EDI)));
-                        hregister:=R_EDI;
-                     end;
-
-
-                   if ((p^.procdefinition^.options and pocontainsself)=0) then
-                     begin
-                       { load ESI }
-                       inc(p^.right^.location.reference.offset,4);
-                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                         newreference(p^.right^.location.reference),R_ESI)));
-                       dec(p^.right^.location.reference.offset,4);
-                       { push self pointer }
-                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
-                     end;
-
-                   if hregister=R_NO then
-                     exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))))
-                   else
-                     exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,hregister)));
-
-                   del_reference(p^.right^.location.reference);
-                end
-              else
-                begin
-                   case p^.right^.location.loc of
-                      LOC_REGISTER,LOC_CREGISTER:
-                         begin
-                             exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
-                             ungetregister32(p^.right^.location.register);
-                         end
-                      else
-                         exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
-                         del_reference(p^.right^.location.reference);
-                   end;
-                end;
-           end;
-
-           { this was only for normal functions
-             displaced here so we also get
-             it to work for procvars PM }
-           if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
-             begin
-                { consider the alignment with the rest (PM) }
-                inc(pushedparasize,pop_size);
-                pop_size:=0;
-                { better than an add on all processors }
-                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!              }
-                else if (pushedparasize=8) and
-                  not(cs_littlesize in aktglobalswitches) and
-                  (aktoptprocessor=ClassP5) and
-                  (procinfo._class=nil) then
-                    begin
-                       exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
-                       exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
-                    end
-                else if pushedparasize<>0 then
-                  exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
-             end;
-      dont_call:
-         pushedparasize:=oldpushedparasize;
-         unused:=unusedregisters;
-
-         { handle function results }
-         { structured results are easy to handle.... }
-         { needed also when result_no_used !! }
-         if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
-           begin
-              p^.location.loc:=LOC_MEM;
-              p^.location.reference.symbol:=nil;
-              p^.location.reference:=funcretref;
-           end;
-         { 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
-           begin
-              { a contructor could be a function with boolean result }
-              if (p^.right=nil) and
-                 ((p^.procdefinition^.options and poconstructor)<>0) and
-                 { quick'n'dirty check if it is a class or an object }
-                 (p^.resulttype^.deftype=orddef) then
-                begin
-                   p^.location.loc:=LOC_FLAGS;
-                   p^.location.resflags:=F_NE;
-                   if extended_new then
-                     begin
-{$ifdef test_dest_loc}
-                        if dest_loc_known and (dest_loc_tree=p) then
-                          mov_reg_to_dest(p,S_L,R_EAX)
-                        else
-{$endif test_dest_loc}
-                          begin
-                             hregister:=getexplicitregister32(R_EAX);
-                             emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
-                             p^.location.register:=hregister;
-                          end;
-                     end;
-                end
-               { structed results are easy to handle.... }
-              else if ret_in_param(p^.resulttype) then
-                begin
-                   {p^.location.loc:=LOC_MEM;
-                   stringdispose(p^.location.reference.symbol);
-                   p^.location.reference:=funcretref;
-                   already done above (PM) }
-                end
-              else
-                begin
-                   if (p^.resulttype^.deftype=orddef) then
-                     begin
-                        p^.location.loc:=LOC_REGISTER;
-                        case porddef(p^.resulttype)^.typ of
-                          s32bit,u32bit,bool32bit :
-                            begin
-{$ifdef test_dest_loc}
-                               if dest_loc_known and (dest_loc_tree=p) then
-                                 mov_reg_to_dest(p,S_L,R_EAX)
-                               else
-{$endif test_dest_loc}
-                                 begin
-                                    hregister:=getexplicitregister32(R_EAX);
-                                    emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
-                                    p^.location.register:=hregister;
-                                 end;
-                            end;
-                          uchar,u8bit,bool8bit,s8bit:
-                            begin
-{$ifdef test_dest_loc}
-                                 if dest_loc_known and (dest_loc_tree=p) then
-                                   mov_reg_to_dest(p,S_B,R_AL)
-                                 else
-{$endif test_dest_loc}
-                                   begin
-                                      hregister:=getexplicitregister32(R_EAX);
-                                      emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
-                                      p^.location.register:=reg32toreg8(hregister);
-                                   end;
-                              end;
-                          s16bit,u16bit,bool16bit :
-                            begin
-{$ifdef test_dest_loc}
-                               if dest_loc_known and (dest_loc_tree=p) then
-                                 mov_reg_to_dest(p,S_W,R_AX)
-                               else
-{$endif test_dest_loc}
-                                 begin
-                                    hregister:=getexplicitregister32(R_EAX);
-                                    emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
-                                    p^.location.register:=reg32toreg16(hregister);
-                                 end;
-                            end;
-                           s64bitint,u64bit:
-                             begin
-{$ifdef test_dest_loc}
-{$error Don't know what to do here}
-{$endif test_dest_loc}
-                                hregister:=getexplicitregister32(R_EAX);
-                                hregister2:=getexplicitregister32(R_EDX);
-                                emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
-                                emit_reg_reg(A_MOV,S_L,R_EDX,hregister2);
-                                p^.location.registerlow:=hregister;
-                                p^.location.registerhigh:=hregister2;
-                             end;
-                        else internalerror(7);
-                     end
-
-                end
-              else if (p^.resulttype^.deftype=floatdef) then
-                case pfloatdef(p^.resulttype)^.typ of
-                  f32bit:
-                    begin
-                       p^.location.loc:=LOC_REGISTER;
-{$ifdef test_dest_loc}
-                       if dest_loc_known and (dest_loc_tree=p) then
-                         mov_reg_to_dest(p,S_L,R_EAX)
-                       else
-{$endif test_dest_loc}
-                         begin
-                            hregister:=getexplicitregister32(R_EAX);
-                            emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
-                            p^.location.register:=hregister;
-                         end;
-                    end;
-                  else
-                    p^.location.loc:=LOC_FPU;
-                end
-              else if is_ansistring(p^.resulttype) or
-                is_widestring(p^.resulttype) then
-                begin
-                   gettempansistringreference(hr);
-                   { cleanup the temp slot }
-                   exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
-                   decrstringref(exprasmlist,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,
-                     newreference(hr))));
-                   p^.location.loc:=LOC_MEM;
-                   p^.location.reference:=hr;
-                end
-              else
-                begin
-                   p^.location.loc:=LOC_REGISTER;
-{$ifdef test_dest_loc}
-                   if dest_loc_known and (dest_loc_tree=p) then
-                     mov_reg_to_dest(p,S_L,R_EAX)
-                   else
-{$endif test_dest_loc}
-                    begin
-                       hregister:=getexplicitregister32(R_EAX);
-                       emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
-                       p^.location.register:=hregister;
-                    end;
-                end;
-             end;
-           end;
-
-         { 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);
-           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);
-
-         { at last, restore instance pointer (SELF) }
-         if loadesi then
-           maybe_loadesi;
-         pp:=params;
-         while assigned(pp) do
-           begin
-              if assigned(pp^.left) then
-                begin
-                  if (pp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) and
-                     ungettempoftype(pp^.left^.resulttype) then
-                    ungetiftemp(pp^.left^.location.reference);
-                { process also all nodes of an array of const }
-                  if pp^.left^.treetype=arrayconstructn then
-                    begin
-                      if assigned(pp^.left^.left) then
-                       begin
-                         hp:=pp^.left;
-                         while assigned(hp) do
-                          begin
-                            if (hp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) and
-                               ungettempoftype(hp^.left^.resulttype) then
-                              ungetiftemp(hp^.left^.location.reference);
-                            hp:=hp^.right;
-                          end;
-                       end;
-                    end;
-                end;
-              pp:=pp^.right;
-           end;
-         if inlined then
-           ungetpersistanttemp(inlinecode^.retoffset);
-         disposetree(params);
-
-
-         { from now on the result can be freed normally }
-         if inlined and ret_in_param(p^.resulttype) then
-           persistanttemptonormal(funcretref.offset);
-
-         { if return value is not used }
-         if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
-           begin
-              if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
-                begin
-                   { data which must be finalized ? }
-                   if (p^.resulttype^.needs_inittable) and
-                     ( (p^.resulttype^.deftype<>objectdef) or
-                       not(pobjectdef(p^.resulttype)^.isclass)) then
-                      finalize(exprasmlist,p^.resulttype,p^.location.reference);
-                   { release unused temp }
-                   ungetiftemp(p^.location.reference)
-                end
-              else if p^.location.loc=LOC_FPU then
-                { release FPU stack }
-                exprasmlist^.concat(new(pai386,op_reg(A_FSTP,S_NO,R_ST0)));
-           end;
-      end;
-
-
-{*****************************************************************************
-                             SecondProcInlineN
-*****************************************************************************}
-
-
-    procedure secondprocinline(var p : ptree);
-       var st : psymtable;
-           oldprocsym : pprocsym;
-           para_size : longint;
-           oldprocinfo : tprocinfo;
-           { just dummies for genentrycode }
-           nostackframe,make_global : boolean;
-           proc_names : tstringcontainer;
-           inlineentrycode,inlineexitcode : paasmoutput;
-           oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
-       begin
-          oldexitlabel:=aktexitlabel;
-          oldexit2label:=aktexit2label;
-          oldquickexitlabel:=quickexitlabel;
-          getlabel(aktexitlabel);
-          getlabel(aktexit2label);
-          oldprocsym:=aktprocsym;
-          oldprocinfo:=procinfo;
-          { set the return value }
-          aktprocsym:=p^.inlineprocsym;
-          procinfo.retdef:=aktprocsym^.definition^.retdef;
-          procinfo.retoffset:=p^.retoffset;
-          { arg space has been filled by the parent secondcall }
-          st:=aktprocsym^.definition^.localst;
-          { set it to the same lexical level }
-          st^.symtablelevel:=oldprocsym^.definition^.localst^.symtablelevel;
-          if st^.datasize>0 then
-            begin
-              st^.address_fixup:=gettempofsizepersistant(st^.datasize);
-{$ifdef extdebug}
-              Comment(V_debug,'local symtable is at offset '+tostr(st^.address_fixup));
-              exprasmlist^.concat(new(pai_asm_comment,init(strpnew(
-                'local symtable is at offset '+tostr(st^.address_fixup)))));
-{$endif extdebug}
-            end;
-{$ifdef extdebug}
-          exprasmlist^.concat(new(pai_asm_comment,init('Start of inlined proc')));
-{$endif extdebug}
-          { takes care of local data initialization }
-          inlineentrycode:=new(paasmoutput,init);
-          inlineexitcode:=new(paasmoutput,init);
-          proc_names.init;
-          para_size:=p^.para_size;
-          make_global:=false; { to avoid warning }
-          genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
-          exprasmlist^.concatlist(inlineentrycode);
-          secondpass(p^.inlinetree);
-          genexitcode(inlineexitcode,0,false,true);
-          exprasmlist^.concatlist(inlineexitcode);
-{$ifdef extdebug}
-          exprasmlist^.concat(new(pai_asm_comment,init('End of inlined proc')));
-{$endif extdebug}
-          {we can free the local data now, reset also the fixup address }
-          if st^.datasize>0 then
-            begin
-              ungetpersistanttemp(st^.address_fixup);
-              st^.address_fixup:=0;
-            end;
-          aktprocsym:=oldprocsym;
-          freelabel(aktexitlabel);
-          freelabel(aktexit2label);
-          aktexitlabel:=oldexitlabel;
-          aktexit2label:=oldexit2label;
-          quickexitlabel:=oldquickexitlabel;
-          procinfo:=oldprocinfo;
-       end;
-
-
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 assembler for in call nodes
+
+    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 cg386cal;
+interface
+
+{ $define AnsiStrRef}
+
+    uses
+      symtable,tree;
+
+    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
+                push_from_left_to_right,inlined,dword_align : boolean;para_offset : longint);
+    procedure secondcalln(var p : ptree);
+    procedure secondprocinline(var p : ptree);
+
+
+implementation
+
+    uses
+      globtype,systems,
+      cobjects,verbose,globals,
+      aasm,types,
+{$ifdef GDB}
+      gdb,
+{$endif GDB}
+      hcodegen,temp_gen,pass_2,
+{$ifndef OLDASM}
+      i386base,i386asm,
+{$else}
+      i386,
+{$endif}
+      cgai386,tgeni386,cg386ld;
+
+{*****************************************************************************
+                             SecondCallParaN
+*****************************************************************************}
+
+    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
+                push_from_left_to_right,inlined,dword_align : boolean;para_offset : longint);
+
+      procedure maybe_push_high;
+        begin
+           { open array ? }
+           { defcoll^.data can be nil for read/write }
+           if assigned(defcoll^.data) and
+              push_high_param(defcoll^.data) then
+             begin
+               if assigned(p^.hightree) then
+                begin
+                  secondpass(p^.hightree);
+                  { this is a longint anyway ! }
+                  push_value_para(p^.hightree,inlined,para_offset,4);
+                end
+               else
+                internalerror(432645);
+             end;
+        end;
+
+      var
+         otlabel,oflabel : plabel;
+         align : longint;
+         { temporary variables: }
+         tempdeftype : tdeftype;
+         r : preference;
+      begin
+         { push from left to right if specified }
+         if push_from_left_to_right and assigned(p^.right) then
+           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,
+             inlined,dword_align,para_offset);
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         secondpass(p^.left);
+         { filter array constructor with c styled args }
+         if is_array_constructor(p^.left^.resulttype) and p^.left^.cargs then
+           begin
+             { nothing, everything is already pushed }
+           end
+         { in codegen.handleread.. defcoll^.data is set to nil }
+         else if assigned(defcoll^.data) and
+           (defcoll^.data^.deftype=formaldef) then
+           begin
+              { allow @var }
+              inc(pushedparasize,4);
+              if p^.left^.treetype=addrn then
+                begin
+                { always a register }
+                  if inlined then
+                    begin
+                       r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
+                       exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                         p^.left^.location.register,r)));
+                    end
+                  else
+                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.left^.location.register)));
+                  ungetregister32(p^.left^.location.register);
+                end
+              else
+                begin
+                   if not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
+                     CGMessage(type_e_mismatch)
+                   else
+                     begin
+                       if inlined then
+                         begin
+                           exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+                             newreference(p^.left^.location.reference),R_EDI)));
+                           r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
+                           exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                         end
+                      else
+                        emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                        del_reference(p^.left^.location.reference);
+                     end;
+                end;
+           end
+         { handle call by reference parameter }
+         else if (defcoll^.paratyp=vs_var) then
+           begin
+              if (p^.left^.location.loc<>LOC_REFERENCE) then
+                CGMessage(cg_e_var_must_be_reference);
+              maybe_push_high;
+              inc(pushedparasize,4);
+              if inlined then
+                begin
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+                     newreference(p^.left^.location.reference),R_EDI)));
+                   r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
+                end
+              else
+                emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+              del_reference(p^.left^.location.reference);
+           end
+         else
+           begin
+              tempdeftype:=p^.resulttype^.deftype;
+              if tempdeftype=filedef then
+               CGMessage(cg_e_file_must_call_by_reference);
+              if push_addr_param(p^.resulttype) then
+                begin
+                   maybe_push_high;
+                   inc(pushedparasize,4);
+                   if inlined then
+                     begin
+                        exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+                          newreference(p^.left^.location.reference),R_EDI)));
+                        r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
+                        exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                          R_EDI,r)));
+                     end
+                   else
+                     emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                   del_reference(p^.left^.location.reference);
+                end
+              else
+                begin
+                   align:=target_os.stackalignment;
+                   if dword_align then
+                     align:=4;
+                   push_value_para(p^.left,inlined,para_offset,align);
+                end;
+           end;
+         freelabel(truelabel);
+         freelabel(falselabel);
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+         { push from right to left }
+         if not push_from_left_to_right and assigned(p^.right) then
+           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right,
+             inlined,dword_align,para_offset);
+      end;
+
+
+{*****************************************************************************
+                             SecondCallN
+*****************************************************************************}
+
+    procedure secondcalln(var p : ptree);
+      var
+         unusedregisters : tregisterset;
+         pushed : tpushed;
+         hr,funcretref : treference;
+         hregister,hregister2 : tregister;
+         oldpushedparasize : longint;
+         { true if ESI must be loaded again after the subroutine }
+         loadesi : boolean;
+         { true if a virtual method must be called directly }
+         no_virtual_call : boolean;
+         { true if we produce a con- or destrutor in a call }
+         is_con_or_destructor : boolean;
+         { true if a constructor is called again }
+         extended_new : boolean;
+         { adress returned from an I/O-error }
+         iolabel : plabel;
+         { lexlevel count }
+         i : longint;
+         { help reference pointer }
+         r : preference;
+         hp,
+         pp,params : ptree;
+         inlined : boolean;
+         inlinecode : ptree;
+         para_offset : longint;
+         { instruction for alignement correction }
+{         corr : pai386;}
+         { we must pop this size also after !! }
+{         must_pop : boolean; }
+         pop_size : longint;
+
+      label
+         dont_call;
+
+      begin
+         reset_reference(p^.location.reference);
+         extended_new:=false;
+         iolabel:=nil;
+         inlinecode:=nil;
+         inlined:=false;
+         loadesi:=true;
+         no_virtual_call:=false;
+         unusedregisters:=unused;
+
+         if not assigned(p^.procdefinition) then
+          exit;
+         if (p^.procdefinition^.options and poinline)<>0 then
+           begin
+              inlined:=true;
+              inlinecode:=p^.right;
+              { set it to the same lexical level as the local symtable, becuase
+                the para's are stored there }
+              pprocdef(p^.procdefinition)^.parast^.symtablelevel:=aktprocsym^.definition^.localst^.symtablelevel;
+              if assigned(p^.left) then
+                inlinecode^.para_offset:=gettempofsizepersistant(inlinecode^.para_size);
+              pprocdef(p^.procdefinition)^.parast^.address_fixup:=inlinecode^.para_offset;
+{$ifdef extdebug}
+             Comment(V_debug,
+               'inlined parasymtable is at offset '
+               +tostr(pprocdef(p^.procdefinition)^.parast^.address_fixup));
+             exprasmlist^.concat(new(pai_asm_comment,init(
+               strpnew('inlined parasymtable is at offset '
+               +tostr(pprocdef(p^.procdefinition)^.parast^.address_fixup)))));
+{$endif extdebug}
+              p^.right:=nil;
+              { disable further inlining of the same proc
+                in the args }
+              p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
+           end;
+         { only if no proc var }
+         if not(assigned(p^.right)) then
+           is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
+             or ((p^.procdefinition^.options and podestructor)<>0);
+         { proc variables destroy all registers }
+         if (p^.right=nil) and
+            { virtual methods too }
+            ((p^.procdefinition^.options and povirtualmethod)=0) then
+           begin
+              if ((p^.procdefinition^.options and poiocheck)<>0) and
+                 ((aktprocsym^.definition^.options and poiocheck)=0) and
+                 (cs_check_io in aktlocalswitches) then
+                begin
+                   getlabel(iolabel);
+                   emitlab(iolabel);
+                end
+              else
+                iolabel:=nil;
+
+              { save all used registers }
+              pushusedregisters(exprasmlist,pushed,pprocdef(p^.procdefinition)^.usedregisters);
+
+              { give used registers through }
+              usedinproc:=usedinproc or pprocdef(p^.procdefinition)^.usedregisters;
+           end
+         else
+           begin
+              pushusedregisters(exprasmlist,pushed,$ff);
+              usedinproc:=$ff;
+              { no IO check for methods and procedure variables }
+              iolabel:=nil;
+           end;
+
+         { generate the code for the parameter and push them }
+         oldpushedparasize:=pushedparasize;
+         pushedparasize:=0;
+         pop_size:=0;
+         if (not inlined) then
+          begin
+          { Old pushedsize aligned on 4 ? }
+            i:=oldpushedparasize and 3;
+            if i>0 then
+             inc(pop_size,4-i);
+          { This parasize aligned on 4 ? }
+            i:=p^.procdefinition^.para_size and 3;
+            if i>0 then
+             inc(pop_size,4-i);
+          { insert the opcode and update pushedparasize }
+            if pop_size>0 then
+             begin
+               inc(pushedparasize,pop_size);
+               exprasmlist^.concat(new(pai386,op_const_reg(A_SUB,S_L,pop_size,R_ESP)));
+{$ifdef GDB}
+               if (cs_debuginfo in aktmoduleswitches) and
+                  (exprasmlist^.first=exprasmlist^.last) then
+                 exprasmlist^.concat(new(pai_force_line,init));
+{$endif GDB}
+             end;
+          end;
+
+         if (p^.resulttype<>pdef(voiddef)) and
+            ret_in_param(p^.resulttype) then
+           begin
+              funcretref.symbol:=nil;
+{$ifdef test_dest_loc}
+              if dest_loc_known and (dest_loc_tree=p) and
+                 (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
+                begin
+                   funcretref:=dest_loc.reference;
+                   if assigned(dest_loc.reference.symbol) then
+                     funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
+                   in_dest_loc:=true;
+                end
+              else
+{$endif test_dest_loc}
+                if inlined then
+                  begin
+                     reset_reference(funcretref);
+                     funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
+                     funcretref.base:=procinfo.framepointer;
+                  end
+                else
+                  gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
+           end;
+         if assigned(p^.left) then
+           begin
+              { be found elsewhere }
+              if inlined then
+                para_offset:=pprocdef(p^.procdefinition)^.parast^.address_fixup+
+                  pprocdef(p^.procdefinition)^.parast^.datasize
+              else
+                para_offset:=0;
+              if assigned(p^.right) then
+                secondcallparan(p^.left,pabstractprocdef(p^.right^.resulttype)^.para1,
+                  (p^.procdefinition^.options and poleftright)<>0,
+                  inlined,(p^.procdefinition^.options and (pocdecl or postdcall))<>0,para_offset)
+              else
+                secondcallparan(p^.left,p^.procdefinition^.para1,
+                  (p^.procdefinition^.options and poleftright)<>0,
+                  inlined,(p^.procdefinition^.options and (pocdecl or postdcall))<>0,para_offset);
+           end;
+         params:=p^.left;
+         p^.left:=nil;
+         if inlined then
+           inlinecode^.retoffset:=gettempofsizepersistant(4);
+         if ret_in_param(p^.resulttype) then
+           begin
+              inc(pushedparasize,4);
+              if inlined then
+                begin
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+                     newreference(funcretref),R_EDI)));
+                   r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                     R_EDI,r)));
+                end
+              else
+                emitpushreferenceaddr(exprasmlist,funcretref);
+           end;
+         { procedure variable ? }
+         if (p^.right=nil) then
+           begin
+              { overloaded operator have no symtable }
+              { push self }
+              if assigned(p^.symtable) and
+                (p^.symtable^.symtabletype=withsymtable) then
+                begin
+                   { dirty trick to avoid the secondcall below }
+                   p^.methodpointer:=genzeronode(callparan);
+                   p^.methodpointer^.location.loc:=LOC_REGISTER;
+                   p^.methodpointer^.location.register:=R_ESI;
+                   { ARGHHH this is wrong !!!
+                     if we can init from base class for a child
+                     class that the wrong VMT will be
+                     transfered to constructor !! }
+                   p^.methodpointer^.resulttype:=
+                     ptree(pwithsymtable(p^.symtable)^.withnode)^.left^.resulttype;
+                   { change dispose type !! }
+                   p^.disposetyp:=dt_mbleft_and_method;
+                   { make a reference }
+                   new(r);
+                   reset_reference(r^);
+                   { if assigned(ptree(pwithsymtable(p^.symtable)^.withnode)^.pref) then
+                     begin
+                        r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.pref^;
+                     end
+                   else
+                     begin
+                        r^.offset:=p^.symtable^.datasize;
+                        r^.base:=procinfo.framepointer;
+                     end; }
+                   r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^;
+                   if (not pwithsymtable(p^.symtable)^.direct_with) or
+                      pobjectdef(p^.methodpointer^.resulttype)^.isclass then
+                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)))
+                   else
+                     exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_ESI)));
+                end;
+
+              { push self }
+              if assigned(p^.symtable) and
+                ((p^.symtable^.symtabletype=objectsymtable) or
+                (p^.symtable^.symtabletype=withsymtable)) then
+                begin
+                   if assigned(p^.methodpointer) then
+                     begin
+                        {
+                        if p^.methodpointer^.resulttype=classrefdef then
+                          begin
+                              two possibilities:
+                               1. constructor
+                               2. class method
+
+                          end
+                        else }
+                          begin
+                             case p^.methodpointer^.treetype of
+                               typen:
+                                 begin
+                                    { direct call to inherited method }
+                                    if (p^.procdefinition^.options and poabstractmethod)<>0 then
+                                      begin
+                                         CGMessage(cg_e_cant_call_abstract_method);
+                                         goto dont_call;
+                                      end;
+                                    { generate no virtual call }
+                                    no_virtual_call:=true;
+
+                                    if (p^.symtableprocentry^.properties and sp_static)<>0 then
+                                      begin
+                                         { well lets put the VMT address directly into ESI }
+                                         { it is kind of dirty but that is the simplest    }
+                                         { way to accept virtual static functions (PM)     }
+                                         loadesi:=true;
+                                         { if no VMT just use $0 bug0214 PM }
+                                         if (pobjectdef(p^.methodpointer^.resulttype)^.options and oo_hasvmt)=0 then
+                                           exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,0,R_ESI)))
+                                         else
+                                           begin
+                                             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 !! }
+                                      end
+                                    else
+                                      { this is a member call, so ESI isn't modfied }
+                                      loadesi:=false;
+
+                                    { a class destructor needs a flag }
+                                    if pobjectdef(p^.methodpointer^.resulttype)^.isclass and
+                                        assigned(aktprocsym) and
+                                        ((aktprocsym^.definition^.options and
+                                        (podestructor))<>0) then
+                                        begin
+                                           push_int(0);
+                                           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+                                        end;
+
+                                    if not(is_con_or_destructor and
+                                           pobjectdef(p^.methodpointer^.resulttype)^.isclass and
+                                           assigned(aktprocsym) and
+                                           ((aktprocsym^.definition^.options and (poconstructor or podestructor))<>0)
+                                          ) then
+                                      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                                  }
+                                    { con- and destructors need a pointer to the vmt }
+                                    if is_con_or_destructor and
+                                    not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
+                                    assigned(aktprocsym) then
+                                      begin
+                                         if not ((aktprocsym^.definition^.options
+                                           and (poconstructor or podestructor))<>0) then
+
+                                          CGMessage(cg_w_member_cd_call_from_method);
+                                      end;
+                                    { class destructors get there flag below }
+                                    if is_con_or_destructor and
+                                        not(pobjectdef(p^.methodpointer^.resulttype)^.isclass and
+                                        assigned(aktprocsym) and
+                                        ((aktprocsym^.definition^.options and
+                                        (podestructor))<>0)) then
+                                      push_int(0);
+                                 end;
+                               hnewn:
+                                 begin
+                                    { extended syntax of new }
+                                    { ESI must be zero }
+                                    exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
+                                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+                                    { 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:
+                                 begin
+                                    secondpass(p^.methodpointer);
+
+                                    { destructor with extended syntax called from dispose }
+                                    { 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
+                                    { call to an instance member }
+                                    if (p^.symtable^.symtabletype<>withsymtable) then
+                                      begin
+                                         secondpass(p^.methodpointer);
+                                         case p^.methodpointer^.location.loc of
+                                            LOC_CREGISTER,
+                                            LOC_REGISTER:
+                                              begin
+                                                 emit_reg_reg(A_MOV,S_L,p^.methodpointer^.location.register,R_ESI);
+                                                 ungetregister32(p^.methodpointer^.location.register);
+                                              end;
+                                            else
+                                              begin
+                                                 if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
+                                                    ((p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                                   pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                                     newreference(p^.methodpointer^.location.reference),R_ESI)))
+                                                 else
+                                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+                                                     newreference(p^.methodpointer^.location.reference),R_ESI)));
+                                                 del_reference(p^.methodpointer^.location.reference);
+                                              end;
+                                         end;
+                                      end;
+                                    { when calling a class method, we have to load ESI with the VMT !
+                                      But, not for a class method via self }
+                                    if ((p^.procdefinition^.options and pocontainsself)=0) then
+                                      begin
+                                        if ((p^.procdefinition^.options and poclassmethod)<>0)
+                                           and not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
+                                          begin
+                                             { class method needs current VMT }
+                                             new(r);
+                                             reset_reference(r^);
+                                             r^.base:=R_ESI;
+                                             r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
+                                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
+                                          end;
+
+                                        { direct call to destructor: don't remove data! }
+                                        if ((p^.procdefinition^.options and podestructor)<>0) and
+                                          (p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                          (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                          exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,1)));
+
+                                        { direct call to class constructor, don't allocate memory }
+                                        if ((p^.procdefinition^.options and poconstructor)<>0) and
+                                          (p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                          (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                          exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
+                                        else
+                                          exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+                                      end;
+
+                                    if is_con_or_destructor then
+                                      begin
+                                         { classes don't get a VMT pointer pushed }
+                                         if (p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                           not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                           begin
+                                              if ((p^.procdefinition^.options and poconstructor)<>0) then
+                                                begin
+                                                   { 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                                           }
+                                              else
+                                                push_int(0);
+                                           end;
+                                      end;
+                                 end;
+                             end;
+                          end;
+                     end
+                   else
+                     begin
+                        if ((p^.procdefinition^.options and poclassmethod)<>0) and
+                          not(
+                            assigned(aktprocsym) and
+                            ((aktprocsym^.definition^.options and poclassmethod)<>0)
+                          ) then
+                          begin
+                             { class method needs current VMT }
+                             new(r);
+                             reset_reference(r^);
+                             r^.base:=R_ESI;
+                             r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
+                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
+                          end
+                        else
+                          begin
+                             { member call, ESI isn't modified }
+                             loadesi:=false;
+                          end;
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+                        { but a con- or destructor here would probably almost }
+                        { always be placed wrong }
+                        if is_con_or_destructor then
+                          begin
+                             CGMessage(cg_w_member_cd_call_from_method);
+                             push_int(0);
+                          end;
+                     end;
+                end;
+
+              { push base pointer ?}
+              if (lexlevel>=normal_function_level) and assigned(pprocdef(p^.procdefinition)^.parast) and
+                ((pprocdef(p^.procdefinition)^.parast^.symtablelevel)>normal_function_level) then
+                begin
+                   { if we call a nested function in a method, we must      }
+                   { push also SELF!                                        }
+                   { THAT'S NOT TRUE, we have to load ESI via frame pointer }
+                   { access                                                 }
+                   {
+                     begin
+                        loadesi:=false;
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+                     end;
+                   }
+                   if lexlevel=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
+                     begin
+                        new(r);
+                        reset_reference(r^);
+                        r^.offset:=procinfo.framepointer_offset;
+                        r^.base:=procinfo.framepointer;
+                        exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,r)))
+                     end
+                     { this is only true if the difference is one !!
+                       but it cannot be more !! }
+                   else if (lexlevel=pprocdef(p^.procdefinition)^.parast^.symtablelevel-1) then
+                     begin
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,procinfo.framepointer)))
+                     end
+                   else if (lexlevel>pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
+                     begin
+                        hregister:=getregister32;
+                        new(r);
+                        reset_reference(r^);
+                        r^.offset:=procinfo.framepointer_offset;
+                        r^.base:=procinfo.framepointer;
+                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
+                        for i:=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
+                          begin
+                             new(r);
+                             reset_reference(r^);
+                             {we should get the correct frame_pointer_offset at each level
+                             how can we do this !!! }
+                             r^.offset:=procinfo.framepointer_offset;
+                             r^.base:=hregister;
+                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,hregister)));
+                          end;
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,hregister)));
+                        ungetregister32(hregister);
+                     end
+                   else
+                     internalerror(25000);
+                end;
+
+              if ((p^.procdefinition^.options and povirtualmethod)<>0) and
+                 not(no_virtual_call) then
+                begin
+                   { static functions contain the vmt_address in ESI }
+                   { also class methods                              }
+                   { Here it is quite tricky because it also depends }
+                   { on the methodpointer                         PM }
+                   if assigned(aktprocsym) then
+                     begin
+                       if ((((aktprocsym^.properties and sp_static)<>0) or
+                        ((aktprocsym^.definition^.options and poclassmethod)<>0)) and
+                        ((p^.methodpointer=nil) or (p^.methodpointer^.treetype=typen)))
+                        or
+                        ((p^.procdefinition^.options and postaticmethod)<>0) or
+                        ((p^.procdefinition^.options and poconstructor)<>0) or
+                        { ESI is loaded earlier }
+                        ((p^.procdefinition^.options and poclassmethod)<>0)then
+                         begin
+                            new(r);
+                            reset_reference(r^);
+                            r^.base:=R_ESI;
+                         end
+                       else
+                         begin
+                            new(r);
+                            reset_reference(r^);
+                            r^.base:=R_ESI;
+                            { this is one point where we need vmt_offset (PM) }
+                            r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
+                            exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
+                            new(r);
+                            reset_reference(r^);
+                            r^.base:=R_EDI;
+                         end;
+                     end
+                   else
+                     { aktprocsym should be assigned, also in main program }
+                     internalerror(12345);
+                   {
+                     begin
+                       new(r);
+                       reset_reference(r^);
+                       r^.base:=R_ESI;
+                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
+                       new(r);
+                       reset_reference(r^);
+                       r^.base:=R_EDI;
+                     end;
+                   }
+                   if pprocdef(p^.procdefinition)^.extnumber=-1 then
+                        internalerror($Da);
+                   r^.offset:=pprocdef(p^.procdefinition)^.extnumber*4+12;
+{$ifndef TESTOBJEXT}
+                   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);
+                     end;
+{$else TESTOBJEXT}
+                   if (cs_check_range in aktlocalswitches) then
+                     begin
+                        exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
+                          newasmsymbol(pprocdef(p^.procdefinition)^._class^.vmt_mangledname))));
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
+                        emitcall('FPC_CHECK_OBJECT_EXT',true);
+                     end;
+{$endif TESTOBJEXT}
+                   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)))
+              else { inlined proc }
+                { inlined code is in inlinecode }
+                begin
+                   { set poinline again }
+                   p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
+                   { process the inlinecode }
+                   secondpass(inlinecode);
+                   { free the args }
+                   ungetpersistanttemp(pprocdef(p^.procdefinition)^.parast^.address_fixup);
+                end;
+           end
+         else
+           { now procedure variable case }
+           begin
+              secondpass(p^.right);
+              { method pointer ? }
+              if (p^.procdefinition^.options and pomethodpointer)<>0 then
+                begin
+                   { method pointer can't be in a register }
+                   hregister:=R_NO;
+
+                   { do some hacking if we call a method pointer }
+                   { 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
+                        del_reference(p^.right^.location.reference);
+                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                          newreference(p^.right^.location.reference),R_EDI)));
+                        hregister:=R_EDI;
+                     end;
+
+
+                   if ((p^.procdefinition^.options and pocontainsself)=0) then
+                     begin
+                       { load ESI }
+                       inc(p^.right^.location.reference.offset,4);
+                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                         newreference(p^.right^.location.reference),R_ESI)));
+                       dec(p^.right^.location.reference.offset,4);
+                       { push self pointer }
+                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+                     end;
+
+                   if hregister=R_NO then
+                     exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))))
+                   else
+                     exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,hregister)));
+
+                   del_reference(p^.right^.location.reference);
+                end
+              else
+                begin
+                   case p^.right^.location.loc of
+                      LOC_REGISTER,LOC_CREGISTER:
+                         begin
+                             exprasmlist^.concat(new(pai386,op_reg(A_CALL,S_NO,p^.right^.location.register)));
+                             ungetregister32(p^.right^.location.register);
+                         end
+                      else
+                         exprasmlist^.concat(new(pai386,op_ref(A_CALL,S_NO,newreference(p^.right^.location.reference))));
+                         del_reference(p^.right^.location.reference);
+                   end;
+                end;
+           end;
+
+           { this was only for normal functions
+             displaced here so we also get
+             it to work for procvars PM }
+           if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
+             begin
+                { consider the alignment with the rest (PM) }
+                inc(pushedparasize,pop_size);
+                pop_size:=0;
+                { better than an add on all processors }
+                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!              }
+                else if (pushedparasize=8) and
+                  not(cs_littlesize in aktglobalswitches) and
+                  (aktoptprocessor=ClassP5) and
+                  (procinfo._class=nil) then
+                    begin
+                       exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
+                       exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ESI)));
+                    end
+                else if pushedparasize<>0 then
+                  exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,pushedparasize,R_ESP)));
+             end;
+      dont_call:
+         pushedparasize:=oldpushedparasize;
+         unused:=unusedregisters;
+
+         { handle function results }
+         { structured results are easy to handle.... }
+         { needed also when result_no_used !! }
+         if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
+           begin
+              p^.location.loc:=LOC_MEM;
+              p^.location.reference.symbol:=nil;
+              p^.location.reference:=funcretref;
+           end;
+         { 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
+           begin
+              { a contructor could be a function with boolean result }
+              if (p^.right=nil) and
+                 ((p^.procdefinition^.options and poconstructor)<>0) and
+                 { quick'n'dirty check if it is a class or an object }
+                 (p^.resulttype^.deftype=orddef) then
+                begin
+                   p^.location.loc:=LOC_FLAGS;
+                   p^.location.resflags:=F_NE;
+                   if extended_new then
+                     begin
+{$ifdef test_dest_loc}
+                        if dest_loc_known and (dest_loc_tree=p) then
+                          mov_reg_to_dest(p,S_L,R_EAX)
+                        else
+{$endif test_dest_loc}
+                          begin
+                             hregister:=getexplicitregister32(R_EAX);
+                             emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
+                             p^.location.register:=hregister;
+                          end;
+                     end;
+                end
+               { structed results are easy to handle.... }
+              else if ret_in_param(p^.resulttype) then
+                begin
+                   {p^.location.loc:=LOC_MEM;
+                   stringdispose(p^.location.reference.symbol);
+                   p^.location.reference:=funcretref;
+                   already done above (PM) }
+                end
+              else
+                begin
+                   if (p^.resulttype^.deftype=orddef) then
+                     begin
+                        p^.location.loc:=LOC_REGISTER;
+                        case porddef(p^.resulttype)^.typ of
+                          s32bit,u32bit,bool32bit :
+                            begin
+{$ifdef test_dest_loc}
+                               if dest_loc_known and (dest_loc_tree=p) then
+                                 mov_reg_to_dest(p,S_L,R_EAX)
+                               else
+{$endif test_dest_loc}
+                                 begin
+                                    hregister:=getexplicitregister32(R_EAX);
+                                    emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
+                                    p^.location.register:=hregister;
+                                 end;
+                            end;
+                          uchar,u8bit,bool8bit,s8bit:
+                            begin
+{$ifdef test_dest_loc}
+                                 if dest_loc_known and (dest_loc_tree=p) then
+                                   mov_reg_to_dest(p,S_B,R_AL)
+                                 else
+{$endif test_dest_loc}
+                                   begin
+                                      hregister:=getexplicitregister32(R_EAX);
+                                      emit_reg_reg(A_MOV,S_B,R_AL,reg32toreg8(hregister));
+                                      p^.location.register:=reg32toreg8(hregister);
+                                   end;
+                              end;
+                          s16bit,u16bit,bool16bit :
+                            begin
+{$ifdef test_dest_loc}
+                               if dest_loc_known and (dest_loc_tree=p) then
+                                 mov_reg_to_dest(p,S_W,R_AX)
+                               else
+{$endif test_dest_loc}
+                                 begin
+                                    hregister:=getexplicitregister32(R_EAX);
+                                    emit_reg_reg(A_MOV,S_W,R_AX,reg32toreg16(hregister));
+                                    p^.location.register:=reg32toreg16(hregister);
+                                 end;
+                            end;
+                           s64bitint,u64bit:
+                             begin
+{$ifdef test_dest_loc}
+{$error Don't know what to do here}
+{$endif test_dest_loc}
+                                hregister:=getexplicitregister32(R_EAX);
+                                hregister2:=getexplicitregister32(R_EDX);
+                                emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
+                                emit_reg_reg(A_MOV,S_L,R_EDX,hregister2);
+                                p^.location.registerlow:=hregister;
+                                p^.location.registerhigh:=hregister2;
+                             end;
+                        else internalerror(7);
+                     end
+
+                end
+              else if (p^.resulttype^.deftype=floatdef) then
+                case pfloatdef(p^.resulttype)^.typ of
+                  f32bit:
+                    begin
+                       p^.location.loc:=LOC_REGISTER;
+{$ifdef test_dest_loc}
+                       if dest_loc_known and (dest_loc_tree=p) then
+                         mov_reg_to_dest(p,S_L,R_EAX)
+                       else
+{$endif test_dest_loc}
+                         begin
+                            hregister:=getexplicitregister32(R_EAX);
+                            emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
+                            p^.location.register:=hregister;
+                         end;
+                    end;
+                  else
+                    p^.location.loc:=LOC_FPU;
+                end
+              else if is_ansistring(p^.resulttype) or
+                is_widestring(p^.resulttype) then
+                begin
+                   gettempansistringreference(hr);
+                   { cleanup the temp slot }
+                   exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
+                   decrstringref(exprasmlist,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,
+                     newreference(hr))));
+                   p^.location.loc:=LOC_MEM;
+                   p^.location.reference:=hr;
+                end
+              else
+                begin
+                   p^.location.loc:=LOC_REGISTER;
+{$ifdef test_dest_loc}
+                   if dest_loc_known and (dest_loc_tree=p) then
+                     mov_reg_to_dest(p,S_L,R_EAX)
+                   else
+{$endif test_dest_loc}
+                    begin
+                       hregister:=getexplicitregister32(R_EAX);
+                       emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
+                       p^.location.register:=hregister;
+                    end;
+                end;
+             end;
+           end;
+
+         { 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);
+           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);
+
+         { at last, restore instance pointer (SELF) }
+         if loadesi then
+           maybe_loadesi;
+         pp:=params;
+         while assigned(pp) do
+           begin
+              if assigned(pp^.left) then
+                begin
+                  if (pp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) and
+                     ungettempoftype(pp^.left^.resulttype) then
+                    ungetiftemp(pp^.left^.location.reference);
+                { process also all nodes of an array of const }
+                  if pp^.left^.treetype=arrayconstructn then
+                    begin
+                      if assigned(pp^.left^.left) then
+                       begin
+                         hp:=pp^.left;
+                         while assigned(hp) do
+                          begin
+                            if (hp^.left^.location.loc in [LOC_REFERENCE,LOC_MEM]) and
+                               ungettempoftype(hp^.left^.resulttype) then
+                              ungetiftemp(hp^.left^.location.reference);
+                            hp:=hp^.right;
+                          end;
+                       end;
+                    end;
+                end;
+              pp:=pp^.right;
+           end;
+         if inlined then
+           ungetpersistanttemp(inlinecode^.retoffset);
+         disposetree(params);
+
+
+         { from now on the result can be freed normally }
+         if inlined and ret_in_param(p^.resulttype) then
+           persistanttemptonormal(funcretref.offset);
+
+         { if return value is not used }
+         if (not p^.return_value_used) and (p^.resulttype<>pdef(voiddef)) then
+           begin
+              if p^.location.loc in [LOC_MEM,LOC_REFERENCE] then
+                begin
+                   { data which must be finalized ? }
+                   if (p^.resulttype^.needs_inittable) and
+                     ( (p^.resulttype^.deftype<>objectdef) or
+                       not(pobjectdef(p^.resulttype)^.isclass)) then
+                      finalize(exprasmlist,p^.resulttype,p^.location.reference);
+                   { release unused temp }
+                   ungetiftemp(p^.location.reference)
+                end
+              else if p^.location.loc=LOC_FPU then
+                { release FPU stack }
+                exprasmlist^.concat(new(pai386,op_reg(A_FSTP,S_NO,R_ST0)));
+           end;
+      end;
+
+
+{*****************************************************************************
+                             SecondProcInlineN
+*****************************************************************************}
+
+
+    procedure secondprocinline(var p : ptree);
+       var st : psymtable;
+           oldprocsym : pprocsym;
+           para_size : longint;
+           oldprocinfo : tprocinfo;
+           { just dummies for genentrycode }
+           nostackframe,make_global : boolean;
+           proc_names : tstringcontainer;
+           inlineentrycode,inlineexitcode : paasmoutput;
+           oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
+       begin
+          oldexitlabel:=aktexitlabel;
+          oldexit2label:=aktexit2label;
+          oldquickexitlabel:=quickexitlabel;
+          getlabel(aktexitlabel);
+          getlabel(aktexit2label);
+          oldprocsym:=aktprocsym;
+          oldprocinfo:=procinfo;
+          { set the return value }
+          aktprocsym:=p^.inlineprocsym;
+          procinfo.retdef:=aktprocsym^.definition^.retdef;
+          procinfo.retoffset:=p^.retoffset;
+          { arg space has been filled by the parent secondcall }
+          st:=aktprocsym^.definition^.localst;
+          { set it to the same lexical level }
+          st^.symtablelevel:=oldprocsym^.definition^.localst^.symtablelevel;
+          if st^.datasize>0 then
+            begin
+              st^.address_fixup:=gettempofsizepersistant(st^.datasize);
+{$ifdef extdebug}
+              Comment(V_debug,'local symtable is at offset '+tostr(st^.address_fixup));
+              exprasmlist^.concat(new(pai_asm_comment,init(strpnew(
+                'local symtable is at offset '+tostr(st^.address_fixup)))));
+{$endif extdebug}
+            end;
+{$ifdef extdebug}
+          exprasmlist^.concat(new(pai_asm_comment,init('Start of inlined proc')));
+{$endif extdebug}
+          { takes care of local data initialization }
+          inlineentrycode:=new(paasmoutput,init);
+          inlineexitcode:=new(paasmoutput,init);
+          proc_names.init;
+          para_size:=p^.para_size;
+          make_global:=false; { to avoid warning }
+          genentrycode(inlineentrycode,proc_names,make_global,0,para_size,nostackframe,true);
+          exprasmlist^.concatlist(inlineentrycode);
+          secondpass(p^.inlinetree);
+          genexitcode(inlineexitcode,0,false,true);
+          exprasmlist^.concatlist(inlineexitcode);
+{$ifdef extdebug}
+          exprasmlist^.concat(new(pai_asm_comment,init('End of inlined proc')));
+{$endif extdebug}
+          {we can free the local data now, reset also the fixup address }
+          if st^.datasize>0 then
+            begin
+              ungetpersistanttemp(st^.address_fixup);
+              st^.address_fixup:=0;
+            end;
+          aktprocsym:=oldprocsym;
+          freelabel(aktexitlabel);
+          freelabel(aktexit2label);
+          aktexitlabel:=oldexitlabel;
+          aktexit2label:=oldexit2label;
+          quickexitlabel:=oldquickexitlabel;
+          procinfo:=oldprocinfo;
+       end;
+
+
+
+end.
+{
   $Log$
-  Revision 1.85  1999-05-21 13:54:44  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.85  1999/05/21 13:54:44  peter
     * NEWLAB for label as symbol
-
-  Revision 1.84  1999/05/18 22:34:26  pierre
-   * extedebug problem solved
-
-  Revision 1.83  1999/05/18 21:58:24  florian
-    * fixed some bugs related to temp. ansistrings and functions results
-      which return records/objects/arrays which need init/final.
-
-  Revision 1.82  1999/05/18 14:15:23  peter
-    * containsself fixes
-    * checktypes()
-
-  Revision 1.81  1999/05/18 09:52:17  peter
-    * procedure of object and addrn fixes
-
-  Revision 1.80  1999/05/17 23:51:37  peter
-    * with temp vars now use a reference with a persistant temp instead
-      of setting datasize
-
-  Revision 1.79  1999/05/17 21:56:59  florian
-    * new temporary ansistring handling
-
-  Revision 1.78  1999/05/01 13:24:02  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.77  1999/04/29 22:12:21  pierre
-   * fix for ID 388 removing real from stack was wrong
-
-  Revision 1.76  1999/04/25 22:33:19  pierre
-   * fix for TESTOBJEXT code
-
-  Revision 1.75  1999/04/19 09:45:46  pierre
-    +  cdecl or stdcall push all args with longint size
-    *  tempansi stuff cleaned up
-
-  Revision 1.74  1999/04/16 13:42:23  jonas
-    * more regalloc fixes (still not complete)
-
-  Revision 1.73  1999/04/16 10:26:56  pierre
-   * no add $0,%esp for cdecl functions without parameters
-
-  Revision 1.72  1999/04/09 08:41:48  peter
-    * define to get ansistring returns in ref instead of reg
-
-  Revision 1.71  1999/03/31 13:55:04  peter
-    * assembler inlining working for ag386bin
-
-  Revision 1.70  1999/03/24 23:16:46  peter
-    * fixed bugs 212,222,225,227,229,231,233
-
-  Revision 1.69  1999/02/25 21:02:21  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.68  1999/02/22 02:15:04  peter
-    * updates for ag386bin
-
-  Revision 1.67  1999/02/11 09:46:21  pierre
-    * fix for normal method calls inside static methods :
-      WARNING there were both parser and codegen errors !!
-      added static_call boolean to calln tree
-
-  Revision 1.66  1999/02/09 15:45:46  florian
-    + complex results for assembler functions, fixes bug0155
-
-  Revision 1.65  1999/02/08 11:29:04  pierre
-   * fix for bug0214
-     several problems where combined
-     search_class_member did not set srsymtable
-     => in do_member_read the call node got a wrong symtable
-     in cg386cal the vmt was pushed twice without chacking if it exists
-     now %esi is set to zero and pushed if not vmt
-     (not very efficient but should work !)
-
-  Revision 1.64  1999/02/04 10:49:39  florian
-    + range checking for ansi- and widestrings
-    * made it compilable with TP
-
-  Revision 1.63  1999/02/03 10:18:14  pierre
-   * conditionnal code for extended check of virtual methods
-
-  Revision 1.62  1999/02/02 23:52:32  florian
-    * problem with calls to method pointers in methods fixed
-    - double ansistrings temp management removed
-
-  Revision 1.61  1999/02/02 11:04:36  florian
-    * class destructors fixed, class instances weren't disposed correctly
-
-  Revision 1.60  1999/01/28 23:56:44  florian
-    * the reference in the result location of a function call wasn't resetted =>
-      problem with unallowed far pointer, is solved now
-
-  Revision 1.59  1999/01/27 00:13:52  florian
-    * "procedure of object"-stuff fixed
-
-  Revision 1.58  1999/01/21 22:10:35  peter
-    * fixed array of const
-    * generic platform independent high() support
-
-  Revision 1.57  1999/01/21 16:40:51  pierre
-   * fix for constructor inside with statements
-
-  Revision 1.56  1998/12/30 13:41:05  peter
-    * released valuepara
-
-  Revision 1.55  1998/12/22 13:10:58  florian
-    * memory leaks for ansistring type casts fixed
-
-  Revision 1.54  1998/12/19 00:23:41  florian
-    * ansistring memory leaks fixed
-
-  Revision 1.53  1998/12/11 00:02:47  peter
-    + globtype,tokens,version unit splitted from globals
-
-  Revision 1.52  1998/12/10 14:39:29  florian
-    * bug with p(const a : ansistring) fixed
-    * duplicate constant ansistrings were handled wrong, fixed
-
-  Revision 1.51  1998/12/10 09:47:15  florian
-    + basic operations with int64/qord (compiler with -dint64)
-    + rtti of enumerations extended: names are now written
-
-  Revision 1.50  1998/12/06 13:12:44  florian
-    * better code generation for classes which are passed as parameters to
-      subroutines
-
-  Revision 1.49  1998/11/30 09:43:00  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.48  1998/11/27 14:50:30  peter
-    + open strings, $P switch support
-
-  Revision 1.47  1998/11/26 21:30:03  peter
-    * fix for valuepara
-
-  Revision 1.46  1998/11/26 14:39:10  peter
-    * ansistring -> pchar fixed
-    * ansistring constants fixed
-    * ansistring constants are now written once
-
-  Revision 1.45  1998/11/18 15:44:07  peter
-    * VALUEPARA for tp7 compatible value parameters
-
-  Revision 1.44  1998/11/16 15:35:36  peter
-    * rename laod/copystring -> load/copyshortstring
-    * fixed int-bool cnv bug
-    + char-ansistring conversion
-
-  Revision 1.43  1998/11/15 16:32:33  florian
-    * some stuff of Pavel implement (win32 dll creation)
-    * bug with ansistring function results fixed
-
-  Revision 1.42  1998/11/13 15:40:13  pierre
-    + added -Se in Makefile cvstest target
-    + lexlevel cleanup
-      normal_function_level main_program_level and unit_init_level defined
-    * tins_cache grown to A_EMMS (gave range check error in asm readers)
-      (test added in code !)
-    * -Un option was wrong
-    * _FAIL and _SELF only keyword inside
-      constructors and methods respectively
-
-  Revision 1.41  1998/11/12 11:19:40  pierre
-   * fix for first line of function break
-
-  Revision 1.40  1998/11/10 10:09:08  peter
-    * va_list -> array of const
-
-  Revision 1.39  1998/11/09 11:44:33  peter
-    + va_list for printf support
-
-  Revision 1.38  1998/10/21 15:12:49  pierre
-    * bug fix for IOCHECK inside a procedure with iocheck modifier
-    * removed the GPF for unexistant overloading
-      (firstcall was called with procedinition=nil !)
-    * changed typen to what Florian proposed
-      gentypenode(p : pdef) sets the typenodetype field
-      and resulttype is only set if inside bt_type block !
-
-  Revision 1.37  1998/10/21 08:39:57  florian
-    + ansistring operator +
-    + $h and string[n] for n>255 added
-    * small problem with TP fixed
-
-  Revision 1.36  1998/10/20 08:06:39  pierre
-    * several memory corruptions due to double freemem solved
-      => never use p^.loc.location:=p^.left^.loc.location;
-    + finally I added now by default
-      that ra386dir translates global and unit symbols
-    + added a first field in tsymtable and
-      a nextsym field in tsym
-      (this allows to obtain ordered type info for
-      records and objects in gdb !)
-
-  Revision 1.35  1998/10/16 08:51:45  peter
-    + target_os.stackalignment
-    + stack can be aligned at 2 or 4 byte boundaries
-
-  Revision 1.34  1998/10/09 08:56:22  pierre
-    * several memory leaks fixed
-
-  Revision 1.33  1998/10/06 17:16:39  pierre
-    * some memory leaks fixed (thanks to Peter for heaptrc !)
-
-  Revision 1.32  1998/10/01 09:22:52  peter
-    * fixed value openarray
-    * ungettemp of arrayconstruct
-
-  Revision 1.31  1998/09/28 16:57:15  pierre
-    * changed all length(p^.value_str^) into str_length(p)
-      to get it work with and without ansistrings
-    * changed sourcefiles field of tmodule to a pointer
-
-  Revision 1.30  1998/09/26 15:03:02  florian
-    * small problems with DOM and excpetions fixed (code generation
-      of raise was wrong and self was sometimes destroyed :()
-
-  Revision 1.29  1998/09/25 00:04:00  florian
-    * problems when calling class methods fixed
-
-  Revision 1.28  1998/09/24 14:27:37  peter
-    * some better support for openarray
-
-  Revision 1.27  1998/09/24 09:02:13  peter
-    * rewritten isconvertable to use case
-    * array of .. and single variable are compatible
-
-  Revision 1.26  1998/09/21 08:45:06  pierre
-    + added vmt_offset in tobjectdef.write for fututre use
-      (first steps to have objects without vmt if no virtual !!)
-    + added fpu_used field for tabstractprocdef  :
-      sets this level to 2 if the functions return with value in FPU
-      (is then set to correct value at parsing of implementation)
-      THIS MIGHT refuse some code with FPU expression too complex
-      that were accepted before and even in some cases
-      that don't overflow in fact
-      ( like if f : float; is a forward that finally in implementation
-       only uses one fpu register !!)
-      Nevertheless I think that it will improve security on
-      FPU operations !!
-    * most other changes only for UseBrowser code
-      (added symtable references for record and objects)
-      local switch for refs to args and local of each function
-      (static symtable still missing)
-      UseBrowser still not stable and probably broken by
-      the definition hash array !!
-
-  Revision 1.25  1998/09/20 12:26:35  peter
-    * merged fixes
-
-  Revision 1.24  1998/09/17 09:42:10  peter
-    + pass_2 for cg386
-    * Message() -> CGMessage() for pass_1/pass_2
-
-  Revision 1.23  1998/09/14 10:43:45  peter
-    * all internal RTL functions start with FPC_
-
-  Revision 1.22.2.1  1998/09/20 12:20:06  peter
-    * Fixed stack not on 4 byte boundary when doing a call
-
-  Revision 1.22  1998/09/04 08:41:37  peter
-    * updated some error CGMessages
-
-  Revision 1.21  1998/09/01 12:47:57  peter
-    * use pdef^.size instead of orddef^.typ
-
-  Revision 1.20  1998/08/31 12:22:15  peter
-    * secondinline moved to cg386inl
-
-  Revision 1.19  1998/08/31 08:52:03  peter
-    * fixed error 10 with succ() and pref()
-
-  Revision 1.18  1998/08/20 21:36:38  peter
-    * fixed 'with object do' bug
-
-  Revision 1.17  1998/08/19 16:07:36  jonas
-    * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
-
-  Revision 1.16  1998/08/18 09:24:36  pierre
-    * small warning position bug fixed
-    * support_mmx switches splitting was missing
-    * rhide error and warning output corrected
-
-  Revision 1.15  1998/08/13 11:00:09  peter
-    * fixed procedure<>procedure construct
-
-  Revision 1.14  1998/08/11 14:05:33  peter
-    * fixed sizeof(array of char)
-
-  Revision 1.13  1998/08/10 14:49:45  peter
-    + localswitches, moduleswitches, globalswitches splitting
-
-  Revision 1.12  1998/07/30 13:30:31  florian
-    * final implemenation of exception support, maybe it needs
-      some fixes :)
-
-  Revision 1.11  1998/07/24 22:16:52  florian
-    * internal error 10 together with array access fixed. I hope
-      that's the final fix.
-
-  Revision 1.10  1998/07/18 22:54:23  florian
-    * some ansi/wide/longstring support fixed:
-       o parameter passing
-       o returning as result from functions
-
-  Revision 1.9  1998/07/07 17:40:37  peter
-    * packrecords 4 works
-    * word aligning of parameters
-
-  Revision 1.8  1998/07/06 15:51:15  michael
-  Added length checking for string reading
-
-  Revision 1.7  1998/07/06 14:19:51  michael
-  + Added calls for reading/writing ansistrings
-
-  Revision 1.6  1998/07/01 15:28:48  peter
-    + better writeln/readln handling, now 100% like tp7
-
-  Revision 1.5  1998/06/25 14:04:17  peter
-    + internal inc/dec
-
-  Revision 1.4  1998/06/25 08:48:06  florian
-    * first version of rtti support
-
-  Revision 1.3  1998/06/09 16:01:33  pierre
-    + added procedure directive parsing for procvars
-      (accepted are popstack cdecl and pascal)
-    + added C vars with the following syntax
-      var C calias 'true_c_name';(can be followed by external)
-      reason is that you must add the Cprefix
-
-      which is target dependent
-
-  Revision 1.2  1998/06/08 13:13:29  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:10  peter
-    * splitted cgi386
-
-}
-
+
+  Revision 1.84  1999/05/18 22:34:26  pierre
+   * extedebug problem solved
+
+  Revision 1.83  1999/05/18 21:58:24  florian
+    * fixed some bugs related to temp. ansistrings and functions results
+      which return records/objects/arrays which need init/final.
+
+  Revision 1.82  1999/05/18 14:15:23  peter
+    * containsself fixes
+    * checktypes()
+
+  Revision 1.81  1999/05/18 09:52:17  peter
+    * procedure of object and addrn fixes
+
+  Revision 1.80  1999/05/17 23:51:37  peter
+    * with temp vars now use a reference with a persistant temp instead
+      of setting datasize
+
+  Revision 1.79  1999/05/17 21:56:59  florian
+    * new temporary ansistring handling
+
+  Revision 1.78  1999/05/01 13:24:02  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.77  1999/04/29 22:12:21  pierre
+   * fix for ID 388 removing real from stack was wrong
+
+  Revision 1.76  1999/04/25 22:33:19  pierre
+   * fix for TESTOBJEXT code
+
+  Revision 1.75  1999/04/19 09:45:46  pierre
+    +  cdecl or stdcall push all args with longint size
+    *  tempansi stuff cleaned up
+
+  Revision 1.74  1999/04/16 13:42:23  jonas
+    * more regalloc fixes (still not complete)
+
+  Revision 1.73  1999/04/16 10:26:56  pierre
+   * no add $0,%esp for cdecl functions without parameters
+
+  Revision 1.72  1999/04/09 08:41:48  peter
+    * define to get ansistring returns in ref instead of reg
+
+  Revision 1.71  1999/03/31 13:55:04  peter
+    * assembler inlining working for ag386bin
+
+  Revision 1.70  1999/03/24 23:16:46  peter
+    * fixed bugs 212,222,225,227,229,231,233
+
+  Revision 1.69  1999/02/25 21:02:21  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.68  1999/02/22 02:15:04  peter
+    * updates for ag386bin
+
+  Revision 1.67  1999/02/11 09:46:21  pierre
+    * fix for normal method calls inside static methods :
+      WARNING there were both parser and codegen errors !!
+      added static_call boolean to calln tree
+
+  Revision 1.66  1999/02/09 15:45:46  florian
+    + complex results for assembler functions, fixes bug0155
+
+  Revision 1.65  1999/02/08 11:29:04  pierre
+   * fix for bug0214
+     several problems where combined
+     search_class_member did not set srsymtable
+     => in do_member_read the call node got a wrong symtable
+     in cg386cal the vmt was pushed twice without chacking if it exists
+     now %esi is set to zero and pushed if not vmt
+     (not very efficient but should work !)
+
+  Revision 1.64  1999/02/04 10:49:39  florian
+    + range checking for ansi- and widestrings
+    * made it compilable with TP
+
+  Revision 1.63  1999/02/03 10:18:14  pierre
+   * conditionnal code for extended check of virtual methods
+
+  Revision 1.62  1999/02/02 23:52:32  florian
+    * problem with calls to method pointers in methods fixed
+    - double ansistrings temp management removed
+
+  Revision 1.61  1999/02/02 11:04:36  florian
+    * class destructors fixed, class instances weren't disposed correctly
+
+  Revision 1.60  1999/01/28 23:56:44  florian
+    * the reference in the result location of a function call wasn't resetted =>
+      problem with unallowed far pointer, is solved now
+
+  Revision 1.59  1999/01/27 00:13:52  florian
+    * "procedure of object"-stuff fixed
+
+  Revision 1.58  1999/01/21 22:10:35  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.57  1999/01/21 16:40:51  pierre
+   * fix for constructor inside with statements
+
+  Revision 1.56  1998/12/30 13:41:05  peter
+    * released valuepara
+
+  Revision 1.55  1998/12/22 13:10:58  florian
+    * memory leaks for ansistring type casts fixed
+
+  Revision 1.54  1998/12/19 00:23:41  florian
+    * ansistring memory leaks fixed
+
+  Revision 1.53  1998/12/11 00:02:47  peter
+    + globtype,tokens,version unit splitted from globals
+
+  Revision 1.52  1998/12/10 14:39:29  florian
+    * bug with p(const a : ansistring) fixed
+    * duplicate constant ansistrings were handled wrong, fixed
+
+  Revision 1.51  1998/12/10 09:47:15  florian
+    + basic operations with int64/qord (compiler with -dint64)
+    + rtti of enumerations extended: names are now written
+
+  Revision 1.50  1998/12/06 13:12:44  florian
+    * better code generation for classes which are passed as parameters to
+      subroutines
+
+  Revision 1.49  1998/11/30 09:43:00  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.48  1998/11/27 14:50:30  peter
+    + open strings, $P switch support
+
+  Revision 1.47  1998/11/26 21:30:03  peter
+    * fix for valuepara
+
+  Revision 1.46  1998/11/26 14:39:10  peter
+    * ansistring -> pchar fixed
+    * ansistring constants fixed
+    * ansistring constants are now written once
+
+  Revision 1.45  1998/11/18 15:44:07  peter
+    * VALUEPARA for tp7 compatible value parameters
+
+  Revision 1.44  1998/11/16 15:35:36  peter
+    * rename laod/copystring -> load/copyshortstring
+    * fixed int-bool cnv bug
+    + char-ansistring conversion
+
+  Revision 1.43  1998/11/15 16:32:33  florian
+    * some stuff of Pavel implement (win32 dll creation)
+    * bug with ansistring function results fixed
+
+  Revision 1.42  1998/11/13 15:40:13  pierre
+    + added -Se in Makefile cvstest target
+    + lexlevel cleanup
+      normal_function_level main_program_level and unit_init_level defined
+    * tins_cache grown to A_EMMS (gave range check error in asm readers)
+      (test added in code !)
+    * -Un option was wrong
+    * _FAIL and _SELF only keyword inside
+      constructors and methods respectively
+
+  Revision 1.41  1998/11/12 11:19:40  pierre
+   * fix for first line of function break
+
+  Revision 1.40  1998/11/10 10:09:08  peter
+    * va_list -> array of const
+
+  Revision 1.39  1998/11/09 11:44:33  peter
+    + va_list for printf support
+
+  Revision 1.38  1998/10/21 15:12:49  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.37  1998/10/21 08:39:57  florian
+    + ansistring operator +
+    + $h and string[n] for n>255 added
+    * small problem with TP fixed
+
+  Revision 1.36  1998/10/20 08:06:39  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.35  1998/10/16 08:51:45  peter
+    + target_os.stackalignment
+    + stack can be aligned at 2 or 4 byte boundaries
+
+  Revision 1.34  1998/10/09 08:56:22  pierre
+    * several memory leaks fixed
+
+  Revision 1.33  1998/10/06 17:16:39  pierre
+    * some memory leaks fixed (thanks to Peter for heaptrc !)
+
+  Revision 1.32  1998/10/01 09:22:52  peter
+    * fixed value openarray
+    * ungettemp of arrayconstruct
+
+  Revision 1.31  1998/09/28 16:57:15  pierre
+    * changed all length(p^.value_str^) into str_length(p)
+      to get it work with and without ansistrings
+    * changed sourcefiles field of tmodule to a pointer
+
+  Revision 1.30  1998/09/26 15:03:02  florian
+    * small problems with DOM and excpetions fixed (code generation
+      of raise was wrong and self was sometimes destroyed :()
+
+  Revision 1.29  1998/09/25 00:04:00  florian
+    * problems when calling class methods fixed
+
+  Revision 1.28  1998/09/24 14:27:37  peter
+    * some better support for openarray
+
+  Revision 1.27  1998/09/24 09:02:13  peter
+    * rewritten isconvertable to use case
+    * array of .. and single variable are compatible
+
+  Revision 1.26  1998/09/21 08:45:06  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.25  1998/09/20 12:26:35  peter
+    * merged fixes
+
+  Revision 1.24  1998/09/17 09:42:10  peter
+    + pass_2 for cg386
+    * Message() -> CGMessage() for pass_1/pass_2
+
+  Revision 1.23  1998/09/14 10:43:45  peter
+    * all internal RTL functions start with FPC_
+
+  Revision 1.22.2.1  1998/09/20 12:20:06  peter
+    * Fixed stack not on 4 byte boundary when doing a call
+
+  Revision 1.22  1998/09/04 08:41:37  peter
+    * updated some error CGMessages
+
+  Revision 1.21  1998/09/01 12:47:57  peter
+    * use pdef^.size instead of orddef^.typ
+
+  Revision 1.20  1998/08/31 12:22:15  peter
+    * secondinline moved to cg386inl
+
+  Revision 1.19  1998/08/31 08:52:03  peter
+    * fixed error 10 with succ() and pref()
+
+  Revision 1.18  1998/08/20 21:36:38  peter
+    * fixed 'with object do' bug
+
+  Revision 1.17  1998/08/19 16:07:36  jonas
+    * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
+
+  Revision 1.16  1998/08/18 09:24:36  pierre
+    * small warning position bug fixed
+    * support_mmx switches splitting was missing
+    * rhide error and warning output corrected
+
+  Revision 1.15  1998/08/13 11:00:09  peter
+    * fixed procedure<>procedure construct
+
+  Revision 1.14  1998/08/11 14:05:33  peter
+    * fixed sizeof(array of char)
+
+  Revision 1.13  1998/08/10 14:49:45  peter
+    + localswitches, moduleswitches, globalswitches splitting
+
+  Revision 1.12  1998/07/30 13:30:31  florian
+    * final implemenation of exception support, maybe it needs
+      some fixes :)
+
+  Revision 1.11  1998/07/24 22:16:52  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.10  1998/07/18 22:54:23  florian
+    * some ansi/wide/longstring support fixed:
+       o parameter passing
+       o returning as result from functions
+
+  Revision 1.9  1998/07/07 17:40:37  peter
+    * packrecords 4 works
+    * word aligning of parameters
+
+  Revision 1.8  1998/07/06 15:51:15  michael
+  Added length checking for string reading
+
+  Revision 1.7  1998/07/06 14:19:51  michael
+  + Added calls for reading/writing ansistrings
+
+  Revision 1.6  1998/07/01 15:28:48  peter
+    + better writeln/readln handling, now 100% like tp7
+
+  Revision 1.5  1998/06/25 14:04:17  peter
+    + internal inc/dec
+
+  Revision 1.4  1998/06/25 08:48:06  florian
+    * first version of rtti support
+
+  Revision 1.3  1998/06/09 16:01:33  pierre
+    + added procedure directive parsing for procvars
+      (accepted are popstack cdecl and pascal)
+    + added C vars with the following syntax
+      var C calias 'true_c_name';(can be followed by external)
+      reason is that you must add the Cprefix
+
+      which is target dependent
+
+  Revision 1.2  1998/06/08 13:13:29  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:10  peter
+    * splitted cgi386
+
+}
+

compiler/cg386inl.pas

@@ -1,1540 +1,1551 @@
-{
-    $Id$
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Generate i386 inline nodes
-
-    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 cg386inl;
-interface
-
-    uses
-      tree;
-
-    procedure secondinline(var p : ptree);
-
-
-implementation
-
-    uses
-      globtype,systems,
-      cobjects,verbose,globals,files,
-      symtable,aasm,types,
-      hcodegen,temp_gen,pass_1,pass_2,
-{$ifndef OLDASM}
-      i386base,i386asm,
-{$else}
-      i386,
-{$endif}
-      cgai386,tgeni386,cg386cal;
-
-
-{*****************************************************************************
-                                Helpers
-*****************************************************************************}
-
-    { reverts the parameter list }
-    var nb_para : integer;
-
-    function reversparameter(p : ptree) : ptree;
-
-       var
-         hp1,hp2 : ptree;
-
-      begin
-         hp1:=nil;
-         nb_para := 0;
-         while assigned(p) do
-           begin
-              { pull out }
-              hp2:=p;
-              p:=p^.right;
-              inc(nb_para);
-              { pull in }
-              hp2^.right:=hp1;
-              hp1:=hp2;
-           end;
-         reversparameter:=hp1;
-       end;
-
-
-{*****************************************************************************
-                             SecondInLine
-*****************************************************************************}
-
-    procedure StoreDirectFuncResult(dest:ptree);
-      var
-        hp : ptree;
-        hdef : porddef;
-        hreg : tregister;
-        oldregisterdef : boolean;
-      begin
-        SecondPass(dest);
-        if Codegenerror then
-         exit;
-        Case dest^.resulttype^.deftype of
-          floatdef:
-            floatstore(PFloatDef(dest^.resulttype)^.typ,dest^.location.reference);
-          orddef:
-            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;
-          else
-            internalerror(66766766);
-        end;
-      end;
-
-
-    procedure secondinline(var p : ptree);
-       const
-         {tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
-{         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);
-       var
-         aktfile : treference;
-         ft : tfiletype;
-         opsize : topsize;
-         op,
-         asmop : tasmop;
-         pushed : tpushed;
-         {inc/dec}
-         addconstant : boolean;
-         addvalue : longint;
-
-
-      procedure handlereadwrite(doread,doln : boolean);
-      { produces code for READ(LN) and WRITE(LN) }
-
-        procedure loadstream;
-          const
-            io:array[boolean] of string[7]=('_OUTPUT','_INPUT');
-          var
-            r : preference;
-          begin
-            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;
-
-        const
-           rdwrprefix:array[boolean] of string[15]=('FPC_WRITE_TEXT_','FPC_READ_TEXT_');
-        var
-           destpara,
-           node,hp    : ptree;
-           typedtyp,
-           pararesult : pdef;
-           orgfloattype : tfloattype;
-           has_length : boolean;
-           dummycoll  : tdefcoll;
-           iolabel    : plabel;
-           npara      : longint;
-        begin
-           { I/O check }
-           if (cs_check_io in aktlocalswitches) and
-              ((aktprocsym^.definition^.options and poiocheck)=0) then
-             begin
-                getlabel(iolabel);
-                emitlab(iolabel);
-             end
-           else
-             iolabel:=nil;
-           { for write of real with the length specified }
-           has_length:=false;
-           hp:=nil;
-           { reserve temporary pointer to data variable }
-           aktfile.symbol:=nil;
-           gettempofsizereference(4,aktfile);
-           { first state text data }
-           ft:=ft_text;
-           { and state a parameter ? }
-           if p^.left=nil then
-             begin
-                { the following instructions are for "writeln;" }
-                loadstream;
-                { save @aktfile in temporary variable }
-                exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
-             end
-           else
-             begin
-                { revers paramters }
-                node:=reversparameter(p^.left);
-
-                p^.left := node;
-                npara := nb_para;
-                { calculate data variable }
-                { is first parameter a file type ? }
-                if node^.left^.resulttype^.deftype=filedef then
-                  begin
-                     ft:=pfiledef(node^.left^.resulttype)^.filetype;
-                     if ft=ft_typed then
-                       typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
-                     secondpass(node^.left);
-                     if codegenerror then
-                       exit;
-
-                     { save reference in temporary variables }
-                     if node^.left^.location.loc<>LOC_REFERENCE then
-                       begin
-                          CGMessage(cg_e_illegal_expression);
-                          exit;
-                       end;
-
-                     exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_EDI)));
-
-                     { skip to the next parameter }
-                     node:=node^.right;
-                  end
-                else
-                  begin
-                  { load stdin/stdout stream }
-                     loadstream;
-                  end;
-
-                { save @aktfile in temporary variable }
-                exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
-                if doread then
-                { parameter by READ gives call by reference }
-                  dummycoll.paratyp:=vs_var
-                { an WRITE Call by "Const" }
-                else
-                  dummycoll.paratyp:=vs_const;
-
-                { because of secondcallparan, which otherwise attaches }
-                if ft=ft_typed then
-                  { this is to avoid copy of simple const parameters }
-                  {dummycoll.data:=new(pformaldef,init)}
-                  dummycoll.data:=cformaldef
-                else
-                  { I think, this isn't a good solution (FK) }
-                  dummycoll.data:=nil;
-
-                while assigned(node) do
-                  begin
-                     pushusedregisters(exprasmlist,pushed,$ff);
-                     hp:=node;
-                     node:=node^.right;
-                     hp^.right:=nil;
-                     if hp^.is_colon_para then
-                       CGMessage(parser_e_illegal_colon_qualifier);
-                     { when float is written then we need bestreal to be pushed
-                       convert here else we loose the old flaot type }
-                     if (not doread) and
-                        (ft<>ft_typed) and
-                        (hp^.left^.resulttype^.deftype=floatdef) then
-                      begin
-                        orgfloattype:=pfloatdef(hp^.left^.resulttype)^.typ;
-                        hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
-                        firstpass(hp^.left);
-                      end;
-                     { when read ord,floats are functions, so they need this
-                       parameter as their destination instead of being pushed }
-                     if doread and
-                        (ft<>ft_typed) and
-                        (hp^.resulttype^.deftype in [orddef,floatdef]) then
-                      destpara:=hp^.left
-                     else
-                      begin
-                        if ft=ft_typed then
-                          never_copy_const_param:=true;
-                        { reset data type }
-                        dummycoll.data:=nil;
-                        { create temporary defs for high tree generation }
-                        if doread and (is_shortstring(hp^.resulttype)) then
-                          dummycoll.data:=openshortstringdef
-                        else
-                          if (is_chararray(hp^.resulttype)) then
-                            dummycoll.data:=openchararraydef;
-                        secondcallparan(hp,@dummycoll,false,false,false,0);
-                        if ft=ft_typed then
-                          never_copy_const_param:=false;
-                      end;
-                     hp^.right:=node;
-                     if codegenerror then
-                       exit;
-
-                     emit_push_mem(aktfile);
-                     if (ft=ft_typed) then
-                       begin
-                          { OK let's try this }
-                          { first we must only allow the right type }
-                          { 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 !!!!        }
-                          { how can we make that                    }
-                          { I think that is only possible by adding }
-                          { 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)
-                            else
-                              emitcall('FPC_TYPED_WRITE',true);
-                       end
-                     else
-                       begin
-                          { save current position }
-                          pararesult:=hp^.left^.resulttype;
-                          { handle possible field width  }
-                          { of course only for write(ln) }
-                          if not doread then
-                            begin
-                               { handle total width parameter }
-                              if assigned(node) and node^.is_colon_para then
-                                begin
-                                   hp:=node;
-                                   node:=node^.right;
-                                   hp^.right:=nil;
-                                   secondcallparan(hp,@dummycoll,false,false,false,0);
-                                   hp^.right:=node;
-                                   if codegenerror then
-                                     exit;
-                                   has_length:=true;
-                                end
-                              else
-                                if pararesult^.deftype<>floatdef then
-                                  push_int(0)
-                                else
-                                  push_int(-32767);
-                            { a second colon para for a float ? }
-                              if assigned(node) and node^.is_colon_para then
-                                begin
-                                   hp:=node;
-                                   node:=node^.right;
-                                   hp^.right:=nil;
-                                   secondcallparan(hp,@dummycoll,false,false,false,0);
-                                   hp^.right:=node;
-                                   if pararesult^.deftype<>floatdef then
-                                     CGMessage(parser_e_illegal_colon_qualifier);
-                                   if codegenerror then
-                                     exit;
-                                end
-                              else
-                                begin
-                                  if pararesult^.deftype=floatdef then
-                                    push_int(-1);
-                                end;
-                             { push also the real type for floats }
-                              if pararesult^.deftype=floatdef then
-                                push_int(ord(orgfloattype));
-                            end;
-                          case pararesult^.deftype of
-                            stringdef :
-                              begin
-                                emitcall(rdwrprefix[doread]+pstringdef(pararesult)^.stringtypname,true);
-                              end;
-                            pointerdef :
-                              begin
-                                if is_pchar(pararesult) then
-                                  emitcall(rdwrprefix[doread]+'PCHAR_AS_POINTER',true)
-                              end;
-                            arraydef :
-                              begin
-                                if is_chararray(pararesult) then
-                                  emitcall(rdwrprefix[doread]+'PCHAR_AS_ARRAY',true)
-                              end;
-                            floatdef :
-                              begin
-                                emitcall(rdwrprefix[doread]+'FLOAT',true);
-                                if doread then
-                                  StoreDirectFuncResult(destpara);
-                              end;
-                            orddef :
-                              begin
-                                case porddef(pararesult)^.typ of
-                                  s8bit,s16bit,s32bit :
-                                    emitcall(rdwrprefix[doread]+'SINT',true);
-                                  u8bit,u16bit,u32bit :
-                                    emitcall(rdwrprefix[doread]+'UINT',true);
-                                  uchar :
-                                    emitcall(rdwrprefix[doread]+'CHAR',true);
-                                  s64bitint:
-                                    emitcall(rdwrprefix[doread]+'INT64',true);
-                                  u64bit :
-                                    emitcall(rdwrprefix[doread]+'QWORD',true);
-                                  bool8bit,
-                                  bool16bit,
-                                  bool32bit :
-                                    emitcall(rdwrprefix[doread]+'BOOLEAN',true);
-                                end;
-                                if doread then
-                                 StoreDirectFuncResult(destpara);
-                              end;
-                          end;
-                       end;
-                   { load ESI in methods again }
-                     popusedregisters(exprasmlist,pushed);
-                     maybe_loadesi;
-                  end;
-             end;
-         { Insert end of writing for textfiles }
-           if ft=ft_text then
-             begin
-               pushusedregisters(exprasmlist,pushed,$ff);
-               emit_push_mem(aktfile);
-               if doread then
-                begin
-                  if doln then
-                    emitcall('FPC_READLN_END',true)
-                  else
-                    emitcall('FPC_READ_END',true);
-                end
-               else
-                begin
-                  if doln then
-                    emitcall('FPC_WRITELN_END',true)
-                  else
-                    emitcall('FPC_WRITE_END',true);
-                end;
-               popusedregisters(exprasmlist,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);
-             end;
-         { Freeup all used temps }
-           ungetiftemp(aktfile);
-           if assigned(p^.left) then
-             begin
-                p^.left:=reversparameter(p^.left);
-                if npara<>nb_para then
-                  CGMessage(cg_f_internal_error_in_secondinline);
-                hp:=p^.left;
-                while assigned(hp) do
-                  begin
-                     if assigned(hp^.left) then
-                       if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
-                         ungetiftemp(hp^.left^.location.reference);
-                     hp:=hp^.right;
-                  end;
-             end;
-        end;
-
-      procedure handle_str;
-
-        var
-           hp,node : ptree;
-           dummycoll : tdefcoll;
-           is_real,has_length : boolean;
-           realtype : tfloattype;
-           procedureprefix : string;
-
-          begin
-           pushusedregisters(exprasmlist,pushed,$ff);
-           node:=p^.left;
-           is_real:=false;
-           has_length:=false;
-           while assigned(node^.right) do node:=node^.right;
-           { if a real parameter somewhere then call REALSTR }
-           if (node^.left^.resulttype^.deftype=floatdef) then
-            begin
-              is_real:=true;
-              realtype:=pfloatdef(node^.left^.resulttype)^.typ;
-            end;
-
-           node:=p^.left;
-           { we have at least two args }
-           { with at max 2 colon_para in between }
-
-           { string arg }
-           hp:=node;
-           node:=node^.right;
-           hp^.right:=nil;
-           dummycoll.paratyp:=vs_var;
-           if is_shortstring(hp^.resulttype) then
-             dummycoll.data:=openshortstringdef
-           else
-             dummycoll.data:=hp^.resulttype;
-           procedureprefix:='FPC_'+pstringdef(hp^.resulttype)^.stringtypname+'_';
-           secondcallparan(hp,@dummycoll,false,false,false,0);
-           if codegenerror then
-             exit;
-
-           dummycoll.paratyp:=vs_const;
-           disposetree(p^.left);
-           p^.left:=nil;
-           { second arg }
-           hp:=node;
-           node:=node^.right;
-           hp^.right:=nil;
-
-           { if real push real type }
-           if is_real then
-             push_int(ord(realtype));
-
-           { frac  para }
-           if hp^.is_colon_para and assigned(node) and
-              node^.is_colon_para then
-             begin
-                dummycoll.data:=hp^.resulttype;
-                secondcallparan(hp,@dummycoll,false
-                  ,false,false,0
-                  );
-                if codegenerror then
-                  exit;
-                disposetree(hp);
-                hp:=node;
-                node:=node^.right;
-                hp^.right:=nil;
-                has_length:=true;
-             end
-           else
-             if is_real then
-             push_int(-1);
-
-           { third arg, length only if is_real }
-           if hp^.is_colon_para then
-             begin
-                dummycoll.data:=hp^.resulttype;
-                secondcallparan(hp,@dummycoll,false
-                  ,false,false,0
-                  );
-                if codegenerror then
-                  exit;
-                disposetree(hp);
-                hp:=node;
-                node:=node^.right;
-                hp^.right:=nil;
-             end
-           else
-             if is_real then
-               push_int(-32767)
-             else
-               push_int(-1);
-
-           { Convert float to bestreal }
-           if is_real then
-            begin
-              hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
-              firstpass(hp^.left);
-            end;
-
-           { last arg longint or real }
-           secondcallparan(hp,@dummycoll,false
-             ,false,false,0
-             );
-           if codegenerror then
-             exit;
-
-           if is_real then
-             emitcall(procedureprefix+'FLOAT',true)
-           else
-             case porddef(hp^.resulttype)^.typ of
-                u32bit:
-                  emitcall(procedureprefix+'CARDINAL',true);
-
-                u64bit:
-                  emitcall(procedureprefix+'QWORD',true);
-
-                s64bitint:
-                  emitcall(procedureprefix+'INT64',true);
-
-                else
-                  emitcall(procedureprefix+'LONGINT',true);
-             end;
-           disposetree(hp);
-
-           popusedregisters(exprasmlist,pushed);
-        end;
-
-{$IfnDef OLDVAL}
-
-        Procedure Handle_Val;
-
-        var
-           hp,node, code_para, dest_para : ptree;
-           hreg: TRegister;
-           hdef: POrdDef;
-           procedureprefix : string;
-           hr, hr2: TReference;
-           dummycoll : tdefcoll;
-           has_code, has_32bit_code, oldregisterdef: boolean;
-
-          begin
-           node:=p^.left;
-           hp:=node;
-           node:=node^.right;
-           hp^.right:=nil;
-          {if we have 3 parameters, we have a code parameter}
-           has_code := Assigned(node^.right);
-           has_32bit_code := false;
-           reset_reference(hr);
-           hreg := R_NO;
-
-           If has_code then
-             Begin
-               {code is an orddef, that's checked in tcinl}
-               code_para := hp;
-               hp := node;
-               node := node^.right;
-               hp^.right := nil;
-               has_32bit_code := (porddef(code_para^.left^.resulttype)^.typ in [u32bit,s32bit]);
-             End;
-
-          {hp = destination now, save for later use}
-           dest_para := hp;
-
-          {if EAX is already in use, it's a register variable. Since we don't
-           need another register besides EAX, release the one we got}
-           If hreg <> R_EAX Then ungetregister32(hreg);
-
-          {load and push the address of the destination}
-           dummycoll.paratyp:=vs_var;
-           dummycoll.data:=dest_para^.resulttype;
-           secondcallparan(dest_para,@dummycoll,false,false,false,0);
-           if codegenerror then
-             exit;
-
-          {save the regvars}
-           pushusedregisters(exprasmlist,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}
-
-           If has_32bit_code Then
-             Begin
-               dummycoll.paratyp:=vs_var;
-               dummycoll.data:=code_para^.resulttype;
-               secondcallparan(code_para,@dummycoll,false,false,false,0);
-               if codegenerror then
-                 exit;
-               Disposetree(code_para);
-             End
-           Else
-             Begin
-           {only 32bit code parameter is supported, so fake one}
-               GetTempOfSizeReference(4,hr);
-               emitpushreferenceaddr(exprasmlist,hr);
-             End;
-
-          {node = first parameter = string}
-           dummycoll.paratyp:=vs_const;
-           dummycoll.data:=node^.resulttype;
-           secondcallparan(node,@dummycoll,false,false,false,0);
-           if codegenerror then
-             exit;
-
-           Case dest_para^.resulttype^.deftype of
-             floatdef:
-               procedureprefix := 'FPC_VAL_REAL_';
-             orddef:
-               if is_signed(dest_para^.resulttype) then
-                 begin
-                   {if we are converting to a signed number, we have to include the
-                    size of the destination, so the Val function can extend the sign
-                    of the result to allow proper range checking}
-                   exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,dest_para^.resulttype^.size)));
-                   procedureprefix := 'FPC_VAL_SINT_'
-                 end
-               else
-                 procedureprefix := 'FPC_VAL_UINT_';
-           End;
-           emitcall(procedureprefix+pstringdef(node^.resulttype)^.stringtypname,true);
-           { before disposing node we need to ungettemp !! PM }
-           if node^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
-             ungetiftemp(node^.left^.location.reference);
-           disposetree(node);
-           p^.left := nil;
-
-          {reload esi in case the dest_para/code_para is a class variable or so}
-           maybe_loadesi;
-
-           If (dest_para^.resulttype^.deftype = orddef) Then
-             Begin
-              {store the result in a safe place, because EAX may be used by a
-               register variable}
-               hreg := getexplicitregister32(R_EAX);
-               emit_reg_reg(A_MOV,S_L,R_EAX,hreg);
-              {as of now, hreg now holds the location of the result, if it was
-               integer}
-             End;
-
-           { restore the register vars}
-
-           popusedregisters(exprasmlist,pushed);
-
-           If has_code and Not(has_32bit_code) Then
-             {only 16bit code is possible}
-             Begin
-              {load the address of the code parameter}
-               secondpass(code_para^.left);
-              {move the code to its destination}
-               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,NewReference(hr),R_EDI)));
-               emit_mov_reg_loc(R_DI,code_para^.left^.location);
-               Disposetree(code_para);
-             End;
-
-          {restore the address of the result}
-           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
-
-          {set up hr2 to a refernce with EDI as base register}
-           reset_reference(hr2);
-           hr2.base := R_EDI;
-
-          {save the function result in the destination variable}
-           Case dest_para^.left^.resulttype^.deftype of
-             floatdef:
-               floatstore(PFloatDef(dest_para^.left^.resulttype)^.typ, hr2);
-             orddef:
-               Case PordDef(dest_para^.left^.resulttype)^.typ of
-                 u8bit,s8bit:
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_B,
-                     RegToReg8(hreg),newreference(hr2))));
-                 u16bit,s16bit:
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_W,
-                     RegToReg16(hreg),newreference(hr2))));
-                 u32bit,s32bit:
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_L,
-                     hreg,newreference(hr2))));
-                 {u64bit,s64bitint: ???}
-               End;
-           End;
-           If (cs_check_range in aktlocalswitches) and
-              (dest_para^.left^.resulttype^.deftype = orddef) and
-            {the following has to be changed to 64bit checking, once Val
-             returns 64 bit values (unless a special Val function is created
-             for that)}
-            {no need to rangecheck longints or cardinals on 32bit processors}
-               not((porddef(dest_para^.left^.resulttype)^.typ = s32bit) and
-                   (porddef(dest_para^.left^.resulttype)^.low = $80000000) and
-                   (porddef(dest_para^.left^.resulttype)^.high = $7fffffff)) and
-               not((porddef(dest_para^.left^.resulttype)^.typ = u32bit) and
-                   (porddef(dest_para^.left^.resulttype)^.low = 0) and
-                   (porddef(dest_para^.left^.resulttype)^.high = $ffffffff)) then
-             Begin
-               hp := getcopy(dest_para^.left);
-               hp^.location.loc := LOC_REGISTER;
-               hp^.location.register := hreg;
-              {do not register this temporary def}
-               OldRegisterDef := RegisterDef;
-               RegisterDef := False;
-               Case PordDef(dest_para^.left^.resulttype)^.typ of
-                 u8bit,u16bit,u32bit: new(hdef,init(u32bit,0,$ffffffff));
-                 s8bit,s16bit,s32bit: new(hdef,init(s32bit,$80000000,$7fffffff));
-               end;
-               hp^.resulttype := hdef;
-               emitrangecheck(hp,dest_para^.left^.resulttype);
-               hp^.right := nil;
-               Dispose(hp^.resulttype, Done);
-               RegisterDef := OldRegisterDef;
-               disposetree(hp);
-             End;
-          {dest_para^.right is already nil}
-           disposetree(dest_para);
-           UnGetIfTemp(hr);
-        end;
-{$EndIf OLDVAL}
-
-      var
-         r : preference;
-         hp : ptree;
-         l : longint;
-         ispushed : boolean;
-         hregister : tregister;
-         otlabel,oflabel   : plabel;
-         oldpushedparasize : longint;
-
-      begin
-      { save & reset pushedparasize }
-         oldpushedparasize:=pushedparasize;
-         pushedparasize:=0;
-         case p^.inlinenumber of
-            in_assert_x_y:
-              begin
-                 otlabel:=truelabel;
-                 oflabel:=falselabel;
-                 getlabel(truelabel);
-                 getlabel(falselabel);
-                 secondpass(p^.left^.left);
-                 if cs_do_assertion in aktlocalswitches then
-                   begin
-                      maketojumpbool(p^.left^.left);
-                      emitlab(falselabel);
-                      { erroraddr }
-                      exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
-                      { lineno }
-                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,aktfilepos.line)));
-                      { filename string }
-                      hp:=genstringconstnode(current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex));
-                      secondpass(hp);
-                      if codegenerror then
-                       exit;
-                      emitpushreferenceaddr(exprasmlist,hp^.location.reference);
-                      disposetree(hp);
-                      { push msg }
-                      secondpass(p^.left^.right^.left);
-                      emitpushreferenceaddr(exprasmlist,p^.left^.right^.left^.location.reference);
-                      { call }
-                      emitcall('FPC_ASSERT',true);
-                      emitlab(truelabel);
-                   end;
-                 freelabel(truelabel);
-                 freelabel(falselabel);
-                 truelabel:=otlabel;
-                 falselabel:=oflabel;
-              end;
-            in_lo_word,
-            in_hi_word :
-              begin
-                 secondpass(p^.left);
-                 p^.location.loc:=LOC_REGISTER;
-                 if p^.left^.location.loc<>LOC_REGISTER then
-                   begin
-                     if p^.left^.location.loc=LOC_CREGISTER then
-                       begin
-                          p^.location.register:=reg32toreg16(getregister32);
-                          emit_reg_reg(A_MOV,S_W,p^.left^.location.register,
-                            p^.location.register);
-                       end
-                     else
-                       begin
-                          del_reference(p^.left^.location.reference);
-                          p^.location.register:=reg32toreg16(getregister32);
-                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,newreference(p^.left^.location.reference),
-                            p^.location.register)));
-                       end;
-                   end
-                 else p^.location.register:=p^.left^.location.register;
-                 if p^.inlinenumber=in_hi_word then
-                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_W,8,p^.location.register)));
-                 p^.location.register:=reg16toreg8(p^.location.register);
-              end;
-            in_sizeof_x,
-            in_typeof_x :
-              begin
-                 { for both cases load vmt }
-                 if p^.left^.treetype=typen then
-                   begin
-                      p^.location.register:=getregister32;
-                      exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,
-                        S_L,newasmsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname),0,
-                        p^.location.register)));
-                   end
-                 else
-                   begin
-                      secondpass(p^.left);
-                      del_reference(p^.left^.location.reference);
-                      p^.location.loc:=LOC_REGISTER;
-                      p^.location.register:=getregister32;
-                      { load VMT pointer }
-                      inc(p^.left^.location.reference.offset,
-                        pobjectdef(p^.left^.resulttype)^.vmt_offset);
-                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                      newreference(p^.left^.location.reference),
-                        p^.location.register)));
-                   end;
-                 { in sizeof load size }
-                 if p^.inlinenumber=in_sizeof_x then
-                   begin
-                      new(r);
-                      reset_reference(r^);
-                      r^.base:=p^.location.register;
-                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,
-                        p^.location.register)));
-                   end;
-              end;
-            in_lo_long,
-            in_hi_long :
-              begin
-                 secondpass(p^.left);
-                 p^.location.loc:=LOC_REGISTER;
-                 if p^.left^.location.loc<>LOC_REGISTER then
-                   begin
-                      if p^.left^.location.loc=LOC_CREGISTER then
-                        begin
-                           p^.location.register:=getregister32;
-                           emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
-                             p^.location.register);
-                        end
-                      else
-                        begin
-                           del_reference(p^.left^.location.reference);
-                           p^.location.register:=getregister32;
-                           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
-                             p^.location.register)));
-                        end;
-                   end
-                 else p^.location.register:=p^.left^.location.register;
-                 if p^.inlinenumber=in_hi_long then
-                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_L,16,p^.location.register)));
-                 p^.location.register:=reg32toreg16(p^.location.register);
-              end;
-            in_length_string :
-              begin
-                 secondpass(p^.left);
-                 set_location(p^.location,p^.left^.location);
-                 { length in ansi strings is at offset -8 }
-                 if is_ansistring(p^.left^.resulttype) then
-                   dec(p^.location.reference.offset,8)
-                 { char is always 1, so make it a constant value }
-                 else if is_char(p^.left^.resulttype) then
-                   begin
-                     clear_location(p^.location);
-                     p^.location.loc:=LOC_MEM;
-                     p^.location.reference.is_immediate:=true;
-                     p^.location.reference.offset:=1;
-                   end;
-              end;
-            in_pred_x,
-            in_succ_x:
-              begin
-                 secondpass(p^.left);
-                 if not (cs_check_overflow in aktlocalswitches) then
-                   if p^.inlinenumber=in_pred_x then
-                     asmop:=A_DEC
-                   else
-                     asmop:=A_INC
-                 else
-                   if p^.inlinenumber=in_pred_x then
-                     asmop:=A_SUB
-                   else
-                     asmop:=A_ADD;
-                 case p^.resulttype^.size of
-                   4 : opsize:=S_L;
-                   2 : opsize:=S_W;
-                   1 : opsize:=S_B;
-                 else
-                   internalerror(10080);
-                 end;
-                 p^.location.loc:=LOC_REGISTER;
-                 if p^.left^.location.loc<>LOC_REGISTER then
-                   begin
-                      p^.location.register:=getregister32;
-                      if (p^.resulttype^.size=2) then
-                        p^.location.register:=reg32toreg16(p^.location.register);
-                      if (p^.resulttype^.size=1) then
-                        p^.location.register:=reg32toreg8(p^.location.register);
-                      if p^.left^.location.loc=LOC_CREGISTER then
-                        emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
-                          p^.location.register)
-                      else
-                      if p^.left^.location.loc=LOC_FLAGS then
-                        emit_flag2reg(p^.left^.location.resflags,p^.location.register)
-                      else
-                        begin
-                           del_reference(p^.left^.location.reference);
-                           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.left^.location.reference),
-                             p^.location.register)));
-                        end;
-                   end
-                 else p^.location.register:=p^.left^.location.register;
-
-                 if not (cs_check_overflow in aktlocalswitches) then
-                   exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
-                     p^.location.register)))
-                 else
-                   exprasmlist^.concat(new(pai386,op_const_reg(asmop,opsize,1,
-                     p^.location.register)));
-                 emitoverflowcheck(p);
-                 emitrangecheck(p,p^.resulttype);
-              end;
-            in_dec_x,
-            in_inc_x :
-              begin
-              { set defaults }
-                addvalue:=1;
-                addconstant:=true;
-              { load first parameter, must be a reference }
-                secondpass(p^.left^.left);
-                case p^.left^.left^.resulttype^.deftype of
-                  orddef,
-                 enumdef : begin
-                             case p^.left^.left^.resulttype^.size of
-                              1 : opsize:=S_B;
-                              2 : opsize:=S_W;
-                              4 : opsize:=S_L;
-                             end;
-                           end;
-              pointerdef : begin
-                             opsize:=S_L;
-                             if porddef(ppointerdef(p^.left^.left^.resulttype)^.definition)=voiddef then
-                              addvalue:=1
-                             else
-                              addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
-                           end;
-                else
-                 internalerror(10081);
-                end;
-              { second argument specified?, must be a s32bit in register }
-                if assigned(p^.left^.right) then
-                 begin
-                   secondpass(p^.left^.right^.left);
-                 { when constant, just multiply the addvalue }
-                   if is_constintnode(p^.left^.right^.left) then
-                    addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
-                   else
-                    begin
-                      case p^.left^.right^.left^.location.loc of
-                   LOC_REGISTER,
-                  LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
-                        LOC_MEM,
-                  LOC_REFERENCE : begin
-                                    del_reference(p^.left^.right^.left^.location.reference);
-                                    hregister:=getregister32;
-                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                      newreference(p^.left^.right^.left^.location.reference),hregister)));
-                                  end;
-                       else
-                        internalerror(10082);
-                       end;
-                    { insert multiply with addvalue if its >1 }
-                      if addvalue>1 then
-                       exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,opsize,
-                         addvalue,hregister)));
-                      addconstant:=false;
-                    end;
-                 end;
-              { write the add instruction }
-                if addconstant then
-                 begin
-                   if (addvalue=1) and not(cs_check_overflow in aktlocalswitches) then
-                     begin
-                        if p^.left^.left^.location.loc=LOC_CREGISTER then
-                          exprasmlist^.concat(new(pai386,op_reg(incdecop[p^.inlinenumber],opsize,
-                            p^.left^.left^.location.register)))
-                        else
-                          exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize,
-                            newreference(p^.left^.left^.location.reference))))
-                     end
-                   else
-                     begin
-                        if p^.left^.left^.location.loc=LOC_CREGISTER then
-                          exprasmlist^.concat(new(pai386,op_const_reg(addsubop[p^.inlinenumber],opsize,
-                            addvalue,p^.left^.left^.location.register)))
-                        else
-                          exprasmlist^.concat(new(pai386,op_const_ref(addsubop[p^.inlinenumber],opsize,
-                            addvalue,newreference(p^.left^.left^.location.reference))));
-                     end
-                 end
-                else
-                 begin
-                    { BUG HERE : detected with nasm :
-                      hregister is allways 32 bit
-                      it should be converted to 16 or 8 bit depending on op_size  PM }
-                    { still not perfect :
-                      if hregister is already a 16 bit reg ?? PM }
-                    case opsize of
-                      S_B : hregister:=reg32toreg8(hregister);
-                      S_W : hregister:=reg32toreg16(hregister);
-                    end;
-                    if p^.left^.left^.location.loc=LOC_CREGISTER then
-                      exprasmlist^.concat(new(pai386,op_reg_reg(addsubop[p^.inlinenumber],opsize,
-                        hregister,p^.left^.left^.location.register)))
-                    else
-                      exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
-                        hregister,newreference(p^.left^.left^.location.reference))));
-                    case opsize of
-                      S_B : hregister:=reg8toreg32(hregister);
-                      S_W : hregister:=reg16toreg32(hregister);
-                    end;
-                   ungetregister32(hregister);
-                 end;
-                emitoverflowcheck(p^.left^.left);
-                emitrangecheck(p^.left^.left,p^.left^.left^.resulttype);
-              end;
-            in_assigned_x :
-              begin
-                 secondpass(p^.left^.left);
-                 p^.location.loc:=LOC_FLAGS;
-                 if (p^.left^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                   begin
-                      exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,
-                        p^.left^.left^.location.register,
-                        p^.left^.left^.location.register)));
-                      ungetregister32(p^.left^.left^.location.register);
-                   end
-                 else
-                   begin
-                      exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
-                        newreference(p^.left^.left^.location.reference))));
-                      del_reference(p^.left^.left^.location.reference);
-                   end;
-                 p^.location.resflags:=F_NE;
-              end;
-             in_reset_typedfile,in_rewrite_typedfile :
-               begin
-                  pushusedregisters(exprasmlist,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);
-                  if p^.inlinenumber=in_reset_typedfile then
-                    emitcall('FPC_RESET_TYPED',true)
-                  else
-                    emitcall('FPC_REWRITE_TYPED',true);
-                  popusedregisters(exprasmlist,pushed);
-               end;
-            in_write_x :
-              handlereadwrite(false,false);
-            in_writeln_x :
-              handlereadwrite(false,true);
-            in_read_x :
-              handlereadwrite(true,false);
-            in_readln_x :
-              handlereadwrite(true,true);
-            in_str_x_string :
-              begin
-                 handle_str;
-                 maybe_loadesi;
-              end;
-{$IfnDef OLDVAL}
-            in_val_x :
-              Begin
-                handle_val;
-              End;
-{$EndIf OLDVAL}
-            in_include_x_y,
-            in_exclude_x_y:
-              begin
-                 secondpass(p^.left^.left);
-                 if p^.left^.right^.left^.treetype=ordconstn then
-                   begin
-                      { calculate bit position }
-                      l:=1 shl (p^.left^.right^.left^.value mod 32);
-
-                      { determine operator }
-                      if p^.inlinenumber=in_include_x_y then
-                        asmop:=A_OR
-                      else
-                        begin
-                           asmop:=A_AND;
-                           l:=not(l);
-                        end;
-                      if (p^.left^.left^.location.loc=LOC_REFERENCE) then
-                        begin
-                           inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
-                           exprasmlist^.concat(new(pai386,op_const_ref(asmop,S_L,
-                             l,newreference(p^.left^.left^.location.reference))));
-                           del_reference(p^.left^.left^.location.reference);
-                        end
-                      else
-                        { LOC_CREGISTER }
-                        exprasmlist^.concat(new(pai386,op_const_reg(asmop,S_L,
-                          l,p^.left^.left^.location.register)));
-                   end
-                 else
-                   begin
-                      { generate code for the element to set }
-                      ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
-                      secondpass(p^.left^.right^.left);
-                      if ispushed then
-                        restore(p^.left^.left);
-                      { determine asm operator }
-                      if p^.inlinenumber=in_include_x_y then
-                        asmop:=A_BTS
-                      else
-                        asmop:=A_BTR;
-                      if psetdef(p^.left^.resulttype)^.settype=smallset then
-                        begin
-                           if p^.left^.right^.left^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
-                             hregister:=p^.left^.right^.left^.location.register
-                           else
-                             begin
-                                hregister:=R_EDI;
-                                opsize:=def2def_opsize(p^.left^.right^.left^.resulttype,u32bitdef);
-                                if opsize in [S_B,S_W,S_L] then
-                                 op:=A_MOV
-                                else
-                                 op:=A_MOVZX;
-                                exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
-                                  newreference(p^.left^.right^.left^.location.reference),R_EDI)));
-                             end;
-                          if (p^.left^.left^.location.loc=LOC_REFERENCE) then
-                            exprasmlist^.concat(new(pai386,op_reg_ref(asmop,S_L,hregister,
-                              newreference(p^.left^.right^.left^.location.reference))))
-                          else
-                            exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,hregister,
-                              p^.left^.right^.left^.location.register)));
-                        end
-                      else
-                        begin
-                           pushsetelement(p^.left^.right^.left);
-                           { normset is allways a ref }
-                           emitpushreferenceaddr(exprasmlist,
-                             p^.left^.left^.location.reference);
-                           if p^.inlinenumber=in_include_x_y then
-                             emitcall('FPC_SET_SET_BYTE',true)
-                           else
-                             emitcall('FPC_SET_UNSET_BYTE',true);
-                           {CGMessage(cg_e_include_not_implemented);}
-                        end;
-                   end;
-              end;
-            else internalerror(9);
-         end;
-         { reset pushedparasize }
-         pushedparasize:=oldpushedparasize;
-      end;
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 inline nodes
+
+    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 cg386inl;
+interface
+
+    uses
+      tree;
+
+    procedure secondinline(var p : ptree);
+
+
+implementation
+
+    uses
+      globtype,systems,
+      cobjects,verbose,globals,files,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_1,pass_2,
+{$ifndef OLDASM}
+      i386base,i386asm,
+{$else}
+      i386,
+{$endif}
+      cgai386,tgeni386,cg386cal;
+
+
+{*****************************************************************************
+                                Helpers
+*****************************************************************************}
+
+    { reverts the parameter list }
+    var nb_para : integer;
+
+    function reversparameter(p : ptree) : ptree;
+
+       var
+         hp1,hp2 : ptree;
+
+      begin
+         hp1:=nil;
+         nb_para := 0;
+         while assigned(p) do
+           begin
+              { pull out }
+              hp2:=p;
+              p:=p^.right;
+              inc(nb_para);
+              { pull in }
+              hp2^.right:=hp1;
+              hp1:=hp2;
+           end;
+         reversparameter:=hp1;
+       end;
+
+
+{*****************************************************************************
+                             SecondInLine
+*****************************************************************************}
+
+    procedure StoreDirectFuncResult(dest:ptree);
+      var
+        hp : ptree;
+        hdef : porddef;
+        hreg : tregister;
+        oldregisterdef : boolean;
+      begin
+        SecondPass(dest);
+        if Codegenerror then
+         exit;
+        Case dest^.resulttype^.deftype of
+          floatdef:
+            floatstore(PFloatDef(dest^.resulttype)^.typ,dest^.location.reference);
+          orddef:
+            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;
+          else
+            internalerror(66766766);
+        end;
+      end;
+
+
+    procedure secondinline(var p : ptree);
+       const
+         {tfloattype = (s32real,s64real,s80real,s64bit,f16bit,f32bit);}
+{         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);
+       var
+         aktfile : treference;
+         ft : tfiletype;
+         opsize : topsize;
+         op,
+         asmop : tasmop;
+         pushed : tpushed;
+         {inc/dec}
+         addconstant : boolean;
+         addvalue : longint;
+
+
+      procedure handlereadwrite(doread,doln : boolean);
+      { produces code for READ(LN) and WRITE(LN) }
+
+        procedure loadstream;
+          const
+            io:array[boolean] of string[7]=('_OUTPUT','_INPUT');
+          var
+            r : preference;
+          begin
+            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;
+
+        const
+           rdwrprefix:array[boolean] of string[15]=('FPC_WRITE_TEXT_','FPC_READ_TEXT_');
+        var
+           destpara,
+           node,hp    : ptree;
+           typedtyp,
+           pararesult : pdef;
+           orgfloattype : tfloattype;
+           has_length : boolean;
+           dummycoll  : tdefcoll;
+           iolabel    : plabel;
+           npara      : longint;
+        begin
+           { I/O check }
+           if (cs_check_io in aktlocalswitches) and
+              ((aktprocsym^.definition^.options and poiocheck)=0) then
+             begin
+                getlabel(iolabel);
+                emitlab(iolabel);
+             end
+           else
+             iolabel:=nil;
+           { for write of real with the length specified }
+           has_length:=false;
+           hp:=nil;
+           { reserve temporary pointer to data variable }
+           aktfile.symbol:=nil;
+           gettempofsizereference(4,aktfile);
+           { first state text data }
+           ft:=ft_text;
+           { and state a parameter ? }
+           if p^.left=nil then
+             begin
+                { the following instructions are for "writeln;" }
+                loadstream;
+                { save @aktfile in temporary variable }
+                exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
+             end
+           else
+             begin
+                { revers paramters }
+                node:=reversparameter(p^.left);
+
+                p^.left := node;
+                npara := nb_para;
+                { calculate data variable }
+                { is first parameter a file type ? }
+                if node^.left^.resulttype^.deftype=filedef then
+                  begin
+                     ft:=pfiledef(node^.left^.resulttype)^.filetype;
+                     if ft=ft_typed then
+                       typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
+                     secondpass(node^.left);
+                     if codegenerror then
+                       exit;
+
+                     { save reference in temporary variables }
+                     if node^.left^.location.loc<>LOC_REFERENCE then
+                       begin
+                          CGMessage(cg_e_illegal_expression);
+                          exit;
+                       end;
+
+                     exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_EDI)));
+
+                     { skip to the next parameter }
+                     node:=node^.right;
+                  end
+                else
+                  begin
+                  { load stdin/stdout stream }
+                     loadstream;
+                  end;
+
+                { save @aktfile in temporary variable }
+                exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
+                if doread then
+                { parameter by READ gives call by reference }
+                  dummycoll.paratyp:=vs_var
+                { an WRITE Call by "Const" }
+                else
+                  dummycoll.paratyp:=vs_const;
+
+                { because of secondcallparan, which otherwise attaches }
+                if ft=ft_typed then
+                  { this is to avoid copy of simple const parameters }
+                  {dummycoll.data:=new(pformaldef,init)}
+                  dummycoll.data:=cformaldef
+                else
+                  { I think, this isn't a good solution (FK) }
+                  dummycoll.data:=nil;
+
+                while assigned(node) do
+                  begin
+                     pushusedregisters(exprasmlist,pushed,$ff);
+                     hp:=node;
+                     node:=node^.right;
+                     hp^.right:=nil;
+                     if hp^.is_colon_para then
+                       CGMessage(parser_e_illegal_colon_qualifier);
+                     { when float is written then we need bestreal to be pushed
+                       convert here else we loose the old flaot type }
+                     if (not doread) and
+                        (ft<>ft_typed) and
+                        (hp^.left^.resulttype^.deftype=floatdef) then
+                      begin
+                        orgfloattype:=pfloatdef(hp^.left^.resulttype)^.typ;
+                        hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
+                        firstpass(hp^.left);
+                      end;
+                     { when read ord,floats are functions, so they need this
+                       parameter as their destination instead of being pushed }
+                     if doread and
+                        (ft<>ft_typed) and
+                        (hp^.resulttype^.deftype in [orddef,floatdef]) then
+                      destpara:=hp^.left
+                     else
+                      begin
+                        if ft=ft_typed then
+                          never_copy_const_param:=true;
+                        { reset data type }
+                        dummycoll.data:=nil;
+                        { create temporary defs for high tree generation }
+                        if doread and (is_shortstring(hp^.resulttype)) then
+                          dummycoll.data:=openshortstringdef
+                        else
+                          if (is_chararray(hp^.resulttype)) then
+                            dummycoll.data:=openchararraydef;
+                        secondcallparan(hp,@dummycoll,false,false,false,0);
+                        if ft=ft_typed then
+                          never_copy_const_param:=false;
+                      end;
+                     hp^.right:=node;
+                     if codegenerror then
+                       exit;
+
+                     emit_push_mem(aktfile);
+                     if (ft=ft_typed) then
+                       begin
+                          { OK let's try this }
+                          { first we must only allow the right type }
+                          { 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 !!!!        }
+                          { how can we make that                    }
+                          { I think that is only possible by adding }
+                          { 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)
+                            else
+                              emitcall('FPC_TYPED_WRITE',true);
+                       end
+                     else
+                       begin
+                          { save current position }
+                          pararesult:=hp^.left^.resulttype;
+                          { handle possible field width  }
+                          { of course only for write(ln) }
+                          if not doread then
+                            begin
+                               { handle total width parameter }
+                              if assigned(node) and node^.is_colon_para then
+                                begin
+                                   hp:=node;
+                                   node:=node^.right;
+                                   hp^.right:=nil;
+                                   secondcallparan(hp,@dummycoll,false,false,false,0);
+                                   hp^.right:=node;
+                                   if codegenerror then
+                                     exit;
+                                   has_length:=true;
+                                end
+                              else
+                                if pararesult^.deftype<>floatdef then
+                                  push_int(0)
+                                else
+                                  push_int(-32767);
+                            { a second colon para for a float ? }
+                              if assigned(node) and node^.is_colon_para then
+                                begin
+                                   hp:=node;
+                                   node:=node^.right;
+                                   hp^.right:=nil;
+                                   secondcallparan(hp,@dummycoll,false,false,false,0);
+                                   hp^.right:=node;
+                                   if pararesult^.deftype<>floatdef then
+                                     CGMessage(parser_e_illegal_colon_qualifier);
+                                   if codegenerror then
+                                     exit;
+                                end
+                              else
+                                begin
+                                  if pararesult^.deftype=floatdef then
+                                    push_int(-1);
+                                end;
+                             { push also the real type for floats }
+                              if pararesult^.deftype=floatdef then
+                                push_int(ord(orgfloattype));
+                            end;
+                          case pararesult^.deftype of
+                            stringdef :
+                              begin
+                                emitcall(rdwrprefix[doread]+pstringdef(pararesult)^.stringtypname,true);
+                              end;
+                            pointerdef :
+                              begin
+                                if is_pchar(pararesult) then
+                                  emitcall(rdwrprefix[doread]+'PCHAR_AS_POINTER',true)
+                              end;
+                            arraydef :
+                              begin
+                                if is_chararray(pararesult) then
+                                  emitcall(rdwrprefix[doread]+'PCHAR_AS_ARRAY',true)
+                              end;
+                            floatdef :
+                              begin
+                                emitcall(rdwrprefix[doread]+'FLOAT',true);
+                                if doread then
+                                  StoreDirectFuncResult(destpara);
+                              end;
+                            orddef :
+                              begin
+                                case porddef(pararesult)^.typ of
+                                  s8bit,s16bit,s32bit :
+                                    emitcall(rdwrprefix[doread]+'SINT',true);
+                                  u8bit,u16bit,u32bit :
+                                    emitcall(rdwrprefix[doread]+'UINT',true);
+                                  uchar :
+                                    emitcall(rdwrprefix[doread]+'CHAR',true);
+                                  s64bitint:
+                                    emitcall(rdwrprefix[doread]+'INT64',true);
+                                  u64bit :
+                                    emitcall(rdwrprefix[doread]+'QWORD',true);
+                                  bool8bit,
+                                  bool16bit,
+                                  bool32bit :
+                                    emitcall(rdwrprefix[doread]+'BOOLEAN',true);
+                                end;
+                                if doread then
+                                 StoreDirectFuncResult(destpara);
+                              end;
+                          end;
+                       end;
+                   { load ESI in methods again }
+                     popusedregisters(exprasmlist,pushed);
+                     maybe_loadesi;
+                  end;
+             end;
+         { Insert end of writing for textfiles }
+           if ft=ft_text then
+             begin
+               pushusedregisters(exprasmlist,pushed,$ff);
+               emit_push_mem(aktfile);
+               if doread then
+                begin
+                  if doln then
+                    emitcall('FPC_READLN_END',true)
+                  else
+                    emitcall('FPC_READ_END',true);
+                end
+               else
+                begin
+                  if doln then
+                    emitcall('FPC_WRITELN_END',true)
+                  else
+                    emitcall('FPC_WRITE_END',true);
+                end;
+               popusedregisters(exprasmlist,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);
+             end;
+         { Freeup all used temps }
+           ungetiftemp(aktfile);
+           if assigned(p^.left) then
+             begin
+                p^.left:=reversparameter(p^.left);
+                if npara<>nb_para then
+                  CGMessage(cg_f_internal_error_in_secondinline);
+                hp:=p^.left;
+                while assigned(hp) do
+                  begin
+                     if assigned(hp^.left) then
+                       if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
+                         ungetiftemp(hp^.left^.location.reference);
+                     hp:=hp^.right;
+                  end;
+             end;
+        end;
+
+      procedure handle_str;
+
+        var
+           hp,node : ptree;
+           dummycoll : tdefcoll;
+           is_real,has_length : boolean;
+           realtype : tfloattype;
+           procedureprefix : string;
+
+          begin
+           pushusedregisters(exprasmlist,pushed,$ff);
+           node:=p^.left;
+           is_real:=false;
+           has_length:=false;
+           while assigned(node^.right) do node:=node^.right;
+           { if a real parameter somewhere then call REALSTR }
+           if (node^.left^.resulttype^.deftype=floatdef) then
+            begin
+              is_real:=true;
+              realtype:=pfloatdef(node^.left^.resulttype)^.typ;
+            end;
+
+           node:=p^.left;
+           { we have at least two args }
+           { with at max 2 colon_para in between }
+
+           { string arg }
+           hp:=node;
+           node:=node^.right;
+           hp^.right:=nil;
+           dummycoll.paratyp:=vs_var;
+           if is_shortstring(hp^.resulttype) then
+             dummycoll.data:=openshortstringdef
+           else
+             dummycoll.data:=hp^.resulttype;
+           procedureprefix:='FPC_'+pstringdef(hp^.resulttype)^.stringtypname+'_';
+           secondcallparan(hp,@dummycoll,false,false,false,0);
+           if codegenerror then
+             exit;
+
+           dummycoll.paratyp:=vs_const;
+           disposetree(p^.left);
+           p^.left:=nil;
+           { second arg }
+           hp:=node;
+           node:=node^.right;
+           hp^.right:=nil;
+
+           { if real push real type }
+           if is_real then
+             push_int(ord(realtype));
+
+           { frac  para }
+           if hp^.is_colon_para and assigned(node) and
+              node^.is_colon_para then
+             begin
+                dummycoll.data:=hp^.resulttype;
+                secondcallparan(hp,@dummycoll,false
+                  ,false,false,0
+                  );
+                if codegenerror then
+                  exit;
+                disposetree(hp);
+                hp:=node;
+                node:=node^.right;
+                hp^.right:=nil;
+                has_length:=true;
+             end
+           else
+             if is_real then
+             push_int(-1);
+
+           { third arg, length only if is_real }
+           if hp^.is_colon_para then
+             begin
+                dummycoll.data:=hp^.resulttype;
+                secondcallparan(hp,@dummycoll,false
+                  ,false,false,0
+                  );
+                if codegenerror then
+                  exit;
+                disposetree(hp);
+                hp:=node;
+                node:=node^.right;
+                hp^.right:=nil;
+             end
+           else
+             if is_real then
+               push_int(-32767)
+             else
+               push_int(-1);
+
+           { Convert float to bestreal }
+           if is_real then
+            begin
+              hp^.left:=gentypeconvnode(hp^.left,bestrealdef^);
+              firstpass(hp^.left);
+            end;
+
+           { last arg longint or real }
+           secondcallparan(hp,@dummycoll,false
+             ,false,false,0
+             );
+           if codegenerror then
+             exit;
+
+           if is_real then
+             emitcall(procedureprefix+'FLOAT',true)
+           else
+             case porddef(hp^.resulttype)^.typ of
+                u32bit:
+                  emitcall(procedureprefix+'CARDINAL',true);
+
+                u64bit:
+                  emitcall(procedureprefix+'QWORD',true);
+
+                s64bitint:
+                  emitcall(procedureprefix+'INT64',true);
+
+                else
+                  emitcall(procedureprefix+'LONGINT',true);
+             end;
+           disposetree(hp);
+
+           popusedregisters(exprasmlist,pushed);
+        end;
+
+{$IfnDef OLDVAL}
+
+        Procedure Handle_Val;
+
+        var
+           hp,node, code_para, dest_para : ptree;
+           hreg: TRegister;
+           hdef: POrdDef;
+           procedureprefix : string;
+           hr, hr2: TReference;
+           dummycoll : tdefcoll;
+           has_code, has_32bit_code, oldregisterdef: boolean;
+
+          begin
+           node:=p^.left;
+           hp:=node;
+           node:=node^.right;
+           hp^.right:=nil;
+          {if we have 3 parameters, we have a code parameter}
+           has_code := Assigned(node^.right);
+           has_32bit_code := false;
+           reset_reference(hr);
+           hreg := R_NO;
+
+           If has_code then
+             Begin
+               {code is an orddef, that's checked in tcinl}
+               code_para := hp;
+               hp := node;
+               node := node^.right;
+               hp^.right := nil;
+               has_32bit_code := (porddef(code_para^.left^.resulttype)^.typ in [u32bit,s32bit]);
+             End;
+
+          {hp = destination now, save for later use}
+           dest_para := hp;
+
+          {if EAX is already in use, it's a register variable. Since we don't
+           need another register besides EAX, release the one we got}
+           If hreg <> R_EAX Then ungetregister32(hreg);
+
+          {load and push the address of the destination}
+           dummycoll.paratyp:=vs_var;
+           dummycoll.data:=dest_para^.resulttype;
+           secondcallparan(dest_para,@dummycoll,false,false,false,0);
+           if codegenerror then
+             exit;
+
+          {save the regvars}
+           pushusedregisters(exprasmlist,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}
+
+           If has_32bit_code Then
+             Begin
+               dummycoll.paratyp:=vs_var;
+               dummycoll.data:=code_para^.resulttype;
+               secondcallparan(code_para,@dummycoll,false,false,false,0);
+               if codegenerror then
+                 exit;
+               Disposetree(code_para);
+             End
+           Else
+             Begin
+           {only 32bit code parameter is supported, so fake one}
+               GetTempOfSizeReference(4,hr);
+               emitpushreferenceaddr(exprasmlist,hr);
+             End;
+
+          {node = first parameter = string}
+           dummycoll.paratyp:=vs_const;
+           dummycoll.data:=node^.resulttype;
+           secondcallparan(node,@dummycoll,false,false,false,0);
+           if codegenerror then
+             exit;
+
+           Case dest_para^.resulttype^.deftype of
+             floatdef:
+               procedureprefix := 'FPC_VAL_REAL_';
+             orddef:
+               if is_signed(dest_para^.resulttype) then
+                 begin
+                   {if we are converting to a signed number, we have to include the
+                    size of the destination, so the Val function can extend the sign
+                    of the result to allow proper range checking}
+                   exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,dest_para^.resulttype^.size)));
+                   procedureprefix := 'FPC_VAL_SINT_'
+                 end
+               else
+                 procedureprefix := 'FPC_VAL_UINT_';
+           End;
+           emitcall(procedureprefix+pstringdef(node^.resulttype)^.stringtypname,true);
+           { before disposing node we need to ungettemp !! PM }
+           if node^.left^.location.loc in [LOC_REFERENCE,LOC_MEM] then
+             ungetiftemp(node^.left^.location.reference);
+           disposetree(node);
+           p^.left := nil;
+
+          {reload esi in case the dest_para/code_para is a class variable or so}
+           maybe_loadesi;
+
+           If (dest_para^.resulttype^.deftype = orddef) Then
+             Begin
+              {store the result in a safe place, because EAX may be used by a
+               register variable}
+               hreg := getexplicitregister32(R_EAX);
+               emit_reg_reg(A_MOV,S_L,R_EAX,hreg);
+              {as of now, hreg now holds the location of the result, if it was
+               integer}
+             End;
+
+           { restore the register vars}
+
+           popusedregisters(exprasmlist,pushed);
+
+           If has_code and Not(has_32bit_code) Then
+             {only 16bit code is possible}
+             Begin
+              {load the address of the code parameter}
+               secondpass(code_para^.left);
+              {move the code to its destination}
+               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,NewReference(hr),R_EDI)));
+               emit_mov_reg_loc(R_DI,code_para^.left^.location);
+               Disposetree(code_para);
+             End;
+
+          {restore the address of the result}
+           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
+
+          {set up hr2 to a refernce with EDI as base register}
+           reset_reference(hr2);
+           hr2.base := R_EDI;
+
+          {save the function result in the destination variable}
+           Case dest_para^.left^.resulttype^.deftype of
+             floatdef:
+               floatstore(PFloatDef(dest_para^.left^.resulttype)^.typ, hr2);
+             orddef:
+               Case PordDef(dest_para^.left^.resulttype)^.typ of
+                 u8bit,s8bit:
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_B,
+                     RegToReg8(hreg),newreference(hr2))));
+                 u16bit,s16bit:
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_W,
+                     RegToReg16(hreg),newreference(hr2))));
+                 u32bit,s32bit:
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_L,
+                     hreg,newreference(hr2))));
+                 {u64bit,s64bitint: ???}
+               End;
+           End;
+           If (cs_check_range in aktlocalswitches) and
+              (dest_para^.left^.resulttype^.deftype = orddef) and
+            {the following has to be changed to 64bit checking, once Val
+             returns 64 bit values (unless a special Val function is created
+             for that)}
+            {no need to rangecheck longints or cardinals on 32bit processors}
+               not((porddef(dest_para^.left^.resulttype)^.typ = s32bit) and
+                   (porddef(dest_para^.left^.resulttype)^.low = $80000000) and
+                   (porddef(dest_para^.left^.resulttype)^.high = $7fffffff)) and
+               not((porddef(dest_para^.left^.resulttype)^.typ = u32bit) and
+                   (porddef(dest_para^.left^.resulttype)^.low = 0) and
+                   (porddef(dest_para^.left^.resulttype)^.high = $ffffffff)) then
+             Begin
+               hp := getcopy(dest_para^.left);
+               hp^.location.loc := LOC_REGISTER;
+               hp^.location.register := hreg;
+              {do not register this temporary def}
+               OldRegisterDef := RegisterDef;
+               RegisterDef := False;
+               Case PordDef(dest_para^.left^.resulttype)^.typ of
+                 u8bit,u16bit,u32bit: new(hdef,init(u32bit,0,$ffffffff));
+                 s8bit,s16bit,s32bit: new(hdef,init(s32bit,$80000000,$7fffffff));
+               end;
+               hp^.resulttype := hdef;
+               emitrangecheck(hp,dest_para^.left^.resulttype);
+               hp^.right := nil;
+               Dispose(hp^.resulttype, Done);
+               RegisterDef := OldRegisterDef;
+               disposetree(hp);
+             End;
+          {dest_para^.right is already nil}
+           disposetree(dest_para);
+           UnGetIfTemp(hr);
+        end;
+{$EndIf OLDVAL}
+
+      var
+         r : preference;
+         hp : ptree;
+         l : longint;
+         ispushed : boolean;
+         hregister : tregister;
+         otlabel,oflabel   : plabel;
+         oldpushedparasize : longint;
+
+      begin
+      { save & reset pushedparasize }
+         oldpushedparasize:=pushedparasize;
+         pushedparasize:=0;
+         case p^.inlinenumber of
+            in_assert_x_y:
+              begin
+                 otlabel:=truelabel;
+                 oflabel:=falselabel;
+                 getlabel(truelabel);
+                 getlabel(falselabel);
+                 secondpass(p^.left^.left);
+                 if cs_do_assertion in aktlocalswitches then
+                   begin
+                      maketojumpbool(p^.left^.left);
+                      emitlab(falselabel);
+                      { erroraddr }
+                      exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
+                      { lineno }
+                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,aktfilepos.line)));
+                      { filename string }
+                      hp:=genstringconstnode(current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex));
+                      secondpass(hp);
+                      if codegenerror then
+                       exit;
+                      emitpushreferenceaddr(exprasmlist,hp^.location.reference);
+                      disposetree(hp);
+                      { push msg }
+                      secondpass(p^.left^.right^.left);
+                      emitpushreferenceaddr(exprasmlist,p^.left^.right^.left^.location.reference);
+                      { call }
+                      emitcall('FPC_ASSERT',true);
+                      emitlab(truelabel);
+                   end;
+                 freelabel(truelabel);
+                 freelabel(falselabel);
+                 truelabel:=otlabel;
+                 falselabel:=oflabel;
+              end;
+            in_lo_word,
+            in_hi_word :
+              begin
+                 secondpass(p^.left);
+                 p^.location.loc:=LOC_REGISTER;
+                 if p^.left^.location.loc<>LOC_REGISTER then
+                   begin
+                     if p^.left^.location.loc=LOC_CREGISTER then
+                       begin
+                          p^.location.register:=reg32toreg16(getregister32);
+                          emit_reg_reg(A_MOV,S_W,p^.left^.location.register,
+                            p^.location.register);
+                       end
+                     else
+                       begin
+                          del_reference(p^.left^.location.reference);
+                          p^.location.register:=reg32toreg16(getregister32);
+                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,newreference(p^.left^.location.reference),
+                            p^.location.register)));
+                       end;
+                   end
+                 else p^.location.register:=p^.left^.location.register;
+                 if p^.inlinenumber=in_hi_word then
+                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_W,8,p^.location.register)));
+                 p^.location.register:=reg16toreg8(p^.location.register);
+              end;
+            in_sizeof_x,
+            in_typeof_x :
+              begin
+                 { for both cases load vmt }
+                 if p^.left^.treetype=typen then
+                   begin
+                      p^.location.register:=getregister32;
+                      exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,
+                        S_L,newasmsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname),0,
+                        p^.location.register)));
+                   end
+                 else
+                   begin
+                      secondpass(p^.left);
+                      del_reference(p^.left^.location.reference);
+                      p^.location.loc:=LOC_REGISTER;
+                      p^.location.register:=getregister32;
+                      { load VMT pointer }
+                      inc(p^.left^.location.reference.offset,
+                        pobjectdef(p^.left^.resulttype)^.vmt_offset);
+                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                      newreference(p^.left^.location.reference),
+                        p^.location.register)));
+                   end;
+                 { in sizeof load size }
+                 if p^.inlinenumber=in_sizeof_x then
+                   begin
+                      new(r);
+                      reset_reference(r^);
+                      r^.base:=p^.location.register;
+                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,
+                        p^.location.register)));
+                   end;
+              end;
+            in_lo_long,
+            in_hi_long :
+              begin
+                 secondpass(p^.left);
+                 p^.location.loc:=LOC_REGISTER;
+                 if p^.left^.location.loc<>LOC_REGISTER then
+                   begin
+                      if p^.left^.location.loc=LOC_CREGISTER then
+                        begin
+                           p^.location.register:=getregister32;
+                           emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
+                             p^.location.register);
+                        end
+                      else
+                        begin
+                           del_reference(p^.left^.location.reference);
+                           p^.location.register:=getregister32;
+                           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
+                             p^.location.register)));
+                        end;
+                   end
+                 else p^.location.register:=p^.left^.location.register;
+                 if p^.inlinenumber=in_hi_long then
+                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_L,16,p^.location.register)));
+                 p^.location.register:=reg32toreg16(p^.location.register);
+              end;
+            in_length_string :
+              begin
+                 secondpass(p^.left);
+                 set_location(p^.location,p^.left^.location);
+                 { length in ansi strings is at offset -8 }
+                 if is_ansistring(p^.left^.resulttype) then
+                   dec(p^.location.reference.offset,8)
+                 { char is always 1, so make it a constant value }
+                 else if is_char(p^.left^.resulttype) then
+                   begin
+                     clear_location(p^.location);
+                     p^.location.loc:=LOC_MEM;
+                     p^.location.reference.is_immediate:=true;
+                     p^.location.reference.offset:=1;
+                   end;
+              end;
+            in_pred_x,
+            in_succ_x:
+              begin
+                 secondpass(p^.left);
+                 if not (cs_check_overflow in aktlocalswitches) then
+                   if p^.inlinenumber=in_pred_x then
+                     asmop:=A_DEC
+                   else
+                     asmop:=A_INC
+                 else
+                   if p^.inlinenumber=in_pred_x then
+                     asmop:=A_SUB
+                   else
+                     asmop:=A_ADD;
+                 case p^.resulttype^.size of
+                   4 : opsize:=S_L;
+                   2 : opsize:=S_W;
+                   1 : opsize:=S_B;
+                 else
+                   internalerror(10080);
+                 end;
+                 p^.location.loc:=LOC_REGISTER;
+                 if p^.left^.location.loc<>LOC_REGISTER then
+                   begin
+                      p^.location.register:=getregister32;
+                      if (p^.resulttype^.size=2) then
+                        p^.location.register:=reg32toreg16(p^.location.register);
+                      if (p^.resulttype^.size=1) then
+                        p^.location.register:=reg32toreg8(p^.location.register);
+                      if p^.left^.location.loc=LOC_CREGISTER then
+                        emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
+                          p^.location.register)
+                      else
+                      if p^.left^.location.loc=LOC_FLAGS then
+                        emit_flag2reg(p^.left^.location.resflags,p^.location.register)
+                      else
+                        begin
+                           del_reference(p^.left^.location.reference);
+                           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,newreference(p^.left^.location.reference),
+                             p^.location.register)));
+                        end;
+                   end
+                 else p^.location.register:=p^.left^.location.register;
+
+                 if not (cs_check_overflow in aktlocalswitches) then
+                   exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
+                     p^.location.register)))
+                 else
+                   exprasmlist^.concat(new(pai386,op_const_reg(asmop,opsize,1,
+                     p^.location.register)));
+                 emitoverflowcheck(p);
+                 emitrangecheck(p,p^.resulttype);
+              end;
+            in_dec_x,
+            in_inc_x :
+              begin
+              { set defaults }
+                addvalue:=1;
+                addconstant:=true;
+              { load first parameter, must be a reference }
+                secondpass(p^.left^.left);
+                case p^.left^.left^.resulttype^.deftype of
+                  orddef,
+                 enumdef : begin
+                             case p^.left^.left^.resulttype^.size of
+                              1 : opsize:=S_B;
+                              2 : opsize:=S_W;
+                              4 : opsize:=S_L;
+                             end;
+                           end;
+              pointerdef : begin
+                             opsize:=S_L;
+                             if porddef(ppointerdef(p^.left^.left^.resulttype)^.definition)=voiddef then
+                              addvalue:=1
+                             else
+                              addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
+                           end;
+                else
+                 internalerror(10081);
+                end;
+              { second argument specified?, must be a s32bit in register }
+                if assigned(p^.left^.right) then
+                 begin
+                   secondpass(p^.left^.right^.left);
+                 { when constant, just multiply the addvalue }
+                   if is_constintnode(p^.left^.right^.left) then
+                    addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
+                   else
+                    begin
+                      case p^.left^.right^.left^.location.loc of
+                   LOC_REGISTER,
+                  LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
+                        LOC_MEM,
+                  LOC_REFERENCE : begin
+                                    del_reference(p^.left^.right^.left^.location.reference);
+                                    hregister:=getregister32;
+                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                      newreference(p^.left^.right^.left^.location.reference),hregister)));
+                                  end;
+                       else
+                        internalerror(10082);
+                       end;
+                    { insert multiply with addvalue if its >1 }
+                      if addvalue>1 then
+                       exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,opsize,
+                         addvalue,hregister)));
+                      addconstant:=false;
+                    end;
+                 end;
+              { write the add instruction }
+                if addconstant then
+                 begin
+                   if (addvalue=1) and not(cs_check_overflow in aktlocalswitches) then
+                     begin
+                        if p^.left^.left^.location.loc=LOC_CREGISTER then
+                          exprasmlist^.concat(new(pai386,op_reg(incdecop[p^.inlinenumber],opsize,
+                            p^.left^.left^.location.register)))
+                        else
+                          exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize,
+                            newreference(p^.left^.left^.location.reference))))
+                     end
+                   else
+                     begin
+                        if p^.left^.left^.location.loc=LOC_CREGISTER then
+                          exprasmlist^.concat(new(pai386,op_const_reg(addsubop[p^.inlinenumber],opsize,
+                            addvalue,p^.left^.left^.location.register)))
+                        else
+                          exprasmlist^.concat(new(pai386,op_const_ref(addsubop[p^.inlinenumber],opsize,
+                            addvalue,newreference(p^.left^.left^.location.reference))));
+                     end
+                 end
+                else
+                 begin
+                    { BUG HERE : detected with nasm :
+                      hregister is allways 32 bit
+                      it should be converted to 16 or 8 bit depending on op_size  PM }
+                    { still not perfect :
+                      if hregister is already a 16 bit reg ?? PM }
+                    case opsize of
+                      S_B : hregister:=reg32toreg8(hregister);
+                      S_W : hregister:=reg32toreg16(hregister);
+                    end;
+                    if p^.left^.left^.location.loc=LOC_CREGISTER then
+                      exprasmlist^.concat(new(pai386,op_reg_reg(addsubop[p^.inlinenumber],opsize,
+                        hregister,p^.left^.left^.location.register)))
+                    else
+                      exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
+                        hregister,newreference(p^.left^.left^.location.reference))));
+                    case opsize of
+                      S_B : hregister:=reg8toreg32(hregister);
+                      S_W : hregister:=reg16toreg32(hregister);
+                    end;
+                   ungetregister32(hregister);
+                 end;
+                emitoverflowcheck(p^.left^.left);
+                emitrangecheck(p^.left^.left,p^.left^.left^.resulttype);
+              end;
+            in_assigned_x :
+              begin
+                 secondpass(p^.left^.left);
+                 p^.location.loc:=LOC_FLAGS;
+                 if (p^.left^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+                   begin
+                      exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,
+                        p^.left^.left^.location.register,
+                        p^.left^.left^.location.register)));
+                      ungetregister32(p^.left^.left^.location.register);
+                   end
+                 else
+                   begin
+                      exprasmlist^.concat(new(pai386,op_const_ref(A_CMP,S_L,0,
+                        newreference(p^.left^.left^.location.reference))));
+                      del_reference(p^.left^.left^.location.reference);
+                   end;
+                 p^.location.resflags:=F_NE;
+              end;
+             in_reset_typedfile,in_rewrite_typedfile :
+               begin
+                  pushusedregisters(exprasmlist,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);
+                  if p^.inlinenumber=in_reset_typedfile then
+                    emitcall('FPC_RESET_TYPED',true)
+                  else
+                    emitcall('FPC_REWRITE_TYPED',true);
+                  popusedregisters(exprasmlist,pushed);
+               end;
+            in_write_x :
+              handlereadwrite(false,false);
+            in_writeln_x :
+              handlereadwrite(false,true);
+            in_read_x :
+              handlereadwrite(true,false);
+            in_readln_x :
+              handlereadwrite(true,true);
+            in_str_x_string :
+              begin
+                 handle_str;
+                 maybe_loadesi;
+              end;
+{$IfnDef OLDVAL}
+            in_val_x :
+              Begin
+                handle_val;
+              End;
+{$EndIf OLDVAL}
+            in_include_x_y,
+            in_exclude_x_y:
+              begin
+                 secondpass(p^.left^.left);
+                 if p^.left^.right^.left^.treetype=ordconstn then
+                   begin
+                      { calculate bit position }
+                      l:=1 shl (p^.left^.right^.left^.value mod 32);
+
+                      { determine operator }
+                      if p^.inlinenumber=in_include_x_y then
+                        asmop:=A_OR
+                      else
+                        begin
+                           asmop:=A_AND;
+                           l:=not(l);
+                        end;
+                      if (p^.left^.left^.location.loc=LOC_REFERENCE) then
+                        begin
+                           inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
+                           exprasmlist^.concat(new(pai386,op_const_ref(asmop,S_L,
+                             l,newreference(p^.left^.left^.location.reference))));
+                           del_reference(p^.left^.left^.location.reference);
+                        end
+                      else
+                        { LOC_CREGISTER }
+                        exprasmlist^.concat(new(pai386,op_const_reg(asmop,S_L,
+                          l,p^.left^.left^.location.register)));
+                   end
+                 else
+                   begin
+                      { generate code for the element to set }
+                      ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
+                      secondpass(p^.left^.right^.left);
+                      if ispushed then
+                        restore(p^.left^.left);
+                      { determine asm operator }
+                      if p^.inlinenumber=in_include_x_y then
+                        asmop:=A_BTS
+                      else
+                        asmop:=A_BTR;
+                      if psetdef(p^.left^.resulttype)^.settype=smallset then
+                        begin
+                           if p^.left^.right^.left^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
+                             hregister:=p^.left^.right^.left^.location.register
+                           else
+                             begin
+                                hregister:=R_EDI;
+                                opsize:=def2def_opsize(p^.left^.right^.left^.resulttype,u32bitdef);
+                                if opsize in [S_B,S_W,S_L] then
+                                 op:=A_MOV
+                                else
+                                 op:=A_MOVZX;
+                                exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
+                                  newreference(p^.left^.right^.left^.location.reference),R_EDI)));
+                             end;
+                          if (p^.left^.left^.location.loc=LOC_REFERENCE) then
+                            exprasmlist^.concat(new(pai386,op_reg_ref(asmop,S_L,hregister,
+                              newreference(p^.left^.right^.left^.location.reference))))
+                          else
+                            exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,hregister,
+                              p^.left^.right^.left^.location.register)));
+                        end
+                      else
+                        begin
+                           pushsetelement(p^.left^.right^.left);
+                           { normset is allways a ref }
+                           emitpushreferenceaddr(exprasmlist,
+                             p^.left^.left^.location.reference);
+                           if p^.inlinenumber=in_include_x_y then
+                             emitcall('FPC_SET_SET_BYTE',true)
+                           else
+                             emitcall('FPC_SET_UNSET_BYTE',true);
+                           {CGMessage(cg_e_include_not_implemented);}
+                        end;
+                   end;
+              end;
+            else internalerror(9);
+         end;
+         { reset pushedparasize }
+         pushedparasize:=oldpushedparasize;
+      end;
+
+end.
+{
   $Log$
-  Revision 1.52  1999-05-21 13:54:50  peter
+  Revision 1.53  1999-05-23 18:42:01  florian
+    * better error recovering in typed constants
+    * some problems with arrays of const fixed, some problems
+      due my previous
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.52  1999/05/21 13:54:50  peter
     * NEWLAB for label as symbol
-
-  Revision 1.51  1999/05/18 21:58:27  florian
-    * fixed some bugs related to temp. ansistrings and functions results
-      which return records/objects/arrays which need init/final.
-
-  Revision 1.50  1999/05/17 21:57:03  florian
-    * new temporary ansistring handling
-
-  Revision 1.49  1999/05/12 15:46:26  pierre
-   * handle_str disposetree was badly placed
-
-  Revision 1.48  1999/05/12 00:19:42  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.47  1999/05/06 09:05:13  peter
-    * generic write_float and str_float
-    * fixed constant float conversions
-
-  Revision 1.46  1999/05/05 16:18:20  jonas
-    * changes to handle_val so register vars are pushed/poped only once
-
-  Revision 1.45  1999/05/01 13:24:08  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.44  1999/04/26 18:28:13  peter
-    * better read/write array
-
-  Revision 1.43  1999/04/19 09:45:48  pierre
-    +  cdecl or stdcall push all args with longint size
-    *  tempansi stuff cleaned up
-
-  Revision 1.42  1999/04/14 09:11:59  peter
-    * fixed include
-
-  Revision 1.41  1999/04/08 23:59:49  pierre
-   * temp string for val code freed
-
-  Revision 1.40  1999/04/08 15:57:46  peter
-    + subrange checking for readln()
-
-  Revision 1.39  1999/04/07 15:31:16  pierre
-    * all formaldefs are now a sinlge definition
-      cformaldef (this was necessary for double_checksum)
-    + small part of double_checksum code
-
-  Revision 1.38  1999/04/05 11:07:26  jonas
-    * fixed some typos in the constants of the range checking for Val
-
-  Revision 1.37  1999/04/01 22:07:51  peter
-    * universal string names (ansistr instead of stransi) for val/str
-
-  Revision 1.36  1999/04/01 06:21:04  jonas
-    * added initialization for has_32bit_code (caused problems with Val statement
-      without code parameter)
-
-  Revision 1.35  1999/03/31 20:30:49  michael
-  * fixed typo: odlval to oldval
-
-  Revision 1.34  1999/03/31 17:13:09  jonas
-    * bugfix for -Ox with internal val code
-    * internal val code now requires less free registers
-    * internal val code no longer needs a temp var for range checking
-
-  Revision 1.33  1999/03/26 00:24:15  peter
-    * last para changed to long for easier pushing with 4 byte aligns
-
-  Revision 1.32  1999/03/26 00:05:26  peter
-    * released valintern
-    + deffile is now removed when compiling is finished
-    * ^( compiles now correct
-    + static directive
-    * shrd fixed
-
-  Revision 1.31  1999/03/24 23:16:49  peter
-    * fixed bugs 212,222,225,227,229,231,233
-
-  Revision 1.30  1999/03/16 17:52:56  jonas
-    * changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
-    * in cgi386inl: also range checking for subrange types (compile with "-dreadrangecheck")
-    * in cgai386: also small fixes to emitrangecheck
-
-  Revision 1.29  1999/02/25 21:02:27  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.28  1999/02/22 02:15:11  peter
-    * updates for ag386bin
-
-  Revision 1.27  1999/02/17 14:21:40  pierre
-   * unused local removed
-
-  Revision 1.26  1999/02/15 11:40:21  pierre
-   * pred/succ with overflow check must use ADD DEC !!
-
-  Revision 1.25  1999/02/05 10:56:19  florian
-    * in some cases a writeln of temp. ansistrings cause a memory leak, fixed
-
-  Revision 1.24  1999/01/21 22:10:39  peter
-    * fixed array of const
-    * generic platform independent high() support
-
-  Revision 1.23  1999/01/06 12:23:29  florian
-    * str(...) for ansi/long and widestrings fixed
-
-  Revision 1.22  1998/12/11 23:36:07  florian
-    + again more stuff for int64/qword:
-         - comparision operators
-         - code generation for: str, read(ln), write(ln)
-
-  Revision 1.21  1998/12/11 00:02:50  peter
-    + globtype,tokens,version unit splitted from globals
-
-  Revision 1.20  1998/11/27 14:50:32  peter
-    + open strings, $P switch support
-
-  Revision 1.19  1998/11/26 13:10:40  peter
-    * new int - int conversion -dNEWCNV
-    * some function renamings
-
-  Revision 1.18  1998/11/24 17:04:27  peter
-    * fixed length(char) when char is a variable
-
-  Revision 1.17  1998/11/05 12:02:33  peter
-    * released useansistring
-    * removed -Sv, its now available in fpc modes
-
-  Revision 1.16  1998/10/22 17:11:13  pierre
-    + terminated the include exclude implementation for i386
-    * enums inside records fixed
-
-  Revision 1.15  1998/10/21 15:12:50  pierre
-    * bug fix for IOCHECK inside a procedure with iocheck modifier
-    * removed the GPF for unexistant overloading
-      (firstcall was called with procedinition=nil !)
-    * changed typen to what Florian proposed
-      gentypenode(p : pdef) sets the typenodetype field
-      and resulttype is only set if inside bt_type block !
-
-  Revision 1.14  1998/10/20 08:06:40  pierre
-    * several memory corruptions due to double freemem solved
-      => never use p^.loc.location:=p^.left^.loc.location;
-    + finally I added now by default
-      that ra386dir translates global and unit symbols
-    + added a first field in tsymtable and
-      a nextsym field in tsym
-      (this allows to obtain ordered type info for
-      records and objects in gdb !)
-
-  Revision 1.13  1998/10/13 16:50:02  pierre
-    * undid some changes of Peter that made the compiler wrong
-      for m68k (I had to reinsert some ifdefs)
-    * removed several memory leaks under m68k
-    * removed the meory leaks for assembler readers
-    * cross compiling shoud work again better
-      ( crosscompiling sysamiga works
-       but as68k still complain about some code !)
-
-  Revision 1.12  1998/10/08 17:17:12  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.11  1998/10/05 21:33:15  peter
-    * fixed 161,165,166,167,168
-
-  Revision 1.10  1998/10/05 12:32:44  peter
-    + assert() support
-
-  Revision 1.8  1998/10/02 10:35:09  peter
-    * support for inc(pointer,value) which now increases with value instead
-      of 0*value :)
-
-  Revision 1.7  1998/09/21 08:45:07  pierre
-    + added vmt_offset in tobjectdef.write for fututre use
-      (first steps to have objects without vmt if no virtual !!)
-    + added fpu_used field for tabstractprocdef  :
-      sets this level to 2 if the functions return with value in FPU
-      (is then set to correct value at parsing of implementation)
-      THIS MIGHT refuse some code with FPU expression too complex
-      that were accepted before and even in some cases
-      that don't overflow in fact
-      ( like if f : float; is a forward that finally in implementation
-       only uses one fpu register !!)
-      Nevertheless I think that it will improve security on
-      FPU operations !!
-    * most other changes only for UseBrowser code
-      (added symtable references for record and objects)
-      local switch for refs to args and local of each function
-      (static symtable still missing)
-      UseBrowser still not stable and probably broken by
-      the definition hash array !!
-
-  Revision 1.6  1998/09/20 12:26:37  peter
-    * merged fixes
-
-  Revision 1.5  1998/09/17 09:42:15  peter
-    + pass_2 for cg386
-    * Message() -> CGMessage() for pass_1/pass_2
-
-  Revision 1.4  1998/09/14 10:43:49  peter
-    * all internal RTL functions start with FPC_
-
-  Revision 1.3.2.1  1998/09/20 12:20:07  peter
-    * Fixed stack not on 4 byte boundary when doing a call
-
-  Revision 1.3  1998/09/05 23:03:57  florian
-    * some fixes to get -Or work:
-      - inc/dec didn't take care of CREGISTER
-      - register calculcation of inc/dec was wrong
-      - var/const parameters get now assigned 32 bit register, but
-        const parameters only if they are passed by reference !
-
-  Revision 1.2  1998/09/04 08:41:40  peter
-    * updated some error CGMessages
-
-  Revision 1.1  1998/08/31 12:22:14  peter
-    * secondinline moved to cg386inl
-
-  Revision 1.19  1998/08/31 08:52:03  peter
-    * fixed error 10 with succ() and pref()
-
-  Revision 1.18  1998/08/20 21:36:38  peter
-    * fixed 'with object do' bug
-
-  Revision 1.17  1998/08/19 16:07:36  jonas
-    * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
-
-  Revision 1.16  1998/08/18 09:24:36  pierre
-    * small warning position bug fixed
-    * support_mmx switches splitting was missing
-    * rhide error and warning output corrected
-
-  Revision 1.15  1998/08/13 11:00:09  peter
-    * fixed procedure<>procedure construct
-
-  Revision 1.14  1998/08/11 14:05:33  peter
-    * fixed sizeof(array of char)
-
-  Revision 1.13  1998/08/10 14:49:45  peter
-    + localswitches, moduleswitches, globalswitches splitting
-
-  Revision 1.12  1998/07/30 13:30:31  florian
-    * final implemenation of exception support, maybe it needs
-      some fixes :)
-
-  Revision 1.11  1998/07/24 22:16:52  florian
-    * internal error 10 together with array access fixed. I hope
-      that's the final fix.
-
-  Revision 1.10  1998/07/18 22:54:23  florian
-    * some ansi/wide/longstring support fixed:
-       o parameter passing
-       o returning as result from functions
-
-  Revision 1.9  1998/07/07 17:40:37  peter
-    * packrecords 4 works
-    * word aligning of parameters
-
-  Revision 1.8  1998/07/06 15:51:15  michael
-  Added length checking for string reading
-
-  Revision 1.7  1998/07/06 14:19:51  michael
-  + Added calls for reading/writing ansistrings
-
-  Revision 1.6  1998/07/01 15:28:48  peter
-    + better writeln/readln handling, now 100% like tp7
-
-  Revision 1.5  1998/06/25 14:04:17  peter
-    + internal inc/dec
-
-  Revision 1.4  1998/06/25 08:48:06  florian
-    * first version of rtti support
-
-  Revision 1.3  1998/06/09 16:01:33  pierre
-    + added procedure directive parsing for procvars
-      (accepted are popstack cdecl and pascal)
-    + added C vars with the following syntax
-      var C calias 'true_c_name';(can be followed by external)
-      reason is that you must add the Cprefix
-
-      which is target dependent
-
-  Revision 1.2  1998/06/08 13:13:29  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:10  peter
-    * splitted cgi386
-
-}
-
+
+  Revision 1.51  1999/05/18 21:58:27  florian
+    * fixed some bugs related to temp. ansistrings and functions results
+      which return records/objects/arrays which need init/final.
+
+  Revision 1.50  1999/05/17 21:57:03  florian
+    * new temporary ansistring handling
+
+  Revision 1.49  1999/05/12 15:46:26  pierre
+   * handle_str disposetree was badly placed
+
+  Revision 1.48  1999/05/12 00:19:42  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.47  1999/05/06 09:05:13  peter
+    * generic write_float and str_float
+    * fixed constant float conversions
+
+  Revision 1.46  1999/05/05 16:18:20  jonas
+    * changes to handle_val so register vars are pushed/poped only once
+
+  Revision 1.45  1999/05/01 13:24:08  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.44  1999/04/26 18:28:13  peter
+    * better read/write array
+
+  Revision 1.43  1999/04/19 09:45:48  pierre
+    +  cdecl or stdcall push all args with longint size
+    *  tempansi stuff cleaned up
+
+  Revision 1.42  1999/04/14 09:11:59  peter
+    * fixed include
+
+  Revision 1.41  1999/04/08 23:59:49  pierre
+   * temp string for val code freed
+
+  Revision 1.40  1999/04/08 15:57:46  peter
+    + subrange checking for readln()
+
+  Revision 1.39  1999/04/07 15:31:16  pierre
+    * all formaldefs are now a sinlge definition
+      cformaldef (this was necessary for double_checksum)
+    + small part of double_checksum code
+
+  Revision 1.38  1999/04/05 11:07:26  jonas
+    * fixed some typos in the constants of the range checking for Val
+
+  Revision 1.37  1999/04/01 22:07:51  peter
+    * universal string names (ansistr instead of stransi) for val/str
+
+  Revision 1.36  1999/04/01 06:21:04  jonas
+    * added initialization for has_32bit_code (caused problems with Val statement
+      without code parameter)
+
+  Revision 1.35  1999/03/31 20:30:49  michael
+  * fixed typo: odlval to oldval
+
+  Revision 1.34  1999/03/31 17:13:09  jonas
+    * bugfix for -Ox with internal val code
+    * internal val code now requires less free registers
+    * internal val code no longer needs a temp var for range checking
+
+  Revision 1.33  1999/03/26 00:24:15  peter
+    * last para changed to long for easier pushing with 4 byte aligns
+
+  Revision 1.32  1999/03/26 00:05:26  peter
+    * released valintern
+    + deffile is now removed when compiling is finished
+    * ^( compiles now correct
+    + static directive
+    * shrd fixed
+
+  Revision 1.31  1999/03/24 23:16:49  peter
+    * fixed bugs 212,222,225,227,229,231,233
+
+  Revision 1.30  1999/03/16 17:52:56  jonas
+    * changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
+    * in cgi386inl: also range checking for subrange types (compile with "-dreadrangecheck")
+    * in cgai386: also small fixes to emitrangecheck
+
+  Revision 1.29  1999/02/25 21:02:27  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.28  1999/02/22 02:15:11  peter
+    * updates for ag386bin
+
+  Revision 1.27  1999/02/17 14:21:40  pierre
+   * unused local removed
+
+  Revision 1.26  1999/02/15 11:40:21  pierre
+   * pred/succ with overflow check must use ADD DEC !!
+
+  Revision 1.25  1999/02/05 10:56:19  florian
+    * in some cases a writeln of temp. ansistrings cause a memory leak, fixed
+
+  Revision 1.24  1999/01/21 22:10:39  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.23  1999/01/06 12:23:29  florian
+    * str(...) for ansi/long and widestrings fixed
+
+  Revision 1.22  1998/12/11 23:36:07  florian
+    + again more stuff for int64/qword:
+         - comparision operators
+         - code generation for: str, read(ln), write(ln)
+
+  Revision 1.21  1998/12/11 00:02:50  peter
+    + globtype,tokens,version unit splitted from globals
+
+  Revision 1.20  1998/11/27 14:50:32  peter
+    + open strings, $P switch support
+
+  Revision 1.19  1998/11/26 13:10:40  peter
+    * new int - int conversion -dNEWCNV
+    * some function renamings
+
+  Revision 1.18  1998/11/24 17:04:27  peter
+    * fixed length(char) when char is a variable
+
+  Revision 1.17  1998/11/05 12:02:33  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.16  1998/10/22 17:11:13  pierre
+    + terminated the include exclude implementation for i386
+    * enums inside records fixed
+
+  Revision 1.15  1998/10/21 15:12:50  pierre
+    * bug fix for IOCHECK inside a procedure with iocheck modifier
+    * removed the GPF for unexistant overloading
+      (firstcall was called with procedinition=nil !)
+    * changed typen to what Florian proposed
+      gentypenode(p : pdef) sets the typenodetype field
+      and resulttype is only set if inside bt_type block !
+
+  Revision 1.14  1998/10/20 08:06:40  pierre
+    * several memory corruptions due to double freemem solved
+      => never use p^.loc.location:=p^.left^.loc.location;
+    + finally I added now by default
+      that ra386dir translates global and unit symbols
+    + added a first field in tsymtable and
+      a nextsym field in tsym
+      (this allows to obtain ordered type info for
+      records and objects in gdb !)
+
+  Revision 1.13  1998/10/13 16:50:02  pierre
+    * undid some changes of Peter that made the compiler wrong
+      for m68k (I had to reinsert some ifdefs)
+    * removed several memory leaks under m68k
+    * removed the meory leaks for assembler readers
+    * cross compiling shoud work again better
+      ( crosscompiling sysamiga works
+       but as68k still complain about some code !)
+
+  Revision 1.12  1998/10/08 17:17:12  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.11  1998/10/05 21:33:15  peter
+    * fixed 161,165,166,167,168
+
+  Revision 1.10  1998/10/05 12:32:44  peter
+    + assert() support
+
+  Revision 1.8  1998/10/02 10:35:09  peter
+    * support for inc(pointer,value) which now increases with value instead
+      of 0*value :)
+
+  Revision 1.7  1998/09/21 08:45:07  pierre
+    + added vmt_offset in tobjectdef.write for fututre use
+      (first steps to have objects without vmt if no virtual !!)
+    + added fpu_used field for tabstractprocdef  :
+      sets this level to 2 if the functions return with value in FPU
+      (is then set to correct value at parsing of implementation)
+      THIS MIGHT refuse some code with FPU expression too complex
+      that were accepted before and even in some cases
+      that don't overflow in fact
+      ( like if f : float; is a forward that finally in implementation
+       only uses one fpu register !!)
+      Nevertheless I think that it will improve security on
+      FPU operations !!
+    * most other changes only for UseBrowser code
+      (added symtable references for record and objects)
+      local switch for refs to args and local of each function
+      (static symtable still missing)
+      UseBrowser still not stable and probably broken by
+      the definition hash array !!
+
+  Revision 1.6  1998/09/20 12:26:37  peter
+    * merged fixes
+
+  Revision 1.5  1998/09/17 09:42:15  peter
+    + pass_2 for cg386
+    * Message() -> CGMessage() for pass_1/pass_2
+
+  Revision 1.4  1998/09/14 10:43:49  peter
+    * all internal RTL functions start with FPC_
+
+  Revision 1.3.2.1  1998/09/20 12:20:07  peter
+    * Fixed stack not on 4 byte boundary when doing a call
+
+  Revision 1.3  1998/09/05 23:03:57  florian
+    * some fixes to get -Or work:
+      - inc/dec didn't take care of CREGISTER
+      - register calculcation of inc/dec was wrong
+      - var/const parameters get now assigned 32 bit register, but
+        const parameters only if they are passed by reference !
+
+  Revision 1.2  1998/09/04 08:41:40  peter
+    * updated some error CGMessages
+
+  Revision 1.1  1998/08/31 12:22:14  peter
+    * secondinline moved to cg386inl
+
+  Revision 1.19  1998/08/31 08:52:03  peter
+    * fixed error 10 with succ() and pref()
+
+  Revision 1.18  1998/08/20 21:36:38  peter
+    * fixed 'with object do' bug
+
+  Revision 1.17  1998/08/19 16:07:36  jonas
+    * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
+
+  Revision 1.16  1998/08/18 09:24:36  pierre
+    * small warning position bug fixed
+    * support_mmx switches splitting was missing
+    * rhide error and warning output corrected
+
+  Revision 1.15  1998/08/13 11:00:09  peter
+    * fixed procedure<>procedure construct
+
+  Revision 1.14  1998/08/11 14:05:33  peter
+    * fixed sizeof(array of char)
+
+  Revision 1.13  1998/08/10 14:49:45  peter
+    + localswitches, moduleswitches, globalswitches splitting
+
+  Revision 1.12  1998/07/30 13:30:31  florian
+    * final implemenation of exception support, maybe it needs
+      some fixes :)
+
+  Revision 1.11  1998/07/24 22:16:52  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.10  1998/07/18 22:54:23  florian
+    * some ansi/wide/longstring support fixed:
+       o parameter passing
+       o returning as result from functions
+
+  Revision 1.9  1998/07/07 17:40:37  peter
+    * packrecords 4 works
+    * word aligning of parameters
+
+  Revision 1.8  1998/07/06 15:51:15  michael
+  Added length checking for string reading
+
+  Revision 1.7  1998/07/06 14:19:51  michael
+  + Added calls for reading/writing ansistrings
+
+  Revision 1.6  1998/07/01 15:28:48  peter
+    + better writeln/readln handling, now 100% like tp7
+
+  Revision 1.5  1998/06/25 14:04:17  peter
+    + internal inc/dec
+
+  Revision 1.4  1998/06/25 08:48:06  florian
+    * first version of rtti support
+
+  Revision 1.3  1998/06/09 16:01:33  pierre
+    + added procedure directive parsing for procvars
+      (accepted are popstack cdecl and pascal)
+    + added C vars with the following syntax
+      var C calias 'true_c_name';(can be followed by external)
+      reason is that you must add the Cprefix
+
+      which is target dependent
+
+  Revision 1.2  1998/06/08 13:13:29  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:10  peter
+    * splitted cgi386
+
+}
+

compiler/cg386ld.pas

@@ -1,1091 +1,1107 @@
-{
-    $Id$
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Generate i386 assembler for load/assignment nodes
-
-    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 cg386ld;
-interface
-
-    uses
-      tree;
-
-    procedure secondload(var p : ptree);
-    procedure secondassignment(var p : ptree);
-    procedure secondfuncret(var p : ptree);
-    procedure secondarrayconstruct(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,cg386cnv;
-
-{*****************************************************************************
-                             SecondLoad
-*****************************************************************************}
-
-    procedure secondload(var p : ptree);
-      var
-         hregister : tregister;
-         symtabletype : tsymtabletype;
-         i : longint;
-         hp : preference;
-         s : pasmsymbol;
-         popeax : boolean;
-
-      begin
-         simple_loadn:=true;
-         reset_reference(p^.location.reference);
-         case p^.symtableentry^.typ of
-              { this is only for toasm and toaddr }
-              absolutesym :
-                 begin
-                    p^.location.reference.symbol:=nil;
-                    if (pabsolutesym(p^.symtableentry)^.abstyp=toaddr) then
-                     begin
-                       if pabsolutesym(p^.symtableentry)^.absseg then
-                        p^.location.reference.segment:=R_FS;
-                       p^.location.reference.offset:=pabsolutesym(p^.symtableentry)^.address;
-                     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
-                    hregister:=R_NO;
-                    { C variable }
-                    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
-                      begin
-                         hregister:=getregister32;
-                         p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
-                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hregister)));
-                         p^.location.reference.symbol:=nil;
-                         p^.location.reference.base:=hregister;
-                      end
-                    { external variable }
-                    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
-                      begin
-                         popeax:=not(R_EAX in unused);
-                         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);
-
-                         reset_reference(p^.location.reference);
-                         p^.location.reference.base:=getregister32;
-                         emit_reg_reg(A_MOV,S_L,R_EAX,p^.location.reference.base);
-                         if popeax then
-                           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
-
-                      end
-                    { normal variable }
-                    else
-                      begin
-                         symtabletype:=p^.symtable^.symtabletype;
-                         { in case it is a register variable: }
-                         if pvarsym(p^.symtableentry)^.reg<>R_NO then
-                           begin
-                              p^.location.loc:=LOC_CREGISTER;
-                              p^.location.register:=pvarsym(p^.symtableentry)^.reg;
-                              unused:=unused-[pvarsym(p^.symtableentry)^.reg];
-                           end
-                         else
-                           begin
-                              { first handle local and temporary variables }
-                              if (symtabletype in [parasymtable,inlinelocalsymtable,
-                                                   inlineparasymtable,localsymtable]) then
-                                begin
-                                   p^.location.reference.base:=procinfo.framepointer;
-                                   p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address+p^.symtable^.address_fixup;
-                                   if (symtabletype in [localsymtable,inlinelocalsymtable]) then
-                                     p^.location.reference.offset:=-p^.location.reference.offset;
-                                   if (lexlevel>(p^.symtable^.symtablelevel)) then
-                                     begin
-                                        hregister:=getregister32;
-
-                                        { make a reference }
-                                        hp:=new_reference(procinfo.framepointer,
-                                          procinfo.framepointer_offset);
-
-                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
-
-                                        simple_loadn:=false;
-                                        i:=lexlevel-1;
-                                        while i>(p^.symtable^.symtablelevel) do
-                                          begin
-                                             { make a reference }
-                                             hp:=new_reference(hregister,8);
-                                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
-                                             dec(i);
-                                          end;
-                                        p^.location.reference.base:=hregister;
-                                     end;
-                                end
-                              else
-                                case symtabletype of
-                                   unitsymtable,globalsymtable,
-                                   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
-                                        p^.location.reference.base:=procinfo.framepointer;
-                                        p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
-                                     end;
-                                   objectsymtable:
-                                     begin
-                                        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
-                                             p^.location.reference.base:=R_ESI;
-                                             p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
-                                          end;
-                                     end;
-                                   withsymtable:
-                                     begin
-                                        { make a reference }
-                                        { symtable datasize field
-                                          contains the offset of the temp
-                                          stored }
-{                                        hp:=new_reference(procinfo.framepointer,
-                                          p^.symtable^.datasize);
-
-                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));}
-
-                                        if ptree(pwithsymtable(p^.symtable)^.withnode)^.islocal then
-                                         begin
-                                           p^.location.reference:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^;
-                                         end
-                                        else
-                                         begin
-                                           hregister:=getregister32;
-                                           p^.location.reference.base:=hregister;
-                                           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                             newreference(ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^),
-                                             hregister)));
-                                         end;
-                                        inc(p^.location.reference.offset,pvarsym(p^.symtableentry)^.address);
-                                     end;
-                                end;
-                           end;
-                         { in case call by reference, then calculate. Open array
-                           is always an reference! }
-                         if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
-                            is_open_array(pvarsym(p^.symtableentry)^.definition) or
-                            ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
-                             push_addr_param(pvarsym(p^.symtableentry)^.definition)) then
-                           begin
-                              simple_loadn:=false;
-                              if hregister=R_NO then
-                                hregister:=getregister32;
-{$ifdef OLDHIGH}
-                              if is_open_array(pvarsym(p^.symtableentry)^.definition) or
-                                 is_open_string(pvarsym(p^.symtableentry)^.definition) then
-                                begin
-                                   if (p^.location.reference.base=procinfo.framepointer) then
-                                     begin
-                                        highframepointer:=p^.location.reference.base;
-                                        highoffset:=p^.location.reference.offset;
-                                     end
-                                   else
-                                     begin
-                                        highframepointer:=R_EDI;
-                                        highoffset:=p^.location.reference.offset;
-                                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
-                                          p^.location.reference.base,R_EDI)));
-                                     end;
-                                end;
-{$endif}
-                              if p^.location.loc=LOC_CREGISTER then
-                                begin
-                                   exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
-                                     p^.location.register,hregister)));
-                                   p^.location.loc:=LOC_REFERENCE;
-                                end
-                              else
-                                begin
-                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                     newreference(p^.location.reference),
-                                     hregister)));
-                                end;
-                              reset_reference(p^.location.reference);
-                              p^.location.reference.base:=hregister;
-                          end;
-                      end;
-                 end;
-              procsym:
-                 begin
-                    if assigned(p^.left) then
-                      begin
-                         secondpass(p^.left);
-                         p^.location.loc:=LOC_MEM;
-                         gettempofsizereference(8,p^.location.reference);
-
-                         { load class instance address }
-                         case p^.left^.location.loc of
-
-                            LOC_CREGISTER,
-                            LOC_REGISTER:
-                              begin
-                                 hregister:=p^.left^.location.register;
-                                 ungetregister32(p^.left^.location.register);
-                                 { such code is allowed !
-                                   CGMessage(cg_e_illegal_expression); }
-                              end;
-
-                            LOC_MEM,
-                            LOC_REFERENCE:
-                              begin
-                                 hregister:=R_EDI;
-                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                   newreference(p^.left^.location.reference),R_EDI)));
-                                 del_reference(p^.left^.location.reference);
-                                 ungetiftemp(p^.left^.location.reference);
-                              end;
-                            else internalerror(26019);
-                         end;
-
-                         { store the class instance address }
-                         new(hp);
-                         hp^:=p^.location.reference;
-                         inc(hp^.offset,4);
-                         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
-                           R_EDI,hp)));
-
-                         { virtual method ? }
-                         if (pprocsym(p^.symtableentry)^.definition^.options and povirtualmethod)<>0 then
-                           begin
-                              new(hp);
-                              reset_reference(hp^);
-                              hp^.base:=hregister;
-                              { load vmt pointer }
-                              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                hp,R_EDI)));
-{$IfDef regallocfix}
-                              del_reference(hp^);
-{$EndIf regallocfix}
-                              { load method address }
-                              new(hp);
-                              reset_reference(hp^);
-                              hp^.base:=R_EDI;
-                              hp^.offset:=pprocsym(p^.symtableentry)^.definition^.extnumber*4+12;
-                              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                hp,R_EDI)));
-                              { ... and store it }
-                              exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
-                                R_EDI,newreference(p^.location.reference))));
-                           end
-                         else
-                           begin
-                              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;
-      end;
-
-
-{*****************************************************************************
-                             SecondAssignment
-*****************************************************************************}
-
-    procedure secondassignment(var p : ptree);
-      var
-         opsize : topsize;
-         otlabel,hlabel,oflabel : plabel;
-         hregister : tregister;
-         loc : tloc;
-         r : preference;
-{$ifndef OLDASM}
-         ai : pai386;
-{$endif}
-      begin
-         otlabel:=truelabel;
-         oflabel:=falselabel;
-         getlabel(truelabel);
-         getlabel(falselabel);
-         { calculate left sides }
-         if not(p^.concat_string) then
-           secondpass(p^.left);
-
-         if codegenerror then
-           exit;
-
-         case p^.left^.location.loc of
-            LOC_REFERENCE : begin
-                              { in case left operator uses to register }
-                              { but to few are free then LEA }
-                              if (p^.left^.location.reference.base<>R_NO) and
-                                 (p^.left^.location.reference.index<>R_NO) and
-                                 (usablereg32<p^.right^.registers32) then
-                                begin
-                                   del_reference(p^.left^.location.reference);
-                                   hregister:=getregister32;
-                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(
-                                     p^.left^.location.reference),
-                                     hregister)));
-                                   reset_reference(p^.left^.location.reference);
-                                   p^.left^.location.reference.base:=hregister;
-                                   p^.left^.location.reference.index:=R_NO;
-                                end;
-                              loc:=LOC_REFERENCE;
-                           end;
-            LOC_CREGISTER:
-              loc:=LOC_CREGISTER;
-            LOC_MMXREGISTER:
-              loc:=LOC_MMXREGISTER;
-            LOC_CMMXREGISTER:
-              loc:=LOC_CMMXREGISTER;
-            else
-               begin
-                  CGMessage(cg_e_illegal_expression);
-                  exit;
-               end;
-         end;
-         { 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                         }
-{$ifdef test_dest_loc}
-         if (aktexprlevel<4) then
-           begin
-              dest_loc_known:=true;
-              dest_loc:=p^.left^.location;
-              dest_loc_tree:=p^.right;
-           end;
-{$endif test_dest_loc}
-
-         secondpass(p^.right);
-         if codegenerror then
-           exit;
-
-{$ifdef test_dest_loc}
-         dest_loc_known:=false;
-         if in_dest_loc then
-           begin
-              truelabel:=otlabel;
-              falselabel:=oflabel;
-              in_dest_loc:=false;
-              exit;
-           end;
-{$endif test_dest_loc}
-         if p^.left^.resulttype^.deftype=stringdef then
-           begin
-              if is_ansistring(p^.left^.resulttype) then
-                begin
-                  { the source and destinations are released
-                    in loadansistring, because an ansi string can
-                    also be in a register
-                  }
-                  loadansistring(p);
-                end
-              else
-              if is_shortstring(p^.left^.resulttype) and
-                not (p^.concat_string) then
-                begin
-                  if is_ansistring(p^.right^.resulttype) then
-                    begin
-                      if (p^.right^.treetype=stringconstn) and
-                         (p^.right^.length=0) then
-                        begin
-                          exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,
-                            0,newreference(p^.left^.location.reference))));
-{$IfDef regallocfix}
-                          del_reference(p^.left^.location.reference);
-{$EndIf regallocfix}
-                        end
-                      else
-                        loadansi2short(p^.right,p^.left);
-                    end
-                  else
-                    begin
-                       { we do not need destination anymore }
-                       del_reference(p^.left^.location.reference);
-                       del_reference(p^.right^.location.reference);
-                       loadshortstring(p);
-                       ungetiftemp(p^.right^.location.reference);
-                    end;
-                end
-              else
-                begin
-                  { its the only thing we have to do }
-                  del_reference(p^.right^.location.reference);
-                end
-           end
-        else case p^.right^.location.loc of
-            LOC_REFERENCE,
-            LOC_MEM : begin
-                         { extra handling for ordinal constants }
-                         if (p^.right^.treetype in [ordconstn,fixconstn]) or
-                            (loc=LOC_CREGISTER) then
-                           begin
-                              case p^.left^.resulttype^.size of
-                                 1 : opsize:=S_B;
-                                 2 : opsize:=S_W;
-                                 4 : opsize:=S_L;
-                              end;
-                              if loc=LOC_CREGISTER then
-                                begin
-                                  exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
-                                    newreference(p^.right^.location.reference),
-                                    p^.left^.location.register)));
-{$IfDef regallocfix}
-                                  del_reference(p^.right^.location.reference);
-{$EndIf regallocfix}
-                                end
-                              else
-                                begin
-                                  exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
-                                    p^.right^.location.reference.offset,
-                                    newreference(p^.left^.location.reference))));
-{$IfDef regallocfix}
-                                  del_reference(p^.left^.location.reference);
-{$EndIf regallocfix}
-                                {exprasmlist^.concat(new(pai386,op_const_loc(A_MOV,opsize,
-                                    p^.right^.location.reference.offset,
-                                    p^.left^.location)));}
-                                end;
-
-                           end
-                         else
-                           begin
-                              if (p^.right^.resulttype^.needs_inittable) and
-                                ( (p^.right^.resulttype^.deftype<>objectdef) or
-                                  not(pobjectdef(p^.right^.resulttype)^.isclass)) then
-                                begin
-                                   { this would be a problem }
-                                   if not(p^.left^.resulttype^.needs_inittable) then
-                                     internalerror(3457);
-
-                                   { increment source reference counter }
-                                   new(r);
-                                   reset_reference(r^);
-                                   r^.symbol:=newasmsymbol(lab2str(p^.right^.resulttype^.get_inittable_label));
-                                   emitpushreferenceaddr(exprasmlist,r^);
-
-                                   emitpushreferenceaddr(exprasmlist,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);
-                                   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}
-                              concatcopy(p^.right^.location.reference,
-                                p^.left^.location.reference,p^.left^.resulttype^.size,true,false);
-                              ungetiftemp(p^.right^.location.reference);
-{$Else regallocfix}
-                              concatcopy(p^.right^.location.reference,
-                                p^.left^.location.reference,p^.left^.resulttype^.size,false,false);
-                              ungetiftemp(p^.right^.location.reference);
-{$endif regallocfix}
-                           end;
-                      end;
-{$ifdef SUPPORT_MMX}
-            LOC_CMMXREGISTER,
-            LOC_MMXREGISTER:
-              begin
-                 if loc=LOC_CMMXREGISTER then
-                   exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVQ,S_NO,
-                   p^.right^.location.register,p^.left^.location.register)))
-                 else
-                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOVQ,S_NO,
-                     p^.right^.location.register,newreference(p^.left^.location.reference))));
-              end;
-{$endif SUPPORT_MMX}
-            LOC_REGISTER,
-            LOC_CREGISTER : begin
-                              case p^.right^.resulttype^.size of
-                                 1 : opsize:=S_B;
-                                 2 : opsize:=S_W;
-                                 4 : opsize:=S_L;
-                                 8 : opsize:=S_L;
-                              end;
-                              { simplified with op_reg_loc         }
-                              if loc=LOC_CREGISTER then
-                                begin
-                                  exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
-                                    p^.right^.location.register,
-                                    p^.left^.location.register)));
-{$IfDef regallocfix}
-                                 ungetregister(p^.right^.location.register);
-{$EndIf regallocfix}
-                                end
-                              else
-                                Begin
-                                  exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,
-                                    p^.right^.location.register,
-                                    newreference(p^.left^.location.reference))));
-{$IfDef regallocfix}
-                                  ungetregister(p^.right^.location.register);
-                                  del_reference(p^.left^.location.reference);
-{$EndIf regallocfix}
-                                end;
-                              if is_64bitint(p^.right^.resulttype) then
-                                begin
-                                   { simplified with op_reg_loc         }
-                                   if loc=LOC_CREGISTER then
-                                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
-                                       p^.right^.location.registerhigh,
-                                       p^.left^.location.registerhigh)))
-                                   else
-                                     begin
-                                        r:=newreference(p^.left^.location.reference);
-                                        inc(r^.offset,4);
-                                        exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,
-                                          p^.right^.location.registerhigh,r)));
-                                     end;
-                                end;
-                              {exprasmlist^.concat(new(pai386,op_reg_loc(A_MOV,opsize,
-                                  p^.right^.location.register,
-                                  p^.left^.location)));             }
-
-                           end;
-            LOC_FPU : begin
-                              if loc<>LOC_REFERENCE then
-                                internalerror(10010)
-                              else
-                                floatstore(pfloatdef(p^.left^.resulttype)^.typ,
-                                  p^.left^.location.reference);
-                           end;
-            LOC_JUMP     : begin
-                              getlabel(hlabel);
-                              emitlab(truelabel);
-                              if loc=LOC_CREGISTER then
-                                exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,
-                                  1,p^.left^.location.register)))
-                              else
-                                exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,
-                                  1,newreference(p^.left^.location.reference))));
-                              {exprasmlist^.concat(new(pai386,op_const_loc(A_MOV,S_B,
-                                  1,p^.left^.location)));}
-                              emitjmp(C_None,hlabel);
-                              emitlab(falselabel);
-                              if loc=LOC_CREGISTER then
-                                exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,
-                                  p^.left^.location.register,
-                                  p^.left^.location.register)))
-                              else
-                                begin
-                                  exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,
-                                    0,newreference(p^.left^.location.reference))));
-{$IfDef regallocfix}
-                                  del_reference(p^.left^.location.reference);
-{$EndIf regallocfix}
-                                 end;
-                              emitlab(hlabel);
-                           end;
-            LOC_FLAGS    : begin
-                              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}
-                           end;
-         end;
-         freelabel(truelabel);
-         freelabel(falselabel);
-         truelabel:=otlabel;
-         falselabel:=oflabel;
-      end;
-
-
-{*****************************************************************************
-                             SecondFuncRet
-*****************************************************************************}
-
-    procedure secondfuncret(var p : ptree);
-      var
-         hr : tregister;
-         hp : preference;
-         pp : pprocinfo;
-         hr_valid : boolean;
-      begin
-         reset_reference(p^.location.reference);
-         hr_valid:=false;
-         if @procinfo<>pprocinfo(p^.funcretprocinfo) then
-           begin
-              hr:=getregister32;
-              hr_valid:=true;
-              hp:=new_reference(procinfo.framepointer,
-                procinfo.framepointer_offset);
-              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hr)));
-              pp:=procinfo.parent;
-              { walk up the stack frame }
-              while pp<>pprocinfo(p^.funcretprocinfo) do
-                begin
-                   hp:=new_reference(hr,
-                     pp^.framepointer_offset);
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hr)));
-                   pp:=pp^.parent;
-                end;
-              p^.location.reference.base:=hr;
-           end
-         else
-           p^.location.reference.base:=procinfo.framepointer;
-         p^.location.reference.offset:=procinfo.retoffset;
-         if ret_in_param(p^.retdef) then
-           begin
-              if not hr_valid then
-                hr:=getregister32;
-              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hr)));
-              p^.location.reference.base:=hr;
-              p^.location.reference.offset:=0;
-           end;
-      end;
-
-
-{*****************************************************************************
-                           SecondArrayConstruct
-*****************************************************************************}
-
-      const
-        vtInteger    = 0;
-        vtBoolean    = 1;
-        vtChar       = 2;
-        vtExtended   = 3;
-        vtString     = 4;
-        vtPointer    = 5;
-        vtPChar      = 6;
-        vtObject     = 7;
-        vtClass      = 8;
-        vtWideChar   = 9;
-        vtPWideChar  = 10;
-        vtAnsiString = 11;
-        vtCurrency   = 12;
-        vtVariant    = 13;
-        vtInterface  = 14;
-        vtWideString = 15;
-        vtInt64      = 16;
-
-    procedure secondarrayconstruct(var p : ptree);
-      var
-        hp    : ptree;
-        href  : treference;
-        lt    : pdef;
-        vaddr : boolean;
-        vtype : longint;
-      begin
-        if not p^.cargs then
-         begin
-           reset_reference(p^.location.reference);
-           gettempofsizereference((parraydef(p^.resulttype)^.highrange+1)*8,p^.location.reference);
-           href:=p^.location.reference;
-         end;
-        hp:=p;
-        while assigned(hp) do
-         begin
-           secondpass(hp^.left);
-           if codegenerror then
-            exit;
-           { find the correct vtype value }
-           vtype:=$ff;
-           vaddr:=false;
-           lt:=hp^.left^.resulttype;
-           case lt^.deftype of
-           enumdef,
-            orddef : begin
-                       if (lt^.deftype=enumdef) or
-                          is_integer(lt) then
-                        vtype:=vtInteger
-                       else
-                        if is_boolean(lt) then
-                         vtype:=vtBoolean
-                       else
-                        if (lt^.deftype=orddef) and (porddef(lt)^.typ=uchar) then
-                         vtype:=vtChar;
-                     end;
-          floatdef : begin
-                       vtype:=vtExtended;
-                       vaddr:=true;
-                     end;
-        procvardef,
-        pointerdef : begin
-                       if is_pchar(lt) then
-                        vtype:=vtPChar
-                       else
-                        vtype:=vtPointer;
-                     end;
-       classrefdef : vtype:=vtClass;
-         objectdef : begin
-                       vtype:=vtObject;
-                     end;
-         stringdef : begin
-                       if is_shortstring(lt) then
-                        begin
-                          vtype:=vtString;
-                          vaddr:=true;
-                        end
-                       else
-                        if is_ansistring(lt) then
-                         vtype:=vtAnsiString;
-                     end;
-           end;
-           if vtype=$ff then
-            internalerror(14357);
-           { write C style pushes or an pascal array }
-           if p^.cargs then
-            begin
-              if vaddr then
-               begin
-                 emit_to_reference(hp^.left);
-                 emit_push_lea_loc(hp^.left^.location);
-               end
-              else
-               emit_push_loc(hp^.left^.location);
-            end
-           else
-            begin
-              { update href to the vtype field and write it }
-              exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,
-                vtype,newreference(href))));
-              inc(href.offset,4);
-              { write changing field update href to the next element }
-              if vaddr then
-               begin
-                 emit_to_reference(hp^.left);
-                 emit_lea_loc_ref(hp^.left^.location,href);
-               end
-              else
-               emit_mov_loc_ref(hp^.left^.location,href);
-              inc(href.offset,4);
-            end;
-           { load next entry }
-           hp:=hp^.right;
-         end;
-      end;
-
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 assembler for load/assignment nodes
+
+    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 cg386ld;
+interface
+
+    uses
+      tree;
+
+    procedure secondload(var p : ptree);
+    procedure secondassignment(var p : ptree);
+    procedure secondfuncret(var p : ptree);
+    procedure secondarrayconstruct(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,cg386cnv;
+
+{*****************************************************************************
+                             SecondLoad
+*****************************************************************************}
+
+    procedure secondload(var p : ptree);
+      var
+         hregister : tregister;
+         symtabletype : tsymtabletype;
+         i : longint;
+         hp : preference;
+         s : pasmsymbol;
+         popeax : boolean;
+
+      begin
+         simple_loadn:=true;
+         reset_reference(p^.location.reference);
+         case p^.symtableentry^.typ of
+              { this is only for toasm and toaddr }
+              absolutesym :
+                 begin
+                    p^.location.reference.symbol:=nil;
+                    if (pabsolutesym(p^.symtableentry)^.abstyp=toaddr) then
+                     begin
+                       if pabsolutesym(p^.symtableentry)^.absseg then
+                        p^.location.reference.segment:=R_FS;
+                       p^.location.reference.offset:=pabsolutesym(p^.symtableentry)^.address;
+                     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
+                    hregister:=R_NO;
+                    { C variable }
+                    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
+                      begin
+                         hregister:=getregister32;
+                         p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
+                         exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hregister)));
+                         p^.location.reference.symbol:=nil;
+                         p^.location.reference.base:=hregister;
+                      end
+                    { external variable }
+                    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
+                      begin
+                         popeax:=not(R_EAX in unused);
+                         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);
+
+                         reset_reference(p^.location.reference);
+                         p^.location.reference.base:=getregister32;
+                         emit_reg_reg(A_MOV,S_L,R_EAX,p^.location.reference.base);
+                         if popeax then
+                           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
+
+                      end
+                    { normal variable }
+                    else
+                      begin
+                         symtabletype:=p^.symtable^.symtabletype;
+                         { in case it is a register variable: }
+                         if pvarsym(p^.symtableentry)^.reg<>R_NO then
+                           begin
+                              p^.location.loc:=LOC_CREGISTER;
+                              p^.location.register:=pvarsym(p^.symtableentry)^.reg;
+                              unused:=unused-[pvarsym(p^.symtableentry)^.reg];
+                           end
+                         else
+                           begin
+                              { first handle local and temporary variables }
+                              if (symtabletype in [parasymtable,inlinelocalsymtable,
+                                                   inlineparasymtable,localsymtable]) then
+                                begin
+                                   p^.location.reference.base:=procinfo.framepointer;
+                                   p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address+p^.symtable^.address_fixup;
+                                   if (symtabletype in [localsymtable,inlinelocalsymtable]) then
+                                     p^.location.reference.offset:=-p^.location.reference.offset;
+                                   if (lexlevel>(p^.symtable^.symtablelevel)) then
+                                     begin
+                                        hregister:=getregister32;
+
+                                        { make a reference }
+                                        hp:=new_reference(procinfo.framepointer,
+                                          procinfo.framepointer_offset);
+
+                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
+
+                                        simple_loadn:=false;
+                                        i:=lexlevel-1;
+                                        while i>(p^.symtable^.symtablelevel) do
+                                          begin
+                                             { make a reference }
+                                             hp:=new_reference(hregister,8);
+                                             exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
+                                             dec(i);
+                                          end;
+                                        p^.location.reference.base:=hregister;
+                                     end;
+                                end
+                              else
+                                case symtabletype of
+                                   unitsymtable,globalsymtable,
+                                   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
+                                        p^.location.reference.base:=procinfo.framepointer;
+                                        p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
+                                     end;
+                                   objectsymtable:
+                                     begin
+                                        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
+                                             p^.location.reference.base:=R_ESI;
+                                             p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
+                                          end;
+                                     end;
+                                   withsymtable:
+                                     begin
+                                        { make a reference }
+                                        { symtable datasize field
+                                          contains the offset of the temp
+                                          stored }
+{                                        hp:=new_reference(procinfo.framepointer,
+                                          p^.symtable^.datasize);
+
+                                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));}
+
+                                        if ptree(pwithsymtable(p^.symtable)^.withnode)^.islocal then
+                                         begin
+                                           p^.location.reference:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^;
+                                         end
+                                        else
+                                         begin
+                                           hregister:=getregister32;
+                                           p^.location.reference.base:=hregister;
+                                           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                             newreference(ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^),
+                                             hregister)));
+                                         end;
+                                        inc(p^.location.reference.offset,pvarsym(p^.symtableentry)^.address);
+                                     end;
+                                end;
+                           end;
+                         { in case call by reference, then calculate. Open array
+                           is always an reference! }
+                         if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
+                            is_open_array(pvarsym(p^.symtableentry)^.definition) or
+                            is_array_of_const(pvarsym(p^.symtableentry)^.definition) or
+                            ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
+                             push_addr_param(pvarsym(p^.symtableentry)^.definition)) then
+                           begin
+                              simple_loadn:=false;
+                              if hregister=R_NO then
+                                hregister:=getregister32;
+{$ifdef OLDHIGH}
+                              if is_open_array(pvarsym(p^.symtableentry)^.definition) or
+                                 is_open_string(pvarsym(p^.symtableentry)^.definition) then
+                                begin
+                                   if (p^.location.reference.base=procinfo.framepointer) then
+                                     begin
+                                        highframepointer:=p^.location.reference.base;
+                                        highoffset:=p^.location.reference.offset;
+                                     end
+                                   else
+                                     begin
+                                        highframepointer:=R_EDI;
+                                        highoffset:=p^.location.reference.offset;
+                                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
+                                          p^.location.reference.base,R_EDI)));
+                                     end;
+                                end;
+{$endif}
+                              if p^.location.loc=LOC_CREGISTER then
+                                begin
+                                   exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
+                                     p^.location.register,hregister)));
+                                   p^.location.loc:=LOC_REFERENCE;
+                                end
+                              else
+                                begin
+                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                     newreference(p^.location.reference),
+                                     hregister)));
+                                end;
+                              reset_reference(p^.location.reference);
+                              p^.location.reference.base:=hregister;
+                          end;
+                      end;
+                 end;
+              procsym:
+                 begin
+                    if assigned(p^.left) then
+                      begin
+                         secondpass(p^.left);
+                         p^.location.loc:=LOC_MEM;
+                         gettempofsizereference(8,p^.location.reference);
+
+                         { load class instance address }
+                         case p^.left^.location.loc of
+
+                            LOC_CREGISTER,
+                            LOC_REGISTER:
+                              begin
+                                 hregister:=p^.left^.location.register;
+                                 ungetregister32(p^.left^.location.register);
+                                 { such code is allowed !
+                                   CGMessage(cg_e_illegal_expression); }
+                              end;
+
+                            LOC_MEM,
+                            LOC_REFERENCE:
+                              begin
+                                 hregister:=R_EDI;
+                                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                   newreference(p^.left^.location.reference),R_EDI)));
+                                 del_reference(p^.left^.location.reference);
+                                 ungetiftemp(p^.left^.location.reference);
+                              end;
+                            else internalerror(26019);
+                         end;
+
+                         { store the class instance address }
+                         new(hp);
+                         hp^:=p^.location.reference;
+                         inc(hp^.offset,4);
+                         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                           R_EDI,hp)));
+
+                         { virtual method ? }
+                         if (pprocsym(p^.symtableentry)^.definition^.options and povirtualmethod)<>0 then
+                           begin
+                              new(hp);
+                              reset_reference(hp^);
+                              hp^.base:=hregister;
+                              { load vmt pointer }
+                              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                hp,R_EDI)));
+{$IfDef regallocfix}
+                              del_reference(hp^);
+{$EndIf regallocfix}
+                              { load method address }
+                              new(hp);
+                              reset_reference(hp^);
+                              hp^.base:=R_EDI;
+                              hp^.offset:=pprocsym(p^.symtableentry)^.definition^.extnumber*4+12;
+                              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                hp,R_EDI)));
+                              { ... and store it }
+                              exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                                R_EDI,newreference(p^.location.reference))));
+                           end
+                         else
+                           begin
+                              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;
+      end;
+
+
+{*****************************************************************************
+                             SecondAssignment
+*****************************************************************************}
+
+    procedure secondassignment(var p : ptree);
+      var
+         opsize : topsize;
+         otlabel,hlabel,oflabel : plabel;
+         hregister : tregister;
+         loc : tloc;
+         r : preference;
+{$ifndef OLDASM}
+         ai : pai386;
+{$endif}
+      begin
+         otlabel:=truelabel;
+         oflabel:=falselabel;
+         getlabel(truelabel);
+         getlabel(falselabel);
+         { calculate left sides }
+         if not(p^.concat_string) then
+           secondpass(p^.left);
+
+         if codegenerror then
+           exit;
+
+         case p^.left^.location.loc of
+            LOC_REFERENCE : begin
+                              { in case left operator uses to register }
+                              { but to few are free then LEA }
+                              if (p^.left^.location.reference.base<>R_NO) and
+                                 (p^.left^.location.reference.index<>R_NO) and
+                                 (usablereg32<p^.right^.registers32) then
+                                begin
+                                   del_reference(p^.left^.location.reference);
+                                   hregister:=getregister32;
+                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(
+                                     p^.left^.location.reference),
+                                     hregister)));
+                                   reset_reference(p^.left^.location.reference);
+                                   p^.left^.location.reference.base:=hregister;
+                                   p^.left^.location.reference.index:=R_NO;
+                                end;
+                              loc:=LOC_REFERENCE;
+                           end;
+            LOC_CREGISTER:
+              loc:=LOC_CREGISTER;
+            LOC_MMXREGISTER:
+              loc:=LOC_MMXREGISTER;
+            LOC_CMMXREGISTER:
+              loc:=LOC_CMMXREGISTER;
+            else
+               begin
+                  CGMessage(cg_e_illegal_expression);
+                  exit;
+               end;
+         end;
+         { 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                         }
+{$ifdef test_dest_loc}
+         if (aktexprlevel<4) then
+           begin
+              dest_loc_known:=true;
+              dest_loc:=p^.left^.location;
+              dest_loc_tree:=p^.right;
+           end;
+{$endif test_dest_loc}
+
+         secondpass(p^.right);
+         if codegenerror then
+           exit;
+
+{$ifdef test_dest_loc}
+         dest_loc_known:=false;
+         if in_dest_loc then
+           begin
+              truelabel:=otlabel;
+              falselabel:=oflabel;
+              in_dest_loc:=false;
+              exit;
+           end;
+{$endif test_dest_loc}
+         if p^.left^.resulttype^.deftype=stringdef then
+           begin
+              if is_ansistring(p^.left^.resulttype) then
+                begin
+                  { the source and destinations are released
+                    in loadansistring, because an ansi string can
+                    also be in a register
+                  }
+                  loadansistring(p);
+                end
+              else
+              if is_shortstring(p^.left^.resulttype) and
+                not (p^.concat_string) then
+                begin
+                  if is_ansistring(p^.right^.resulttype) then
+                    begin
+                      if (p^.right^.treetype=stringconstn) and
+                         (p^.right^.length=0) then
+                        begin
+                          exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,
+                            0,newreference(p^.left^.location.reference))));
+{$IfDef regallocfix}
+                          del_reference(p^.left^.location.reference);
+{$EndIf regallocfix}
+                        end
+                      else
+                        loadansi2short(p^.right,p^.left);
+                    end
+                  else
+                    begin
+                       { we do not need destination anymore }
+                       del_reference(p^.left^.location.reference);
+                       del_reference(p^.right^.location.reference);
+                       loadshortstring(p);
+                       ungetiftemp(p^.right^.location.reference);
+                    end;
+                end
+              else
+                begin
+                  { its the only thing we have to do }
+                  del_reference(p^.right^.location.reference);
+                end
+           end
+        else case p^.right^.location.loc of
+            LOC_REFERENCE,
+            LOC_MEM : begin
+                         { extra handling for ordinal constants }
+                         if (p^.right^.treetype in [ordconstn,fixconstn]) or
+                            (loc=LOC_CREGISTER) then
+                           begin
+                              case p^.left^.resulttype^.size of
+                                 1 : opsize:=S_B;
+                                 2 : opsize:=S_W;
+                                 4 : opsize:=S_L;
+                              end;
+                              if loc=LOC_CREGISTER then
+                                begin
+                                  exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
+                                    newreference(p^.right^.location.reference),
+                                    p^.left^.location.register)));
+{$IfDef regallocfix}
+                                  del_reference(p^.right^.location.reference);
+{$EndIf regallocfix}
+                                end
+                              else
+                                begin
+                                  exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize,
+                                    p^.right^.location.reference.offset,
+                                    newreference(p^.left^.location.reference))));
+{$IfDef regallocfix}
+                                  del_reference(p^.left^.location.reference);
+{$EndIf regallocfix}
+                                {exprasmlist^.concat(new(pai386,op_const_loc(A_MOV,opsize,
+                                    p^.right^.location.reference.offset,
+                                    p^.left^.location)));}
+                                end;
+
+                           end
+                         else
+                           begin
+                              if (p^.right^.resulttype^.needs_inittable) and
+                                ( (p^.right^.resulttype^.deftype<>objectdef) or
+                                  not(pobjectdef(p^.right^.resulttype)^.isclass)) then
+                                begin
+                                   { this would be a problem }
+                                   if not(p^.left^.resulttype^.needs_inittable) then
+                                     internalerror(3457);
+
+                                   { increment source reference counter }
+                                   new(r);
+                                   reset_reference(r^);
+                                   r^.symbol:=newasmsymbol(lab2str(p^.right^.resulttype^.get_inittable_label));
+                                   emitpushreferenceaddr(exprasmlist,r^);
+
+                                   emitpushreferenceaddr(exprasmlist,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);
+                                   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}
+                              concatcopy(p^.right^.location.reference,
+                                p^.left^.location.reference,p^.left^.resulttype^.size,true,false);
+                              ungetiftemp(p^.right^.location.reference);
+{$Else regallocfix}
+                              concatcopy(p^.right^.location.reference,
+                                p^.left^.location.reference,p^.left^.resulttype^.size,false,false);
+                              ungetiftemp(p^.right^.location.reference);
+{$endif regallocfix}
+                           end;
+                      end;
+{$ifdef SUPPORT_MMX}
+            LOC_CMMXREGISTER,
+            LOC_MMXREGISTER:
+              begin
+                 if loc=LOC_CMMXREGISTER then
+                   exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVQ,S_NO,
+                   p^.right^.location.register,p^.left^.location.register)))
+                 else
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_MOVQ,S_NO,
+                     p^.right^.location.register,newreference(p^.left^.location.reference))));
+              end;
+{$endif SUPPORT_MMX}
+            LOC_REGISTER,
+            LOC_CREGISTER : begin
+                              case p^.right^.resulttype^.size of
+                                 1 : opsize:=S_B;
+                                 2 : opsize:=S_W;
+                                 4 : opsize:=S_L;
+                                 8 : opsize:=S_L;
+                              end;
+                              { simplified with op_reg_loc         }
+                              if loc=LOC_CREGISTER then
+                                begin
+                                  exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
+                                    p^.right^.location.register,
+                                    p^.left^.location.register)));
+{$IfDef regallocfix}
+                                 ungetregister(p^.right^.location.register);
+{$EndIf regallocfix}
+                                end
+                              else
+                                Begin
+                                  exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,
+                                    p^.right^.location.register,
+                                    newreference(p^.left^.location.reference))));
+{$IfDef regallocfix}
+                                  ungetregister(p^.right^.location.register);
+                                  del_reference(p^.left^.location.reference);
+{$EndIf regallocfix}
+                                end;
+                              if is_64bitint(p^.right^.resulttype) then
+                                begin
+                                   { simplified with op_reg_loc         }
+                                   if loc=LOC_CREGISTER then
+                                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
+                                       p^.right^.location.registerhigh,
+                                       p^.left^.location.registerhigh)))
+                                   else
+                                     begin
+                                        r:=newreference(p^.left^.location.reference);
+                                        inc(r^.offset,4);
+                                        exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,
+                                          p^.right^.location.registerhigh,r)));
+                                     end;
+                                end;
+                              {exprasmlist^.concat(new(pai386,op_reg_loc(A_MOV,opsize,
+                                  p^.right^.location.register,
+                                  p^.left^.location)));             }
+
+                           end;
+            LOC_FPU : begin
+                              if loc<>LOC_REFERENCE then
+                                internalerror(10010)
+                              else
+                                floatstore(pfloatdef(p^.left^.resulttype)^.typ,
+                                  p^.left^.location.reference);
+                           end;
+            LOC_JUMP     : begin
+                              getlabel(hlabel);
+                              emitlab(truelabel);
+                              if loc=LOC_CREGISTER then
+                                exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,
+                                  1,p^.left^.location.register)))
+                              else
+                                exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,
+                                  1,newreference(p^.left^.location.reference))));
+                              {exprasmlist^.concat(new(pai386,op_const_loc(A_MOV,S_B,
+                                  1,p^.left^.location)));}
+                              emitjmp(C_None,hlabel);
+                              emitlab(falselabel);
+                              if loc=LOC_CREGISTER then
+                                exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,
+                                  p^.left^.location.register,
+                                  p^.left^.location.register)))
+                              else
+                                begin
+                                  exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,
+                                    0,newreference(p^.left^.location.reference))));
+{$IfDef regallocfix}
+                                  del_reference(p^.left^.location.reference);
+{$EndIf regallocfix}
+                                 end;
+                              emitlab(hlabel);
+                           end;
+            LOC_FLAGS    : begin
+                              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}
+                           end;
+         end;
+         freelabel(truelabel);
+         freelabel(falselabel);
+         truelabel:=otlabel;
+         falselabel:=oflabel;
+      end;
+
+
+{*****************************************************************************
+                             SecondFuncRet
+*****************************************************************************}
+
+    procedure secondfuncret(var p : ptree);
+      var
+         hr : tregister;
+         hp : preference;
+         pp : pprocinfo;
+         hr_valid : boolean;
+      begin
+         reset_reference(p^.location.reference);
+         hr_valid:=false;
+         if @procinfo<>pprocinfo(p^.funcretprocinfo) then
+           begin
+              hr:=getregister32;
+              hr_valid:=true;
+              hp:=new_reference(procinfo.framepointer,
+                procinfo.framepointer_offset);
+              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hr)));
+              pp:=procinfo.parent;
+              { walk up the stack frame }
+              while pp<>pprocinfo(p^.funcretprocinfo) do
+                begin
+                   hp:=new_reference(hr,
+                     pp^.framepointer_offset);
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hr)));
+                   pp:=pp^.parent;
+                end;
+              p^.location.reference.base:=hr;
+           end
+         else
+           p^.location.reference.base:=procinfo.framepointer;
+         p^.location.reference.offset:=procinfo.retoffset;
+         if ret_in_param(p^.retdef) then
+           begin
+              if not hr_valid then
+                hr:=getregister32;
+              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hr)));
+              p^.location.reference.base:=hr;
+              p^.location.reference.offset:=0;
+           end;
+      end;
+
+
+{*****************************************************************************
+                           SecondArrayConstruct
+*****************************************************************************}
+
+      const
+        vtInteger    = 0;
+        vtBoolean    = 1;
+        vtChar       = 2;
+        vtExtended   = 3;
+        vtString     = 4;
+        vtPointer    = 5;
+        vtPChar      = 6;
+        vtObject     = 7;
+        vtClass      = 8;
+        vtWideChar   = 9;
+        vtPWideChar  = 10;
+        vtAnsiString = 11;
+        vtCurrency   = 12;
+        vtVariant    = 13;
+        vtInterface  = 14;
+        vtWideString = 15;
+        vtInt64      = 16;
+
+    procedure secondarrayconstruct(var p : ptree);
+      var
+        hp    : ptree;
+        href  : treference;
+        lt    : pdef;
+        vaddr : boolean;
+        vtype : longint;
+      begin
+        if not p^.cargs then
+         begin
+            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;
+         end;
+        hp:=p;
+        while assigned(hp) do
+         begin
+           secondpass(hp^.left);
+           if codegenerror then
+            exit;
+           { find the correct vtype value }
+           vtype:=$ff;
+           vaddr:=false;
+           lt:=hp^.left^.resulttype;
+           case lt^.deftype of
+           enumdef,
+            orddef : begin
+                       if (lt^.deftype=enumdef) or
+                          is_integer(lt) then
+                        vtype:=vtInteger
+                       else
+                        if is_boolean(lt) then
+                         vtype:=vtBoolean
+                       else
+                        if (lt^.deftype=orddef) and (porddef(lt)^.typ=uchar) then
+                         vtype:=vtChar;
+                     end;
+          floatdef : begin
+                       vtype:=vtExtended;
+                       vaddr:=true;
+                     end;
+        procvardef,
+        pointerdef : begin
+                       if is_pchar(lt) then
+                        vtype:=vtPChar
+                       else
+                        vtype:=vtPointer;
+                     end;
+       classrefdef : vtype:=vtClass;
+         objectdef : begin
+                       vtype:=vtObject;
+                     end;
+         stringdef : begin
+                       if is_shortstring(lt) then
+                        begin
+                          vtype:=vtString;
+                          vaddr:=true;
+                        end
+                       else
+                        if is_ansistring(lt) then
+                         vtype:=vtAnsiString;
+                     end;
+           end;
+           if vtype=$ff then
+            internalerror(14357);
+           { write C style pushes or an pascal array }
+           if p^.cargs then
+            begin
+              if vaddr then
+               begin
+                 emit_to_reference(hp^.left);
+                 emit_push_lea_loc(hp^.left^.location);
+               end
+              else
+               emit_push_loc(hp^.left^.location);
+            end
+           else
+            begin
+              { update href to the vtype field and write it }
+              exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,
+                vtype,newreference(href))));
+              inc(href.offset,4);
+              { write changing field update href to the next element }
+              if vaddr then
+               begin
+                 emit_to_reference(hp^.left);
+                 emit_lea_loc_ref(hp^.left^.location,href);
+               end
+              else
+               emit_mov_loc_ref(hp^.left^.location,href);
+              inc(href.offset,4);
+            end;
+           { load next entry }
+           hp:=hp^.right;
+         end;
+      end;
+
+
+end.
+{
   $Log$
-  Revision 1.57  1999-05-21 13:54:51  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.57  1999/05/21 13:54:51  peter
     * NEWLAB for label as symbol
-
-  Revision 1.56  1999/05/17 23:51:38  peter
-    * with temp vars now use a reference with a persistant temp instead
-      of setting datasize
-
-  Revision 1.55  1999/05/17 21:57:04  florian
-    * new temporary ansistring handling
-
-  Revision 1.54  1999/05/12 00:19:43  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.53  1999/05/06 09:05:16  peter
-    * generic write_float and str_float
-    * fixed constant float conversions
-
-  Revision 1.52  1999/05/01 13:24:10  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.51  1999/04/28 06:01:55  florian
-    * changes of Bruessel:
-       + message handler can now take an explicit self
-       * typinfo fixed: sometimes the type names weren't written
-       * the type checking for pointer comparisations and subtraction
-         and are now more strict (was also buggy)
-       * small bug fix to link.pas to support compiling on another
-         drive
-       * probable bug in popt386 fixed: call/jmp => push/jmp
-         transformation didn't count correctly the jmp references
-       + threadvar support
-       * warning if ln/sqrt gets an invalid constant argument
-
-  Revision 1.50  1999/04/16 13:42:26  jonas
-    * more regalloc fixes (still not complete)
-
-  Revision 1.49  1999/04/13 18:57:48  florian
-    * classes which contain ansistring get unnecessary calls
-      to addref/decref when they are assigned, fixed
-
-  Revision 1.48  1999/04/09 15:48:47  jonas
-    * added fix for missing register deallocation (-dregallocfix)
-
-  Revision 1.47  1999/03/31 13:55:07  peter
-    * assembler inlining working for ag386bin
-
-  Revision 1.46  1999/03/24 23:16:52  peter
-    * fixed bugs 212,222,225,227,229,231,233
-
-  Revision 1.45  1999/02/25 21:02:28  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.44  1999/02/22 02:15:12  peter
-    * updates for ag386bin
-
-  Revision 1.43  1999/01/27 00:13:54  florian
-    * "procedure of object"-stuff fixed
-
-  Revision 1.42  1999/01/21 22:10:40  peter
-    * fixed array of const
-    * generic platform independent high() support
-
-  Revision 1.41  1999/01/20 10:20:18  peter
-    * don't make localvar copies for assembler procedures
-
-  Revision 1.40  1998/12/30 13:41:07  peter
-    * released valuepara
-
-  Revision 1.39  1998/12/19 00:23:45  florian
-    * ansistring memory leaks fixed
-
-  Revision 1.38  1998/12/11 00:02:51  peter
-    + globtype,tokens,version unit splitted from globals
-
-  Revision 1.37  1998/12/10 09:47:17  florian
-    + basic operations with int64/qord (compiler with -dint64)
-    + rtti of enumerations extended: names are now written
-
-  Revision 1.36  1998/12/04 10:18:06  florian
-    * some stuff for procedures of object added
-    * bug with overridden virtual constructors fixed (reported by Italo Gomes)
-
-  Revision 1.35  1998/11/30 09:43:04  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.34  1998/11/28 16:20:48  peter
-    + support for dll variables
-
-  Revision 1.33  1998/11/27 14:50:33  peter
-    + open strings, $P switch support
-
-  Revision 1.32  1998/11/26 09:53:36  florian
-    * for classes no init/final. code is necessary, fixed
-
-  Revision 1.31  1998/11/20 15:35:54  florian
-    * problems with rtti fixed, hope it works
-
-  Revision 1.30  1998/11/18 17:45:24  peter
-    * fixes for VALUEPARA
-
-  Revision 1.29  1998/11/18 15:44:11  peter
-    * VALUEPARA for tp7 compatible value parameters
-
-  Revision 1.28  1998/11/17 11:32:44  peter
-    * optimize str:='' in H+ mode
-    + -! to test ansistrings
-
-  Revision 1.27  1998/11/16 15:35:39  peter
-    * rename laod/copystring -> load/copyshortstring
-    * fixed int-bool cnv bug
-    + char-ansistring conversion
-
-  Revision 1.26  1998/11/10 10:09:10  peter
-    * va_list -> array of const
-
-  Revision 1.25  1998/11/05 12:02:35  peter
-    * released useansistring
-    * removed -Sv, its now available in fpc modes
-
-  Revision 1.24  1998/10/14 08:47:14  pierre
-    * bugs in secondfuncret for result in subprocedures removed
-
-  Revision 1.23  1998/10/06 17:16:44  pierre
-    * some memory leaks fixed (thanks to Peter for heaptrc !)
-
-  Revision 1.22  1998/10/01 09:22:53  peter
-    * fixed value openarray
-    * ungettemp of arrayconstruct
-
-  Revision 1.21  1998/09/28 11:07:39  peter
-    + floatdef support for array of const
-
-  Revision 1.20  1998/09/24 14:26:03  peter
-    * updated for new tvarrec
-
-  Revision 1.19  1998/09/23 17:49:59  peter
-    * high(arrayconstructor) is now correct
-    * procvardef support for variant record
-
-  Revision 1.18  1998/09/23 09:58:48  peter
-    * first working array of const things
-
-  Revision 1.17  1998/09/20 18:00:19  florian
-    * small compiling problems fixed
-
-  Revision 1.16  1998/09/20 17:46:48  florian
-    * some things regarding ansistrings fixed
-
-  Revision 1.15  1998/09/17 09:42:16  peter
-    + pass_2 for cg386
-    * Message() -> CGMessage() for pass_1/pass_2
-
-  Revision 1.14  1998/09/14 10:43:50  peter
-    * all internal RTL functions start with FPC_
-
-  Revision 1.13  1998/09/04 12:24:24  florian
-    * bug0159 fixed
-
-  Revision 1.12  1998/09/04 11:55:17  florian
-    * problem with -Or fixed
-
-  Revision 1.11  1998/09/03 16:03:14  florian
-    + rtti generation
-    * init table generation changed
-
-  Revision 1.10  1998/08/21 14:08:40  pierre
-    + TEST_FUNCRET now default (old code removed)
-      works also for m68k (at least compiles)
-
-  Revision 1.9  1998/08/20 09:26:37  pierre
-    + funcret setting in underproc testing
-      compile with _dTEST_FUNCRET
-
-  Revision 1.8  1998/08/10 14:49:48  peter
-    + localswitches, moduleswitches, globalswitches splitting
-
-  Revision 1.7  1998/07/30 13:30:33  florian
-    * final implemenation of exception support, maybe it needs
-      some fixes :)
-
-  Revision 1.6  1998/07/26 21:58:57  florian
-   + better support for switch $H
-   + index access to ansi strings added
-   + assigment of data (records/arrays) containing ansi strings
-
-  Revision 1.5  1998/07/24 22:16:54  florian
-    * internal error 10 together with array access fixed. I hope
-      that's the final fix.
-
-  Revision 1.4  1998/06/11 13:58:45  peter
-    * fixed too long line
-
-  Revision 1.3  1998/06/09 16:01:35  pierre
-    + added procedure directive parsing for procvars
-      (accepted are popstack cdecl and pascal)
-    + added C vars with the following syntax
-      var C calias 'true_c_name';(can be followed by external)
-      reason is that you must add the Cprefix
-
-      which is target dependent
-
-  Revision 1.2  1998/06/08 13:13:34  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.56  1999/05/17 23:51:38  peter
+    * with temp vars now use a reference with a persistant temp instead
+      of setting datasize
+
+  Revision 1.55  1999/05/17 21:57:04  florian
+    * new temporary ansistring handling
+
+  Revision 1.54  1999/05/12 00:19:43  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.53  1999/05/06 09:05:16  peter
+    * generic write_float and str_float
+    * fixed constant float conversions
+
+  Revision 1.52  1999/05/01 13:24:10  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.51  1999/04/28 06:01:55  florian
+    * changes of Bruessel:
+       + message handler can now take an explicit self
+       * typinfo fixed: sometimes the type names weren't written
+       * the type checking for pointer comparisations and subtraction
+         and are now more strict (was also buggy)
+       * small bug fix to link.pas to support compiling on another
+         drive
+       * probable bug in popt386 fixed: call/jmp => push/jmp
+         transformation didn't count correctly the jmp references
+       + threadvar support
+       * warning if ln/sqrt gets an invalid constant argument
+
+  Revision 1.50  1999/04/16 13:42:26  jonas
+    * more regalloc fixes (still not complete)
+
+  Revision 1.49  1999/04/13 18:57:48  florian
+    * classes which contain ansistring get unnecessary calls
+      to addref/decref when they are assigned, fixed
+
+  Revision 1.48  1999/04/09 15:48:47  jonas
+    * added fix for missing register deallocation (-dregallocfix)
+
+  Revision 1.47  1999/03/31 13:55:07  peter
+    * assembler inlining working for ag386bin
+
+  Revision 1.46  1999/03/24 23:16:52  peter
+    * fixed bugs 212,222,225,227,229,231,233
+
+  Revision 1.45  1999/02/25 21:02:28  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.44  1999/02/22 02:15:12  peter
+    * updates for ag386bin
+
+  Revision 1.43  1999/01/27 00:13:54  florian
+    * "procedure of object"-stuff fixed
+
+  Revision 1.42  1999/01/21 22:10:40  peter
+    * fixed array of const
+    * generic platform independent high() support
+
+  Revision 1.41  1999/01/20 10:20:18  peter
+    * don't make localvar copies for assembler procedures
+
+  Revision 1.40  1998/12/30 13:41:07  peter
+    * released valuepara
+
+  Revision 1.39  1998/12/19 00:23:45  florian
+    * ansistring memory leaks fixed
+
+  Revision 1.38  1998/12/11 00:02:51  peter
+    + globtype,tokens,version unit splitted from globals
+
+  Revision 1.37  1998/12/10 09:47:17  florian
+    + basic operations with int64/qord (compiler with -dint64)
+    + rtti of enumerations extended: names are now written
+
+  Revision 1.36  1998/12/04 10:18:06  florian
+    * some stuff for procedures of object added
+    * bug with overridden virtual constructors fixed (reported by Italo Gomes)
+
+  Revision 1.35  1998/11/30 09:43:04  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.34  1998/11/28 16:20:48  peter
+    + support for dll variables
+
+  Revision 1.33  1998/11/27 14:50:33  peter
+    + open strings, $P switch support
+
+  Revision 1.32  1998/11/26 09:53:36  florian
+    * for classes no init/final. code is necessary, fixed
+
+  Revision 1.31  1998/11/20 15:35:54  florian
+    * problems with rtti fixed, hope it works
+
+  Revision 1.30  1998/11/18 17:45:24  peter
+    * fixes for VALUEPARA
+
+  Revision 1.29  1998/11/18 15:44:11  peter
+    * VALUEPARA for tp7 compatible value parameters
+
+  Revision 1.28  1998/11/17 11:32:44  peter
+    * optimize str:='' in H+ mode
+    + -! to test ansistrings
+
+  Revision 1.27  1998/11/16 15:35:39  peter
+    * rename laod/copystring -> load/copyshortstring
+    * fixed int-bool cnv bug
+    + char-ansistring conversion
+
+  Revision 1.26  1998/11/10 10:09:10  peter
+    * va_list -> array of const
+
+  Revision 1.25  1998/11/05 12:02:35  peter
+    * released useansistring
+    * removed -Sv, its now available in fpc modes
+
+  Revision 1.24  1998/10/14 08:47:14  pierre
+    * bugs in secondfuncret for result in subprocedures removed
+
+  Revision 1.23  1998/10/06 17:16:44  pierre
+    * some memory leaks fixed (thanks to Peter for heaptrc !)
+
+  Revision 1.22  1998/10/01 09:22:53  peter
+    * fixed value openarray
+    * ungettemp of arrayconstruct
+
+  Revision 1.21  1998/09/28 11:07:39  peter
+    + floatdef support for array of const
+
+  Revision 1.20  1998/09/24 14:26:03  peter
+    * updated for new tvarrec
+
+  Revision 1.19  1998/09/23 17:49:59  peter
+    * high(arrayconstructor) is now correct
+    * procvardef support for variant record
+
+  Revision 1.18  1998/09/23 09:58:48  peter
+    * first working array of const things
+
+  Revision 1.17  1998/09/20 18:00:19  florian
+    * small compiling problems fixed
+
+  Revision 1.16  1998/09/20 17:46:48  florian
+    * some things regarding ansistrings fixed
+
+  Revision 1.15  1998/09/17 09:42:16  peter
+    + pass_2 for cg386
+    * Message() -> CGMessage() for pass_1/pass_2
+
+  Revision 1.14  1998/09/14 10:43:50  peter
+    * all internal RTL functions start with FPC_
+
+  Revision 1.13  1998/09/04 12:24:24  florian
+    * bug0159 fixed
+
+  Revision 1.12  1998/09/04 11:55:17  florian
+    * problem with -Or fixed
+
+  Revision 1.11  1998/09/03 16:03:14  florian
+    + rtti generation
+    * init table generation changed
+
+  Revision 1.10  1998/08/21 14:08:40  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.9  1998/08/20 09:26:37  pierre
+    + funcret setting in underproc testing
+      compile with _dTEST_FUNCRET
+
+  Revision 1.8  1998/08/10 14:49:48  peter
+    + localswitches, moduleswitches, globalswitches splitting
+
+  Revision 1.7  1998/07/30 13:30:33  florian
+    * final implemenation of exception support, maybe it needs
+      some fixes :)
+
+  Revision 1.6  1998/07/26 21:58:57  florian
+   + better support for switch $H
+   + index access to ansi strings added
+   + assigment of data (records/arrays) containing ansi strings
+
+  Revision 1.5  1998/07/24 22:16:54  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.4  1998/06/11 13:58:45  peter
+    * fixed too long line
+
+  Revision 1.3  1998/06/09 16:01:35  pierre
+    + added procedure directive parsing for procvars
+      (accepted are popstack cdecl and pascal)
+    + added C vars with the following syntax
+      var C calias 'true_c_name';(can be followed by external)
+      reason is that you must add the Cprefix
+
+      which is target dependent
+
+  Revision 1.2  1998/06/08 13:13:34  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/cg386mem.pas

@@ -1,1015 +1,1027 @@
-{
-    $Id$
-    Copyright (c) 1993-98 by Florian Klaempfl
-
-    Generate i386 assembler for in memory related nodes
-
-    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 cg386mem;
-interface
-
-    uses
-      tree;
-
-    procedure secondloadvmt(var p : ptree);
-    procedure secondhnewn(var p : ptree);
-    procedure secondnewn(var p : ptree);
-    procedure secondhdisposen(var p : ptree);
-    procedure secondsimplenewdispose(var p : ptree);
-    procedure secondaddr(var p : ptree);
-    procedure seconddoubleaddr(var p : ptree);
-    procedure secondderef(var p : ptree);
-    procedure secondsubscriptn(var p : ptree);
-    procedure secondvecn(var p : ptree);
-    procedure secondselfn(var p : ptree);
-    procedure secondwith(var p : ptree);
-
-
-implementation
-
-    uses
-      globtype,systems,
-      cobjects,verbose,globals,
-      symtable,aasm,types,
-      hcodegen,temp_gen,pass_2,pass_1,
-{$ifndef OLDASM}
-      i386base,i386asm,
-{$else}
-      i386,
-{$endif}
-      cgai386,tgeni386;
-
-{*****************************************************************************
-                             SecondLoadVMT
-*****************************************************************************}
-
-    procedure secondloadvmt(var p : ptree);
-      begin
-         p^.location.register:=getregister32;
-         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;
-
-
-{*****************************************************************************
-                             SecondHNewN
-*****************************************************************************}
-
-    procedure secondhnewn(var p : ptree);
-      begin
-      end;
-
-
-{*****************************************************************************
-                             SecondNewN
-*****************************************************************************}
-
-    procedure secondnewn(var p : ptree);
-      var
-         pushed : tpushed;
-         r : preference;
-      begin
-         if assigned(p^.left) then
-           begin
-              secondpass(p^.left);
-              p^.location.register:=p^.left^.location.register;
-           end
-         else
-           begin
-              pushusedregisters(exprasmlist,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);
-
-              emitcall('FPC_GETMEM',true);
-              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^);
-                   { push pointer adress }
-                   emitpushreferenceaddr(exprasmlist,p^.location.reference);
-                   dispose(r);
-                   emitcall('FPC_INITIALIZE',true);
-                end;
-              popusedregisters(exprasmlist,pushed);
-              { may be load ESI }
-              maybe_loadesi;
-           end;
-         if codegenerror then
-           exit;
-      end;
-
-
-{*****************************************************************************
-                             SecondDisposeN
-*****************************************************************************}
-
-    procedure secondhdisposen(var p : ptree);
-      begin
-         secondpass(p^.left);
-         if codegenerror then
-           exit;
-         reset_reference(p^.location.reference);
-         case p^.left^.location.loc of
-            LOC_REGISTER,
-            LOC_CREGISTER:
-              begin
-                 p^.location.reference.index:=getregister32;
-                 exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
-                   p^.left^.location.register,
-                   p^.location.reference.index)));
-              end;
-            LOC_MEM,LOC_REFERENCE :
-              begin
-                 del_reference(p^.left^.location.reference);
-                 p^.location.reference.index:=getregister32;
-                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
-                   p^.location.reference.index)));
-              end;
-         end;
-      end;
-
-
-{*****************************************************************************
-                             SecondNewDispose
-*****************************************************************************}
-
-    procedure secondsimplenewdispose(var p : ptree);
-
-      var
-         pushed : tpushed;
-         r : preference;
-
-      begin
-         secondpass(p^.left);
-         if codegenerror then
-           exit;
-
-         pushusedregisters(exprasmlist,pushed,$ff);
-         { determines the size of the mem block }
-         push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
-
-         { 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);
-         end;
-
-         { call the mem handling procedures }
-         case p^.treetype of
-           simpledisposen:
-             begin
-                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^);
-                     { 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);
-                     end;
-                     dispose(r);
-                     emitcall('FPC_FINALIZE',true);
-                  end;
-                emitcall('FPC_FREEMEM',true);
-             end;
-           simplenewn:
-             begin
-                emitcall('FPC_GETMEM',true);
-                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^);
-                     { 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);
-                     end;
-                     dispose(r);
-                     emitcall('FPC_INITIALIZE',true);
-                  end;
-             end;
-         end;
-         popusedregisters(exprasmlist,pushed);
-         { may be load ESI }
-         maybe_loadesi;
-      end;
-
-
-{*****************************************************************************
-                             SecondAddr
-*****************************************************************************}
-
-    procedure secondaddr(var p : ptree);
-      begin
-         secondpass(p^.left);
-         p^.location.loc:=LOC_REGISTER;
-         del_reference(p^.left^.location.reference);
-         p^.location.register:=getregister32;
-         {@ on a procvar means returning an address to the procedure that
-           is stored in it.}
-         { yes but p^.left^.symtableentry can be nil
-           for example on @self !! }
-         { symtableentry can be also invalid, if left is no tree node }
-         if (m_tp_procvar in aktmodeswitches) and
-           (p^.left^.treetype=loadn) and
-           assigned(p^.left^.symtableentry) and
-           (p^.left^.symtableentry^.typ=varsym) and
-           (pvarsym(p^.left^.symtableentry)^.definition^.deftype=procvardef) then
-           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-             newreference(p^.left^.location.reference),
-             p^.location.register)))
-         else
-           exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
-             newreference(p^.left^.location.reference),
-             p^.location.register)));
-           { for use of other segments }
-           if p^.left^.location.reference.segment<>R_NO then
-             p^.location.segment:=p^.left^.location.reference.segment;
-      end;
-
-
-{*****************************************************************************
-                             SecondDoubleAddr
-*****************************************************************************}
-
-    procedure seconddoubleaddr(var p : ptree);
-      begin
-         secondpass(p^.left);
-         p^.location.loc:=LOC_REGISTER;
-         del_reference(p^.left^.location.reference);
-         p^.location.register:=getregister32;
-         exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
-         newreference(p^.left^.location.reference),
-           p^.location.register)));
-      end;
-
-
-{*****************************************************************************
-                             SecondDeRef
-*****************************************************************************}
-
-    procedure secondderef(var p : ptree);
-      var
-         hr : tregister;
-      begin
-         secondpass(p^.left);
-         reset_reference(p^.location.reference);
-         case p^.left^.location.loc of
-            LOC_REGISTER:
-              p^.location.reference.base:=p^.left^.location.register;
-            LOC_CREGISTER:
-              begin
-                 { ... and reserve one for the pointer }
-                 hr:=getregister32;
-                 emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
-                 p^.location.reference.base:=hr;
-              end;
-            else
-              begin
-                 { free register }
-                 del_reference(p^.left^.location.reference);
-
-                 { ...and reserve one for the pointer }
-                 hr:=getregister32;
-                 exprasmlist^.concat(new(pai386,op_ref_reg(
-                   A_MOV,S_L,newreference(p^.left^.location.reference),
-                   hr)));
-                 p^.location.reference.base:=hr;
-              end;
-         end;
-         if ppointerdef(p^.left^.resulttype)^.is_far then
-          p^.location.reference.segment:=R_FS;
-         if not ppointerdef(p^.left^.resulttype)^.is_far and
-            (cs_gdb_heaptrc in aktglobalswitches) and
-            (cs_checkpointer in aktglobalswitches) then
-              begin
-                 exprasmlist^.concat(new(pai386,op_reg(
-                   A_PUSH,S_L,p^.location.reference.base)));
-                 emitcall('FPC_CHECKPOINTER',true);
-              end;
-      end;
-
-
-{*****************************************************************************
-                             SecondSubScriptN
-*****************************************************************************}
-
-    procedure secondsubscriptn(var p : ptree);
-      var
-         hr : tregister;
-      begin
-         secondpass(p^.left);
-         if codegenerror then
-           exit;
-         { classes must be dereferenced implicit }
-         if (p^.left^.resulttype^.deftype=objectdef) and
-           pobjectdef(p^.left^.resulttype)^.isclass then
-           begin
-             reset_reference(p^.location.reference);
-             case p^.left^.location.loc of
-                LOC_REGISTER:
-                  p^.location.reference.base:=p^.left^.location.register;
-                LOC_CREGISTER:
-                  begin
-                     { ... and reserve one for the pointer }
-                     hr:=getregister32;
-                     emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
-                       p^.location.reference.base:=hr;
-                  end;
-                else
-                  begin
-                     { free register }
-                     del_reference(p^.left^.location.reference);
-
-                     { ... and reserve one for the pointer }
-                     hr:=getregister32;
-                     exprasmlist^.concat(new(pai386,op_ref_reg(
-                       A_MOV,S_L,newreference(p^.left^.location.reference),
-                       hr)));
-                     p^.location.reference.base:=hr;
-                  end;
-             end;
-           end
-         else
-           set_location(p^.location,p^.left^.location);
-
-         inc(p^.location.reference.offset,p^.vs^.address);
-      end;
-
-
-{*****************************************************************************
-                               SecondVecN
-*****************************************************************************}
-
-    procedure secondvecn(var p : ptree);
-      var
-        is_pushed : boolean;
-        ind,hr : tregister;
-        _p : ptree;
-
-          function get_mul_size:longint;
-          begin
-            if p^.memindex then
-             get_mul_size:=1
-            else
-             get_mul_size:=p^.resulttype^.size;
-          end;
-
-          procedure calc_emit_mul;
-          var
-             l1,l2 : longint;
-          begin
-            l1:=get_mul_size;
-            case l1 of
-             1,2,4,8 : p^.location.reference.scalefactor:=l1;
-            else
-              begin
-                 if ispowerof2(l1,l2) then
-                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,l2,ind)))
-                 else
-                   exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,l1,ind)));
-              end;
-            end;
-          end;
-
-      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                                     }
-         rl : pdef;
-         t   : ptree;
-         hp  : preference;
-         href : treference;
-         tai : Pai386;
-         pushed : tpushed;
-         hightree : ptree;
-
-      begin
-         secondpass(p^.left);
-         rl:=p^.left^.resulttype;
-         { we load the array reference to p^.location }
-
-         { an ansistring needs to be dereferenced }
-         if is_ansistring(p^.left^.resulttype) or
-           is_widestring(p^.left^.resulttype) then
-           begin
-              reset_reference(p^.location.reference);
-              if p^.callunique then
-                begin
-                   if p^.left^.location.loc<>LOC_REFERENCE then
-                     begin
-                        CGMessage(cg_e_illegal_expression);
-                        exit;
-                     end;
-                   pushusedregisters(exprasmlist,pushed,$ff);
-                   emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                   if is_ansistring(p^.left^.resulttype) then
-                     emitcall('FPC_ANSISTR_UNIQUE',true)
-                   else
-                     emitcall('FPC_WIDESTR_UNIQUE',true);
-                   maybe_loadesi;
-                   popusedregisters(exprasmlist,pushed);
-                end;
-
-              if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                begin
-                   p^.location.reference.base:=p^.left^.location.register;
-                end
-              else
-                begin
-                   del_reference(p^.left^.location.reference);
-                   p^.location.reference.base:=getregister32;
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                     newreference(p^.left^.location.reference),
-                     p^.location.reference.base)));
-                end;
-
-              { check for a zero length string,
-                we can use the ansistring routine here }
-              if (cs_check_range in aktlocalswitches) then
-                begin
-                   pushusedregisters(exprasmlist,pushed,$ff);
-                   exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.location.reference.base)));
-                   emitcall('FPC_ANSISTR_CHECKZERO',true);
-                   maybe_loadesi;
-                   popusedregisters(exprasmlist,pushed);
-                end;
-
-              if is_ansistring(p^.left^.resulttype) then
-                { in ansistrings S[1] is pchar(S)[0] !! }
-                dec(p^.location.reference.offset)
-              else
-                begin
-                   { in widestrings S[1] is pwchar(S)[0] !! }
-                   dec(p^.location.reference.offset,2);
-                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,
-                     1,p^.location.reference.base)));
-                end;
-
-              { we've also to keep left up-to-date, because it is used   }
-              { if a constant array index occurs, subject to change (FK) }
-              set_location(p^.left^.location,p^.location);
-           end
-         else
-           set_location(p^.location,p^.left^.location);
-
-         { offset can only differ from 0 if arraydef }
-         if p^.left^.resulttype^.deftype=arraydef then
-           dec(p^.location.reference.offset,
-               get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
-         if p^.right^.treetype=ordconstn then
-           begin
-              { offset can only differ from 0 if arraydef }
-              if (p^.left^.resulttype^.deftype=arraydef) then
-                begin
-                   if not(is_open_array(p^.left^.resulttype)) then
-                     begin
-                        if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
-                           (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
-                           begin
-                              if (cs_check_range in aktlocalswitches) then
-                                CGMessage(parser_e_range_check_error)
-                              else
-                                CGMessage(parser_w_range_check_error);
-                           end;
-                        dec(p^.left^.location.reference.offset,
-                            get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
-                     end
-                   else
-                     begin
-                        { range checking for open arrays !!!! }
-                        {!!!!!!!!!!!!!!!!!}
-                     end;
-                end
-              else if (p^.left^.resulttype^.deftype=stringdef) then
-                begin
-                   if (p^.right^.value=0) and not(is_shortstring(p^.left^.resulttype)) then
-                     CGMessage(cg_e_can_access_element_zero);
-
-                   if (cs_check_range in aktlocalswitches) then
-                     case pstringdef(p^.left^.resulttype)^.string_typ of
-                        { it's the same for ansi- and wide strings }
-                        st_widestring,
-                        st_ansistring:
-                          begin
-                             pushusedregisters(exprasmlist,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);
-                             maybe_loadesi;
-                          end;
-
-                        st_shortstring:
-                          begin
-                             {!!!!!!!!!!!!!!!!!}
-                          end;
-
-                        st_longstring:
-                          begin
-                             {!!!!!!!!!!!!!!!!!}
-                          end;
-                     end;
-                end;
-
-              inc(p^.left^.location.reference.offset,
-                  get_mul_size*p^.right^.value);
-              if p^.memseg then
-                p^.left^.location.reference.segment:=R_FS;
-              p^.left^.resulttype:=p^.resulttype;
-              disposetree(p^.right);
-              _p:=p^.left;
-              putnode(p);
-              p:=_p;
-           end
-         else
-         { not treetype=ordconstn }
-           begin
-              { quick hack, to overcome Delphi 2 }
-              if (cs_regalloc in aktglobalswitches) and
-                (p^.left^.resulttype^.deftype=arraydef) then
-                begin
-                   extraoffset:=0;
-                   if (p^.right^.treetype=addn) then
-                     begin
-                        if p^.right^.right^.treetype=ordconstn then
-                          begin
-                             extraoffset:=p^.right^.right^.value;
-                             t:=p^.right^.left;
-                             putnode(p^.right);
-                             putnode(p^.right^.right);
-                             p^.right:=t
-                          end
-                        else if p^.right^.left^.treetype=ordconstn then
-                          begin
-                             extraoffset:=p^.right^.left^.value;
-                             t:=p^.right^.right;
-                             putnode(p^.right);
-                             putnode(p^.right^.left);
-                             p^.right:=t
-                          end;
-                     end
-                   else if (p^.right^.treetype=subn) then
-                     begin
-                        if p^.right^.right^.treetype=ordconstn then
-                          begin
-                             extraoffset:=p^.right^.right^.value;
-                             t:=p^.right^.left;
-                             putnode(p^.right);
-                             putnode(p^.right^.right);
-                             p^.right:=t
-                          end
-                        else if p^.right^.left^.treetype=ordconstn then
-                          begin
-                             extraoffset:=p^.right^.left^.value;
-                             t:=p^.right^.right;
-                             putnode(p^.right);
-                             putnode(p^.right^.left);
-                             p^.right:=t
-                          end;
-                     end;
-                   inc(p^.location.reference.offset,
-                       get_mul_size*extraoffset);
-                end;
-              { calculate from left to right }
-              if (p^.location.loc<>LOC_REFERENCE) and
-                 (p^.location.loc<>LOC_MEM) then
-                CGMessage(cg_e_illegal_expression);
-              is_pushed:=maybe_push(p^.right^.registers32,p);
-              secondpass(p^.right);
-              if is_pushed then
-                restore(p);
-              { here we change the location of p^.right
-                and the update was forgotten so it
-                led to wrong code in emitrangecheck later PM
-                so make range check before }
-
-              if cs_check_range in aktlocalswitches then
-               begin
-                 if p^.left^.resulttype^.deftype=arraydef then
-                   begin
-                     if is_open_array(p^.left^.resulttype) then
-                      begin
-                        reset_reference(href);
-                        parraydef(p^.left^.resulttype)^.genrangecheck;
-                        href.symbol:=newasmsymbol(parraydef(p^.left^.resulttype)^.getrangecheckstring);
-                        href.offset:=4;
-                        getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
-                        hightree:=genloadnode(pvarsym(srsym),p^.left^.symtable);
-                        firstpass(hightree);
-                        secondpass(hightree);
-                        emit_mov_loc_ref(hightree^.location,href);
-                        disposetree(hightree);
-                      end;
-                     emitrangecheck(p^.right,p^.left^.resulttype);
-                   end;
-               end;
-
-              case p^.right^.location.loc of
-                 LOC_REGISTER:
-                   begin
-                      ind:=p^.right^.location.register;
-                      case p^.right^.resulttype^.size of
-                         1:
-                           begin
-                              hr:=reg8toreg32(ind);
-                              emit_reg_reg(A_MOVZX,S_BL,ind,hr);
-                              ind:=hr;
-                           end;
-                         2:
-                           begin
-                              hr:=reg16toreg32(ind);
-                              emit_reg_reg(A_MOVZX,S_WL,ind,hr);
-                              ind:=hr;
-                           end;
-                      end;
-                   end;
-                 LOC_CREGISTER:
-                   begin
-                      ind:=getregister32;
-                      case p^.right^.resulttype^.size of
-                         1:
-                           emit_reg_reg(A_MOVZX,S_BL,p^.right^.location.register,ind);
-                         2:
-                           emit_reg_reg(A_MOVZX,S_WL,p^.right^.location.register,ind);
-                         4:
-                           emit_reg_reg(A_MOV,S_L,p^.right^.location.register,ind);
-                      end;
-                   end;
-                 LOC_FLAGS:
-                   begin
-                      ind:=getregister32;
-                      emit_flag2reg(p^.right^.location.resflags,reg32toreg8(ind));
-                      emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
-                   end
-                 else
-                    begin
-                       del_reference(p^.right^.location.reference);
-                       ind:=getregister32;
-                       { Booleans are stored in an 8 bit memory location, so
-                         the use of MOVL is not correct }
-                       case p^.right^.resulttype^.size of
-                        1 : tai:=new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.right^.location.reference),ind));
-                        2 : tai:=new(Pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.right^.location.reference),ind));
-                        4 : tai:=new(Pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),ind));
-                       end;
-                       exprasmlist^.concat(tai);
-                    end;
-                end;
-
-            { produce possible range check code: }
-              if cs_check_range in aktlocalswitches then
-               begin
-                 if p^.left^.resulttype^.deftype=arraydef then
-                   begin
-                     { done defore (PM) }
-                   end
-                 else if (p^.left^.resulttype^.deftype=stringdef) then
-                   begin
-                      case pstringdef(p^.left^.resulttype)^.string_typ of
-                         { it's the same for ansi- and wide strings }
-                         st_widestring,
-                         st_ansistring:
-                           begin
-                              pushusedregisters(exprasmlist,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);
-                              maybe_loadesi;
-                           end;
-                         st_shortstring:
-                           begin
-                              {!!!!!!!!!!!!!!!!!}
-                           end;
-                         st_longstring:
-                           begin
-                              {!!!!!!!!!!!!!!!!!}
-                           end;
-                      end;
-                   end;
-               end;
-
-              if p^.location.reference.index=R_NO then
-               begin
-                 p^.location.reference.index:=ind;
-                 calc_emit_mul;
-               end
-              else
-               begin
-                 if p^.location.reference.base=R_NO then
-                  begin
-                    case p^.location.reference.scalefactor of
-                     2 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,1,p^.location.reference.index)));
-                     4 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,2,p^.location.reference.index)));
-                     8 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,3,p^.location.reference.index)));
-                    end;
-                    calc_emit_mul;
-                    p^.location.reference.base:=p^.location.reference.index;
-                    p^.location.reference.index:=ind;
-                  end
-                 else
-                  begin
-                    exprasmlist^.concat(new(pai386,op_ref_reg(
-                      A_LEA,S_L,newreference(p^.location.reference),
-                      p^.location.reference.index)));
-                    ungetregister32(p^.location.reference.base);
-                    { the symbol offset is loaded,               }
-                    { so release the symbol name and set symbol  }
-                    { to nil                                     }
-                    p^.location.reference.symbol:=nil;
-                    p^.location.reference.offset:=0;
-                    calc_emit_mul;
-                    p^.location.reference.base:=p^.location.reference.index;
-                    p^.location.reference.index:=ind;
-                  end;
-               end;
-
-              if p^.memseg then
-                p^.location.reference.segment:=R_FS;
-           end;
-      end;
-
-{*****************************************************************************
-                               SecondSelfN
-*****************************************************************************}
-
-    procedure secondselfn(var p : ptree);
-      begin
-         reset_reference(p^.location.reference);
-         if (p^.resulttype^.deftype=classrefdef) or
-           ((p^.resulttype^.deftype=objectdef)
-             and pobjectdef(p^.resulttype)^.isclass
-           ) then
-           p^.location.register:=R_ESI
-         else
-           p^.location.reference.base:=R_ESI;
-      end;
-
-
-{*****************************************************************************
-                               SecondWithN
-*****************************************************************************}
-
-    procedure secondwith(var p : ptree);
-      var
-        usetemp : boolean;
-      begin
-         if assigned(p^.left) then
-            begin
-               secondpass(p^.left);
-               if p^.left^.location.reference.segment<>R_NO then
-                 message(parser_e_no_with_for_variable_in_other_segments);
-
-               new(p^.withreference);
-
-               usetemp:=false;
-               if (p^.left^.treetype=loadn) and
-                  (p^.left^.symtable=aktprocsym^.definition^.localst) then
-                 begin
-                    { for locals use the local storage }
-                    p^.withreference^:=p^.left^.location.reference;
-                    p^.islocal:=true;
-                 end
-               else
-                if (p^.left^.resulttype^.deftype=objectdef) and
-                   pobjectdef(p^.left^.resulttype)^.isclass then
-                 begin
-                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                      newreference(p^.left^.location.reference),R_EDI)));
-                    usetemp:=true;
-                 end
-               else
-                 begin
-                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
-                     newreference(p^.left^.location.reference),R_EDI)));
-                   usetemp:=true;
-                 end;
-
-               { if usetemp is set the value must be in %edi }
-               if usetemp then
-                begin
-                  gettempofsizereference(4,p^.withreference^);
-                  normaltemptopersistant(p^.withreference^.offset);
-                  { move to temp reference }
-                  exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
-                    R_EDI,newreference(p^.withreference^))));
-                  del_reference(p^.left^.location.reference);
-                end;
-
-               { p^.right can be optimize out !!! }
-               if assigned(p^.right) then
-                 secondpass(p^.right);
-
-               if usetemp then
-                 ungetpersistanttemp(p^.withreference^.offset);
-
-               dispose(p^.withreference);
-               p^.withreference:=nil;
-            end;
-       end;
-
-
-end.
-{
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 assembler for in memory related nodes
+
+    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 cg386mem;
+interface
+
+    uses
+      tree;
+
+    procedure secondloadvmt(var p : ptree);
+    procedure secondhnewn(var p : ptree);
+    procedure secondnewn(var p : ptree);
+    procedure secondhdisposen(var p : ptree);
+    procedure secondsimplenewdispose(var p : ptree);
+    procedure secondaddr(var p : ptree);
+    procedure seconddoubleaddr(var p : ptree);
+    procedure secondderef(var p : ptree);
+    procedure secondsubscriptn(var p : ptree);
+    procedure secondvecn(var p : ptree);
+    procedure secondselfn(var p : ptree);
+    procedure secondwith(var p : ptree);
+
+
+implementation
+
+    uses
+      globtype,systems,
+      cobjects,verbose,globals,
+      symtable,aasm,types,
+      hcodegen,temp_gen,pass_2,pass_1,
+{$ifndef OLDASM}
+      i386base,i386asm,
+{$else}
+      i386,
+{$endif}
+      cgai386,tgeni386;
+
+{*****************************************************************************
+                             SecondLoadVMT
+*****************************************************************************}
+
+    procedure secondloadvmt(var p : ptree);
+      begin
+         p^.location.register:=getregister32;
+         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;
+
+
+{*****************************************************************************
+                             SecondHNewN
+*****************************************************************************}
+
+    procedure secondhnewn(var p : ptree);
+      begin
+      end;
+
+
+{*****************************************************************************
+                             SecondNewN
+*****************************************************************************}
+
+    procedure secondnewn(var p : ptree);
+      var
+         pushed : tpushed;
+         r : preference;
+      begin
+         if assigned(p^.left) then
+           begin
+              secondpass(p^.left);
+              p^.location.register:=p^.left^.location.register;
+           end
+         else
+           begin
+              pushusedregisters(exprasmlist,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);
+
+              emitcall('FPC_GETMEM',true);
+              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^);
+                   { push pointer adress }
+                   emitpushreferenceaddr(exprasmlist,p^.location.reference);
+                   dispose(r);
+                   emitcall('FPC_INITIALIZE',true);
+                end;
+              popusedregisters(exprasmlist,pushed);
+              { may be load ESI }
+              maybe_loadesi;
+           end;
+         if codegenerror then
+           exit;
+      end;
+
+
+{*****************************************************************************
+                             SecondDisposeN
+*****************************************************************************}
+
+    procedure secondhdisposen(var p : ptree);
+      begin
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+         reset_reference(p^.location.reference);
+         case p^.left^.location.loc of
+            LOC_REGISTER,
+            LOC_CREGISTER:
+              begin
+                 p^.location.reference.index:=getregister32;
+                 exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
+                   p^.left^.location.register,
+                   p^.location.reference.index)));
+              end;
+            LOC_MEM,LOC_REFERENCE :
+              begin
+                 del_reference(p^.left^.location.reference);
+                 p^.location.reference.index:=getregister32;
+                 exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
+                   p^.location.reference.index)));
+              end;
+         end;
+      end;
+
+
+{*****************************************************************************
+                             SecondNewDispose
+*****************************************************************************}
+
+    procedure secondsimplenewdispose(var p : ptree);
+
+      var
+         pushed : tpushed;
+         r : preference;
+
+      begin
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+
+         pushusedregisters(exprasmlist,pushed,$ff);
+         { determines the size of the mem block }
+         push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
+
+         { 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);
+         end;
+
+         { call the mem handling procedures }
+         case p^.treetype of
+           simpledisposen:
+             begin
+                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^);
+                     { 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);
+                     end;
+                     dispose(r);
+                     emitcall('FPC_FINALIZE',true);
+                  end;
+                emitcall('FPC_FREEMEM',true);
+             end;
+           simplenewn:
+             begin
+                emitcall('FPC_GETMEM',true);
+                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^);
+                     { 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);
+                     end;
+                     dispose(r);
+                     emitcall('FPC_INITIALIZE',true);
+                  end;
+             end;
+         end;
+         popusedregisters(exprasmlist,pushed);
+         { may be load ESI }
+         maybe_loadesi;
+      end;
+
+
+{*****************************************************************************
+                             SecondAddr
+*****************************************************************************}
+
+    procedure secondaddr(var p : ptree);
+      begin
+         secondpass(p^.left);
+         p^.location.loc:=LOC_REGISTER;
+         del_reference(p^.left^.location.reference);
+         p^.location.register:=getregister32;
+         {@ on a procvar means returning an address to the procedure that
+           is stored in it.}
+         { yes but p^.left^.symtableentry can be nil
+           for example on @self !! }
+         { symtableentry can be also invalid, if left is no tree node }
+         if (m_tp_procvar in aktmodeswitches) and
+           (p^.left^.treetype=loadn) and
+           assigned(p^.left^.symtableentry) and
+           (p^.left^.symtableentry^.typ=varsym) and
+           (pvarsym(p^.left^.symtableentry)^.definition^.deftype=procvardef) then
+           exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+             newreference(p^.left^.location.reference),
+             p^.location.register)))
+         else
+           exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+             newreference(p^.left^.location.reference),
+             p^.location.register)));
+           { for use of other segments }
+           if p^.left^.location.reference.segment<>R_NO then
+             p^.location.segment:=p^.left^.location.reference.segment;
+      end;
+
+
+{*****************************************************************************
+                             SecondDoubleAddr
+*****************************************************************************}
+
+    procedure seconddoubleaddr(var p : ptree);
+      begin
+         secondpass(p^.left);
+         p^.location.loc:=LOC_REGISTER;
+         del_reference(p^.left^.location.reference);
+         p^.location.register:=getregister32;
+         exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+         newreference(p^.left^.location.reference),
+           p^.location.register)));
+      end;
+
+
+{*****************************************************************************
+                             SecondDeRef
+*****************************************************************************}
+
+    procedure secondderef(var p : ptree);
+      var
+         hr : tregister;
+      begin
+         secondpass(p^.left);
+         reset_reference(p^.location.reference);
+         case p^.left^.location.loc of
+            LOC_REGISTER:
+              p^.location.reference.base:=p^.left^.location.register;
+            LOC_CREGISTER:
+              begin
+                 { ... and reserve one for the pointer }
+                 hr:=getregister32;
+                 emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
+                 p^.location.reference.base:=hr;
+              end;
+            else
+              begin
+                 { free register }
+                 del_reference(p^.left^.location.reference);
+
+                 { ...and reserve one for the pointer }
+                 hr:=getregister32;
+                 exprasmlist^.concat(new(pai386,op_ref_reg(
+                   A_MOV,S_L,newreference(p^.left^.location.reference),
+                   hr)));
+                 p^.location.reference.base:=hr;
+              end;
+         end;
+         if ppointerdef(p^.left^.resulttype)^.is_far then
+          p^.location.reference.segment:=R_FS;
+         if not ppointerdef(p^.left^.resulttype)^.is_far and
+            (cs_gdb_heaptrc in aktglobalswitches) and
+            (cs_checkpointer in aktglobalswitches) then
+              begin
+                 exprasmlist^.concat(new(pai386,op_reg(
+                   A_PUSH,S_L,p^.location.reference.base)));
+                 emitcall('FPC_CHECKPOINTER',true);
+              end;
+      end;
+
+
+{*****************************************************************************
+                             SecondSubScriptN
+*****************************************************************************}
+
+    procedure secondsubscriptn(var p : ptree);
+      var
+         hr : tregister;
+      begin
+         secondpass(p^.left);
+         if codegenerror then
+           exit;
+         { classes must be dereferenced implicit }
+         if (p^.left^.resulttype^.deftype=objectdef) and
+           pobjectdef(p^.left^.resulttype)^.isclass then
+           begin
+             reset_reference(p^.location.reference);
+             case p^.left^.location.loc of
+                LOC_REGISTER:
+                  p^.location.reference.base:=p^.left^.location.register;
+                LOC_CREGISTER:
+                  begin
+                     { ... and reserve one for the pointer }
+                     hr:=getregister32;
+                     emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hr);
+                       p^.location.reference.base:=hr;
+                  end;
+                else
+                  begin
+                     { free register }
+                     del_reference(p^.left^.location.reference);
+
+                     { ... and reserve one for the pointer }
+                     hr:=getregister32;
+                     exprasmlist^.concat(new(pai386,op_ref_reg(
+                       A_MOV,S_L,newreference(p^.left^.location.reference),
+                       hr)));
+                     p^.location.reference.base:=hr;
+                  end;
+             end;
+           end
+         else
+           set_location(p^.location,p^.left^.location);
+
+         inc(p^.location.reference.offset,p^.vs^.address);
+      end;
+
+
+{*****************************************************************************
+                               SecondVecN
+*****************************************************************************}
+
+    procedure secondvecn(var p : ptree);
+      var
+        is_pushed : boolean;
+        ind,hr : tregister;
+        _p : ptree;
+
+          function get_mul_size:longint;
+          begin
+            if p^.memindex then
+             get_mul_size:=1
+            else
+             get_mul_size:=p^.resulttype^.size;
+          end;
+
+          procedure calc_emit_mul;
+          var
+             l1,l2 : longint;
+          begin
+            l1:=get_mul_size;
+            case l1 of
+             1,2,4,8 : p^.location.reference.scalefactor:=l1;
+            else
+              begin
+                 if ispowerof2(l1,l2) then
+                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,l2,ind)))
+                 else
+                   exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,l1,ind)));
+              end;
+            end;
+          end;
+
+      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                                     }
+         rl : pdef;
+         t   : ptree;
+         hp  : preference;
+         href : treference;
+         tai : Pai386;
+         pushed : tpushed;
+         hightree : ptree;
+
+      begin
+         secondpass(p^.left);
+         rl:=p^.left^.resulttype;
+         { we load the array reference to p^.location }
+
+         { an ansistring needs to be dereferenced }
+         if is_ansistring(p^.left^.resulttype) or
+           is_widestring(p^.left^.resulttype) then
+           begin
+              reset_reference(p^.location.reference);
+              if p^.callunique then
+                begin
+                   if p^.left^.location.loc<>LOC_REFERENCE then
+                     begin
+                        CGMessage(cg_e_illegal_expression);
+                        exit;
+                     end;
+                   pushusedregisters(exprasmlist,pushed,$ff);
+                   emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                   if is_ansistring(p^.left^.resulttype) then
+                     emitcall('FPC_ANSISTR_UNIQUE',true)
+                   else
+                     emitcall('FPC_WIDESTR_UNIQUE',true);
+                   maybe_loadesi;
+                   popusedregisters(exprasmlist,pushed);
+                end;
+
+              if p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
+                begin
+                   p^.location.reference.base:=p^.left^.location.register;
+                end
+              else
+                begin
+                   del_reference(p^.left^.location.reference);
+                   p^.location.reference.base:=getregister32;
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                     newreference(p^.left^.location.reference),
+                     p^.location.reference.base)));
+                end;
+
+              { check for a zero length string,
+                we can use the ansistring routine here }
+              if (cs_check_range in aktlocalswitches) then
+                begin
+                   pushusedregisters(exprasmlist,pushed,$ff);
+                   exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,p^.location.reference.base)));
+                   emitcall('FPC_ANSISTR_CHECKZERO',true);
+                   maybe_loadesi;
+                   popusedregisters(exprasmlist,pushed);
+                end;
+
+              if is_ansistring(p^.left^.resulttype) then
+                { in ansistrings S[1] is pchar(S)[0] !! }
+                dec(p^.location.reference.offset)
+              else
+                begin
+                   { in widestrings S[1] is pwchar(S)[0] !! }
+                   dec(p^.location.reference.offset,2);
+                   exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,
+                     1,p^.location.reference.base)));
+                end;
+
+              { we've also to keep left up-to-date, because it is used   }
+              { if a constant array index occurs, subject to change (FK) }
+              set_location(p^.left^.location,p^.location);
+           end
+         else
+           set_location(p^.location,p^.left^.location);
+
+         { offset can only differ from 0 if arraydef }
+         if p^.left^.resulttype^.deftype=arraydef then
+           dec(p^.location.reference.offset,
+               get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
+         if p^.right^.treetype=ordconstn then
+           begin
+              { offset can only differ from 0 if arraydef }
+              if (p^.left^.resulttype^.deftype=arraydef) then
+                begin
+                   if not(is_open_array(p^.left^.resulttype)) and
+                      not(is_array_of_const(p^.left^.resulttype)) then
+                     begin
+                        if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
+                           (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
+                           begin
+                              if (cs_check_range in aktlocalswitches) then
+                                CGMessage(parser_e_range_check_error)
+                              else
+                                CGMessage(parser_w_range_check_error);
+                           end;
+                        dec(p^.left^.location.reference.offset,
+                            get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
+                     end
+                   else
+                     begin
+                        { range checking for open arrays !!!! }
+                        {!!!!!!!!!!!!!!!!!}
+                     end;
+                end
+              else if (p^.left^.resulttype^.deftype=stringdef) then
+                begin
+                   if (p^.right^.value=0) and not(is_shortstring(p^.left^.resulttype)) then
+                     CGMessage(cg_e_can_access_element_zero);
+
+                   if (cs_check_range in aktlocalswitches) then
+                     case pstringdef(p^.left^.resulttype)^.string_typ of
+                        { it's the same for ansi- and wide strings }
+                        st_widestring,
+                        st_ansistring:
+                          begin
+                             pushusedregisters(exprasmlist,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);
+                             maybe_loadesi;
+                          end;
+
+                        st_shortstring:
+                          begin
+                             {!!!!!!!!!!!!!!!!!}
+                          end;
+
+                        st_longstring:
+                          begin
+                             {!!!!!!!!!!!!!!!!!}
+                          end;
+                     end;
+                end;
+
+              inc(p^.left^.location.reference.offset,
+                  get_mul_size*p^.right^.value);
+              if p^.memseg then
+                p^.left^.location.reference.segment:=R_FS;
+              p^.left^.resulttype:=p^.resulttype;
+              disposetree(p^.right);
+              _p:=p^.left;
+              putnode(p);
+              p:=_p;
+           end
+         else
+         { not treetype=ordconstn }
+           begin
+              { quick hack, to overcome Delphi 2 }
+              if (cs_regalloc in aktglobalswitches) and
+                (p^.left^.resulttype^.deftype=arraydef) then
+                begin
+                   extraoffset:=0;
+                   if (p^.right^.treetype=addn) then
+                     begin
+                        if p^.right^.right^.treetype=ordconstn then
+                          begin
+                             extraoffset:=p^.right^.right^.value;
+                             t:=p^.right^.left;
+                             putnode(p^.right);
+                             putnode(p^.right^.right);
+                             p^.right:=t
+                          end
+                        else if p^.right^.left^.treetype=ordconstn then
+                          begin
+                             extraoffset:=p^.right^.left^.value;
+                             t:=p^.right^.right;
+                             putnode(p^.right);
+                             putnode(p^.right^.left);
+                             p^.right:=t
+                          end;
+                     end
+                   else if (p^.right^.treetype=subn) then
+                     begin
+                        if p^.right^.right^.treetype=ordconstn then
+                          begin
+                             extraoffset:=p^.right^.right^.value;
+                             t:=p^.right^.left;
+                             putnode(p^.right);
+                             putnode(p^.right^.right);
+                             p^.right:=t
+                          end
+                        else if p^.right^.left^.treetype=ordconstn then
+                          begin
+                             extraoffset:=p^.right^.left^.value;
+                             t:=p^.right^.right;
+                             putnode(p^.right);
+                             putnode(p^.right^.left);
+                             p^.right:=t
+                          end;
+                     end;
+                   inc(p^.location.reference.offset,
+                       get_mul_size*extraoffset);
+                end;
+              { calculate from left to right }
+              if (p^.location.loc<>LOC_REFERENCE) and
+                 (p^.location.loc<>LOC_MEM) then
+                CGMessage(cg_e_illegal_expression);
+              is_pushed:=maybe_push(p^.right^.registers32,p);
+              secondpass(p^.right);
+              if is_pushed then
+                restore(p);
+              { here we change the location of p^.right
+                and the update was forgotten so it
+                led to wrong code in emitrangecheck later PM
+                so make range check before }
+
+              if cs_check_range in aktlocalswitches then
+               begin
+                 if p^.left^.resulttype^.deftype=arraydef then
+                   begin
+                     if is_open_array(p^.left^.resulttype) then
+                      begin
+                        reset_reference(href);
+                        parraydef(p^.left^.resulttype)^.genrangecheck;
+                        href.symbol:=newasmsymbol(parraydef(p^.left^.resulttype)^.getrangecheckstring);
+                        href.offset:=4;
+                        getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
+                        hightree:=genloadnode(pvarsym(srsym),p^.left^.symtable);
+                        firstpass(hightree);
+                        secondpass(hightree);
+                        emit_mov_loc_ref(hightree^.location,href);
+                        disposetree(hightree);
+                      end;
+                     emitrangecheck(p^.right,p^.left^.resulttype);
+                   end;
+               end;
+
+              case p^.right^.location.loc of
+                 LOC_REGISTER:
+                   begin
+                      ind:=p^.right^.location.register;
+                      case p^.right^.resulttype^.size of
+                         1:
+                           begin
+                              hr:=reg8toreg32(ind);
+                              emit_reg_reg(A_MOVZX,S_BL,ind,hr);
+                              ind:=hr;
+                           end;
+                         2:
+                           begin
+                              hr:=reg16toreg32(ind);
+                              emit_reg_reg(A_MOVZX,S_WL,ind,hr);
+                              ind:=hr;
+                           end;
+                      end;
+                   end;
+                 LOC_CREGISTER:
+                   begin
+                      ind:=getregister32;
+                      case p^.right^.resulttype^.size of
+                         1:
+                           emit_reg_reg(A_MOVZX,S_BL,p^.right^.location.register,ind);
+                         2:
+                           emit_reg_reg(A_MOVZX,S_WL,p^.right^.location.register,ind);
+                         4:
+                           emit_reg_reg(A_MOV,S_L,p^.right^.location.register,ind);
+                      end;
+                   end;
+                 LOC_FLAGS:
+                   begin
+                      ind:=getregister32;
+                      emit_flag2reg(p^.right^.location.resflags,reg32toreg8(ind));
+                      emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
+                   end
+                 else
+                    begin
+                       del_reference(p^.right^.location.reference);
+                       ind:=getregister32;
+                       { Booleans are stored in an 8 bit memory location, so
+                         the use of MOVL is not correct }
+                       case p^.right^.resulttype^.size of
+                        1 : tai:=new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.right^.location.reference),ind));
+                        2 : tai:=new(Pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.right^.location.reference),ind));
+                        4 : tai:=new(Pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),ind));
+                       end;
+                       exprasmlist^.concat(tai);
+                    end;
+                end;
+
+            { produce possible range check code: }
+              if cs_check_range in aktlocalswitches then
+               begin
+                 if p^.left^.resulttype^.deftype=arraydef then
+                   begin
+                     { done defore (PM) }
+                   end
+                 else if (p^.left^.resulttype^.deftype=stringdef) then
+                   begin
+                      case pstringdef(p^.left^.resulttype)^.string_typ of
+                         { it's the same for ansi- and wide strings }
+                         st_widestring,
+                         st_ansistring:
+                           begin
+                              pushusedregisters(exprasmlist,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);
+                              maybe_loadesi;
+                           end;
+                         st_shortstring:
+                           begin
+                              {!!!!!!!!!!!!!!!!!}
+                           end;
+                         st_longstring:
+                           begin
+                              {!!!!!!!!!!!!!!!!!}
+                           end;
+                      end;
+                   end;
+               end;
+
+              if p^.location.reference.index=R_NO then
+               begin
+                 p^.location.reference.index:=ind;
+                 calc_emit_mul;
+               end
+              else
+               begin
+                 if p^.location.reference.base=R_NO then
+                  begin
+                    case p^.location.reference.scalefactor of
+                     2 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,1,p^.location.reference.index)));
+                     4 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,2,p^.location.reference.index)));
+                     8 : exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,3,p^.location.reference.index)));
+                    end;
+                    calc_emit_mul;
+                    p^.location.reference.base:=p^.location.reference.index;
+                    p^.location.reference.index:=ind;
+                  end
+                 else
+                  begin
+                    exprasmlist^.concat(new(pai386,op_ref_reg(
+                      A_LEA,S_L,newreference(p^.location.reference),
+                      p^.location.reference.index)));
+                    ungetregister32(p^.location.reference.base);
+                    { the symbol offset is loaded,               }
+                    { so release the symbol name and set symbol  }
+                    { to nil                                     }
+                    p^.location.reference.symbol:=nil;
+                    p^.location.reference.offset:=0;
+                    calc_emit_mul;
+                    p^.location.reference.base:=p^.location.reference.index;
+                    p^.location.reference.index:=ind;
+                  end;
+               end;
+
+              if p^.memseg then
+                p^.location.reference.segment:=R_FS;
+           end;
+      end;
+
+{*****************************************************************************
+                               SecondSelfN
+*****************************************************************************}
+
+    procedure secondselfn(var p : ptree);
+      begin
+         reset_reference(p^.location.reference);
+         if (p^.resulttype^.deftype=classrefdef) or
+           ((p^.resulttype^.deftype=objectdef)
+             and pobjectdef(p^.resulttype)^.isclass
+           ) then
+           p^.location.register:=R_ESI
+         else
+           p^.location.reference.base:=R_ESI;
+      end;
+
+
+{*****************************************************************************
+                               SecondWithN
+*****************************************************************************}
+
+    procedure secondwith(var p : ptree);
+      var
+        usetemp : boolean;
+      begin
+         if assigned(p^.left) then
+            begin
+               secondpass(p^.left);
+               if p^.left^.location.reference.segment<>R_NO then
+                 message(parser_e_no_with_for_variable_in_other_segments);
+
+               new(p^.withreference);
+
+               usetemp:=false;
+               if (p^.left^.treetype=loadn) and
+                  (p^.left^.symtable=aktprocsym^.definition^.localst) then
+                 begin
+                    { for locals use the local storage }
+                    p^.withreference^:=p^.left^.location.reference;
+                    p^.islocal:=true;
+                 end
+               else
+                if (p^.left^.resulttype^.deftype=objectdef) and
+                   pobjectdef(p^.left^.resulttype)^.isclass then
+                 begin
+                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                      newreference(p^.left^.location.reference),R_EDI)));
+                    usetemp:=true;
+                 end
+               else
+                 begin
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+                     newreference(p^.left^.location.reference),R_EDI)));
+                   usetemp:=true;
+                 end;
+
+               { if usetemp is set the value must be in %edi }
+               if usetemp then
+                begin
+                  gettempofsizereference(4,p^.withreference^);
+                  normaltemptopersistant(p^.withreference^.offset);
+                  { move to temp reference }
+                  exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
+                    R_EDI,newreference(p^.withreference^))));
+                  del_reference(p^.left^.location.reference);
+                end;
+
+               { p^.right can be optimize out !!! }
+               if assigned(p^.right) then
+                 secondpass(p^.right);
+
+               if usetemp then
+                 ungetpersistanttemp(p^.withreference^.offset);
+
+               dispose(p^.withreference);
+               p^.withreference:=nil;
+            end;
+       end;
+
+
+end.
+{
   $Log$
-  Revision 1.44  1999-05-21 13:54:53  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.44  1999/05/21 13:54:53  peter
     * NEWLAB for label as symbol
-
-  Revision 1.43  1999/05/19 16:48:21  florian
-    * tdef.typename: returns a now a proper type name for the most types
-
-  Revision 1.42  1999/05/18 22:11:52  pierre
-   * checkpointer code was wrong!
-
-  Revision 1.41  1999/05/18 21:58:29  florian
-    * fixed some bugs related to temp. ansistrings and functions results
-      which return records/objects/arrays which need init/final.
-
-  Revision 1.40  1999/05/18 14:15:26  peter
-    * containsself fixes
-    * checktypes()
-
-  Revision 1.39  1999/05/17 23:51:39  peter
-    * with temp vars now use a reference with a persistant temp instead
-      of setting datasize
-
-  Revision 1.38  1999/05/17 21:57:05  florian
-    * new temporary ansistring handling
-
-  Revision 1.37  1999/05/17 14:14:14  pierre
-   + -gc for check pointer with heaptrc
-
-  Revision 1.36  1999/05/12 00:19:44  peter
-    * removed R_DEFAULT_SEG
-    * uniform float names
-
-  Revision 1.35  1999/05/01 13:24:13  peter
-    * merged nasm compiler
-    * old asm moved to oldasm/
-
-  Revision 1.34  1999/04/26 18:29:54  peter
-    * farpointerdef moved into pointerdef.is_far
-
-  Revision 1.33  1999/03/26 11:43:26  pierre
-   * bug0236 fixed
-
-  Revision 1.32  1999/03/24 23:16:53  peter
-    * fixed bugs 212,222,225,227,229,231,233
-
-  Revision 1.31  1999/02/25 21:02:29  peter
-    * ag386bin updates
-    + coff writer
-
-  Revision 1.30  1999/02/22 02:15:14  peter
-    * updates for ag386bin
-
-  Revision 1.29  1999/02/07 22:53:07  florian
-    * potential bug in secondvecn fixed
-
-  Revision 1.28  1999/02/04 17:16:51  peter
-    * fixed crash with temp ansistring indexing
-
-  Revision 1.27  1999/02/04 11:44:46  florian
-    * fixed indexed access of ansistrings to temp. ansistring, i.e.
-      c:=(s1+s2)[i], the temp is now correctly remove and the generated
-      code is also fixed
-
-  Revision 1.26  1999/02/04 10:49:41  florian
-    + range checking for ansi- and widestrings
-    * made it compilable with TP
-
-  Revision 1.25  1999/01/21 16:40:52  pierre
-   * fix for constructor inside with statements
-
-  Revision 1.24  1999/01/19 12:05:27  pierre
-   * bug with @procvar=procvar fiwed
-
-  Revision 1.23  1998/12/30 22:15:45  peter
-    + farpointer type
-    * absolutesym now also stores if its far
-
-  Revision 1.22  1998/12/11 00:02:55  peter
-    + globtype,tokens,version unit splitted from globals
-
-  Revision 1.21  1998/12/10 09:47:18  florian
-    + basic operations with int64/qord (compiler with -dint64)
-    + rtti of enumerations extended: names are now written
-
-  Revision 1.20  1998/11/25 19:12:54  pierre
-    * var:=new(pointer_type) support added
-
-  Revision 1.19  1998/11/20 15:35:55  florian
-    * problems with rtti fixed, hope it works
-
-  Revision 1.18  1998/11/17 00:36:40  peter
-    * more ansistring fixes
-
-  Revision 1.17  1998/11/16 15:35:09  pierre
-   * added error for with if different segment
-
-  Revision 1.16  1998/10/21 11:44:42  florian
-    + check for access to index 0 of long/wide/ansi strings added,
-      gives now an error
-    * problem with access to contant index of ansistrings fixed
-
-  Revision 1.15  1998/10/12 09:49:53  florian
-    + support of <procedure var type>:=<pointer> in delphi mode added
-
-  Revision 1.14  1998/10/02 07:20:37  florian
-    * range checking in units doesn't work if the units are smartlinked, fixed
-
-  Revision 1.13  1998/09/27 10:16:23  florian
-    * type casts pchar<->ansistring fixed
-    * ansistring[..] calls does now an unique call
-
-  Revision 1.12  1998/09/23 15:46:36  florian
-    * problem with with and classes fixed
-
-  Revision 1.11  1998/09/17 09:42:18  peter
-    + pass_2 for cg386
-    * Message() -> CGMessage() for pass_1/pass_2
-
-  Revision 1.10  1998/09/14 10:43:52  peter
-    * all internal RTL functions start with FPC_
-
-  Revision 1.9  1998/09/03 16:03:15  florian
-    + rtti generation
-    * init table generation changed
-
-  Revision 1.8  1998/08/23 21:04:34  florian
-    + rtti generation for classes added
-    + new/dispose do now also a call to INITIALIZE/FINALIZE, if necessaray
-
-  Revision 1.7  1998/08/20 11:27:40  michael
-  * Applied Peters Fix
-
-  Revision 1.6  1998/08/10 14:49:49  peter
-    + localswitches, moduleswitches, globalswitches splitting
-
-  Revision 1.5  1998/07/26 21:58:58  florian
-   + better support for switch $H
-   + index access to ansi strings added
-   + assigment of data (records/arrays) containing ansi strings
-
-  Revision 1.4  1998/07/24 22:16:55  florian
-    * internal error 10 together with array access fixed. I hope
-      that's the final fix.
-
-  Revision 1.3  1998/06/25 08:48:09  florian
-    * first version of rtti support
-
-  Revision 1.2  1998/06/08 13:13:35  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:13  peter
-    * splitted cgi386
-
-}
-
+
+  Revision 1.43  1999/05/19 16:48:21  florian
+    * tdef.typename: returns a now a proper type name for the most types
+
+  Revision 1.42  1999/05/18 22:11:52  pierre
+   * checkpointer code was wrong!
+
+  Revision 1.41  1999/05/18 21:58:29  florian
+    * fixed some bugs related to temp. ansistrings and functions results
+      which return records/objects/arrays which need init/final.
+
+  Revision 1.40  1999/05/18 14:15:26  peter
+    * containsself fixes
+    * checktypes()
+
+  Revision 1.39  1999/05/17 23:51:39  peter
+    * with temp vars now use a reference with a persistant temp instead
+      of setting datasize
+
+  Revision 1.38  1999/05/17 21:57:05  florian
+    * new temporary ansistring handling
+
+  Revision 1.37  1999/05/17 14:14:14  pierre
+   + -gc for check pointer with heaptrc
+
+  Revision 1.36  1999/05/12 00:19:44  peter
+    * removed R_DEFAULT_SEG
+    * uniform float names
+
+  Revision 1.35  1999/05/01 13:24:13  peter
+    * merged nasm compiler
+    * old asm moved to oldasm/
+
+  Revision 1.34  1999/04/26 18:29:54  peter
+    * farpointerdef moved into pointerdef.is_far
+
+  Revision 1.33  1999/03/26 11:43:26  pierre
+   * bug0236 fixed
+
+  Revision 1.32  1999/03/24 23:16:53  peter
+    * fixed bugs 212,222,225,227,229,231,233
+
+  Revision 1.31  1999/02/25 21:02:29  peter
+    * ag386bin updates
+    + coff writer
+
+  Revision 1.30  1999/02/22 02:15:14  peter
+    * updates for ag386bin
+
+  Revision 1.29  1999/02/07 22:53:07  florian
+    * potential bug in secondvecn fixed
+
+  Revision 1.28  1999/02/04 17:16:51  peter
+    * fixed crash with temp ansistring indexing
+
+  Revision 1.27  1999/02/04 11:44:46  florian
+    * fixed indexed access of ansistrings to temp. ansistring, i.e.
+      c:=(s1+s2)[i], the temp is now correctly remove and the generated
+      code is also fixed
+
+  Revision 1.26  1999/02/04 10:49:41  florian
+    + range checking for ansi- and widestrings
+    * made it compilable with TP
+
+  Revision 1.25  1999/01/21 16:40:52  pierre
+   * fix for constructor inside with statements
+
+  Revision 1.24  1999/01/19 12:05:27  pierre
+   * bug with @procvar=procvar fiwed
+
+  Revision 1.23  1998/12/30 22:15:45  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.22  1998/12/11 00:02:55  peter
+    + globtype,tokens,version unit splitted from globals
+
+  Revision 1.21  1998/12/10 09:47:18  florian
+    + basic operations with int64/qord (compiler with -dint64)
+    + rtti of enumerations extended: names are now written
+
+  Revision 1.20  1998/11/25 19:12:54  pierre
+    * var:=new(pointer_type) support added
+
+  Revision 1.19  1998/11/20 15:35:55  florian
+    * problems with rtti fixed, hope it works
+
+  Revision 1.18  1998/11/17 00:36:40  peter
+    * more ansistring fixes
+
+  Revision 1.17  1998/11/16 15:35:09  pierre
+   * added error for with if different segment
+
+  Revision 1.16  1998/10/21 11:44:42  florian
+    + check for access to index 0 of long/wide/ansi strings added,
+      gives now an error
+    * problem with access to contant index of ansistrings fixed
+
+  Revision 1.15  1998/10/12 09:49:53  florian
+    + support of <procedure var type>:=<pointer> in delphi mode added
+
+  Revision 1.14  1998/10/02 07:20:37  florian
+    * range checking in units doesn't work if the units are smartlinked, fixed
+
+  Revision 1.13  1998/09/27 10:16:23  florian
+    * type casts pchar<->ansistring fixed
+    * ansistring[..] calls does now an unique call
+
+  Revision 1.12  1998/09/23 15:46:36  florian
+    * problem with with and classes fixed
+
+  Revision 1.11  1998/09/17 09:42:18  peter
+    + pass_2 for cg386
+    * Message() -> CGMessage() for pass_1/pass_2
+
+  Revision 1.10  1998/09/14 10:43:52  peter
+    * all internal RTL functions start with FPC_
+
+  Revision 1.9  1998/09/03 16:03:15  florian
+    + rtti generation
+    * init table generation changed
+
+  Revision 1.8  1998/08/23 21:04:34  florian
+    + rtti generation for classes added
+    + new/dispose do now also a call to INITIALIZE/FINALIZE, if necessaray
+
+  Revision 1.7  1998/08/20 11:27:40  michael
+  * Applied Peters Fix
+
+  Revision 1.6  1998/08/10 14:49:49  peter
+    + localswitches, moduleswitches, globalswitches splitting
+
+  Revision 1.5  1998/07/26 21:58:58  florian
+   + better support for switch $H
+   + index access to ansi strings added
+   + assigment of data (records/arrays) containing ansi strings
+
+  Revision 1.4  1998/07/24 22:16:55  florian
+    * internal error 10 together with array access fixed. I hope
+      that's the final fix.
+
+  Revision 1.3  1998/06/25 08:48:09  florian
+    * first version of rtti support
+
+  Revision 1.2  1998/06/08 13:13:35  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:13  peter
+    * splitted cgi386
+
+}
+

compiler/msgtxt.inc

@@ -589,7 +589,7 @@ const msgtxt : array[0..000095,1..240] of char=(
   '3*2Anasmcoff_coff file using Nasm'#000+
   '3*2Anasmelf_elf32 (Linux) file using Nasm'#000+
   '3*2Anasmobj_ob','j file using Nasm'#000+
-  '3*2Amasm_obj file using Masm (Mircosoft)'#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+

compiler/ptconst.pas

@@ -714,6 +714,14 @@ unit ptconst;
                    consume(RKLAMMER);
                 end;
            end;
+         errordef:
+           begin
+              { try to consume something useful }
+              if token=LKLAMMER then
+                consume_all_until(RKLAMMER)
+              else
+                consume_all_until(SEMICOLON);
+           end;
          else Message(parser_e_type_const_not_possible);
          end;
       end;
@@ -721,7 +729,18 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.44  1999-05-21 13:55:11  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.44  1999/05/21 13:55:11  peter
     * NEWLAB for label as symbol
 
   Revision 1.43  1999/05/12 00:19:54  peter

compiler/symdef.inc

@@ -3499,9 +3499,26 @@ Const local_symtable_index : longint = $8001;
       end;
 {$endif GDB}
 
+    function terrordef.gettypename:string;
+
+      begin
+         gettypename:='<erroneous type>';
+      end;
+
 {
   $Log$
-  Revision 1.121  1999-05-21 13:55:19  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.121  1999/05/21 13:55:19  peter
     * NEWLAB for label as symbol
 
   Revision 1.120  1999/05/20 22:22:43  pierre

compiler/symdefh.inc

@@ -142,6 +142,7 @@
 {$ifdef GDB}
           function stabstring : pchar;virtual;
 {$endif GDB}
+          function gettypename:string;virtual;
        end;
 
        { tpointerdef and tclassrefdef should get a common
@@ -516,7 +517,18 @@
 
 {
   $Log$
-  Revision 1.28  1999-05-19 16:48:28  florian
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.28  1999/05/19 16:48:28  florian
     * tdef.typename: returns a now a proper type name for the most types
 
   Revision 1.27  1999/05/13 21:59:42  peter

compiler/symtable.pas

@@ -284,7 +284,7 @@ unit symtable;
        s32bitdef : porddef;        { Pointer to 32-Bit signed          }
 
        cu64bitdef : porddef;       { pointer to 64 bit unsigned def }
-       cs64bitdef : porddef;       { pointer to 64 bit signed def, }
+       cs64bitintdef : porddef;    { pointer to 64 bit signed def, }
                                    { calculated by the int unit on i386 }
 
        s32floatdef : pfloatdef;    { pointer for realconstn            }
@@ -2345,7 +2345,18 @@ const localsymtablestack : psymtable = nil;
 end.
 {
   $Log$
-  Revision 1.15  1999-05-17 23:51:41  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.15  1999/05/17 23:51:41  peter
     * with temp vars now use a reference with a persistant temp instead
       of setting datasize
 

compiler/tcadd.pas

@@ -481,12 +481,12 @@ implementation
                 begin
                    if (porddef(ld)^.typ<>s64bitint) then
                      begin
-                       p^.left:=gentypeconvnode(p^.left,cs64bitdef);
+                       p^.left:=gentypeconvnode(p^.left,cs64bitintdef);
                        firstpass(p^.left);
                      end;
                    if (porddef(rd)^.typ<>s64bitint) then
                      begin
-                        p^.right:=gentypeconvnode(p^.right,cs64bitdef);
+                        p^.right:=gentypeconvnode(p^.right,cs64bitintdef);
                         firstpass(p^.right);
                      end;
                    calcregisters(p,2,0,0);
@@ -1097,7 +1097,18 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  1999-05-19 20:40:14  florian
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.31  1999/05/19 20:40:14  florian
     * fixed a couple of array related bugs:
       - var a : array[0..1] of char;   p : pchar;  p:=a+123; works now
       - open arrays with an odd size doesn't work: movsb wasn't generated

compiler/tccal.pas

@@ -69,7 +69,8 @@ implementation
         case p^.left^.resulttype^.deftype of
           arraydef :
             begin
-              if is_open_array(p^.left^.resulttype) then
+              if is_open_array(p^.left^.resulttype) or
+                is_array_of_const(p^.left^.resulttype) then
                begin
                  st:=p^.left^.symtable;
                  getsymonlyin(st,'high'+pvarsym(p^.left^.symtableentry)^.name);
@@ -1166,7 +1167,18 @@ implementation
 end.
 {
   $Log$
-  Revision 1.46  1999-05-20 14:58:27  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.46  1999/05/20 14:58:27  peter
     * fixed arrayconstruct->set conversion which didn't work for enum sets
 
   Revision 1.45  1999/05/19 10:31:54  florian

compiler/tcinl.pas

@@ -1011,7 +1011,8 @@ implementation
                                end
                               else
                                begin
-                                 if is_open_array(p^.left^.resulttype) then
+                                 if is_open_array(p^.left^.resulttype) or
+                                   is_array_of_const(p^.left^.resulttype) then
                                   begin
                                     getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
                                     hp:=genloadnode(pvarsym(srsym),p^.left^.symtable);
@@ -1104,7 +1105,18 @@ implementation
 end.
 {
   $Log$
-  Revision 1.33  1999-05-06 09:05:35  peter
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.33  1999/05/06 09:05:35  peter
     * generic write_float and str_float
     * fixed constant float conversions
 

compiler/tcld.pas

@@ -439,7 +439,7 @@ implementation
         parraydef(p^.resulttype)^.definition:=pd;
         parraydef(p^.resulttype)^.IsConstructor:=true;
         parraydef(p^.resulttype)^.IsVariant:=varia;
-        p^.location.loc:=LOC_REFERENCE;
+        p^.location.loc:=LOC_MEM;
       end;
 
 
@@ -457,7 +457,18 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  1999-05-19 15:26:41  florian
+  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
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.31  1999/05/19 15:26:41  florian
     * if a non local variables isn't initialized the compiler doesn't write
       any longer "local var. seems not to be ..."
 

compiler/types.pas

@@ -446,7 +446,8 @@ implementation
 
     function push_high_param(def : pdef) : boolean;
       begin
-         push_high_param:=is_open_array(def) or is_open_string(def);
+         push_high_param:=is_open_array(def) or is_open_string(def) or
+           is_array_of_const(def);
       end;
 
 
@@ -884,7 +885,18 @@ implementation
 end.
 {
   $Log$
-  Revision 1.64  1999-05-19 20:55:08  florian
+  Revision 1.65  1999-05-23 18:42:23  florian
+    * better error recovering in typed constants
+    * some problems with arrays of const fixed, some problems
+      due my previous
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.64  1999/05/19 20:55:08  florian
     * fix of my previous commit
 
   Revision 1.63  1999/05/19 20:40:15  florian

compiler/utils/nasmconv.pp

@@ -13,7 +13,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-program msg2inc;
 program nasmconv;
 
 var
@@ -295,10 +294,21 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  1999-05-12 16:17:10  peter
+  Revision 1.2  1999-05-23 18:42:24  florian
+    * better error recovering in typed constants
+    * some problems with arrays of const fixed, some problems
+      due my previous
+       - the location type of array constructor is now LOC_MEM
+       - the pushing of high fixed
+       - parameter copying fixed
+       - zero temp. allocation removed
+    * small problem in the assembler writers fixed:
+      ref to nil wasn't written correctly
+
+  Revision 1.1  1999/05/12 16:17:10  peter
     * init
 
   Revision 1.1  1999/05/12 16:08:27  peter
     + moved compiler utils
 
-}
+}