freepascal.compiler/compiler/cg68k2.pas

{
    $Id$
    Copyright (c) 1993-98 by Florian Klaempfl, Carl Eric Codere

    This unit generates 68000 (or better) assembler from the parse tree

    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 Cg68k2;

Interface

    uses
       objects,verbose,cobjects,systems,globals,tree,
       symtable,types,strings,pass_1,hcodegen,
       aasm,m68k,tgen68k,files,cga68k;

      const

       { process condition codes bit definitions }
       CARRY_FLAG    = $01;
       OVFL_FLAG     = $02;
       ZERO_FLAG     = $04;
       NEG_FLAG      = $08;
       { to set OR with flags     }
       { to clear AND (NOT flag)  }


    procedure secondadd(var p : ptree);
    procedure processcc(p: ptree);
    procedure secondfor(var p : ptree);
    procedure secondas(var p : ptree);
    procedure secondraise(var p : ptree);
    procedure secondin(var p : ptree);
    procedure secondexpr(var p : ptree);
    procedure secondblockn(var p : ptree);
    procedure second_while_repeatn(var p : ptree);
    procedure secondifn(var p : ptree);
    procedure secondbreakn(var p : ptree);
    { copies p a set element on the stack }
    procedure pushsetelement(var p : ptree);

Implementation

    uses cg68k;


    procedure secondadd(var p : ptree);

    { is also being used for xor, and "mul", "sub, or and comparative }
    { operators                                                       }

      label do_normal;
      var
         swapp : ptree;
         hregister : tregister;
         pushed,mboverflow,cmpop : boolean;
         op : tasmop;
         pushedregs : tpushed;
         flags : tresflags;
         otl,ofl : plabel;
         power : longint;
         href : treference;
         opsize : topsize;
         swapl : tlocation;
         tmpref: treference;
         { true, if unsigned types are compared }
         unsigned : boolean;

          { is_in_dest if the result is put directly into }
          { the resulting refernce or varregister }
           { true, if a small set is handled with the longint code }
          is_set : boolean;
          is_in_dest : boolean;
           { true, if for sets subtractions the extra not should generated }
           extra_not : boolean;

      begin
         unsigned:=false;
         is_in_dest := false;
         extra_not:=false;

         opsize:=S_L;

         { calculate the operator which is more difficult }
         firstcomplex(p);
         { handling boolean expressions extra: }
         if ((p^.left^.resulttype^.deftype=orddef) and
            (porddef(p^.left^.resulttype)^.typ=bool8bit)) then
{            ((p^.right^.resulttype^.deftype=orddef) and
            (porddef(p^.right^.resulttype)^.typ=bool8bit)) then }
           begin
              if (p^.treetype=andn) or (p^.treetype=orn) then
                begin
                   p^.location.loc:=LOC_JUMP;
                   cmpop:=false;
                   case p^.treetype of
                     andn : begin
                               otl:=truelabel;
                               getlabel(truelabel);
                               secondpass(p^.left);
                               maketojumpbool(p^.left);
                               emitl(A_LABEL,truelabel);
                               truelabel:=otl;
                            end;
                     orn : begin
                              ofl:=falselabel;
                              getlabel(falselabel);
                              secondpass(p^.left);
                              maketojumpbool(p^.left);
                              emitl(A_LABEL,falselabel);
                              falselabel:=ofl;
                           end;
                     else Message(sym_e_type_mismatch);
                   end; { end case }
                  secondpass(p^.right);
                  maketojumpbool(p^.right);
                end { endif }
              else if p^.treetype in [unequaln,equaln,xorn] then
                begin
                   opsize:=S_B;
                   if p^.left^.treetype=ordconstn then
                     begin
                        swapp:=p^.right;
                        p^.right:=p^.left;
                        p^.left:=swapp;
                        p^.swaped:=not(p^.swaped);
                     end;
                   secondpass(p^.left);
                   p^.location:=p^.left^.location;
                   (* register needed *)
                   pushed:=maybe_push(p^.right^.registers32,p);
                   secondpass(p^.right);
                   if pushed then restore(p);
                   goto do_normal;
                end { endif }
              else Message(sym_e_type_mismatch);
           end { endif }
         { also handle string operations seperately }
         else if (p^.left^.resulttype^.deftype=stringdef) then
           begin
              { string operations are not commutative }
              if p^.swaped then
                begin
                   swapp:=p^.left;
                   p^.left:=p^.right;
                   p^.right:=swapp;
                   { because of jump being produced at comparison below: }
                   p^.swaped:=not(p^.swaped);
                end;
              case p^.treetype of
                 addn : begin
                           cmpop:=false;
                           secondpass(p^.left);
                           if (p^.left^.treetype<>addn) then
                             begin
                                { can only reference be }
                                { string in register would be funny    }
                                { therefore produce a temporary string }

                                { release the registers }
                                del_reference(p^.left^.location.reference);
                                gettempofsizereference(256,href);
                                copystring(href,p^.left^.location.reference,255);
                                ungetiftemp(p^.left^.location.reference);

                                { does not hurt: }
                                p^.left^.location.loc:=LOC_MEM;
                                p^.left^.location.reference:=href;
                             end;

                           secondpass(p^.right);

                           { on the right we do not need the register anymore too }
                           del_reference(p^.right^.location.reference);
                           pushusedregisters(pushedregs,$ffff);
                           emitpushreferenceaddr(p^.left^.location.reference);
                           emitpushreferenceaddr(p^.right^.location.reference);
                           emitcall('STRCONCAT',true);
                           set_location(p^.location,p^.left^.location);
                           ungetiftemp(p^.right^.location.reference);
                           maybe_loada5;
                           popusedregisters(pushedregs);
                        end; { this case }
              ltn,lten,gtn,gten,
                equaln,unequaln :
                        begin
                           secondpass(p^.left);
                           { are too few registers free? }
                           pushed:=maybe_push(p^.right^.registers32,p);
                           secondpass(p^.right);
                           if pushed then restore(p);
                           cmpop:=true;
                           del_reference(p^.right^.location.reference);
                           del_reference(p^.left^.location.reference);
                           { generates better code }
                           { s='' and s<>''        }
                           if (p^.treetype in [equaln,unequaln]) and
                             (
                               ((p^.left^.treetype=stringconstn) and
                                (p^.left^.values^='')) or
                               ((p^.right^.treetype=stringconstn) and
                                (p^.right^.values^=''))
                             ) then
                             begin
                                { only one node can be stringconstn }
                                { else pass 1 would have evaluted   }
                                { this node                         }
                                if p^.left^.treetype=stringconstn then
                                  exprasmlist^.concat(new(pai68k,op_ref(
                                    A_TST,S_B,newreference(p^.right^.location.reference))))
                                else
                                  exprasmlist^.concat(new(pai68k,op_ref(
                                    A_TST,S_B,newreference(p^.left^.location.reference))));
                             end
                           else
                             begin
                               pushusedregisters(pushedregs,$ffff);
                               emitpushreferenceaddr(p^.left^.location.reference);
                               emitpushreferenceaddr(p^.right^.location.reference);
                               emitcall('STRCMP',true);
                               maybe_loada5;
                               popusedregisters(pushedregs);
                          end;
                           ungetiftemp(p^.left^.location.reference);
                           ungetiftemp(p^.right^.location.reference);
                        end; { end this case }
                else Message(sym_e_type_mismatch);
              end; { end case }
           end { end else if }
         else
           begin
              { in case of constant put it to the left }
              if p^.left^.treetype=ordconstn then
                begin
                   swapp:=p^.right;
                   p^.right:=p^.left;
                   p^.left:=swapp;
                   p^.swaped:=not(p^.swaped);
                end;
              secondpass(p^.left);
              set_location(p^.location,p^.left^.location);
              { are to few registers free? }
              pushed:=maybe_push(p^.right^.registers32,p);
              secondpass(p^.right);
              if pushed then restore(p);
              if (p^.left^.resulttype^.deftype=pointerdef) or

                 (p^.right^.resulttype^.deftype=pointerdef) or

                 ((p^.right^.resulttype^.deftype=objectdef) and
                  pobjectdef(p^.right^.resulttype)^.isclass and
                 (p^.left^.resulttype^.deftype=objectdef) and
                  pobjectdef(p^.left^.resulttype)^.isclass
                 ) or

                 (p^.left^.resulttype^.deftype=classrefdef) or

                 (p^.left^.resulttype^.deftype=procvardef) or

                 (p^.left^.resulttype^.deftype=enumdef) or

                 ((p^.left^.resulttype^.deftype=orddef) and
                 (porddef(p^.left^.resulttype)^.typ=s32bit)) or
                 ((p^.right^.resulttype^.deftype=orddef) and
                 (porddef(p^.right^.resulttype)^.typ=s32bit)) or

                ((p^.left^.resulttype^.deftype=orddef) and
                 (porddef(p^.left^.resulttype)^.typ=u32bit)) or
                 ((p^.right^.resulttype^.deftype=orddef) and
                 (porddef(p^.right^.resulttype)^.typ=u32bit)) or

                { as well as small sets }
                ((p^.left^.resulttype^.deftype=setdef) and
                 (psetdef(p^.left^.resulttype)^.settype=smallset)
                ) then
                begin
           do_normal:
                   mboverflow:=false;
                   cmpop:=false;
                   if (p^.left^.resulttype^.deftype=pointerdef) or
                      (p^.right^.resulttype^.deftype=pointerdef) or
                      ((p^.left^.resulttype^.deftype=orddef) and
                      (porddef(p^.left^.resulttype)^.typ=u32bit)) or
                      ((p^.right^.resulttype^.deftype=orddef) and
                      (porddef(p^.right^.resulttype)^.typ=u32bit)) then
                     unsigned:=true;
                   is_set:=p^.resulttype^.deftype=setdef;

                   case p^.treetype of
                      addn : begin
                                if is_set then
                                  begin
                                     op:=A_OR;
                                     mboverflow:=false;
                                     unsigned:=false;
                                  end
                                else
                                  begin
                                     op:=A_ADD;
                                     mboverflow:=true;
                                  end;
                             end; { end this case }
                        symdifn : begin
                                  { the symetric diff is only for sets }
                                  if is_set then
                                    begin
                                       op:=A_EOR;
                                       mboverflow:=false;
                                       unsigned:=false;
                                    end
                                  else
                                    begin
                                       Message(sym_e_type_mismatch);
                                    end;
                               end;

                      muln : begin
                                if is_set then
                                  begin
                                     op:=A_AND;
                                     mboverflow:=false;
                                     unsigned:=false;
                                  end
                                else
                                  begin
                                     if unsigned then
                                       op:=A_MULU
                                     else
                                       op:=A_MULS;
                                     mboverflow:=true;
                                  end;
                             end; { end this case }
                      subn : begin
                                if is_set then
                                  begin
                                     op:=A_AND;
                                     mboverflow:=false;
                                     unsigned:=false;
                                     extra_not:=true;
                                  end
                                else
                                  begin
                                     op:=A_SUB;
                                     mboverflow:=true;
                                  end;
                             end; {end this case }
                      ltn,lten,gtn,gten,
                      equaln,unequaln :
                             begin
                                op:=A_CMP;
                                cmpop:=true;
                             end;
                      xorn : op:=A_EOR;
                      orn : op:=A_OR;
                      andn : op:=A_AND;
                      else Message(sym_e_type_mismatch);
                   end; {end case }
                   { left and right no register?  }
                   { then one must be demanded    }
                   if (p^.left^.location.loc<>LOC_REGISTER) and
                     (p^.right^.location.loc<>LOC_REGISTER) then
                     begin
                        { register variable ? }
                        if (p^.left^.location.loc=LOC_CREGISTER) then
                          begin
                               { it is OK if this is the destination }
                               if is_in_dest then
                                 begin
                                    hregister:=p^.location.register;
                                    emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
                                      hregister);
                                 end
                               else
                             if cmpop then
                               begin
                                  { do not disturb the register }
                                  hregister:=p^.location.register;
                               end
                             else
                               begin
                                  hregister := getregister32;
                                  emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
                                    hregister);
                               end
                          end
                        else
                          begin
                             del_reference(p^.left^.location.reference);
                               if is_in_dest then
                                 begin
                                    hregister:=p^.location.register;
                                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
                                    newreference(p^.left^.location.reference),hregister)));
                                 end
                               else
                                 begin

                                 { first give free, then demand new register }
                                 hregister := getregister32;
                                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
                                   newreference(p^.left^.location.reference),
                                    hregister)));
                                 end;{ endif p^... }
                          end;

                        p^.location.loc:=LOC_REGISTER;
                        p^.location.register:=hregister;

                     end
                   else
                     { if on the right the register then swap }
                     if (p^.right^.location.loc=LOC_REGISTER) then
                       begin
                          swap_location(p^.location,p^.right^.location);

                          { newly swapped also set swapped flag }
                          p^.swaped:=not(p^.swaped);
                       end;
                   { endif p^...<> LOC_REGISTER }
                   { at this point, p^.location.loc should be LOC_REGISTER }
                   { and p^.location.register should be a valid register   }
                   { containing the left result                    }
                   if p^.right^.location.loc<>LOC_REGISTER then
                     begin
                        if (p^.treetype=subn) and p^.swaped then
                          begin
                             if p^.right^.location.loc=LOC_CREGISTER then
                               begin
                                  if extra_not then
                                    exprasmlist^.concat(new(pai68k,op_reg(A_NOT,opsize,p^.location.register)));


                                  emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,R_D6);
                                  emit_reg_reg(op,opsize,p^.location.register,R_D6);
                                  emit_reg_reg(A_MOVE,opsize,R_D6,p^.location.register);
                               end
                             else
                               begin
                                  if extra_not then
                                    exprasmlist^.concat(new(pai68k,op_reg(A_NOT,opsize,p^.location.register)));

                                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
                                    newreference(p^.right^.location.reference),R_D6)));
                                  exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,p^.location.register,R_D6)));
                                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,opsize,R_D6,p^.location.register)));
                                  del_reference(p^.right^.location.reference);
                               end;
                          end
                          { end subn ... }
                        else
                          begin
                             if (p^.right^.treetype=ordconstn) and (op=A_CMP) and
                                (p^.right^.value=0) then
                               begin
                                  exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,p^.location.register)));
                               end
                             else if (p^.right^.treetype=ordconstn) and (op=A_MULS) and
                                (ispowerof2(p^.right^.value,power)) then
                               begin
                                  if (power <= 8) then
                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_ASL,opsize,power,
                                        p^.location.register)))
                                  else
                                   begin

                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,power,
                                        R_D6)));
                                      exprasmlist^.concat(new(pai68k,op_reg_reg(A_ASL,opsize,R_D6,
                                        p^.location.register)))
                                   end;
                               end
                             else
                               begin
                                  if (p^.right^.location.loc=LOC_CREGISTER) then
                                    begin
                                       if extra_not then
                                         begin
                                            emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D6);
                                            exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,R_D6)));
                                            emit_reg_reg(A_AND,S_L,R_D6,
                                              p^.location.register);
                                         end
                                       else
                                         begin
                                            if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
                                            { Emulation for MC68000 }
                                            begin
                                              emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
                                                 R_D0);
                                              emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1);
                                              emitcall('LONGMUL',true);
                                              emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                                            end
                                            else
                                            if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
                                             Message(cg_f_32bit_not_supported_in_68000)
                                            else
                                              emit_reg_reg(op,opsize,p^.right^.location.register,
                                                p^.location.register);
                                         end;
                                    end
                                  else
                                    begin
                                       if extra_not then
                                         begin
                                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
                                              p^.right^.location.reference),R_D6)));
                                            exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,R_D6)));
                                            emit_reg_reg(A_AND,S_L,R_D6,
                                              p^.location.register);
                                         end
                                       else
                                         begin
                                            if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
                                            { Emulation for MC68000 }
                                            begin
                                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE, opsize,
                                                 newreference(p^.right^.location.reference),R_D1)));
                                              emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D0);
                                              emitcall('LONGMUL',true);
                                              emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                                            end
                                            else
                                            if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
                                             Message(cg_f_32bit_not_supported_in_68000)
                                            else
                                              exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,newreference(
                                                p^.right^.location.reference),p^.location.register)));
                                         end;
                                       del_reference(p^.right^.location.reference);
                                    end;
                               end;
                          end;
                     end
                   else
                     begin
                        { when swapped another result register }
                        if (p^.treetype=subn) and p^.swaped then
                          begin
                             if extra_not then
                               exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));

                             exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
                               p^.location.register,p^.right^.location.register)));
                               swap_location(p^.location,p^.right^.location);
                               { newly swapped also set swapped flag }
                               { just to maintain ordering           }
                               p^.swaped:=not(p^.swaped);
                          end
                        else
                          begin
                             if extra_not then
                                   exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.right^.location.register)));

                             if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
                             { Emulation for MC68000 }
                             begin
                               emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
                               R_D0);
                               emit_reg_reg(A_MOVE,opsize,p^.location.register,R_D1);
                               emitcall('LONGMUL',true);
                               emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                             end
                             else
                             if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
                              Message(cg_f_32bit_not_supported_in_68000)
                             else

                               exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
                               p^.right^.location.register,
                               p^.location.register)));
                          end;
                           ungetregister32(p^.right^.location.register);
                     end;

                   if cmpop then
                        ungetregister32(p^.location.register);
                   { only in case of overflow operations }
                   { produce overflow code }
                   if mboverflow then
                     emitoverflowcheck(p);
               end
              else if ((p^.left^.resulttype^.deftype=orddef) and
                 (porddef(p^.left^.resulttype)^.typ=uchar)) then
                begin
                   case p^.treetype of
                      ltn,lten,gtn,gten,
                      equaln,unequaln :
                                cmpop:=true;
                      else Message(sym_e_type_mismatch);
                   end;
                   unsigned:=true;
                   { left and right no register? }
                   { the one must be demanded    }
                   if (p^.location.loc<>LOC_REGISTER) and
                     (p^.right^.location.loc<>LOC_REGISTER) then
                     begin
                        if p^.location.loc=LOC_CREGISTER then
                          begin
                             if cmpop then
                               { do not disturb register }
                               hregister:=p^.location.register
                             else
                               begin
                                  hregister:=getregister32;
                                  emit_reg_reg(A_MOVE,S_B,p^.location.register,
                                    hregister);
                               end;
                          end
                        else
                          begin
                             del_reference(p^.location.reference);

                             { first give free then demand new register }
                             hregister:=getregister32;
                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),
                               hregister)));
                          end;
                        p^.location.loc:=LOC_REGISTER;
                        p^.location.register:=hregister;
                     end;

                   { now p always a register }

                   if (p^.right^.location.loc=LOC_REGISTER) and
                      (p^.location.loc<>LOC_REGISTER) then
                     begin
                       swap_location(p^.location,p^.right^.location);

                        { newly swapped also set swapped flag }
                        p^.swaped:=not(p^.swaped);
                     end;
                   if p^.right^.location.loc<>LOC_REGISTER then
                     begin
                        if p^.right^.location.loc=LOC_CREGISTER then
                          begin
                             emit_reg_reg(A_CMP,S_B,
                                p^.right^.location.register,p^.location.register);
                          end
                        else
                          begin
                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,S_B,newreference(
                                p^.right^.location.reference),p^.location.register)));
                             del_reference(p^.right^.location.reference);
                          end;
                     end
                   else
                     begin
                        emit_reg_reg(A_CMP,S_B,p^.right^.location.register,
                          p^.location.register);
                        ungetregister32(p^.right^.location.register);
                     end;
                   ungetregister32(p^.location.register);
                end


