+ boolean -> ord conversion

  * fixed ord -> boolean conversion

compiler/cg386cnv.pas

@@ -0,0 +1,903 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 assembler for type converting 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.
+
+ ****************************************************************************
+}
+{$ifdef TP}
+  {$E+,F+,N+,D+,L+,Y+}
+{$endif}
+unit cg386cnv;
+interface
+
+   uses tree;
+
+    procedure secondtypeconv(var p : ptree);
+
+implementation
+
+   uses
+     cobjects,verbose,globals,
+     symtable,aasm,i386,
+     cgi386,cgai386,tgeni386,hcodegen;
+
+
+    { produces if necessary rangecheckcode }
+
+     procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);
+
+       var
+          hp : preference;
+          hregister : tregister;
+          neglabel,poslabel : plabel;
+          is_register : boolean;
+
+      begin
+         { convert from p2 to p1 }
+         { range check from enums is not made yet !!}
+         { and its probably not easy }
+         if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
+           exit;
+         { range checking is different for u32bit }
+         { lets try to generate it allways }
+         if (cs_rangechecking in aktswitches)  and
+           { with $R+ explicit type conversations in TP aren't range checked! }
+           (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
+           ((porddef(p1)^.von>porddef(p2)^.von) or
+           (porddef(p1)^.bis<porddef(p2)^.bis) or
+           (porddef(p1)^.typ=u32bit) or
+           (porddef(p2)^.typ=u32bit)) then
+           begin
+              porddef(p1)^.genrangecheck;
+              is_register:=(p^.left^.location.loc=LOC_REGISTER) or
+                (p^.left^.location.loc=LOC_CREGISTER);
+              if porddef(p2)^.typ=u8bit then
+                begin
+                   if is_register then
+                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.left^.location.register,R_EDI)))
+                   else
+                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.left^.location.reference),R_EDI)));
+                   hregister:=R_EDI;
+                end
+              else if porddef(p2)^.typ=s8bit then
+                begin
+                   if is_register then
+                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.left^.location.register,R_EDI)))
+                   else
+                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.left^.location.reference),R_EDI)));
+                   hregister:=R_EDI;
+                end
+              { rangechecking for u32bit ?? !!!!!!}
+              { lets try }
+              else if (porddef(p2)^.typ=s32bit) or (porddef(p2)^.typ=u32bit)  then
+                begin
+                   if is_register then
+                     hregister:=p^.location.register
+                   else
+                     begin
+                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),R_EDI)));
+                        hregister:=R_EDI;
+                     end;
+                end
+              else if porddef(p2)^.typ=u16bit then
+                begin
+                   if is_register then
+                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.left^.location.register,R_EDI)))
+                   else
+                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.left^.location.reference),R_EDI)));
+                   hregister:=R_EDI;
+                end
+              else if porddef(p2)^.typ=s16bit then
+                begin
+                   if is_register then
+                     exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.left^.location.register,R_EDI)))
+                   else
+                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.left^.location.reference),R_EDI)));
+                   hregister:=R_EDI;
+                end
+              else internalerror(6);
+              hp:=new_reference(R_NO,0);
+              hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
+              if porddef(p1)^.von>porddef(p1)^.bis then
+                begin
+                   getlabel(neglabel);
+                   getlabel(poslabel);
+                   exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
+                   emitl(A_JL,neglabel);
+                end;
+              exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
+              if porddef(p1)^.von>porddef(p1)^.bis then
+                begin
+                   hp:=new_reference(R_NO,0);
+                   hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr+1));
+                   emitl(A_JMP,poslabel);
+                   emitl(A_LABEL,neglabel);
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hp)));
+                   emitl(A_LABEL,poslabel);
+                end;
+
+           end;
+      end;
+
+     type
+        tsecondconvproc = procedure(p,hp : ptree;convtyp : tconverttype);
+
+    procedure second_only_rangecheck(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         maybe_rangechecking(p,hp^.resulttype,p^.resulttype);
+      end;
+
+
+    procedure second_smaller(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         hregister,destregister : tregister;
+         ref : boolean;
+         hpp : preference;
+
+      begin
+         ref:=false;
+         { problems with enums !! }
+         if (cs_rangechecking in aktswitches)  and
+           { with $R+ explicit type conversations in TP aren't range checked! }
+           (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
+           (p^.resulttype^.deftype=orddef) and
+           (hp^.resulttype^.deftype=orddef) then
+           begin
+              if porddef(hp^.resulttype)^.typ=u32bit then
+                begin
+                   { when doing range checking for u32bit, we have some trouble }
+                   { because BOUND assumes signed values                        }
+                   { first, we check if the values is greater than 2^31:        }
+                   { the u32bit rangenr contains the appropriate rangenr        }
+                   porddef(hp^.resulttype)^.genrangecheck;
+                   hregister:=R_EDI;
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     hregister:=p^.location.register
+                   else
+                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                       newreference(p^.location.reference),R_EDI)));
+                   hpp:=new_reference(R_NO,0);
+                   hpp^.symbol:=stringdup('R_'+tostr(porddef(hp^.resulttype)^.rangenr));
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
+
+                   { then we do a normal range check }
+                   porddef(p^.resulttype)^.genrangecheck;
+                   hpp:=new_reference(R_NO,0);
+                   hpp^.symbol:=stringdup('R_'+tostr(porddef(p^.resulttype)^.rangenr));
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
+                end
+              else
+                if ((porddef(p^.resulttype)^.von>porddef(hp^.resulttype)^.von) or
+                (porddef(p^.resulttype)^.bis<porddef(hp^.resulttype)^.bis)) then
+                begin
+                   porddef(p^.resulttype)^.genrangecheck;
+                   { per default the var is copied to EDI }
+                   hregister:=R_EDI;
+                   if porddef(hp^.resulttype)^.typ=s32bit then
+                     begin
+                        if (p^.location.loc=LOC_REGISTER) or
+                           (p^.location.loc=LOC_CREGISTER) then
+                          hregister:=p^.location.register
+                        else
+                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),R_EDI)));
+                     end
+                   else if porddef(hp^.resulttype)^.typ=u16bit then
+                     begin
+                        if (p^.location.loc=LOC_REGISTER) or
+                           (p^.location.loc=LOC_CREGISTER) then
+                          exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.location.register,R_EDI)))
+                        else
+                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.location.reference),R_EDI)));
+                     end
+                   else if porddef(hp^.resulttype)^.typ=s16bit then
+                     begin
+                        if (p^.location.loc=LOC_REGISTER) or
+                           (p^.location.loc=LOC_CREGISTER) then
+                          exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.location.register,R_EDI)))
+                        else
+                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.location.reference),R_EDI)));
+                     end
+                   else internalerror(6);
+                   hpp:=new_reference(R_NO,0);
+                   hpp^.symbol:=stringdup('R_'+tostr(porddef(p^.resulttype)^.rangenr));
+                   exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
+                   (*
+                   if (p^.location.loc=LOC_REGISTER) or
+                      (p^.location.loc=LOC_CREGISTER) then
+                     begin
+                        destregister:=p^.left^.location.register;
+                        case convtyp of
+                           tc_s32bit_2_s8bit,
+                           tc_s32bit_2_u8bit:
+                             destregister:=reg32toreg8(destregister);
+                           tc_s32bit_2_s16bit,
+                           tc_s32bit_2_u16bit:
+                             destregister:=reg32toreg16(destregister);
+                           { this was false because destregister is allways a 32bitreg }
+                           tc_s16bit_2_s8bit,
+                           tc_s16bit_2_u8bit,
+                           tc_u16bit_2_s8bit,
+                           tc_u16bit_2_u8bit:
+                             destregister:=reg32toreg8(destregister);
+                        end;
+                   p^.location.register:=destregister;
+                   exit;
+                   *)
+                end;
+           end;
+         { p^.location.loc is already set! }
+         if (p^.location.loc=LOC_REGISTER) or
+           (p^.location.loc=LOC_CREGISTER) then
+           begin
+              destregister:=p^.left^.location.register;
+              case convtyp of
+                 tc_s32bit_2_s8bit,
+                 tc_s32bit_2_u8bit:
+                   destregister:=reg32toreg8(destregister);
+                 tc_s32bit_2_s16bit,
+                 tc_s32bit_2_u16bit:
+                   destregister:=reg32toreg16(destregister);
+                 tc_s16bit_2_s8bit,
+                 tc_s16bit_2_u8bit,
+                 tc_u16bit_2_s8bit,
+                 tc_u16bit_2_u8bit:
+                   destregister:=reg16toreg8(destregister);
+              end;
+              p^.location.register:=destregister;
+           end;
+      end;
+
+    procedure second_bigger(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         hregister : tregister;
+         opsize : topsize;
+         op : tasmop;
+         is_register : boolean;
+
+      begin
+           is_register:=p^.left^.location.loc=LOC_REGISTER;
+           if not(is_register) and (p^.left^.location.loc<>LOC_CREGISTER) then
+             begin
+                del_reference(p^.left^.location.reference);
+                { we can do this here as we need no temp inside second_bigger }
+                ungetiftemp(p^.left^.location.reference);
+             end;
+         { this is wrong !!!
+         gives me movl (%eax),%eax
+         for the length(string !!!
+         use only for constant values }
+           {Constanst cannot be loaded into registers using MOVZX!}
+           if (p^.left^.location.loc<>LOC_MEM) or (not p^.left^.location.reference.isintvalue) then
+                case convtyp of
+                    tc_u8bit_2_s32bit,tc_u8bit_2_u32bit :
+                      begin
+                          if is_register then
+                            hregister:=reg8toreg32(p^.left^.location.register)
+                          else hregister:=getregister32;
+                          op:=A_MOVZX;
+                          opsize:=S_BL;
+                      end;
+                    { here what do we do for negative values ? }
+                    tc_s8bit_2_s32bit,tc_s8bit_2_u32bit :
+                      begin
+                          if is_register then
+                            hregister:=reg8toreg32(p^.left^.location.register)
+                          else hregister:=getregister32;
+                          op:=A_MOVSX;
+                          opsize:=S_BL;
+                      end;
+                    tc_u16bit_2_s32bit,tc_u16bit_2_u32bit :
+                      begin
+                          if is_register then
+                            hregister:=reg16toreg32(p^.left^.location.register)
+                          else hregister:=getregister32;
+                          op:=A_MOVZX;
+                          opsize:=S_WL;
+                      end;
+                    tc_s16bit_2_s32bit,tc_s16bit_2_u32bit :
+                      begin
+                          if is_register then
+                            hregister:=reg16toreg32(p^.left^.location.register)
+                          else hregister:=getregister32;
+                          op:=A_MOVSX;
+                          opsize:=S_WL;
+                      end;
+                    tc_s8bit_2_u16bit,
+                    tc_u8bit_2_s16bit,
+                    tc_u8bit_2_u16bit :
+                      begin
+                          if is_register then
+                            hregister:=reg8toreg16(p^.left^.location.register)
+                          else hregister:=reg32toreg16(getregister32);
+                          op:=A_MOVZX;
+                          opsize:=S_BW;
+                      end;
+                    tc_s8bit_2_s16bit :
+                      begin
+                          if is_register then
+                            hregister:=reg8toreg16(p^.left^.location.register)
+                          else hregister:=reg32toreg16(getregister32);
+                          op:=A_MOVSX;
+                          opsize:=S_BW;
+                      end;
+                end
+           else
+                case convtyp of
+                    tc_u8bit_2_s32bit,
+                    tc_s8bit_2_s32bit,
+                    tc_u16bit_2_s32bit,
+                    tc_s16bit_2_s32bit,
+                    tc_u8bit_2_u32bit,
+                    tc_s8bit_2_u32bit,
+                    tc_u16bit_2_u32bit,
+                    tc_s16bit_2_u32bit:
+                      begin
+                         hregister:=getregister32;
+                         op:=A_MOV;
+                         opsize:=S_L;
+                      end;
+                    tc_s8bit_2_u16bit,
+                    tc_s8bit_2_s16bit,
+                    tc_u8bit_2_s16bit,
+                    tc_u8bit_2_u16bit:
+                      begin
+                         hregister:=reg32toreg16(getregister32);
+                         op:=A_MOV;
+                         opsize:=S_W;
+                     end;
+                end;
+           if is_register then
+             begin
+                 emit_reg_reg(op,opsize,p^.left^.location.register,hregister);
+             end
+           else
+             begin
+                 if p^.left^.location.loc=LOC_CREGISTER then
+                    emit_reg_reg(op,opsize,p^.left^.location.register,hregister)
+                 else exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,
+                    newreference(p^.left^.location.reference),hregister)));
+             end;
+           p^.location.loc:=LOC_REGISTER;
+           p^.location.register:=hregister;
+           maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
+       end;
+
+    procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+{$ifdef UseAnsiString}
+         if is_ansistring(p^.resulttype) and not is_ansistring(p^.left^.resulttype) then
+           begin
+              { call shortstring to ansistring conversion }
+              { result is in register }
+              del_reference(p^.left^.location.reference);
+              {!!!!
+              copyshortstringtoansistring(p^.location,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
+              }
+              ungetiftemp(p^.left^.location.reference);
+           end
+         else if not is_ansistring(p^.resulttype) and is_ansistring(p^.left^.resulttype) then
+           begin
+              { call ansistring to shortstring conversion }
+              { result is in mem }
+              stringdispose(p^.location.reference.symbol);
+              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
+              if p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE] then
+                del_reference(p^.left^.location.reference);
+              copyansistringtoshortstring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
+              ungetiftemp(p^.left^.location.reference);
+           end
+         else
+{$endif UseAnsiString}
+           begin
+              stringdispose(p^.location.reference.symbol);
+              gettempofsizereference(p^.resulttype^.size,p^.location.reference);
+              del_reference(p^.left^.location.reference);
+              copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
+              ungetiftemp(p^.left^.location.reference);
+           end;
+      end;
+
+    procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=getregister32;
+         inc(p^.left^.location.reference.offset);
+           exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
+             p^.location.register)));
+      end;
+
+    procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         inc(p^.location.reference.offset);
+      end;
+
+    procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         del_reference(p^.left^.location.reference);
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=getregister32;
+         exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
+           p^.location.register)));
+      end;
+
+    procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         p^.location.loc:=LOC_REFERENCE;
+         clear_reference(p^.location.reference);
+         if p^.left^.location.loc=LOC_REGISTER then
+           p^.location.reference.base:=p^.left^.location.register
+         else
+           begin
+              if p^.left^.location.loc=LOC_CREGISTER then
+                begin
+                   p^.location.reference.base:=getregister32;
+                   emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
+                     p^.location.reference.base);
+                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;
+           end;
+      end;
+
+    { generates the code for the type conversion from an array of char }
+    { to a string                                                        }
+    procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         l : longint;
+
+      begin
+         { this is a type conversion which copies the data, so we can't }
+         { return a reference                                             }
+         p^.location.loc:=LOC_MEM;
+
+         { first get the memory for the string }
+         stringdispose(p^.location.reference.symbol);
+         gettempofsizereference(256,p^.location.reference);
+
+         { calc the length of the array }
+         l:=parraydef(p^.left^.resulttype)^.highrange-
+           parraydef(p^.left^.resulttype)^.lowrange+1;
+
+         if l>255 then
+           Message(sym_e_type_mismatch);
+
+         { write the length }
+             exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_B,l,
+               newreference(p^.location.reference))));
+
+         { copy to first char of string }
+         inc(p^.location.reference.offset);
+
+         { generates the copy code      }
+         { and we need the source never }
+         concatcopy(p^.left^.location.reference,p^.location.reference,l,true);
+
+         { correct the string location }
+         dec(p^.location.reference.offset);
+      end;
+
+    procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         stringdispose(p^.location.reference.symbol);
+         gettempofsizereference(256,p^.location.reference);
+      { call loadstring with correct left and right }
+         p^.right:=p^.left;
+         p^.left:=p;
+         loadstring(p);
+         p^.left:=nil; { reset left tree, which is empty }
+      end;
+
+    procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         r : preference;
+
+      begin
+         if (p^.left^.location.loc=LOC_REGISTER) or
+            (p^.left^.location.loc=LOC_CREGISTER) then
+           begin
+              case porddef(p^.left^.resulttype)^.typ of
+                 s8bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,p^.left^.location.register,R_EDI)));
+                 u8bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,p^.left^.location.register,R_EDI)));
+                 s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_WL,p^.left^.location.register,R_EDI)));
+                 u16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,p^.left^.location.register,R_EDI)));
+                 u32bit,s32bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,p^.left^.location.register,R_EDI)));
+                 {!!!! u32bit }
+              end;
+              ungetregister(p^.left^.location.register);
+           end
+         else
+           begin
+              r:=newreference(p^.left^.location.reference);
+              case porddef(p^.left^.resulttype)^.typ of
+                 s8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,r,R_EDI)));
+                 u8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,r,R_EDI)));
+                 s16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,r,R_EDI)));
+                 u16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,r,R_EDI)));
+                 u32bit,s32bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
+                 {!!!! u32bit }
+              end;
+              del_reference(p^.left^.location.reference);
+              ungetiftemp(p^.left^.location.reference);
+         end;
+          if porddef(p^.left^.resulttype)^.typ=u32bit then
+            push_int(0);
+          exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDI)));
+          r:=new_reference(R_ESP,0);
+         { for u32bit a solution is to push $0 and to load a
+         comp }
+          if porddef(p^.left^.resulttype)^.typ=u32bit then
+            exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IQ,r)))
+          else
+            exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IL,r)));
+
+         { better than an add on all processors }
+         if porddef(p^.left^.resulttype)^.typ=u32bit then
+           exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)))
+         else
+           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
+
+         p^.location.loc:=LOC_FPU;
+      end;
+
+    procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         {hs : string;}
+         rreg : tregister;
+         ref : treference;
+
+      begin
+         { real must be on fpu stack }
+         if (p^.left^.location.loc<>LOC_FPU) then
+           exprasmlist^.concat(new(pai386,op_ref(A_FLD,S_FL,newreference(p^.left^.location.reference))));
+         push_int($1f3f);
+         push_int(65536);
+         reset_reference(ref);
+         ref.base:=R_ESP;
+
+         exprasmlist^.concat(new(pai386,op_ref(A_FIMUL,S_IL,newreference(ref))));
+
+         ref.offset:=4;
+         exprasmlist^.concat(new(pai386,op_ref(A_FSTCW,S_L,newreference(ref))));
+
+         ref.offset:=6;
+         exprasmlist^.concat(new(pai386,op_ref(A_FLDCW,S_L,newreference(ref))));
+
+         ref.offset:=0;
+         exprasmlist^.concat(new(pai386,op_ref(A_FISTP,S_IL,newreference(ref))));
+
+         ref.offset:=4;
+         exprasmlist^.concat(new(pai386,op_ref(A_FLDCW,S_L,newreference(ref))));
+
+         rreg:=getregister32;
+         exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,rreg)));
+         { better than an add on all processors }
+         exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
+
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=rreg;
+      end;
+
+    procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+         case p^.left^.location.loc of
+            LOC_FPU : ;
+            LOC_MEM,
+            LOC_REFERENCE:
+              begin
+                 floatload(pfloatdef(p^.left^.resulttype)^.typ,
+                   p^.left^.location.reference);
+                 { we have to free the reference }
+                 del_reference(p^.left^.location.reference);
+              end;
+         end;
+         p^.location.loc:=LOC_FPU;
+      end;
+
+    procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
+
+    var popeax,popebx,popecx,popedx : boolean;
+        startreg : tregister;
+        hl : plabel;
+        r : treference;
+
+      begin
+         if (p^.left^.location.loc=LOC_REGISTER) or
+            (p^.left^.location.loc=LOC_CREGISTER) then
+           begin
+              startreg:=p^.left^.location.register;
+              ungetregister(startreg);
+              popeax:=(startreg<>R_EAX) and not (R_EAX in unused);
+              if popeax then
+                exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
+              { mov eax,eax is removed by emit_reg_reg }
+              emit_reg_reg(A_MOV,S_L,startreg,R_EAX);
+           end
+         else
+           begin
+              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
+                p^.left^.location.reference),R_EAX)));
+              del_reference(p^.left^.location.reference);
+              startreg:=R_NO;
+           end;
+
+         popebx:=(startreg<>R_EBX) and not (R_EBX in unused);
+         if popebx then
+           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
+
+         popecx:=(startreg<>R_ECX) and not (R_ECX in unused);
+         if popecx then
+           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ECX)));
+
+         popedx:=(startreg<>R_EDX) and not (R_EDX in unused);
+         if popedx then
+           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
+
+         exprasmlist^.concat(new(pai386,op_none(A_CDQ,S_NO)));
+         emit_reg_reg(A_XOR,S_L,R_EDX,R_EAX);
+         emit_reg_reg(A_MOV,S_L,R_EAX,R_EBX);
+         emit_reg_reg(A_SUB,S_L,R_EDX,R_EAX);
+         getlabel(hl);
+         emitl(A_JZ,hl);
+         exprasmlist^.concat(new(pai386,op_const_reg(A_RCL,S_L,1,R_EBX)));
+         emit_reg_reg(A_BSR,S_L,R_EAX,R_EDX);
+         exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,32,R_CL)));
+         emit_reg_reg(A_SUB,S_B,R_DL,R_CL);
+         emit_reg_reg(A_SHL,S_L,R_CL,R_EAX);
+         exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_W,1007,R_DX)));
+         exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_W,5,R_DX)));
+         exprasmlist^.concat(new(pai386,op_const_reg_reg(A_SHLD,S_W,11,R_DX,R_BX)));
+         exprasmlist^.concat(new(pai386,op_const_reg_reg(A_SHLD,S_W,20,R_EAX,R_EBX)));
+
+         exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,20,R_EAX)));
+         emitl(A_LABEL,hl);
+         { better than an add on all processors }
+         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
+         exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
+
+         reset_reference(r);
+         r.base:=R_ESP;
+         exprasmlist^.concat(new(pai386,op_ref(A_FLD,S_FL,newreference(r))));
+         exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)));
+         if popedx then
+           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
+         if popecx then
+           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ECX)));
+         if popebx then
+           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EBX)));
+         if popeax then
+           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
+
+         p^.location.loc:=LOC_FPU;
+      end;
+
+    procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         {hs : string;}
+         hregister : tregister;
+
+      begin
+         if (p^.left^.location.loc=LOC_REGISTER) then
+           hregister:=p^.left^.location.register
+         else if (p^.left^.location.loc=LOC_CREGISTER) then
+           hregister:=getregister32
+         else
+           begin
+              del_reference(p^.left^.location.reference);
+              hregister:=getregister32;
+              case porddef(p^.left^.resulttype)^.typ of
+                s8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_BL,newreference(p^.left^.location.reference),
+                  hregister)));
+                u8bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(p^.left^.location.reference),
+                  hregister)));
+                s16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVSX,S_WL,newreference(p^.left^.location.reference),
+                  hregister)));
+                u16bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,newreference(p^.left^.location.reference),
+                  hregister)));
+                u32bit,s32bit : exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
+                  hregister)));
+                {!!!! u32bit }
+              end;
+           end;
+         exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,16,hregister)));
+
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=hregister;
+      end;
+
+
+     procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);
+
+     begin
+          p^.location.loc:=LOC_REGISTER;
+          del_reference(hp^.location.reference);
+          p^.location.register:=getregister32;
+          exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,
+           newreference(hp^.location.reference),p^.location.register)));
+     end;
+
+     procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
+
+      var
+         oldtruelabel,oldfalselabel,hlabel : plabel;
+         hregister : tregister;
+     begin
+         oldtruelabel:=truelabel;
+         oldfalselabel:=falselabel;
+         secondpass(hp);
+         getlabel(truelabel);
+         getlabel(falselabel);
+         p^.location.loc:=LOC_REGISTER;
+         del_reference(hp^.location.reference);
+         hregister:=reg32toreg8(getregister32);
+         case hp^.location.loc of
+            LOC_MEM,LOC_REFERENCE :
+              exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
+                newreference(hp^.location.reference),hregister)));
+            LOC_REGISTER,LOC_CREGISTER :
+              exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_B,
+                hp^.location.register,hregister)));
+           LOC_FLAGS:
+              exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
+           LOC_JUMP:
+             begin
+                getlabel(hlabel);
+                emitl(A_LABEL,truelabel);
+                exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_B,1,hregister)));
+                emitl(A_JMP,hlabel);
+                emitl(A_LABEL,falselabel);
+                exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_B,hregister,hregister)));
+                emitl(A_LABEL,hlabel);
+             end;
+         else
+           internalerror(10060);
+         end;
+         case porddef(p^.resulttype)^.typ of
+            u8bit,
+            s8bit : p^.location.register:=hregister;
+           s16bit : begin
+                      p^.location.register:=reg8toreg16(hregister);
+                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BW,hregister,p^.location.register)));
+                    end;
+           u16bit : begin
+                      p^.location.register:=reg8toreg16(hregister);
+                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
+                    end;
+           s32bit : begin
+                      p^.location.register:=reg8toreg32(hregister);
+                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVSX,S_BL,hregister,p^.location.register)));
+                    end;
+           u32bit : begin
+                      p^.location.register:=reg8toreg32(hregister);
+                      exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
+                    end;
+         else
+           internalerror(10060);
+         end;
+         truelabel:=oldtruelabel;
+         falselabel:=oldfalselabel;
+     end;
+
+     procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
+     var
+        hregister : tregister;
+     begin
+         p^.location.loc:=LOC_REGISTER;
+         del_reference(hp^.location.reference);
+         case hp^.location.loc of
+            LOC_MEM,LOC_REFERENCE :
+              begin
+                hregister:=getregister32;
+                exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                  newreference(hp^.location.reference),hregister)));
+              end;
+            LOC_REGISTER,LOC_CREGISTER :
+              begin
+                hregister:=hp^.location.register;
+              end;
+          else
+            internalerror(10061);
+          end;
+         exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hregister,hregister)));
+       { return only lower 8 bits }
+         p^.location.register:=reg32toreg8(hregister);
+         exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,p^.location.register)));
+     end;
+
+    procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
+
+      begin
+      end;
+
+
+{****************************************************************************
+                             SecondTypeConv
+****************************************************************************}
+
+    procedure secondtypeconv(var p : ptree);
+
+      const
+         secondconvert : array[tc_u8bit_2_s32bit..tc_cchar_charpointer] of
+           tsecondconvproc = (second_bigger,second_only_rangecheck,
+           second_bigger,second_bigger,second_bigger,
+           second_smaller,second_smaller,
+           second_smaller,second_string_string,
+           second_cstring_charpointer,second_string_chararray,
+           second_array_to_pointer,second_pointer_to_array,
+           second_char_to_string,second_bigger,
+           second_bigger,second_bigger,
+           second_smaller,second_smaller,
+           second_smaller,second_smaller,
+           second_bigger,second_smaller,
+           second_only_rangecheck,second_bigger,
+           second_bigger,second_bigger,
+           second_bigger,second_only_rangecheck,
+           second_smaller,second_smaller,
+           second_smaller,second_smaller,
+           second_bool_to_int,second_int_to_bool,
+           second_int_real,second_real_fix,
+           second_fix_real,second_int_fix,second_float_float,
+           second_chararray_to_string,
+           second_proc_to_procvar,
+           { is constant char to pchar, is done by firstpass }
+           second_nothing);
+
+      begin
+         { this isn't good coding, I think tc_bool_2_int, shouldn't be }
+         { type conversion (FK)                                        }
+
+         { this is necessary, because second_bool_byte, have to change   }
+         { true- and false label before calling secondpass               }
+         if p^.convtyp<>tc_bool_2_int then
+           begin
+              secondpass(p^.left);
+              set_location(p^.location,p^.left^.location);
+           end;
+         if (p^.convtyp<>tc_equal) and (p^.convtyp<>tc_not_possible) then
+           {the second argument only is for maybe_range_checking !}
+           secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-06-01 16:50:18  peter
+    + boolean -> ord conversion
+    * fixed ord -> boolean conversion
+
+}

