* secondinline moved to cg386inl

compiler/cg386cal.pas

@@ -2,7 +2,7 @@
     $Id$
     Copyright (c) 1993-98 by Florian Klaempfl
 
-    Generate i386 assembler for in call/inline nodes
+    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
@@ -29,7 +29,6 @@ interface
     procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
                 push_from_left_to_right,inlined : boolean;para_offset : longint);
     procedure secondcalln(var p : ptree);
-    procedure secondinline(var p : ptree);
     procedure secondprocinline(var p : ptree);
 
 
@@ -1311,893 +1310,6 @@ implementation
            end;
       end;
 
-    { 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 secondinline(var p : ptree);
-     const
-{$ifdef OLDINC}
-               decisize:array[in_inc_byte..in_dec_dword] of Topsize=
-                         (S_B,S_W,S_L,S_B,S_W,S_L);
-               in2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
-                         (A_INC,A_INC,A_INC,A_DEC,A_DEC,A_DEC);
-               ad2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
-                         (A_ADD,A_ADD,A_ADD,A_SUB,A_SUB,A_SUB);
-{$endif OLDINC}
-            { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
-            float_name: array[tfloattype] of string[8]=
-                ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
-            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;
-         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[0..1] of string[7]=('_OUTPUT','_INPUT');
-          var
-            r : preference;
-          begin
-            new(r);
-            reset_reference(r^);
-            r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
-            concat_external(r^.symbol^,EXT_NEAR);
-            exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
-          end;
-
-        var
-           node,hp    : ptree;
-           typedtyp,
-           pararesult : pdef;
-           has_length : boolean;
-           dummycoll  : tdefcoll;
-           iolabel    : plabel;
-           npara      : longint;
-
-        begin
-           { I/O check }
-           if cs_check_io in aktlocalswitches then
-             begin
-                getlabel(iolabel);
-                emitl(A_LABEL,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
-                          Message(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)
-                else
-                  { I think, this isn't a good solution (FK) }
-                  dummycoll.data:=nil;
-
-                while assigned(node) do
-                  begin
-                     pushusedregisters(pushed,$ff);
-                     hp:=node;
-                     node:=node^.right;
-                     hp^.right:=nil;
-                     if hp^.is_colon_para then
-                       Message(parser_e_illegal_colon_qualifier);
-                     if ft=ft_typed then
-                       never_copy_const_param:=true;
-                     secondcallparan(hp,@dummycoll,false,false,0);
-                     if ft=ft_typed then
-                       never_copy_const_param:=false;
-                     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('TYPED_READ',true)
-                            else
-                              emitcall('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,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,0);
-                                   hp^.right:=node;
-                                   if pararesult^.deftype<>floatdef then
-                                     Message(parser_e_illegal_colon_qualifier);
-                                   if codegenerror then
-                                     exit;
-                                end
-                              else
-                                begin
-                                  if pararesult^.deftype=floatdef then
-                                    push_int(-1);
-                                end
-                            end;
-                          case pararesult^.deftype of
-                       stringdef : begin
-                                     if doread then
-                                       begin
-                                       { push maximum string length }
-                                       push_int(pstringdef(pararesult)^.len);
-                                       case pstringdef(pararesult)^.string_typ of
-                                        st_shortstring:
-                                          emitcall ('READ_TEXT_STRING',true);
-                                        st_ansistring:
-                                          emitcall ('READ_TEXT_ANSISTRING',true);
-                                        st_longstring:
-                                          emitcall ('READ_TEXT_LONGSTRING',true);
-                                        st_widestring:
-                                          emitcall ('READ_TEXT_ANSISTRING',true);
-                                        end
-                                       end
-                                     else
-                                       Case pstringdef(Pararesult)^.string_typ of
-                                        st_shortstring:
-                                          emitcall ('WRITE_TEXT_STRING',true);
-                                        st_ansistring:
-                                          emitcall ('WRITE_TEXT_ANSISTRING',true);
-                                        st_longstring:
-                                          emitcall ('WRITE_TEXT_LONGSTRING',true);
-                                        st_widestring:
-                                          emitcall ('WRITE_TEXT_ANSISTRING',true);
-                                        end;
-                                   end;
-                      pointerdef : begin
-                                     if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
-                                       begin
-                                         if doread then
-                                           emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
-                                         else
-                                           emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
-                                       end
-                                     else
-                                      Message(parser_e_illegal_parameter_list);
-                                   end;
-                        arraydef : begin
-                                     if (parraydef(pararesult)^.lowrange=0) and
-                                        is_equal(parraydef(pararesult)^.definition,cchardef) then
-                                       begin
-                                         if doread then
-                                           emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
-                                         else
-                                           emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
-                                       end
-                                     else
-                                      Message(parser_e_illegal_parameter_list);
-                                   end;
-                        floatdef : begin
-                                     if doread then
-                                       emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
-                                     else
-                                       emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
-                                   end;
-                          orddef : begin
-                                     case porddef(pararesult)^.typ of
-                                          u8bit : if doread then
-                                                    emitcall('READ_TEXT_BYTE',true);
-                                          s8bit : if doread then
-                                                    emitcall('READ_TEXT_SHORTINT',true);
-                                         u16bit : if doread then
-                                                    emitcall('READ_TEXT_WORD',true);
-                                         s16bit : if doread then
-                                                    emitcall('READ_TEXT_INTEGER',true);
-                                         s32bit : if doread then
-                                                    emitcall('READ_TEXT_LONGINT',true)
-                                                  else
-                                                    emitcall('WRITE_TEXT_LONGINT',true);
-                                         u32bit : if doread then
-                                                    emitcall('READ_TEXT_CARDINAL',true)
-                                                  else
-                                                    emitcall('WRITE_TEXT_CARDINAL',true);
-                                          uchar : if doread then
-                                                    emitcall('READ_TEXT_CHAR',true)
-                                                  else
-                                                    emitcall('WRITE_TEXT_CHAR',true);
-                                       bool8bit,
-                                      bool16bit,
-                                      bool32bit : if  doread then
-                                                  { emitcall('READ_TEXT_BOOLEAN',true) }
-                                                    Message(parser_e_illegal_parameter_list)
-                                                  else
-                                                    emitcall('WRITE_TEXT_BOOLEAN',true);
-                                     else
-                                       Message(parser_e_illegal_parameter_list);
-                                     end;
-                                   end;
-                          else
-                            Message(parser_e_illegal_parameter_list);
-                          end;
-                       end;
-                   { load ESI in methods again }
-                     popusedregisters(pushed);
-                     maybe_loadesi;
-                  end;
-             end;
-         { Insert end of writing for textfiles }
-           if ft=ft_text then
-             begin
-               pushusedregisters(pushed,$ff);
-               emit_push_mem(aktfile);
-               if doread then
-                begin
-                  if doln then
-                    emitcall('READLN_END',true)
-                  else
-
-                    emitcall('READ_END',true);
-                end
-
-               else
-                begin
-                  if doln then
-                    emitcall('WRITELN_END',true)
-                  else
-
-                    emitcall('WRITE_END',true);
-                end;
-               popusedregisters(pushed);
-               maybe_loadesi;
-             end;
-         { Insert IOCheck if set }
-           if assigned(iolabel) then
-             begin
-                { registers are saved in the procedure }
-                exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
-                emitcall('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
-                  Message(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;
-
-          begin
-           pushusedregisters(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
-             is_real:=true;
-
-           node:=p^.left;
-           { we have at least two args }
-           { with at max 2 colon_para in between }
-
-           { first arg longint or float }
-           hp:=node;
-           node:=node^.right;
-           hp^.right:=nil;
-           dummycoll.data:=hp^.resulttype;
-           { string arg }
-
-           dummycoll.paratyp:=vs_var;
-           secondcallparan(hp,@dummycoll,false
-             ,false,0
-             );
-           if codegenerror then
-             exit;
-
-           dummycoll.paratyp:=vs_const;
-           { second arg }
-           hp:=node;
-           node:=node^.right;
-           hp^.right:=nil;
-           { 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,0
-                  );
-                if codegenerror then
-                  exit;
-                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,0
-                  );
-                if codegenerror then
-                  exit;
-                hp:=node;
-                node:=node^.right;
-                hp^.right:=nil;
-             end
-           else
-             if is_real then
-               push_int(-32767)
-             else
-               push_int(-1);
-
-           { last arg longint or real }
-           secondcallparan(hp,@dummycoll,false
-             ,false,0
-             );
-           if codegenerror then
-             exit;
-
-           if is_real then
-             emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
-           else if porddef(hp^.resulttype)^.typ=u32bit then
-             emitcall('STR_CARDINAL',true)
-           else
-             emitcall('STR_LONGINT',true);
-           popusedregisters(pushed);
-        end;
-
-      var
-         r : preference;
-         l : longint;
-         ispushed : boolean;
-         hregister : tregister;
-         otlabel,oflabel,filenamestring : plabel;
-
-      begin
-         case p^.inlinenumber of
-            in_assert_x:
-              begin
-                 otlabel:=truelabel;
-                 oflabel:=falselabel;
-                 getlabel(truelabel);
-                 getlabel(falselabel);
-                 getlabel(filenamestring);
-                 secondpass(p^.left);
-                 if codegenerror then
-                   exit;
-                 if cs_do_assertion in aktlocalswitches then
-                   begin
-                      maketojumpbool(p^.left);
-                      emitl(A_LABEL,falselabel);
-                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
-                        p^.fileinfo.line)));
-                      { generate string }
-                      { push string
-                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
-                        p^.fileinfo.line)));
-                      }
-                      emitcall('FPC_DO_ASSERT',true);
-                      emitl(A_LABEL,truelabel);
-
-                   end;
-                 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_high_x :
-              begin
-                 if is_open_array(p^.left^.resulttype) then
-                   begin
-                      secondpass(p^.left);
-                      del_reference(p^.left^.location.reference);
-                      p^.location.register:=getregister32;
-                      new(r);
-                      reset_reference(r^);
-                      r^.base:=highframepointer;
-                      r^.offset:=highoffset+4;
-                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                        r,p^.location.register)));
-                   end
-              end;
-            in_sizeof_x,
-            in_typeof_x :
-              begin
-               { sizeof(openarray) handling }
-                 if (p^.inlinenumber=in_sizeof_x) and
-                    is_open_array(p^.left^.resulttype) then
-                  begin
-                  { sizeof(openarray)=high(openarray)+1 }
-                    secondpass(p^.left);
-                    del_reference(p^.left^.location.reference);
-                    p^.location.register:=getregister32;
-                    new(r);
-                    reset_reference(r^);
-                    r^.base:=highframepointer;
-                    r^.offset:=highoffset+4;
-                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                      r,p^.location.register)));
-                    exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,
-                      p^.location.register)));
-                    if parraydef(p^.left^.resulttype)^.elesize<>1 then
-                      exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,
-                        parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
-                  end
-                 else
-                  begin
-                    { for both cases load vmt }
-                    if p^.left^.treetype=typen then
-                      begin
-                         p^.location.register:=getregister32;
-                         exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
-                           S_L,newcsymbol(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 }
-                         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;
-              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;
-{***CHARBUG}
-{We can now comment them out, as they are handled as typecast.
- Saves an incredible amount of 8 bytes code.
- I'am not lucky about this, because it's _not_ a type cast (FK) }
-{              in_ord_char,
-               in_chr_byte,}
-{***}
-            in_length_string :
-              begin
-                 secondpass(p^.left);
-                 set_location(p^.location,p^.left^.location);
-                 { length in ansi strings is at offset -8 }
-{$ifdef UseAnsiString}
-                 if is_ansistring(p^.left^.resulttype) then
-                   dec(p^.location.reference.offset,8);
-{$endif UseAnsiString}
-              end;
-            in_pred_x,
-            in_succ_x:
-              begin
-                 secondpass(p^.left);
-                 if p^.inlinenumber=in_pred_x then
-                   asmop:=A_DEC
-                 else
-                   asmop:=A_INC;
-                 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
-                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
-                                  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;
-                 exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
-                   p^.location.register)))
-                 { here we should insert bounds check ? }
-                 { and direct call to bounds will crash the program }
-                 { if we are at the limit }
-                 { we could also simply say that pred(first)=first and succ(last)=last }
-                 { could this be usefull I don't think so (PM)
-                 emitoverflowcheck;}
-              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;
-                             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
-                                    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
-                    exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize,
-                      newreference(p^.left^.left^.location.reference))))
-                   else
-                    exprasmlist^.concat(new(pai386,op_const_ref(addsubop[p^.inlinenumber],opsize,
-                      addvalue,newreference(p^.left^.left^.location.reference))));
-                 end
-                else
-                 begin
-                   exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
-                      hregister,newreference(p^.left^.left^.location.reference))));
-                   ungetregister32(hregister);
-                 end;
-                emitoverflowcheck(p^.left^.left);
-              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(pushed,$ff);
-                  exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size)));
-                  secondload(p^.left);
-                  emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
-                  if p^.inlinenumber=in_reset_typedfile then
-                    emitcall('RESET_TYPED',true)
-                  else
-                    emitcall('REWRITE_TYPED',true);
-                  popusedregisters(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;
-            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;
-                                exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
-                                  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,R_EDI,
-                              newreference(p^.left^.right^.left^.location.reference))))
-                          else
-                            exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,R_EDI,
-                              p^.left^.right^.left^.location.register)));
-                        end
-                      else
-                        begin
-                        end;
-                   end;
-              end;
-            else internalerror(9);
-         end;
-      end;
-
 
 {*****************************************************************************
                              SecondProcInlineN
@@ -2296,7 +1408,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  1998-08-31 08:52:03  peter
+  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

compiler/cg386inl.pas

@@ -0,0 +1,1004 @@
+{
+    $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
+      cobjects,verbose,globals,systems,
+      aasm,i386,types,symtable,
+      cgi386,cgai386,temp_gen,tgeni386,hcodegen,
+      cg386ld,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 secondinline(var p : ptree);
+       const
+         { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
+         float_name: array[tfloattype] of string[8]=
+           ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
+         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;
+         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[0..1] of string[7]=('_OUTPUT','_INPUT');
+          var
+            r : preference;
+          begin
+            new(r);
+            reset_reference(r^);
+            r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
+            concat_external(r^.symbol^,EXT_NEAR);
+            exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
+          end;
+
+        var
+           node,hp    : ptree;
+           typedtyp,
+           pararesult : pdef;
+           has_length : boolean;
+           dummycoll  : tdefcoll;
+           iolabel    : plabel;
+           npara      : longint;
+
+        begin
+           { I/O check }
+           if cs_check_io in aktlocalswitches then
+             begin
+                getlabel(iolabel);
+                emitl(A_LABEL,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
+                          Message(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)
+                else
+                  { I think, this isn't a good solution (FK) }
+                  dummycoll.data:=nil;
+
+                while assigned(node) do
+                  begin
+                     pushusedregisters(pushed,$ff);
+                     hp:=node;
+                     node:=node^.right;
+                     hp^.right:=nil;
+                     if hp^.is_colon_para then
+                       Message(parser_e_illegal_colon_qualifier);
+                     if ft=ft_typed then
+                       never_copy_const_param:=true;
+                     secondcallparan(hp,@dummycoll,false,false,0);
+                     if ft=ft_typed then
+                       never_copy_const_param:=false;
+                     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('TYPED_READ',true)
+                            else
+                              emitcall('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,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,0);
+                                   hp^.right:=node;
+                                   if pararesult^.deftype<>floatdef then
+                                     Message(parser_e_illegal_colon_qualifier);
+                                   if codegenerror then
+                                     exit;
+                                end
+                              else
+                                begin
+                                  if pararesult^.deftype=floatdef then
+                                    push_int(-1);
+                                end
+                            end;
+                          case pararesult^.deftype of
+                       stringdef : begin
+                                     if doread then
+                                       begin
+                                       { push maximum string length }
+                                       push_int(pstringdef(pararesult)^.len);
+                                       case pstringdef(pararesult)^.string_typ of
+                                        st_shortstring:
+                                          emitcall ('READ_TEXT_STRING',true);
+                                        st_ansistring:
+                                          emitcall ('READ_TEXT_ANSISTRING',true);
+                                        st_longstring:
+                                          emitcall ('READ_TEXT_LONGSTRING',true);
+                                        st_widestring:
+                                          emitcall ('READ_TEXT_ANSISTRING',true);
+                                        end
+                                       end
+                                     else
+                                       Case pstringdef(Pararesult)^.string_typ of
+                                        st_shortstring:
+                                          emitcall ('WRITE_TEXT_STRING',true);
+                                        st_ansistring:
+                                          emitcall ('WRITE_TEXT_ANSISTRING',true);
+                                        st_longstring:
+                                          emitcall ('WRITE_TEXT_LONGSTRING',true);
+                                        st_widestring:
+                                          emitcall ('WRITE_TEXT_ANSISTRING',true);
+                                        end;
+                                   end;
+                      pointerdef : begin
+                                     if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
+                                       begin
+                                         if doread then
+                                           emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
+                                         else
+                                           emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
+                                       end
+                                     else
+                                      Message(parser_e_illegal_parameter_list);
+                                   end;
+                        arraydef : begin
+                                     if (parraydef(pararesult)^.lowrange=0) and
+                                        is_equal(parraydef(pararesult)^.definition,cchardef) then
+                                       begin
+                                         if doread then
+                                           emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
+                                         else
+                                           emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
+                                       end
+                                     else
+                                      Message(parser_e_illegal_parameter_list);
+                                   end;
+                        floatdef : begin
+                                     if doread then
+                                       emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
+                                     else
+                                       emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
+                                   end;
+                          orddef : begin
+                                     case porddef(pararesult)^.typ of
+                                          u8bit : if doread then
+                                                    emitcall('READ_TEXT_BYTE',true);
+                                          s8bit : if doread then
+                                                    emitcall('READ_TEXT_SHORTINT',true);
+                                         u16bit : if doread then
+                                                    emitcall('READ_TEXT_WORD',true);
+                                         s16bit : if doread then
+                                                    emitcall('READ_TEXT_INTEGER',true);
+                                         s32bit : if doread then
+                                                    emitcall('READ_TEXT_LONGINT',true)
+                                                  else
+                                                    emitcall('WRITE_TEXT_LONGINT',true);
+                                         u32bit : if doread then
+                                                    emitcall('READ_TEXT_CARDINAL',true)
+                                                  else
+                                                    emitcall('WRITE_TEXT_CARDINAL',true);
+                                          uchar : if doread then
+                                                    emitcall('READ_TEXT_CHAR',true)
+                                                  else
+                                                    emitcall('WRITE_TEXT_CHAR',true);
+                                       bool8bit,
+                                      bool16bit,
+                                      bool32bit : if  doread then
+                                                  { emitcall('READ_TEXT_BOOLEAN',true) }
+                                                    Message(parser_e_illegal_parameter_list)
+                                                  else
+                                                    emitcall('WRITE_TEXT_BOOLEAN',true);
+                                     else
+                                       Message(parser_e_illegal_parameter_list);
+                                     end;
+                                   end;
+                          else
+                            Message(parser_e_illegal_parameter_list);
+                          end;
+                       end;
+                   { load ESI in methods again }
+                     popusedregisters(pushed);
+                     maybe_loadesi;
+                  end;
+             end;
+         { Insert end of writing for textfiles }
+           if ft=ft_text then
+             begin
+               pushusedregisters(pushed,$ff);
+               emit_push_mem(aktfile);
+               if doread then
+                begin
+                  if doln then
+                    emitcall('READLN_END',true)
+                  else
+
+                    emitcall('READ_END',true);
+                end
+
+               else
+                begin
+                  if doln then
+                    emitcall('WRITELN_END',true)
+                  else
+
+                    emitcall('WRITE_END',true);
+                end;
+               popusedregisters(pushed);
+               maybe_loadesi;
+             end;
+         { Insert IOCheck if set }
+           if assigned(iolabel) then
+             begin
+                { registers are saved in the procedure }
+                exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
+                emitcall('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
+                  Message(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;
+
+          begin
+           pushusedregisters(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
+             is_real:=true;
+
+           node:=p^.left;
+           { we have at least two args }
+           { with at max 2 colon_para in between }
+
+           { first arg longint or float }
+           hp:=node;
+           node:=node^.right;
+           hp^.right:=nil;
+           dummycoll.data:=hp^.resulttype;
+           { string arg }
+
+           dummycoll.paratyp:=vs_var;
+           secondcallparan(hp,@dummycoll,false
+             ,false,0
+             );
+           if codegenerror then
+             exit;
+
+           dummycoll.paratyp:=vs_const;
+           { second arg }
+           hp:=node;
+           node:=node^.right;
+           hp^.right:=nil;
+           { 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,0
+                  );
+                if codegenerror then
+                  exit;
+                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,0
+                  );
+                if codegenerror then
+                  exit;
+                hp:=node;
+                node:=node^.right;
+                hp^.right:=nil;
+             end
+           else
+             if is_real then
+               push_int(-32767)
+             else
+               push_int(-1);
+
+           { last arg longint or real }
+           secondcallparan(hp,@dummycoll,false
+             ,false,0
+             );
+           if codegenerror then
+             exit;
+
+           if is_real then
+             emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
+           else if porddef(hp^.resulttype)^.typ=u32bit then
+             emitcall('STR_CARDINAL',true)
+           else
+             emitcall('STR_LONGINT',true);
+           popusedregisters(pushed);
+        end;
+
+      var
+         r : preference;
+         l : longint;
+         ispushed : boolean;
+         hregister : tregister;
+         otlabel,oflabel,filenamestring : plabel;
+
+      begin
+         case p^.inlinenumber of
+            in_assert_x:
+              begin
+                 otlabel:=truelabel;
+                 oflabel:=falselabel;
+                 getlabel(truelabel);
+                 getlabel(falselabel);
+                 getlabel(filenamestring);
+                 secondpass(p^.left);
+                 if codegenerror then
+                   exit;
+                 if cs_do_assertion in aktlocalswitches then
+                   begin
+                      maketojumpbool(p^.left);
+                      emitl(A_LABEL,falselabel);
+                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
+                        p^.fileinfo.line)));
+                      { generate string }
+                      { push string
+                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,
+                        p^.fileinfo.line)));
+                      }
+                      emitcall('FPC_DO_ASSERT',true);
+                      emitl(A_LABEL,truelabel);
+
+                   end;
+                 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_high_x :
+              begin
+                 if is_open_array(p^.left^.resulttype) then
+                   begin
+                      secondpass(p^.left);
+                      del_reference(p^.left^.location.reference);
+                      p^.location.register:=getregister32;
+                      new(r);
+                      reset_reference(r^);
+                      r^.base:=highframepointer;
+                      r^.offset:=highoffset+4;
+                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                        r,p^.location.register)));
+                   end
+              end;
+            in_sizeof_x,
+            in_typeof_x :
+              begin
+               { sizeof(openarray) handling }
+                 if (p^.inlinenumber=in_sizeof_x) and
+                    is_open_array(p^.left^.resulttype) then
+                  begin
+                  { sizeof(openarray)=high(openarray)+1 }
+                    secondpass(p^.left);
+                    del_reference(p^.left^.location.reference);
+                    p^.location.register:=getregister32;
+                    new(r);
+                    reset_reference(r^);
+                    r^.base:=highframepointer;
+                    r^.offset:=highoffset+4;
+                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                      r,p^.location.register)));
+                    exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,
+                      p^.location.register)));
+                    if parraydef(p^.left^.resulttype)^.elesize<>1 then
+                      exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,
+                        parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
+                  end
+                 else
+                  begin
+                    { for both cases load vmt }
+                    if p^.left^.treetype=typen then
+                      begin
+                         p^.location.register:=getregister32;
+                         exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
+                           S_L,newcsymbol(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 }
+                         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;
+              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;
+{***CHARBUG}
+{We can now comment them out, as they are handled as typecast.
+ Saves an incredible amount of 8 bytes code.
+ I'am not lucky about this, because it's _not_ a type cast (FK) }
+{              in_ord_char,
+               in_chr_byte,}
+{***}
+            in_length_string :
+              begin
+                 secondpass(p^.left);
+                 set_location(p^.location,p^.left^.location);
+                 { length in ansi strings is at offset -8 }
+{$ifdef UseAnsiString}
+                 if is_ansistring(p^.left^.resulttype) then
+                   dec(p^.location.reference.offset,8);
+{$endif UseAnsiString}
+              end;
+            in_pred_x,
+            in_succ_x:
+              begin
+                 secondpass(p^.left);
+                 if p^.inlinenumber=in_pred_x then
+                   asmop:=A_DEC
+                 else
+                   asmop:=A_INC;
+                 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
+                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
+                                  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;
+                 exprasmlist^.concat(new(pai386,op_reg(asmop,opsize,
+                   p^.location.register)))
+                 { here we should insert bounds check ? }
+                 { and direct call to bounds will crash the program }
+                 { if we are at the limit }
+                 { we could also simply say that pred(first)=first and succ(last)=last }
+                 { could this be usefull I don't think so (PM)
+                 emitoverflowcheck;}
+              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;
+                             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
+                                    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
+                    exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize,
+                      newreference(p^.left^.left^.location.reference))))
+                   else
+                    exprasmlist^.concat(new(pai386,op_const_ref(addsubop[p^.inlinenumber],opsize,
+                      addvalue,newreference(p^.left^.left^.location.reference))));
+                 end
+                else
+                 begin
+                   exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
+                      hregister,newreference(p^.left^.left^.location.reference))));
+                   ungetregister32(hregister);
+                 end;
+                emitoverflowcheck(p^.left^.left);
+              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(pushed,$ff);
+                  exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pfiledef(p^.left^.resulttype)^.typed_as^.size)));
+                  secondload(p^.left);
+                  emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
+                  if p^.inlinenumber=in_reset_typedfile then
+                    emitcall('RESET_TYPED',true)
+                  else
+                    emitcall('REWRITE_TYPED',true);
+                  popusedregisters(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;
+            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;
+                                exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                  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,R_EDI,
+                              newreference(p^.left^.right^.left^.location.reference))))
+                          else
+                            exprasmlist^.concat(new(pai386,op_reg_reg(asmop,S_L,R_EDI,
+                              p^.left^.right^.left^.location.register)));
+                        end
+                      else
+                        begin
+                        end;
+                   end;
+              end;
+            else internalerror(9);
+         end;
+      end;
+
+end.
+{
+  $Log$
+  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/cgi386.pas

@@ -66,7 +66,7 @@ implementation
 {$ifdef i386}
      ,i386,tgeni386,cgai386
      ,cg386con,cg386mat,cg386cnv,cg386set,cg386add
-     ,cg386mem,cg386cal,cg386ld,cg386flw
+     ,cg386mem,cg386cal,cg386ld,cg386flw,cg386inl
 {$endif}
      ;
 
@@ -506,7 +506,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  1998-08-28 10:54:20  peter
+  Revision 1.51  1998-08-31 12:22:14  peter
+    * secondinline moved to cg386inl
+
+  Revision 1.50  1998/08/28 10:54:20  peter
     * fixed smallset generation from elements, it has never worked before!
 
   Revision 1.49  1998/08/19 16:07:42  jonas