{*********************************************************************}

              else if (p^.left^.resulttype^.deftype=floatdef) and
                  (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
                 begin
                    { real constants to the left }
                    if p^.left^.treetype=realconstn then
                      begin
                         swapp:=p^.right;
                         p^.right:=p^.left;
                         p^.left:=swapp;
                         p^.swaped:=not(p^.swaped);
                      end;
                    cmpop:=false;
                    case p^.treetype of
                       addn : op:=A_FADD;
                       muln : op:=A_FMUL;
                       subn : op:=A_FSUB;
                       slashn : op:=A_FDIV;
                       ltn,lten,gtn,gten,
                       equaln,unequaln : begin
                                            op:=A_FCMP;
                                            cmpop:=true;
                                         end;
                       else Message(sym_e_type_mismatch);
                    end;

                    if (p^.left^.location.loc <> LOC_FPU) and
                       (p^.right^.location.loc <> LOC_FPU) then
                      begin
                         { we suppose left in reference }
                         del_reference(p^.left^.location.reference);
                         { get a copy, since we don't want to modify the same }
                         { node at the same time.                             }
                         tmpref:=p^.left^.location.reference;
                         if assigned(p^.left^.location.reference.symbol) then
                           tmpref.symbol:=stringdup(p^.left^.location.reference.symbol^);

                         floatload(pfloatdef(p^.left^.resulttype)^.typ, tmpref,
                           p^.left^.location);
                         clear_reference(tmpref);
                      end
                    else
                      begin
                        if (p^.right^.location.loc = LOC_FPU)
                        and(p^.left^.location.loc <> LOC_FPU) then
                           begin
                             swap_location(p^.left^.location, p^.right^.location);
                             p^.swaped := not(p^.swaped);
                           end
                      end;

                   { ---------------- LEFT = LOC_FPUREG -------------------- }
                       if ((p^.treetype =subn) or (p^.treetype = slashn)) and (p^.swaped) then
                          {  fpu_reg =  right(FP1) / fpu_reg }
                          {  fpu_reg = right(FP1) -  fpu_reg  }
                          begin
                             if (cs_fp_emulation in aktswitches) then
                              begin
                               { fpu_reg = right / D1 }
                               { fpu_reg = right - D1 }
                                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)));


                                  { load value into D1 }
                                  if p^.right^.location.loc <> LOC_FPU then
                                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                                       newreference(p^.right^.location.reference),R_D1)))
                                  else
                                     emit_reg_reg(A_MOVE,S_L,p^.right^.location.fpureg,R_D1);

                                  { probably a faster way to do this but... }
                                  case op of
                                   A_FADD: emitcall('SINGLE_ADD',true);
                                   A_FMUL: emitcall('SINGLE_MUL',true);
                                   A_FSUB: emitcall('SINGLE_SUB',true);
                                   A_FDIV: emitcall('SINGLE_DIV',true);
                                   A_FCMP: emitcall('SINGLE_CMP',true);
                                  end;
                                  if not cmpop then { only flags are affected with cmpop }
                                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,
                                       p^.left^.location.fpureg)));

                                  { if this was a reference, then delete as it }
                                  { it no longer required.                     }
                                  if p^.right^.location.loc <> LOC_FPU then
                                     del_reference(p^.right^.location.reference);
                              end
                             else
                              begin

                                  if p^.right^.location.loc <> LOC_FPU then
                                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
                                       getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
                                      newreference(p^.right^.location.reference),
                                      R_FP1)))
                                  else
                                    { FPm --> FPn must use extended precision }
                                    emit_reg_reg(A_FMOVE,S_X,p^.right^.location.fpureg,R_FP1);

                                  { arithmetic expression performed in extended mode }
                                  exprasmlist^.concat(new(pai68k,op_reg_reg(op,S_X,
                                      p^.left^.location.fpureg,R_FP1)));

                                  { cmpop does not change any floating point register!! }
                                  if not cmpop then
                                       emit_reg_reg(A_FMOVE,S_X,R_FP1,p^.left^.location.fpureg)
{                                       exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,
                                       getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
                                       R_FP1,p^.left^.location.fpureg)))}
                                  else
                                  { process comparison, to make it compatible with the rest of the code }
                                      processcc(p);

                                  { if this was a reference, then delete as it }
                                  { it no longer required.                     }
                                  if p^.right^.location.loc <> LOC_FPU then
                                     del_reference(p^.right^.location.reference);
                              end;
                          end
                       else { everything is in the right order }
                         begin
                           {  fpu_reg = fpu_reg / right }
                           {  fpu_reg = fpu_reg - right }
                           { + commutative ops }
                           if cs_fp_emulation in aktswitches then
                           begin

                             { load value into D7 }
                             if p^.right^.location.loc <> LOC_FPU then
                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                                 newreference(p^.right^.location.reference),R_D0)))
                             else
                               emit_reg_reg(A_MOVE,S_L,p^.right^.location.fpureg,R_D0);

                             emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D1);
                             { probably a faster way to do this but... }
                             case op of
                               A_FADD: emitcall('SINGLE_ADD',true);
                               A_FMUL: emitcall('SINGLE_MUL',true);
                               A_FSUB: emitcall('SINGLE_SUB',true);
                               A_FDIV: emitcall('SINGLE_DIV',true);
                               A_FCMP: emitcall('SINGLE_CMP',true);
                             end;
                             if not cmpop then { only flags are affected with cmpop }
                               exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,
                                 p^.left^.location.fpureg)));
                             { if this was a reference, then delete as it }
                             { it no longer required.                     }
                             if p^.right^.location.loc <> LOC_FPU then
                               del_reference(p^.right^.location.reference);
                           end
                           else
                           begin
                             if p^.right^.location.loc <> LOC_FPU then
                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
                                 getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
                                 newreference(p^.right^.location.reference),R_FP1)))
                             else
                               emit_reg_reg(A_FMOVE,getfloatsize(pfloatdef(p^.left^.resulttype)^.typ),
                                 p^.right^.location.fpureg,R_FP1);

                               emit_reg_reg(op,S_X,R_FP1,p^.left^.location.fpureg);

                               if cmpop then
                                 processcc(p);

                             { if this was a reference, then delete as it }
                             { it no longer required.                     }
                             if p^.right^.location.loc <> LOC_FPU then
                               del_reference(p^.right^.location.reference);

                           end
                         end; { endif treetype = .. }


                         if cmpop then
                          begin
                             if p^.swaped then
                                 case p^.treetype of
                                     equaln: flags := F_E;
                                     unequaln: flags := F_NE;
                                     ltn : flags := F_G;
                                     lten : flags := F_GE;
                                     gtn : flags := F_L;
                                     gten: flags := F_LE;
                                 end
                             else
                                 case p^.treetype of
                                     equaln: flags := F_E;
                                     unequaln : flags := F_NE;
                                     ltn: flags := F_L;
                                     lten : flags := F_LE;
                                     gtn : flags := F_G;
                                     gten: flags := F_GE;
                                 end;
                             p^.location.loc := LOC_FLAGS;
                             p^.location.resflags := flags;
                             cmpop := false;
                          end
                         else
                         begin
                             p^.location.loc := LOC_FPU;
                             if p^.left^.location.loc = LOC_FPU then
                             { copy fpu register result . }
                             { HERE ON EXIT FPU REGISTER IS IN EXTENDED MODE! }
                                p^.location.fpureg := p^.left^.location.fpureg
                             else
                             begin
                               InternalError(34);
                             end;
                         end;

                end
{*********************************************************************}
              else if (p^.left^.resulttype^.deftype=setdef) then
                begin
                   { not commutative }
                   if p^.swaped then
                     begin
                        swapp:=p^.left;
                        p^.left:=p^.right;
                        p^.right:=swapp;
                        { because of jump being produced by comparison }
                        p^.swaped:=not(p^.swaped);
                     end;
                   case p^.treetype of
                      equaln,unequaln : begin
                                     cmpop:=true;
                                     del_reference(p^.left^.location.reference);
                                     del_reference(p^.right^.location.reference);
                                     pushusedregisters(pushedregs,$ffff);
                                     emitpushreferenceaddr(p^.right^.location.reference);
                                     emitpushreferenceaddr(p^.left^.location.reference);
                                     emitcall('SET_COMP_SETS',true);
                                     maybe_loada5;
                                     popusedregisters(pushedregs);
                                     ungetiftemp(p^.left^.location.reference);
                                     ungetiftemp(p^.right^.location.reference);
                                  end;

                      addn,subn,muln,symdifn : begin
                                     cmpop:=false;
                                     del_reference(p^.left^.location.reference);
                                     del_reference(p^.right^.location.reference);
                                     href.symbol:=nil;
                                     pushusedregisters(pushedregs,$ffff);
                                     gettempofsizereference(32,href);
                                     emitpushreferenceaddr(href);
                                     { wrong place !! was hard to find out
                                     pushusedregisters(pushedregs,$ff);}
                                     emitpushreferenceaddr(p^.right^.location.reference);
                                     emitpushreferenceaddr(p^.left^.location.reference);
                                     case p^.treetype of
                                       subn : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
                                         newcsymbol('SET_SUB_SETS',0))));
                                       addn : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
                                         newcsymbol('SET_ADD_SETS',0))));
                                       muln : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
                                         newcsymbol('SET_MUL_SETS',0))));
                                     end;
                                     maybe_loada5;
                                     popusedregisters(pushedregs);
                                     ungetiftemp(p^.left^.location.reference);
                                     ungetiftemp(p^.right^.location.reference);
                                     p^.location.loc:=LOC_MEM;
                                     stringdispose(p^.location.reference.symbol);
                                     p^.location.reference:=href;
                                  end;
                      else Message(sym_e_type_mismatch);
                   end; { end case }
                end {else if begin }
              else Message(sym_e_type_mismatch);
           end; { endif }
          if (p^.left^.resulttype^.deftype<>stringdef) and
             not ((p^.left^.resulttype^.deftype=setdef) and
                (psetdef(p^.left^.resulttype)^.settype<>smallset)) then
            begin
               { this can be useful if for instance length(string) is called }
               if (p^.left^.location.loc=LOC_REFERENCE) or
                  (p^.left^.location.loc=LOC_MEM) then
                 ungetiftemp(p^.left^.location.reference);
               if (p^.right^.location.loc=LOC_REFERENCE) or
                  (p^.right^.location.loc=LOC_MEM) then
                 ungetiftemp(p^.right^.location.reference);
            end;

         { in case of comparison operation the put result in the flags }
         if cmpop then
           begin
              if not(unsigned) then
                begin
                   if p^.swaped then
                     case p^.treetype of
                        equaln : flags:=F_E;
                        unequaln : flags:=F_NE;
                        ltn : flags:=F_G;
                        lten : flags:=F_GE;
                        gtn : flags:=F_L;
                        gten : flags:=F_LE;
                     end
                   else
                     case p^.treetype of
                        equaln : flags:=F_E;
                        unequaln : flags:=F_NE;
                        ltn : flags:=F_L;
                        lten : flags:=F_LE;
                        gtn : flags:=F_G;
                        gten : flags:=F_GE;
                     end;
                end
              else
                begin
                   if p^.swaped then
                     case p^.treetype of
                        equaln : flags:=F_E;
                        unequaln : flags:=F_NE;
                        ltn : flags:=F_A;
                        lten : flags:=F_AE;
                        gtn : flags:=F_B;
                        gten : flags:=F_BE;
                     end
                   else
                     case p^.treetype of
                        equaln : flags:=F_E;
                        unequaln : flags:=F_NE;
                        ltn : flags:=F_B;
                        lten : flags:=F_BE;
                        gtn : flags:=F_A;
                        gten : flags:=F_AE;
                     end;
                end; { end begin }
              p^.location.loc:=LOC_FLAGS;
              p^.location.resflags:=flags;
           end; { endif cmpop }
      end;

 procedure processcc(p: ptree);
 var
   label1,label2: plabel;
 (*************************************************************************)
 (*  Description: This routine handles the conversion of Floating point   *)
 (*  condition codes to normal cpu condition codes.                       *)
 (*************************************************************************)
 begin
      getlabel(label1);
      getlabel(label2);
      case p^.treetype of
        equaln,unequaln: begin
                           { not equal clear zero flag }
                           emitl(A_FBEQ,label1);
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_AND, S_B, NOT ZERO_FLAG, R_CCR)));
                           emitl(A_BRA,label2);
                           emitl(A_LABEL,label1);
                           { equal - set zero flag }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_OR,S_B, ZERO_FLAG, R_CCR)));
                           emitl(A_LABEL,label2);
                        end;
         ltn:           begin
                           emitl(A_FBLT,label1);
                           { not less than       }
                           { clear N and V flags }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_AND, S_B, NOT (NEG_FLAG OR OVFL_FLAG), R_CCR)));
                           emitl(A_BRA,label2);
                           emitl(A_LABEL,label1);
                           { less than }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_OR,S_B, NEG_FLAG, R_CCR)));
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_AND,S_B, NOT OVFL_FLAG, R_CCR)));
                           emitl(A_LABEL,label2);
                        end;
         gtn:           begin
                           emitl(A_FBGT,label1);
                           { not greater than }
                           { set Z flag       }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_OR, S_B, ZERO_FLAG, R_CCR)));
                           emitl(A_BRA,label2);
                           emitl(A_LABEL,label1);
                           { greater than      }
                           { set N and V flags }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_OR,S_B, NEG_FLAG OR OVFL_FLAG , R_CCR)));
                           emitl(A_LABEL,label2);
                        end;
         gten:           begin
                           emitl(A_FBGE,label1);
                           { not greater or equal }
                           { set N and clear V    }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_AND, S_B, NOT OVFL_FLAG, R_CCR)));
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_OR,S_B, NEG_FLAG, R_CCR)));
                           emitl(A_BRA,label2);
                           emitl(A_LABEL,label1);
                           { greater or equal    }
                           { clear V and N flags }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_AND, S_B, NOT (OVFL_FLAG OR NEG_FLAG), R_CCR)));
                           emitl(A_LABEL,label2);
                        end;
         lten:           begin
                           emitl(A_FBLE,label1);
                           { not less or equal }
                           { clear Z, N and V  }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_AND, S_B, NOT (ZERO_FLAG OR NEG_FLAG OR OVFL_FLAG), R_CCR)));
                           emitl(A_BRA,label2);
                           emitl(A_LABEL,label1);
                           { less or equal     }
                           { set Z and N       }
                           { and clear V       }
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_OR,S_B, ZERO_FLAG OR NEG_FLAG, R_CCR)));
                           exprasmlist^.concat(new(pai68k, op_const_reg(
                             A_AND,S_B, NOT OVFL_FLAG, R_CCR)));
                           emitl(A_LABEL,label2);
                        end;
           else
             begin
               InternalError(34);
             end;
      end; { end case }
 end;

    procedure secondfor(var p : ptree);

      var
         l1,l3,oldclabel,oldblabel : plabel;
         omitfirstcomp,temptovalue : boolean;
         hs : byte;
         temp1 : treference;
         hop : tasmop;
         cmpreg,cmp32 : tregister;
         opsize : topsize;
         count_var_is_signed : boolean;

      begin
         oldclabel:=aktcontinuelabel;
         oldblabel:=aktbreaklabel;
         getlabel(aktcontinuelabel);
         getlabel(aktbreaklabel);
         getlabel(l3);

         { could we spare the first comparison ? }
         omitfirstcomp:=false;
         if p^.right^.treetype=ordconstn then
           if p^.left^.right^.treetype=ordconstn then
             omitfirstcomp:=(p^.backward and (p^.left^.right^.value>=p^.right^.value))
               or (not(p^.backward) and (p^.left^.right^.value<=p^.right^.value));

         { only calculate reference }
         cleartempgen;
         secondpass(p^.t2);
         if not(simple_loadn) then
          Message(cg_e_illegal_count_var);

         { produce start assignment }
         cleartempgen;
         secondpass(p^.left);
         count_var_is_signed:=is_signed(porddef(p^.t2^.resulttype));
         hs:=p^.t2^.resulttype^.size;
         cmp32:=getregister32;
         cmpreg:=cmp32;
         case hs of
            1 : begin
                   opsize:=S_B;
                end;
            2 : begin
                   opsize:=S_W;
                end;
            4 : begin
                   opsize:=S_L;
                end;
         end;
         cleartempgen;
         secondpass(p^.right);
         { calculate pointer value and check if changeable and if so }
         { load into temporary variable                              }
         if p^.right^.treetype<>ordconstn then
           begin
              temp1.symbol:=nil;
              gettempofsizereference(hs,temp1);
              temptovalue:=true;
              if (p^.right^.location.loc=LOC_REGISTER) or
                 (p^.right^.location.loc=LOC_CREGISTER) then
                begin
                   exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,opsize,p^.right^.location.register,
                      newreference(temp1))));
                 end
              else
                 concatcopy(p^.right^.location.reference,temp1,hs,false);
           end
         else temptovalue:=false;

         if temptovalue then
           begin
              if p^.t2^.location.loc=LOC_CREGISTER then
               begin
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
                     p^.t2^.location.register)));
                end
              else
                begin
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.t2^.location.reference),
                     cmpreg)));
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
                     cmpreg)));
                end;
           end
         else
           begin
              if not(omitfirstcomp) then
                begin
                   if p^.t2^.location.loc=LOC_CREGISTER then
                     exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^.right^.value,
                       p^.t2^.location.register)))
                   else
                     exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,opsize,p^.right^.value,
               newreference(p^.t2^.location.reference))));
                end;
           end;
         if p^.backward then
          begin
           if count_var_is_signed then
              hop:=A_BLT
           else
              hop:=A_BCS;
          end
         else
           if count_var_is_signed then
             hop:=A_BGT
           else hop:=A_BHI;

         if not(omitfirstcomp) or temptovalue then
          emitl(hop,aktbreaklabel);

         emitl(A_LABEL,l3);

         { help register must not be in instruction block }
         cleartempgen;
         if assigned(p^.t1) then
           secondpass(p^.t1);

         emitl(A_LABEL,aktcontinuelabel);

         { makes no problems there }
         cleartempgen;

         { demand help register again }
         cmp32:=getregister32;
         case hs of
            1 : begin
                   opsize:=S_B;
                end;
            2 : begin
                   opsize:=S_W;
                end;
            4 : opsize:=S_L;
         end;

     { produce comparison and the corresponding }
     { jump                                     }
         if temptovalue then
           begin
              if p^.t2^.location.loc=LOC_CREGISTER then
                begin
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
                     p^.t2^.location.register)));
                end
              else
                begin
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.t2^.location.reference),
                     cmpreg)));
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_CMP,opsize,newreference(temp1),
                     cmpreg)));
                end;
           end
         else
           begin
              if p^.t2^.location.loc=LOC_CREGISTER then
                exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^.right^.value,
                  p^.t2^.location.register)))
              else
                exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,opsize,p^.right^.value,
                  newreference(p^.t2^.location.reference))));
           end;
         if p^.backward then
           if count_var_is_signed then
             hop:=A_BLE
           else
             hop :=A_BLS
          else
            if count_var_is_signed then
              hop:=A_BGE
            else
               hop:=A_BCC;
         emitl(hop,aktbreaklabel);
         { according to count direction DEC or INC... }
         { must be after the test because of 0to 255 for bytes !! }
         if p^.backward then
           hop:=A_SUB
         else hop:=A_ADD;

         if p^.t2^.location.loc=LOC_CREGISTER then
           exprasmlist^.concat(new(pai68k,op_const_reg(hop,opsize,1,p^.t2^.location.register)))
         else
            exprasmlist^.concat(new(pai68k,op_const_ref(hop,opsize,1,newreference(p^.t2^.location.reference))));
         emitl(A_JMP,l3);

     { this is the break label: }
         emitl(A_LABEL,aktbreaklabel);
         ungetregister32(cmp32);

         if temptovalue then
           ungetiftemp(temp1);

         aktcontinuelabel:=oldclabel;
         aktbreaklabel:=oldblabel;
      end;


    procedure secondas(var p : ptree);

      var
         pushed : tpushed;

      begin
         secondpass(p^.left);
         { save all used registers }
         pushusedregisters(pushed,$ffff);

         { push instance to check: }
         case p^.left^.location.loc of
            LOC_REGISTER,LOC_CREGISTER:
              exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
                S_L,p^.left^.location.register,R_SPPUSH)));
            LOC_MEM,LOC_REFERENCE:
              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
                S_L,newreference(p^.left^.location.reference),R_SPPUSH)));
            else internalerror(100);
         end;

         { we doesn't modifiy the left side, we check only the type }
         set_location(p^.location,p^.left^.location);

         { generate type checking }
         secondpass(p^.right);
         case p^.right^.location.loc of
            LOC_REGISTER,LOC_CREGISTER:
              begin
                 exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
                   S_L,p^.right^.location.register,R_SPPUSH)));
                 ungetregister32(p^.right^.location.register);
              end;
            LOC_MEM,LOC_REFERENCE:
              begin
                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
                   S_L,newreference(p^.right^.location.reference),R_SPPUSH)));
                 del_reference(p^.right^.location.reference);
              end;
            else internalerror(100);
         end;
         emitcall('DO_AS',true);
         { restore register, this restores automatically the }
         { result                                            }
         popusedregisters(pushed);
      end;


    { generates the code for a raise statement }
    procedure secondraise(var p : ptree);

      var
         a : plabel;

      begin
         if assigned(p^.left) then
           begin
              { generate the address }
              if assigned(p^.right) then
                begin
                   secondpass(p^.right);
                   if codegenerror then
                     exit;
                end
              else
                begin
                   getlabel(a);
                   emitl(A_LABEL,a);
                   exprasmlist^.concat(new(pai68k,
                     op_csymbol_reg(A_MOVE,S_L,newcsymbol(lab2str(a),0),R_SPPUSH)));
                end;
              secondpass(p^.left);
              if codegenerror then
                exit;

              case p^.left^.location.loc of
                 LOC_MEM,LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
                 LOC_CREGISTER,LOC_REGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
                   p^.left^.location.register,R_SPPUSH)));
                 else Message(sym_e_type_mismatch);
              end;
              emitcall('DO_RAISE',true);
           end
         else
           emitcall('DO_RERAISE',true);
      end;




    { copies p a set element on the stack }
    procedure pushsetelement(var p : ptree);

      var
         hr : tregister;

      begin
         { copy the element on the stack, slightly complicated }
         case p^.location.loc of
            LOC_REGISTER,
            LOC_CREGISTER : begin
                              hr:=p^.location.register;
                              exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,hr,R_SPPUSH)));
                              ungetregister32(hr);
                           end;
            else
               begin
                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
                    newreference(p^.location.reference),R_SPPUSH)));
                  del_reference(p^.location.reference);
               end;
         end;
      end;

    { could be built into secondadd but it }
    { should be easy to read }
    procedure secondin(var p : ptree);


      type  Tsetpart=record
                range:boolean;      {Part is a range.}
                start,stop:byte;    {Start/stop when range; Stop=element
                                     when an element.}
            end;

      var
         pushed,ranges : boolean;
         hr : tregister;
         setparts:array[1..8] of Tsetpart;
         i,numparts:byte;
         href,href2:Treference;
         l,l2 : plabel;
       hl,hl1 : plabel;
       hl2, hl3: plabel;


            function analizeset(Aset:Pconstset):boolean;

            var compares,maxcompares:word;
                i:byte;
            type    byteset=set of byte;

            begin
                analizeset:=false;
                ranges:=false;
                numparts:=0;
                compares:=0;
                {Lots of comparisions take a lot of time, so do not allow
                 too much comparisions. 8 comparisions are, however, still
                 smalller than emitting the set.}
                maxcompares:=5;
                if cs_littlesize in aktswitches then
                    maxcompares:=8;
                for i:=0 to 255 do
                    if i in byteset(Aset^) then
                        begin
                            if (numparts=0) or
                             (i<>setparts[numparts].stop+1) then
                                begin
                                    {Set element is a separate element.}
                                    inc(compares);
                                    if compares>maxcompares then
                                        exit;
                                    inc(numparts);
                                    setparts[numparts].range:=false;
                                    setparts[numparts].stop:=i;
                                end
                             else
                                {Set element is part of a range.}
                                if not setparts[numparts].range then
                                    begin
                                        {Transform an element into a range.}
                                        setparts[numparts].range:=true;
                                        setparts[numparts].start:=
                                         setparts[numparts].stop;
                                        setparts[numparts].stop:=i;
                                        inc(compares);
                                        if compares>maxcompares then
                                            exit;
                                    end
                                else
                                    begin
                                        {Extend a range.}
                                        setparts[numparts].stop:=i;
                                        {A range of two elements can better
                                         be checked as two separate ones.
                                         When extending a range, our range
                                         becomes larger than two elements.}
                                        ranges:=true;
                                    end;
                        end;
                analizeset:=true;
            end;

      begin
         if psetdef(p^.right^.resulttype)^.settype=smallset then
           begin
              if p^.left^.treetype=ordconstn then
                begin
                   { only compulsory }
                   secondpass(p^.left);
                       secondpass(p^.right);
                   if codegenerror then
                     exit;
                   p^.location.resflags:=F_NE;
                       case p^.right^.location.loc of
                      LOC_REGISTER,LOC_CREGISTER : begin
                                                    emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
                                                    exprasmlist^.concat(new(pai68k,
                                                      op_const_reg(A_AND,S_L, 1 shl
                                                       (p^.left^.value and 31),R_D1)));
                                                   end;
                      else
                       begin
                           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
                             p^.right^.location.reference),R_D1)));
                           exprasmlist^.concat(new(pai68k,op_const_reg(
                             A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
                       end;
                   end;
                   del_reference(p^.right^.location.reference);
                end
              else
                begin
                   { calculate both operators }
                   { the complex one first }
                   firstcomplex(p);
                   secondpass(p^.left);
                   { are too few registers free? }
                   pushed:=maybe_push(p^.right^.registers32,p^.left);
                   secondpass(p^.right);
                   if pushed then
                     restore(p^.left);
                   { of course not commutative }
                   if p^.swaped then
                        swaptree(p);
              { load index into register }
                   case p^.left^.location.loc of
                      LOC_REGISTER,
                      LOC_CREGISTER :
                                        hr:=p^.left^.location.register;
                      else
                         begin
                            { the set element isn't never samller than a byte  }
                            { and because it's a small set we need only 5 bits }
                            { but 8 bits are eaiser to load                    }
                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
                              newreference(p^.left^.location.reference),R_D1)));
                            hr:=R_D1;
                            del_reference(p^.left^.location.reference);
                         end;
                   end;
                   case p^.right^.location.loc of
                      LOC_REGISTER,
                      LOC_CREGISTER : exprasmlist^.concat(new(pai68k, op_reg_reg(A_BTST,S_L,hr,p^.right^.location.register)));
                      else
                         begin
                     { OOPS ... bug here thanks Florian!! }
                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
                        R_D0)));
                            exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,hr,R_D0)));
                            del_reference(p^.right^.location.reference);
                         end;
                   end;
                   { support carry routines }
                   { sets the carry flags according to the result of BTST }
                   { i.e the Z flag.                                      }
                   getlabel(hl);
                   emitl(A_BNE,hl);
                   { leave all bits unchanged except Carry  = 0 }
                   exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_B, $FE, R_CCR)));
                   getlabel(hl1);
                   emitl(A_BRA,hl1);
                   emitl(A_LABEL, hl);
                   { set carry to 1 }
                   exprasmlist^.concat(new(pai68k, op_const_reg(A_OR, S_B, $01, R_CCR)));
                   emitl(A_LABEL, hl1);
                   { end support carry routines }
                   p^.location.loc:=LOC_FLAGS;
                   p^.location.resflags:=F_C;
                end;
           end
         else
           begin
              if p^.left^.treetype=ordconstn then
                begin
                   { only compulsory }
                   secondpass(p^.left);
                   secondpass(p^.right);
                   if codegenerror then
                     exit;
                   p^.location.resflags:=F_NE;
                   inc(p^.right^.location.reference.offset,p^.left^.value shr 3);
                   exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_B,
                       newreference(p^.right^.location.reference), R_D1)));
                   exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_B,
                       1 shl (p^.left^.value and 7),R_D1)));
               del_reference(p^.right^.location.reference);
            end
          else
            begin
               if (p^.right^.treetype=setconstrn) and
                  analizeset(p^.right^.constset) then
                    begin
                        {It gives us advantage to check for the set elements
                         separately instead of using the SET_IN_BYTE procedure.
                         To do: Build in support for LOC_JUMP.}
                        secondpass(p^.left);
                        {We won't do a second pass on p^.right, because
                         this will emit the constant set.}
                      case p^.left^.location.loc of
                        LOC_REGISTER,
                        LOC_CREGISTER :
                           exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
                             255,p^.left^.location.register)));
                      end;
                            {Get a label to jump to the end.}
                            p^.location.loc:=LOC_FLAGS;
                            {It's better to use the zero flag when there are
                             no ranges.}
                            if ranges then
                                p^.location.resflags:=F_C
                            else
                                p^.location.resflags:=F_E;
                            href.symbol := nil;
                            clear_reference(href);
                            getlabel(l);
                            href.symbol:=stringdup(lab2str(l));
                            for i:=1 to numparts do
                                if setparts[i].range then
                                    begin
                                        {Check if left is in a range.}
                                        {Get a label to jump over the check.}
                                        href2.symbol := nil;
                                        clear_reference(href2);
                                        getlabel(l2);
                                        href.symbol:=stringdup(lab2str(l2));
                                        if setparts[i].start=setparts[i].stop-1 then
                                        begin

                                          case p^.left^.location.loc of
                                           LOC_REGISTER,
                                           LOC_CREGISTER :
                                                  exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
                                                    setparts[i].start,p^.left^.location.register)));
                                          else
                                                  exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
                                                    setparts[i].start,newreference(p^.left^.location.reference))));
                                          end;
                                          {Result should be in carry flag when ranges are used.}
                                          { Here the m68k does not affect any flag except the  }
                                          { flag which is OR'ed                                }
                                          if ranges then
                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
                                          {If found, jump to end.}
                                          emitl(A_BEQ,l);
                                          case p^.left^.location.loc of
                                           LOC_REGISTER,
                                           LOC_CREGISTER :
                                                exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
                                                 setparts[i].stop,p^.left^.location.register)));
                                          else
                                                exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
                                                 setparts[i].stop,newreference(p^.left^.location.reference))));
                                          end;
                                          {Result should be in carry flag when ranges are used.}
                                          { Here the m68k does not affect any flag except the  }
                                          { flag which is OR'ed                                }
                                          if ranges then
                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
                                          {If found, jump to end.}
                                          emitl(A_BEQ,l);
                                       end
                                        else
                                            begin
                                                if setparts[i].start<>0 then
                                                    begin
                                                        {We only check for the lower bound if it is > 0, because
                                                         set elements lower than 0 do nt exist.}
                                           case p^.left^.location.loc of
                                               LOC_REGISTER,
                                               LOC_CREGISTER :
                                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
                                                         setparts[i].start,p^.left^.location.register)));
                                          else
                                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
                                                         setparts[i].start,newreference(p^.left^.location.reference))));
                                          end;
                                                        {If lower, jump to next check.}
                                                        emitl(A_BCS,l2);
                                                    end;
                                                if setparts[i].stop<>255 then
                                                    begin
                                                        {We only check for the high bound if it is < 255, because
                                                         set elements higher than 255 do nt exist.}
                                           case p^.left^.location.loc of
                                               LOC_REGISTER,
                                               LOC_CREGISTER :
                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
                                                         setparts[i].stop+1,p^.left^.location.register)));
                                          else
                                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
                                                         setparts[i].stop+1,newreference(p^.left^.location.reference))));
                                          end; { end case }
                                                        {If higher, element is in set.}
                                                        emitl(A_BCS,l);
                                                    end;
                                            end;
                                        {Emit the jump over label.}
                                        exprasmlist^.concat(new(pai_label,init(l2)));
                                    end
                                else
                                    begin
                                        {Emit code to check if left is an element.}
                              case p^.left^.location.loc of
                                LOC_REGISTER,
                                LOC_CREGISTER :
                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
                                         setparts[i].stop,p^.left^.location.register)));
                              else
                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
                                         setparts[i].stop,newreference(p^.left^.location.reference))));
                              end;
                                        {Result should be in carry flag when ranges are used.}
                                        if ranges then
                                            exprasmlist^.concat(new(pai68k, op_const_reg(A_OR,S_B,$01,R_CCR)));
                                        {If found, jump to end.}
                                        emitl(A_BEQ,l);
                                    end;
                            if ranges then
                            { clear carry flag }
                                exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_B,$FE,R_CCR)));
                            {To compensate for not doing a second pass.}
                            stringdispose(p^.right^.location.reference.symbol);
                            {Now place the end label.}
                            exprasmlist^.concat(new(pai_label,init(l)));
                        end
                   else
                        begin
                           { calculate both operators }
                           { the complex one first }
                           firstcomplex(p);
                           secondpass(p^.left);
                           set_location(p^.location,p^.left^.location);
                           { are too few registers free? }
                           pushed:=maybe_push(p^.right^.registers32,p);
                           secondpass(p^.right);
                           if pushed then restore(p);
                           { of course not commutative }
                           if p^.swaped then
                             swaptree(p);
                           pushsetelement(p^.left);
                           emitpushreferenceaddr(p^.right^.location.reference);
                           del_reference(p^.right^.location.reference);
                           { registers need not be save. that happens in SET_IN_BYTE }
                           emitcall('SET_IN_BYTE',true);
                     { ungetiftemp(p^.right^.location.reference); }
                          { here we must set the flags manually  }
                          { on returne from the routine, because }
                          { flags are corrupt when restoring the }
                          { stack                                }
                          exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0)));
                          getlabel(hl2);
                          emitl(A_BEQ,hl2);
                          exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_B,
                            $fe,R_CCR)));
                          getlabel(hl3);
                          emitl(A_BRA,hl3);
                          emitl(A_LABEL,hl2);
                          exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,
                             $01,R_CCR)));
                          emitl(A_LABEL,hl3);
                          p^.location.loc:=LOC_FLAGS;
                          p^.location.resflags:=F_C;
                        end;
                end;
             end;
      end;



    procedure secondexpr(var p : ptree);

      begin
         secondpass(p^.left);
      end;

    procedure secondblockn(var p : ptree);

      var
         hp : ptree;

      begin
         hp:=p^.left;
         while assigned(hp) do
           begin
              { assignments could be distance optimized }
              if assigned(hp^.right) then
                begin
                   cleartempgen;
                   secondpass(hp^.right);
                end;
              hp:=hp^.left;
           end;
      end;

    procedure second_while_repeatn(var p : ptree);

      var
         l1,l2,l3,oldclabel,oldblabel : plabel;
         otlabel,oflabel : plabel;
      begin
         getlabel(l1);
         getlabel(l2);
         { arrange continue and breaklabels: }
         oldclabel:=aktcontinuelabel;
         oldblabel:=aktbreaklabel;
         if p^.treetype=repeatn then
           begin
              emitl(A_LABEL,l1);
              aktcontinuelabel:=l1;
              aktbreaklabel:=l2;
              cleartempgen;
              if assigned(p^.right) then
               secondpass(p^.right);

              otlabel:=truelabel;
              oflabel:=falselabel;
              truelabel:=l2;
              falselabel:=l1;
              cleartempgen;
              secondpass(p^.left);
              maketojumpbool(p^.left);
              emitl(A_LABEL,l2);
              truelabel:=otlabel;
              falselabel:=oflabel;
           end
         else
           begin
              { handling code at the end as it is much more efficient }
              emitl(A_JMP,l2);

              emitl(A_LABEL,l1);
              cleartempgen;

              getlabel(l3);
              aktcontinuelabel:=l1;
              aktbreaklabel:=l3;

              if assigned(p^.right) then
               secondpass(p^.right);

              emitl(A_LABEL,l2);
              otlabel:=truelabel;
              oflabel:=falselabel;
              truelabel:=l1;
              falselabel:=l3;
              cleartempgen;
              secondpass(p^.left);
              maketojumpbool(p^.left);

              emitl(A_LABEL,l3);
              truelabel:=otlabel;
              falselabel:=oflabel;
           end;
         aktcontinuelabel:=oldclabel;
         aktbreaklabel:=oldblabel;
      end;

    procedure secondifn(var p : ptree);

      var
         hl,otlabel,oflabel : plabel;

      begin
         otlabel:=truelabel;
         oflabel:=falselabel;
         getlabel(truelabel);
         getlabel(falselabel);
         cleartempgen;
         secondpass(p^.left);
         maketojumpbool(p^.left);
         if assigned(p^.right) then
           begin
              emitl(A_LABEL,truelabel);
              cleartempgen;
              secondpass(p^.right);
           end;
         if assigned(p^.t1) then
           begin
              if assigned(p^.right) then
                begin
                   getlabel(hl);
                   emitl(A_JMP,hl);
                end;
              emitl(A_LABEL,falselabel);
              cleartempgen;
              secondpass(p^.t1);
              if assigned(p^.right) then
                emitl(A_LABEL,hl);
           end
         else
           emitl(A_LABEL,falselabel);
         if not(assigned(p^.right)) then
           emitl(A_LABEL,truelabel);
         truelabel:=otlabel;
         falselabel:=oflabel;
      end;

    procedure secondbreakn(var p : ptree);

      begin
         if aktbreaklabel<>nil then
           emitl(A_JMP,aktbreaklabel)
         else
           Message(cg_e_break_not_allowed);
      end;