compiler/cg386mat.pas

@@ -0,0 +1,392 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 assembler for math 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 cg386mat;
+interface
+
+   uses tree;
+
+    procedure secondmoddiv(var p : ptree);
+    procedure secondshlshr(var p : ptree);
+    procedure secondumminus(var p : ptree);
+
+implementation
+
+   uses
+     cobjects,verbose,globals,
+     symtable,aasm,i386,
+     cgi386,cgai386,tgeni386,hcodegen;
+
+    procedure secondmoddiv(var p : ptree);
+
+      var
+         hreg1 : tregister;
+         pushed,popeax,popedx : boolean;
+         power : longint;
+         hl : plabel;
+
+      begin
+         secondpass(p^.left);
+         set_location(p^.location,p^.left^.location);
+         pushed:=maybe_push(p^.right^.registers32,p);
+         secondpass(p^.right);
+         if pushed then restore(p);
+
+         { put numerator in register }
+         if p^.left^.location.loc<>LOC_REGISTER then
+           begin
+              if p^.left^.location.loc=LOC_CREGISTER then
+                begin
+                  hreg1:=getregister32;
+                  emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hreg1);
+                end
+              else
+                begin
+                  del_reference(p^.left^.location.reference);
+                  hreg1:=getregister32;
+                  exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
+                    hreg1)));
+                end;
+              p^.left^.location.loc:=LOC_REGISTER;
+              p^.left^.location.register:=hreg1;
+           end
+         else hreg1:=p^.left^.location.register;
+
+           if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
+               ispowerof2(p^.right^.value,power) then
+             begin
+                 exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hreg1,hreg1)));
+                 getlabel(hl);
+                 emitl(A_JNS,hl);
+                 if power=1 then
+                    exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,hreg1)))
+                 else exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,p^.right^.value-1,hreg1)));
+
+                 emitl(A_LABEL,hl);
+                 exprasmlist^.concat(new(pai386,op_const_reg(A_SAR,S_L,power,hreg1)));
+             end
+           else
+             begin
+                 { bring denominator to EDI }
+                 { EDI is always free, it's }
+                 { only used for temporary  }
+                 { purposes                 }
+                 if (p^.right^.location.loc<>LOC_REGISTER) and
+                     (p^.right^.location.loc<>LOC_CREGISTER) then
+                    begin
+                       del_reference(p^.right^.location.reference);
+                       p^.left^.location.loc:=LOC_REGISTER;
+                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),R_EDI)));
+                end
+              else
+                begin
+                   ungetregister32(p^.right^.location.register);
+                   emit_reg_reg(A_MOV,S_L,p^.right^.location.register,R_EDI);
+                end;
+              popedx:=false;
+              popeax:=false;
+              if hreg1=R_EDX then
+                begin
+                       if not(R_EAX in unused) then
+                     begin
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
+                        popeax:=true;
+                     end;
+                   emit_reg_reg(A_MOV,S_L,R_EDX,R_EAX);
+                end
+                 else
+                begin
+                   if not(R_EDX in unused) then
+                     begin
+                              exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
+                        popedx:=true;
+                     end;
+                   if hreg1<>R_EAX then
+                     begin
+                        if not(R_EAX in unused) then
+                          begin
+                             exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
+                             popeax:=true;
+                          end;
+                        emit_reg_reg(A_MOV,S_L,hreg1,R_EAX);
+                     end;
+                end;
+              exprasmlist^.concat(new(pai386,op_none(A_CLTD,S_NO)));
+                 exprasmlist^.concat(new(pai386,op_reg(A_IDIV,S_L,R_EDI)));
+                 if p^.treetype=divn then
+                begin
+                   { if result register is busy then copy }
+                   if popeax then
+                     begin
+                        if hreg1=R_EAX then
+                          internalerror(112);
+                        emit_reg_reg(A_MOV,S_L,R_EAX,hreg1)
+                     end
+                   else
+                          if hreg1<>R_EAX then
+                       emit_reg_reg(A_MOV,S_L,R_EAX,hreg1);
+                end
+              else
+                emit_reg_reg(A_MOV,S_L,R_EDX,hreg1);
+              if popeax then
+                exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
+              if popedx then
+                    exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
+             end;
+           { this registers are always used when div/mod are present }
+         usedinproc:=usedinproc or ($80 shr byte(R_EAX));
+         usedinproc:=usedinproc or ($80 shr byte(R_EDX));
+         p^.location.loc:=LOC_REGISTER;
+         p^.location.register:=hreg1;
+      end;
+
+    procedure secondshlshr(var p : ptree);
+
+      var
+         hregister1,hregister2,hregister3 : tregister;
+         pushed,popecx : boolean;
+         op : tasmop;
+
+      begin
+         popecx:=false;
+
+         secondpass(p^.left);
+         pushed:=maybe_push(p^.right^.registers32,p);
+         secondpass(p^.right);
+         if pushed then restore(p);
+
+         { load left operators in a register }
+         if p^.left^.location.loc<>LOC_REGISTER then
+           begin
+              if p^.left^.location.loc=LOC_CREGISTER then
+                begin
+                   hregister1:=getregister32;
+                   emit_reg_reg(A_MOV,S_L,p^.left^.location.register,
+                     hregister1);
+                end
+              else
+                begin
+                   del_reference(p^.left^.location.reference);
+                   hregister1:=getregister32;
+                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
+                     hregister1)));
+                end;
+           end
+           else hregister1:=p^.left^.location.register;
+
+         { determine operator }
+         if p^.treetype=shln then
+           op:=A_SHL
+         else
+           op:=A_SHR;
+
+         { shifting by a constant directly decode: }
+         if (p^.right^.treetype=ordconstn) then
+           begin
+                 exprasmlist^.concat(new(pai386,op_const_reg(op,S_L,p^.right^.location.reference.offset and 31,
+                hregister1)));
+              p^.location.loc:=LOC_REGISTER;
+              p^.location.register:=hregister1;
+           end
+         else
+           begin
+              { load right operators in a register }
+              if p^.right^.location.loc<>LOC_REGISTER then
+                begin
+                       if p^.right^.location.loc=LOC_CREGISTER then
+                     begin
+                              hregister2:=getregister32;
+                        emit_reg_reg(A_MOV,S_L,p^.right^.location.register,
+                          hregister2);
+                     end
+                   else
+                     begin
+                        del_reference(p^.right^.location.reference);
+                        hregister2:=getregister32;
+                        exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),
+                          hregister2)));
+                     end;
+                end
+              else hregister2:=p^.right^.location.register;
+
+                 { left operator is already in a register }
+              { hence are both in a register }
+              { is it in the case ECX ? }
+              if (hregister1=R_ECX) then
+                begin
+                   { then only swap }
+                   emit_reg_reg(A_XCHG,S_L,hregister1,
+                     hregister2);
+
+                   hregister3:=hregister1;
+                   hregister1:=hregister2;
+                   hregister2:=hregister3;
+                end
+              { if second operator not in ECX ? }
+              else if (hregister2<>R_ECX) then
+                begin
+                   { ECX not occupied then swap with right register }
+                   if R_ECX in unused then
+                     begin
+                        emit_reg_reg(A_MOV,S_L,hregister2,R_ECX);
+                        ungetregister32(hregister2);
+                          end
+                       else
+                     begin
+                        { else save ECX and then copy it }
+                        popecx:=true;
+                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ECX)));
+                        emit_reg_reg(A_MOV,S_L,hregister2,R_ECX);
+                        ungetregister32(hregister2);
+                     end;
+                end;
+              { right operand is in ECX }
+              emit_reg_reg(op,S_L,R_CL,hregister1);
+              { maybe ECX back }
+              if popecx then
+                exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_ECX)));
+              p^.location.register:=hregister1;
+             end;
+         { this register is always used when shl/shr are present }
+         usedinproc:=usedinproc or ($80 shr byte(R_ECX));
+      end;
+
+    procedure secondumminus(var p : ptree);
+
+{$ifdef SUPPORT_MMX}
+      procedure do_mmx_neg;
+
+        var
+           op : tasmop;
+
+        begin
+           p^.location.loc:=LOC_MMXREGISTER;
+           if cs_mmx_saturation in aktswitches then
+             case mmx_type(p^.resulttype) of
+                mmxs8bit:
+                  op:=A_PSUBSB;
+                mmxu8bit:
+                  op:=A_PSUBUSB;
+                mmxs16bit,mmxfixed16:
+                  op:=A_PSUBSW;
+                mmxu16bit:
+                  op:=A_PSUBUSW;
+             end
+           else
+             case mmx_type(p^.resulttype) of
+                mmxs8bit,mmxu8bit:
+                  op:=A_PSUBB;
+                mmxs16bit,mmxu16bit,mmxfixed16:
+                  op:=A_PSUBW;
+                mmxs32bit,mmxu32bit:
+                  op:=A_PSUBD;
+             end;
+           emit_reg_reg(op,S_NO,p^.location.register,R_MM7);
+           emit_reg_reg(A_MOVQ,S_NO,R_MM7,p^.location.register);
+        end;
+{$endif}
+
+      begin
+         secondpass(p^.left);
+         p^.location.loc:=LOC_REGISTER;
+         case p^.left^.location.loc of
+            LOC_REGISTER:
+              begin
+                 p^.location.register:=p^.left^.location.register;
+                 exprasmlist^.concat(new(pai386,op_reg(A_NEG,S_L,p^.location.register)));
+              end;
+            LOC_CREGISTER:
+              begin
+                 p^.location.register:=getregister32;
+                 emit_reg_reg(A_MOV,S_L,p^.location.register,
+                   p^.location.register);
+                 exprasmlist^.concat(new(pai386,op_reg(A_NEG,S_L,p^.location.register)));
+              end;
+{$ifdef SUPPORT_MMX}
+            LOC_MMXREGISTER:
+              begin
+                 p^.location:=p^.left^.location;
+                 emit_reg_reg(A_PXOR,S_NO,R_MM7,R_MM7);
+                 do_mmx_neg;
+              end;
+            LOC_CMMXREGISTER:
+              begin
+                 p^.location.register:=getregistermmx;
+                 emit_reg_reg(A_PXOR,S_NO,R_MM7,R_MM7);
+                 emit_reg_reg(A_MOVQ,S_NO,p^.left^.location.register,
+                   p^.location.register);
+                 do_mmx_neg;
+              end;
+{$endif SUPPORT_MMX}
+            LOC_REFERENCE,LOC_MEM:
+                           begin
+                              del_reference(p^.left^.location.reference);
+                              if (p^.left^.resulttype^.deftype=floatdef) and
+                                 (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
+                                begin
+                                   p^.location.loc:=LOC_FPU;
+                                   floatload(pfloatdef(p^.left^.resulttype)^.typ,
+                                     p^.left^.location.reference);
+                                   exprasmlist^.concat(new(pai386,op_none(A_FCHS,S_NO)));
+                                end
+{$ifdef SUPPORT_MMX}
+                              else if (cs_mmx in aktswitches) and is_mmx_able_array(p^.left^.resulttype) then
+                                begin
+                                   p^.location.register:=getregistermmx;
+                                   emit_reg_reg(A_PXOR,S_NO,R_MM7,R_MM7);
+                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVQ,S_NO,
+                                     newreference(p^.left^.location.reference),
+                                     p^.location.register)));
+                                   do_mmx_neg;
+                                end
+{$endif SUPPORT_MMX}
+                              else
+                                begin
+                                   p^.location.register:=getregister32;
+                                   exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                     newreference(p^.left^.location.reference),
+                                     p^.location.register)));
+                                   exprasmlist^.concat(new(pai386,op_reg(A_NEG,S_L,p^.location.register)));
+                                end;
+                           end;
+            LOC_FPU:
+              begin
+                 p^.location.loc:=LOC_FPU;
+                 exprasmlist^.concat(new(pai386,op_none(A_FCHS,S_NO)));
+              end;
+         end;
+{ Here was a problem...            }
+{ Operand to be negated always     }
+{ seems to be converted to signed  }
+{ 32-bit before doing neg!!        }
+{ So this is useless...            }
+{         emitoverflowcheck(p);}
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-06-01 16:50:18  peter
+    + boolean -> ord conversion
+    * fixed ord -> boolean conversion
+
+}

compiler/pass_1.pas

@@ -182,12 +182,12 @@ unit pass_1;
          basedefconverts : array[u8bit..u32bit,u8bit..u32bit] of tconverttype =
            {u8bit}
            ((tc_only_rangechecks32bit,tc_u8bit_2_s32bit,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_only_rangechecks32bit,tc_u8bit_2_s16bit,
+             tc_int_2_bool,tc_not_possible,tc_only_rangechecks32bit,tc_u8bit_2_s16bit,
              tc_u8bit_2_u16bit,{tc_not_possible}tc_u8bit_2_u32bit),
 
            {s32bit}
             (tc_s32bit_2_u8bit,tc_only_rangechecks32bit,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_s32bit_2_s8bit,
+             tc_int_2_bool,tc_not_possible,tc_s32bit_2_s8bit,
              tc_s32bit_2_s16bit,tc_s32bit_2_u16bit,{tc_not_possible}tc_s32bit_2_u32bit),
 
            {uvoid}
@@ -196,9 +196,12 @@ unit pass_1;
              tc_not_possible),
 
            {bool8bit}
-            (tc_not_possible,tc_not_possible,tc_not_possible,
+{            (tc_not_possible,tc_not_possible,tc_not_possible,
              tc_only_rangechecks32bit,tc_not_possible,tc_not_possible,tc_not_possible,
-             tc_not_possible,tc_not_possible),
+             tc_not_possible,tc_not_possible),}
+            (tc_bool_2_int,tc_bool_2_int,tc_not_possible,
+             tc_only_rangechecks32bit,tc_not_possible,tc_bool_2_int,
+             tc_bool_2_int,tc_bool_2_int,tc_bool_2_int),
 
            {uchar}
             (tc_not_possible,tc_not_possible,tc_not_possible,
@@ -207,22 +210,22 @@ unit pass_1;
 
            {s8bit}
             (tc_only_rangechecks32bit,tc_s8bit_2_s32bit,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_only_rangechecks32bit,tc_s8bit_2_s16bit,
+             tc_int_2_bool,tc_not_possible,tc_only_rangechecks32bit,tc_s8bit_2_s16bit,
              tc_s8bit_2_u16bit,{tc_not_possible}tc_s8bit_2_u32bit),
 
            {s16bit}
             (tc_s16bit_2_u8bit,tc_s16bit_2_s32bit,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_s16bit_2_s8bit,tc_only_rangechecks32bit,
+             tc_int_2_bool,tc_not_possible,tc_s16bit_2_s8bit,tc_only_rangechecks32bit,
              tc_only_rangechecks32bit,{tc_not_possible}tc_s8bit_2_u32bit),
 
            {u16bit}
             (tc_u16bit_2_u8bit,tc_u16bit_2_s32bit,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_u16bit_2_s8bit,tc_only_rangechecks32bit,
+             tc_int_2_bool,tc_not_possible,tc_u16bit_2_s8bit,tc_only_rangechecks32bit,
              tc_only_rangechecks32bit,{tc_not_possible}tc_u16bit_2_u32bit),
 
            {u32bit}
             (tc_u32bit_2_u8bit,{tc_not_possible}tc_u32bit_2_s32bit,tc_not_possible,
-             tc_not_possible,tc_not_possible,tc_u32bit_2_s8bit,tc_u32bit_2_s16bit,
+             tc_int_2_bool,tc_not_possible,tc_u32bit_2_s8bit,tc_u32bit_2_s16bit,
              tc_u32bit_2_u16bit,tc_only_rangechecks32bit)
             );
 