end.
{
  $Log$
  Revision 1.2  1998-03-28 23:09:54  florian
    * secondin bugfix (m68k and i386)
    * overflow checking bugfix (m68k and i386) -- pretty useless in
      secondadd, since everything is done using 32-bit
    * loading pointer to routines hopefully fixed (m68k)
    * flags problem with calls to RTL internal routines fixed (still strcmp
      to fix) (m68k)
    * #ELSE was still incorrect (didn't take care of the previous level)
    * problem with filenames in the command line solved
    * problem with mangledname solved
    * linking name problem solved (was case insensitive)
    * double id problem and potential crash solved
    * stop after first error
    * and=>test problem removed
    * correct read for all float types
    * 2 sigsegv fixes and a cosmetic fix for Internal Error
    * push/pop is now correct optimized (=> mov (%esp),reg)

  Revision 1.1.1.1  1998/03/25 11:18:13  root
  * Restored version

  Revision 1.18  1998/03/10 01:17:15  peter
    * all files have the same header
    * messages are fully implemented, EXTDEBUG uses Comment()
    + AG... files for the Assembler generation

  Revision 1.17  1998/03/09 10:44:34  peter
    + string='', string<>'', string:='', string:=char optimizes (the first 2
      were already in cg68k2)

  Revision 1.16  1998/03/06 00:52:02  peter
    * replaced all old messages from errore.msg, only ExtDebug and some
      Comment() calls are left
    * fixed options.pas

  Revision 1.15  1998/03/02 01:48:15  peter
    * renamed target_DOS to target_GO32V1
    + new verbose system, merged old errors and verbose units into one new
      verbose.pas, so errors.pas is obsolete

  Revision 1.14  1998/02/14 05:05:43  carl
    + now compiles under TP with overlays

  Revision 1.13  1998/02/13 10:34:44  daniel
  * Made Motorola version compilable.
  * Fixed optimizer

  Revision 1.12  1998/02/12 11:49:49  daniel
  Yes! Finally! After three retries, my patch!

  Changes:

  Complete rewrite of psub.pas.
  Added support for DLL's.
  Compiler requires less memory.
  Platform units for each platform.

  Revision 1.11  1998/02/07 06:51:51  carl
    + moved secondraise from cg68k

  Revision 1.10  1998/02/05 21:54:31  florian
    + more MMX

  Revision 1.9  1998/02/05 00:59:29  carl
    + added secondas

  Revision 1.8  1998/02/01 17:13:26  florian
    + comparsion of class references

  Revision 1.7  1998/01/21 22:34:23  florian
    + comparsion of Delphi classes

  Revision 1.6  1998/01/11 03:37:18  carl
  * bugfix of muls.l under MC68000 target
  * long subtract bugfix

  Revision 1.3  1997/12/10 23:07:15  florian
  * bugs fixed: 12,38 (also m68k),39,40,41
  + warning if a system unit is without -Us compiled
  + warning if a method is virtual and private (was an error)
  * some indentions changed
  + factor does a better error recovering (omit some crashes)
  + problem with @type(x) removed (crashed the compiler)

  Revision 1.2  1997/12/04 15:15:05  carl
  + updated to v099.

  Revision 1.1.1.1  1997/11/27 08:32:53  michael
  FPC Compiler CVS start


  Pre-CVS log:


  FK     Florian Klaempfl
  +      feature added
  -      removed
  *      bug fixed or changed

  History:
       8th october 1997:
         + only a cmpb $0,_S is generated if s is a string and a
           s='' or s<>'' is performed (FK)
      17th october 1997:
         + unit started (CEC)

}