@@ -919,11 +922,11 @@ unit pass_1;
                      a working hack    (FK)                             }
                    p^.left:=gentypeconvnode(p^.left,u8bitdef);
                    p^.right:=gentypeconvnode(p^.right,u8bitdef);
-                   p^.left^.convtyp:=tc_bool_2_u8bit;
+                   p^.left^.convtyp:=tc_bool_2_int;
                    p^.left^.explizit:=true;
                    firstpass(p^.left);
                    p^.left^.resulttype:=booldef;
-                   p^.right^.convtyp:=tc_bool_2_u8bit;
+                   p^.right^.convtyp:=tc_bool_2_int;
                    p^.right^.explizit:=true;
                    firstpass(p^.right);
                    p^.right^.resulttype:=booldef;
@@ -2181,18 +2184,22 @@ unit pass_1;
          p^.location.loc:=LOC_MEM;
       end;
 
-    procedure first_bool_byte(var p : ptree);
+    procedure first_bool_int(var p : ptree);
+       begin
+          p^.location.loc:=LOC_REGISTER;
+          if p^.registers32<1 then
+            p^.registers32:=1;
+       end;
+
+    procedure first_int_bool(var p : ptree);
 
        begin
           p^.location.loc:=LOC_REGISTER;
-          { Florian I think this is overestimated
-            but I still do not really understand how to get this right (PM) }
-          { Hmmm, I think we need only one reg to return the result of      }
-          { this node => so }
+          p^.left:=gentypeconvnode(p^.left,s32bitdef);
+          firstpass(p^.left);
           if p^.registers32<1 then
             p^.registers32:=1;
-          {  should work (FK)
-          p^.registers32:=p^.left^.registers32+1;}
+          p^.resulttype:=booldef;
        end;
 
     procedure first_proc_to_procvar(var p : ptree);
@@ -2277,9 +2284,10 @@ unit pass_1;
                            first_bigger_smaller,first_bigger_smaller,
                            first_bigger_smaller,first_bigger_smaller,
                            first_bigger_smaller,first_bigger_smaller,
+                           first_bool_int,first_int_bool,
                            first_int_real,first_real_fix,
                            first_fix_real,first_int_fix,first_real_real,
-                           first_locmem,first_bool_byte,first_proc_to_procvar,
+                           first_locmem,first_proc_to_procvar,
                            first_cchar_charpointer);
 
     begin
@@ -2421,7 +2429,7 @@ unit pass_1;
                         (p^.left^.resulttype^.deftype=orddef) and
                         (porddef(p^.left^.resulttype)^.typ=bool8bit) then
                        begin
-                          p^.convtyp:=tc_bool_2_u8bit;
+                          p^.convtyp:=tc_bool_2_int;
                           firstconvert[p^.convtyp](p);
                           exit;
                        end;
@@ -3446,15 +3454,14 @@ unit pass_1;
                   else
                     begin
                        if (p^.left^.resulttype^.deftype=orddef) then
-                         if (porddef(p^.left^.resulttype)^.typ=uchar) or
-                            (porddef(p^.left^.resulttype)^.typ=bool8bit) then
+                         if (porddef(p^.left^.resulttype)^.typ in [uchar,bool8bit]) then
                            begin
                               if porddef(p^.left^.resulttype)^.typ=bool8bit then
                                 begin
                                    hp:=gentypeconvnode(p^.left,u8bitdef);
                                    putnode(p);
                                    p:=hp;
-                                   p^.convtyp:=tc_bool_2_u8bit;
+                                   p^.convtyp:=tc_bool_2_int;
                                    p^.explizit:=true;
                                    firstpass(p);
                                 end
@@ -4912,7 +4919,11 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.22  1998-05-28 17:26:49  peter
+  Revision 1.23  1998-06-01 16:50:20  peter
+    + boolean -> ord conversion
+    * fixed ord -> boolean conversion
+
+  Revision 1.22  1998/05/28 17:26:49  peter
     * fixed -R switch, it didn't work after my previous akt/init patch
     * fixed bugs 110,130,136
 

compiler/systems.pas

@@ -576,11 +576,11 @@ implementation
 {$ifdef i386}
           (
             id : I386_DIRECT;
-            idtxt : 'DIRECT';
+            idtxt : 'DIRECT'
           ),
           (
             id    : I386_INTEL;
-            idtxt : 'INTEL';
+            idtxt : 'INTEL'
           ),
           (
             id    : I386_ATT;
@@ -590,7 +590,7 @@ implementation
 {$ifdef m68k}
           (
             id    : M68K_MOT;
-            idtxt : 'MOT';
+            idtxt : 'MOT'
           )
 {$endif}
           );
@@ -650,7 +650,7 @@ begin
     begin
       t:=asmmodeinfos[tasmmode(i)].id;
       set_string_asmmode:=true;
-    end;   
+    end;
 end;
 
 
@@ -700,7 +700,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.15  1998-05-30 14:31:11  peter
+  Revision 1.16  1998-06-01 16:50:22  peter
+    + boolean -> ord conversion
+    * fixed ord -> boolean conversion
+
+  Revision 1.15  1998/05/30 14:31:11  peter
     + $ASMMODE
 
   Revision 1.14  1998/05/29 13:24:45  peter

compiler/tree.pas

@@ -141,11 +141,11 @@ unit tree;
                       tc_u8bit_2_u32bit,tc_u32bit_2_s32bit,
                       tc_u32bit_2_s8bit,tc_u32bit_2_u8bit,
                       tc_u32bit_2_s16bit,tc_u32bit_2_u16bit,
+                      tc_bool_2_int,tc_int_2_bool,
                       tc_int_2_real,tc_real_2_fix,
                       tc_fix_2_real,tc_int_2_fix,tc_real_2_real,
-                      tc_chararray_2_string,tc_bool_2_u8bit,
-                      tc_proc2procvar,
-                      tc_cchar_charpointer);
+                      tc_chararray_2_string,
+                      tc_proc2procvar,tc_cchar_charpointer);
 
        { allows to determine which elementes are to be replaced }
        tdisposetyp = (dt_nothing,dt_leftright,dt_left,
@@ -293,7 +293,7 @@ unit tree;
 
   implementation
 
-    uses    
+    uses
        scanner,verbose,files,types,pbase;
 
 {****************************************************************************
@@ -961,7 +961,6 @@ unit tree;
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
          p^.resulttype:=t;
-         p^.convtyp:=tc_equal;
          p^.explizit:=false;
          set_file_line(node,p);
          gentypeconvnode:=p;
@@ -1535,7 +1534,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.10  1998-05-20 09:42:38  pierre
+  Revision 1.11  1998-06-01 16:50:23  peter
+    + boolean -> ord conversion
+    * fixed ord -> boolean conversion
+
+  Revision 1.10  1998/05/20 09:42:38  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)