freepascal.compiler/compiler/cg68k.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}

{---------------------------------------------------------------------------}
{ LEFT TO DO IN CG68k AND CG68k2                                            }
{---------------------------------------------------------------------------}
{  o Test and correct problems with extended support.                       }
{  o Optimize secondmoddiv when doing a constant modulo.                    }
{  o Add emulation support for Cardinal under MC68000.                      }
{---------------------------------------------------------------------------}

unit cg68k;


{***************************************************************************}
interface
{***************************************************************************}

uses    objects,verbose,cobjects,comphook,systems,globals,tree,
        symtable,types,strings,pass_1,hcodegen,temp_gen,
        aasm,m68k,tgen68k,files,cga68k,cg68k2,link
{$ifdef GDB}
        ,gdb
{$endif}
        ;

{ produces assembler for the expression in variable p }
{ and produces an assembler node at the end           }
procedure generatecode(var p : ptree);


{ produces the actual code }
function do_secondpass(var p : ptree) : boolean;

procedure secondpass(var p : ptree);

{$ifdef test_dest_loc}
const   { used to avoid temporary assignments }
        dest_loc_known : boolean = false;
        in_dest_loc : boolean = false;
        dest_loc_tree : ptree = nil;

var dest_loc : tlocation;

procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);

{$endif test_dest_loc}



{***************************************************************************}
implementation
{***************************************************************************}

  uses
    scanner;


    const
       never_copy_const_param : boolean = false;
       bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
        { used to avoid temporary assignments }
        dest_loc_known : boolean = false;
        in_dest_loc : boolean = false;
        dest_loc_tree : ptree = nil;



    var
       { this is for open arrays and strings        }
       { but be careful, this data is in the        }
       { generated code destroyed quick, and also   }
       { the next call of secondload destroys this  }
       { data                                       }
       { So be careful using the informations       }
       { provided by this variables                 }
       highframepointer : tregister;
       highoffset : longint;
       dest_loc : tlocation;

        procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);

          begin
             if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then
               begin
                 emit_reg_reg(A_MOVE,s,reg,dest_loc.register);
                 p^.location:=dest_loc;
                 in_dest_loc:=true;
               end
             else
             if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
               begin
                 exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,s,reg,newreference(dest_loc.reference))));
                 p^.location:=dest_loc;
                 in_dest_loc:=true;
               end
             else
               internalerror(20080);
          end;




    procedure error(const t : tmsgconst);

      begin
         if not(codegenerror) then
           verbose.Message(t);
         codegenerror:=true;
      end;

    type
       secondpassproc = procedure(var p : ptree);

    procedure seconderror(var p : ptree);

      begin
         p^.error:=true;
         codegenerror:=true;
      end;

    procedure secondstatement(var p : ptree);
      var
         hp : ptree;

      begin
         hp:=p;
         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 secondload(var p : ptree);

      var
         hregister : tregister;
         i : longint;
         symtabletype: tsymtabletype;
         hp : preference;

      begin
         simple_loadn:=true;
         reset_reference(p^.location.reference);
         case p^.symtableentry^.typ of
              { this is only for toasm and toaddr }
              absolutesym :
                 begin
                    stringdispose(p^.location.reference.symbol);
                    p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
                    if p^.symtableentry^.owner^.symtabletype=unitsymtable then
                      concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
                 end;
              varsym :
                 begin
                    hregister:=R_NO;
                    symtabletype:=p^.symtable^.symtabletype;
                    { in case it is a register variable: }
                    { we simply set the location to the  }
                    { correct register.                  }
                    if pvarsym(p^.symtableentry)^.reg<>R_NO then
                      begin
                         p^.location.loc:=LOC_CREGISTER;
                         p^.location.register:=pvarsym(p^.symtableentry)^.reg;
                         unused:=unused-[pvarsym(p^.symtableentry)^.reg];
                      end
                    else
                      begin
                         { --------------------- LOCAL AND TEMP VARIABLES ------------- }
                         if (symtabletype=parasymtable) or (symtabletype=localsymtable) then
                           begin

                              p^.location.reference.base:=procinfo.framepointer;
                              p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;

                              if (symtabletype=localsymtable) then
                                p^.location.reference.offset:=-p^.location.reference.offset;

                              if (symtabletype=parasymtable) then
                                inc(p^.location.reference.offset,p^.symtable^.call_offset);

                              if (lexlevel>(p^.symtable^.symtablelevel)) then
                                begin
                                   hregister:=getaddressreg;

                                   { make a reference }
                                   new(hp);
                                   reset_reference(hp^);
                                   hp^.offset:=procinfo.framepointer_offset;
                                   hp^.base:=procinfo.framepointer;

                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));

                                   simple_loadn:=false;
                                   i:=lexlevel-1;
                                   while i>(p^.symtable^.symtablelevel) do
                                     begin
                                        { make a reference }
                                        new(hp);
                                        reset_reference(hp^);
                                        hp^.offset:=8;
                                        hp^.base:=hregister;

                                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
                                        dec(i);
                                     end;
                                   p^.location.reference.base:=hregister;
                                end;
                           end
                         { --------------------- END OF LOCAL AND TEMP VARS ---------------- }
                         else
                           case symtabletype of
                              unitsymtable,globalsymtable,
                              staticsymtable : begin
                                                  stringdispose(p^.location.reference.symbol);
                                                  p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
                                                   if symtabletype=unitsymtable then
                                                     concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
                                               end;
                              objectsymtable : begin
                                                  if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then
                                                    begin
                                                       stringdispose(p^.location.reference.symbol);
                                                       p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
                                                        if p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then
                                                          concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
                                                    end
                                                  else
                                                    begin
                                                  p^.location.reference.base:=R_A5;
                                                  p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
                                               end;
                                               end;
                              withsymtable :   begin
                                                  hregister:=getaddressreg;
                                                  p^.location.reference.base:=hregister;
                                                  { make a reference }
                                                  new(hp);
                                                  reset_reference(hp^);
                                                  hp^.offset:=p^.symtable^.datasize;
                                                  hp^.base:=procinfo.framepointer;

                                                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));

                                                  p^.location.reference.offset:=
                                                    pvarsym(p^.symtableentry)^.address;
                                               end;
                           end;

                         { in case call by reference, then calculate: }
                         if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
                            ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
                             dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) then
                           begin
                              simple_loadn:=false;
                              if hregister=R_NO then
                                hregister:=getaddressreg;
                              { ADDED FOR OPEN ARRAY SUPPORT. }
                              if (p^.location.reference.base=procinfo.framepointer) then
                                begin
                                   highframepointer:=p^.location.reference.base;
                                   highoffset:=p^.location.reference.offset;
                                end
                              else
                                begin
                                   highframepointer:=R_A1;
                                   highoffset:=p^.location.reference.offset;
                                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
                                     p^.location.reference.base,R_A1)));
                                end;
                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
                                hregister)));
                              { END ADDITION }
                              clear_reference(p^.location.reference);
                              p^.location.reference.base:=hregister;
                          end;
                         { should be dereferenced later (FK)
                         if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
                           ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
                           begin
                              simple_loadn:=false;
                              if hregister=R_NO then
                                hregister:=getaddressreg;
                              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
                                hregister)));
                              clear_reference(p^.location.reference);
                              p^.location.reference.base:=hregister;
                           end;
                         }
                      end;
                 end;
              procsym:
                 begin
                    {!!!!! Be aware, work on virtual methods too }
                    stringdispose(p^.location.reference.symbol);
                    p^.location.reference.symbol:=
                      stringdup(pprocsym(p^.symtableentry)^.definition^.mangledname);
                    if p^.symtable^.symtabletype=unitsymtable then
                    concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
                 end;
              typedconstsym :
                 begin
                    stringdispose(p^.location.reference.symbol);
                    p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
                    if p^.symtable^.symtabletype=unitsymtable then
                    concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
                 end;
              else internalerror(4);
         end;
      end;


    { D0 and D1 used as temp (ok)   }
    procedure secondmoddiv(var p : ptree);

      var
         hreg1 : tregister;
         power : longint;
         hl : plabel;
         reg: tregister;
         pushed: boolean;
         hl1: plabel;
      begin
         secondpass(p^.left);
         set_location(p^.location,p^.left^.location);
         pushed:=maybe_push(p^.right^.registers32,p);
         secondpass(p^.right);
         if pushed then restore(p);

         { put numerator in register }
         if p^.left^.location.loc<>LOC_REGISTER then
           begin
              if p^.left^.location.loc=LOC_CREGISTER then
                begin
                  hreg1:=getregister32;
                  emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hreg1);
                end
              else
                begin
                  del_reference(p^.left^.location.reference);
                  hreg1:=getregister32;
                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
                    hreg1)));
                end;
              p^.left^.location.loc:=LOC_REGISTER;
              p^.left^.location.register:=hreg1;
           end
         else hreg1:=p^.left^.location.register;

         if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
            ispowerof2(p^.right^.value,power) then
           begin
              exprasmlist^.concat(new(pai68k, op_reg(A_TST, S_L, hreg1)));
              getlabel(hl);
              emitl(A_BPL,hl);
              if (power = 1) then
                 exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L,1, hreg1)))
              else
               Begin
                 { optimize using ADDQ if possible!   }
              if (p^.right^.value-1) < 9 then
                 exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L,p^.right^.value-1, hreg1)))
              else
                 exprasmlist^.concat(new(pai68k, op_const_reg(A_ADD, S_L,p^.right^.value-1, hreg1)));
               end;
              emitl(A_LABEL, hl);
              if (power > 0) and (power < 9) then
                 exprasmlist^.concat(new(pai68k, op_const_reg(A_ASR, S_L,power, hreg1)))
              else
               begin
                  exprasmlist^.concat(new(pai68k, op_const_reg(A_MOVE,S_L,power, R_D0)));
                  exprasmlist^.concat(new(pai68k, op_reg_reg(A_ASR,S_L,R_D0, hreg1)));
               end;
           end
         else
           begin
              { bring denominator to D1 }
              { D1 is always free, it's }
              { only used for temporary  }
              { purposes                 }
              if (p^.right^.location.loc<>LOC_REGISTER) and
                 (p^.right^.location.loc<>LOC_CREGISTER) then
                 begin
                   del_reference(p^.right^.location.reference);
                   p^.left^.location.loc:=LOC_REGISTER;
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),R_D1)));
                end
             else
              begin
                   ungetregister32(p^.right^.location.register);
                   emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
              end;

              { on entering this section D1 should contain the divisor }

              if (aktoptprocessor = MC68020) then
              begin
                 { Check if divisor is ZERO - if so call HALT_ERROR }
                 { with d0 = 200 (Division by zero!)                }
                 getlabel(hl1);
                 exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,R_D1)));
                 { if not zero then simply continue on }
                 emitl(A_BNE,hl1);
                 exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,200,R_D0)));
                 emitcall('HALT_ERROR',true);
                 emitl(A_LABEL,hl1);
                 if (p^.treetype = modn) then
                 Begin
                   reg := getregister32;
                   exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,reg)));
                   getlabel(hl);
                   { here what we do is prepare the high register with the     }
                   { correct sign. i.e we clear it, check if the low dword reg }
                   { which will participate in the division is signed, if so we}
                   { we extend the sign to the high doword register by inverting }
                   { all the bits.                                             }
                   exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,hreg1)));
                   emitl(A_BPL,hl);
                   exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,reg)));
                   emitl(A_LABEL,hl);
                   { reg:hreg1 / d1 }
                   exprasmlist^.concat(new(pai68k,op_reg_reg_reg(A_DIVSL,S_L,R_D1,reg,hreg1)));
                   { hreg1 already contains quotient }
                   { looking for remainder }
                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,reg,hreg1)));
                   ungetregister32(reg);
                 end
                 else
                 { simple division... }
                 Begin
                   { reg:hreg1 / d1 }
                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_DIVS,S_L,R_D1,hreg1)));
                 end;
              end
              else { MC68000 operations }
                 begin
                     { put numerator in d0 }
                     emit_reg_reg(A_MOVE,S_L,hreg1,R_D0);
                     { operation to perform on entry to both }
                     { routines...  d0/d1                    }
                     { return result in d0                   }
                     if p^.treetype = divn then
                       emitcall('LONGDIV',true)
                     else
                       emitcall('LONGMOD',true);
                     emit_reg_reg(A_MOVE,S_L,R_D0,hreg1);
              end; { endif }
         end;
         { this registers are always used when div/mod are present }
         usedinproc:=usedinproc or ($800 shr word(R_D1));
         usedinproc:=usedinproc or ($800 shr word(R_D0));
         p^.location.loc:=LOC_REGISTER;
         p^.location.register:=hreg1;
      end;


    { D6 used as scratch (ok) }
    procedure secondshlshr(var p : ptree);

      var
         hregister1,hregister2,hregister3 : tregister;
         op : tasmop;
         pushed : boolean;
      begin

         secondpass(p^.left);
         pushed:=maybe_push(p^.right^.registers32,p);
         secondpass(p^.right);
         if pushed then restore(p);

         { load left operators in a register }
         if p^.left^.location.loc<>LOC_REGISTER then
           begin
              if p^.left^.location.loc=LOC_CREGISTER then
                begin
                   hregister1:=getregister32;
                   emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
                     hregister1);
                end
              else
                begin
                   del_reference(p^.left^.location.reference);
                   hregister1:=getregister32;
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
                     hregister1)));
                end;
           end
         else hregister1:=p^.left^.location.register;

         { determine operator }
         if p^.treetype=shln then
           op:=A_LSL
         else
           op:=A_LSR;

         { shifting by a constant directly decode: }
         if (p^.right^.treetype=ordconstn) then
           begin
             if (p^.right^.location.reference.offset and 31 > 0) and (p^.right^.location.reference.offset and 31 < 9) then
                 exprasmlist^.concat(new(pai68k,op_const_reg(op,S_L,p^.right^.location.reference.offset and 31,
                   hregister1)))
             else
               begin
                 exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,p^.right^.location.reference.offset and 31,
                   R_D6)));
                 exprasmlist^.concat(new(pai68k,op_reg_reg(op,S_L,R_D6,hregister1)));
               end;
              p^.location.loc:=LOC_REGISTER;
              p^.location.register:=hregister1;
           end
         else
           begin
              { load right operators in a register }
              if p^.right^.location.loc<>LOC_REGISTER then
                begin
                   if p^.right^.location.loc=LOC_CREGISTER then
                     begin
                        hregister2:=getregister32;
                        emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,
                          hregister2);
                     end
                   else
                     begin
                        del_reference(p^.right^.location.reference);
                        hregister2:=getregister32;
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
                          hregister2)));
                     end;
                end
              else hregister2:=p^.right^.location.register;


              emit_reg_reg(op,S_L,hregister2,hregister1);
              p^.location.register:=hregister1;
           end;
         { this register is always used when shl/shr are present }
         usedinproc:=usedinproc or ($800 shr byte(R_D6));
      end;


    procedure secondrealconst(var p : ptree);

      var
         hp1 : pai;
         lastlabel : plabel;
         found : boolean;

      begin
         clear_reference(p^.location.reference);
         lastlabel:=nil;
         found:=false;
         { const already used ? }
         if p^.labnumber=-1 then
           begin
              { tries to found an old entry }
              hp1:=pai(consts^.first);
              while assigned(hp1) do
                begin
                   if hp1^.typ=ait_label then
                     lastlabel:=pai_label(hp1)^.l
                   else
                     begin
                        if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
                          begin
                             { Florian this caused a internalerror(10)=> no free reg !! }
                             {if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
                               ((p^.realtyp=ait_real_80bit) and (pai_extended(hp1)^.value=p^.valued)) or
                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then }
                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) then
                               found:=true;
                             if ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
                               found:=true;
                             if ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) then
                               found:=true;
                             if found then
                               begin
                                  { found! }
                                  p^.labnumber:=lastlabel^.nb;
                                  break;
                               end;
                          end;
                        lastlabel:=nil;
                     end;
                   hp1:=pai(hp1^.next);
                end;
              { :-(, we must generate a new entry }
                 if p^.labnumber=-1 then
                begin
                   getlabel(lastlabel);
                   p^.labnumber:=lastlabel^.nb;
                   case p^.realtyp of
                     ait_real_64bit : consts^.insert(new(pai_double,init(p^.valued)));
                     ait_real_32bit : consts^.insert(new(pai_single,init(p^.valued)));
                     ait_real_extended : consts^.insert(new(pai_extended,init(p^.valued)));
                     else
                       internalerror(10120);
                     end;
                   consts^.insert(new(pai_label,init(lastlabel)));
                end;
           end;
         stringdispose(p^.location.reference.symbol);
         p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
      end;

    procedure secondfixconst(var p : ptree);

      begin
         { an fix comma const. behaves as a memory reference }
         p^.location.loc:=LOC_MEM;
         p^.location.reference.isintvalue:=true;
         p^.location.reference.offset:=p^.valuef;
      end;

    procedure secondordconst(var p : ptree);

      begin
         { an integer const. behaves as a memory reference }
         p^.location.loc:=LOC_MEM;
         p^.location.reference.isintvalue:=true;
         p^.location.reference.offset:=p^.value;
      end;

    procedure secondniln(var p : ptree);

      begin
         p^.location.loc:=LOC_MEM;
         p^.location.reference.isintvalue:=true;
         p^.location.reference.offset:=0;
      end;

    procedure secondstringconst(var p : ptree);

      var
         hp1 : pai;
         lastlabel : plabel;
         pc : pchar;
         same_string : boolean;
         i : word;

      begin
         clear_reference(p^.location.reference);
         lastlabel:=nil;
         { const already used ? }
         if p^.labstrnumber=-1 then
           begin
              { tries to found an old entry }
              hp1:=pai(consts^.first);
              while assigned(hp1) do
                begin
                   if hp1^.typ=ait_label then
                     lastlabel:=pai_label(hp1)^.l
                   else
                     begin
                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
                          (pai_string(hp1)^.len=length(p^.values^)+2) then
                          begin
                             same_string:=true;
                             for i:=1 to length(p^.values^) do
                               if pai_string(hp1)^.str[i]<>p^.values^[i] then
                                 begin
                                    same_string:=false;
                                    break;
                                 end;
                             if same_string then
                               begin
                                  { found! }
                                  p^.labstrnumber:=lastlabel^.nb;
                                  break;
                               end;
                          end;
                        lastlabel:=nil;
                     end;
                   hp1:=pai(hp1^.next);
                end;
              { :-(, we must generate a new entry }
              if p^.labstrnumber=-1 then
                begin
                   getlabel(lastlabel);
                   p^.labstrnumber:=lastlabel^.nb;
                   getmem(pc,length(p^.values^)+3);
                   move(p^.values^,pc^,length(p^.values^)+1);
                   pc[length(p^.values^)+1]:=#0;
                   { we still will have a problem if there is a #0 inside the pchar }
                   consts^.insert(new(pai_string,init_pchar(pc)));
                   { to overcome this problem we set the length explicitly }
                   { with the ending null char }
                   pai_string(consts^.first)^.len:=length(p^.values^)+2;
                   consts^.insert(new(pai_label,init(lastlabel)));
                end;
           end;
         stringdispose(p^.location.reference.symbol);
         p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
         p^.location.loc := LOC_MEM;
      end;

    procedure secondumminus(var p : ptree);

      begin
         secondpass(p^.left);
         p^.location.loc:=LOC_REGISTER;
         case p^.left^.location.loc of
            LOC_REGISTER : begin
                              p^.location.register:=p^.left^.location.register;
                              exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
                           end;
            LOC_CREGISTER : begin
                               p^.location.register:=getregister32;
                               emit_reg_reg(A_MOVE,S_L,p^.location.register,
                                 p^.location.register);
                               exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
                            end;
            LOC_REFERENCE,LOC_MEM :
                           begin
                              del_reference(p^.left^.location.reference);
                              { change sign of a floating point  }
                              { in the case of emulation, get    }
                              { a free register, and change sign }
                              { manually.                        }
                              { otherwise simply load into an FPU}
                              { register.                        }
                              if (p^.left^.resulttype^.deftype=floatdef) and
                                 (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
                                begin
                                   { move to FPU }
                                   floatload(pfloatdef(p^.left^.resulttype)^.typ,
                                     p^.left^.location.reference,p^.location);
                                   if (cs_fp_emulation) in aktmoduleswitches then
                                       { if in emulation mode change sign manually }
                                       exprasmlist^.concat(new(pai68k,op_const_reg(A_BCHG,S_L,31,
                                          p^.location.fpureg)))
                                   else
                                       exprasmlist^.concat(new(pai68k,op_reg(A_FNEG,S_FX,
                                          p^.location.fpureg)));
                                end
                              else
                                begin
                                   p^.location.register:=getregister32;
                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                                     newreference(p^.left^.location.reference),
                                     p^.location.register)));
                                   exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
                                end;
                           end;
            LOC_FPU : begin
                              p^.location.loc:=LOC_FPU;
                              p^.location.fpureg := p^.left^.location.fpureg;
                              if (cs_fp_emulation) in aktmoduleswitches then
                                  exprasmlist^.concat(new(pai68k,op_const_reg(A_BCHG,S_L,31,p^.location.fpureg)))
                              else
                                 exprasmlist^.concat(new(pai68k,op_reg(A_FNEG,S_FX,p^.location.fpureg)));
                           end;
         end;
{         emitoverflowcheck;}
      end;

    { use of A6 is required only temp (ok) }
    procedure secondaddr(var p : ptree);

      begin
         secondpass(p^.left);
         p^.location.loc:=LOC_REGISTER;
         p^.location.register:=getregister32;
         {@ on a procvar means returning an address to the procedure that
          is stored in it.}
       { yes but p^.left^.symtableentry can be nil
       for example on @self !! }
         { symtableentry can be also invalid, if left is no tree node }
         if (p^.left^.treetype=loadn) and
          assigned(p^.left^.symtableentry) and
            (p^.left^.symtableentry^.typ=varsym) and
          (Pvarsym(p^.left^.symtableentry)^.definition^.deftype=
           procvardef) then
            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
             newreference(p^.left^.location.reference),
             p^.location.register)))
         else
           begin
            exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
             newreference(p^.left^.location.reference),R_A0)));
            exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
             R_A0,p^.location.register)));
           end;
         { for use of other segments }
         { if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
             p^.location.segment:=p^.left^.location.reference.segment;
         }
         del_reference(p^.left^.location.reference);
      end;

    { register a6 used as scratch }
    procedure seconddoubleaddr(var p : ptree);

      begin
         secondpass(p^.left);
         p^.location.loc:=LOC_REGISTER;
         del_reference(p^.left^.location.reference);
         p^.location.register:=getregister32;
         exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
          newreference(p^.left^.location.reference),R_A0)));
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
          R_A0,p^.location.register)));
      end;

    procedure secondnot(var p : ptree);

      const
         flagsinvers : array[F_E..F_BE] of tresflags =
            (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
             F_A,F_AE,F_B,F_BE);

      var
         hl : plabel;

      begin
         if (p^.resulttype^.deftype=orddef) and
            (porddef(p^.resulttype)^.typ=bool8bit) then
              begin
                 case p^.location.loc of
                    LOC_JUMP : begin
                                  hl:=truelabel;
                                  truelabel:=falselabel;
                                  falselabel:=hl;
                                  secondpass(p^.left);
                                  maketojumpbool(p^.left);
                                  hl:=truelabel;
                                  truelabel:=falselabel;
                                  falselabel:=hl;
                               end;
                    LOC_FLAGS : begin
                                   secondpass(p^.left);
                                   p^.location.resflags:=flagsinvers[p^.left^.location.resflags];
                                end;
                    LOC_REGISTER : begin
                                      secondpass(p^.left);
                                      p^.location.register:=p^.left^.location.register;
                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
                                   end;
                    LOC_CREGISTER : begin
                                       secondpass(p^.left);
                                       p^.location.loc:=LOC_REGISTER;
                                       p^.location.register:=getregister32;
                                       emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
                                         p^.location.register);
                                       exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
                                    end;
                    LOC_REFERENCE,LOC_MEM : begin
                                              secondpass(p^.left);
                                              del_reference(p^.left^.location.reference);
                                              p^.location.loc:=LOC_REGISTER;
                                              p^.location.register:=getregister32;
                                              if p^.left^.location.loc=LOC_CREGISTER then
                                                emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
                                                   p^.location.register)
                                              else
                                                exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
                                              newreference(p^.left^.location.reference),
                                                p^.location.register)));
                                              exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
                                           end;
                 end;
              end
            else
              begin
                secondpass(p^.left);
                p^.location.loc:=LOC_REGISTER;

                case p^.left^.location.loc of
                   LOC_REGISTER : begin
                                     p^.location.register:=p^.left^.location.register;
                                     exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
                                  end;
                   LOC_CREGISTER : begin
                                     p^.location.register:=getregister32;
                                     emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
                                       p^.location.register);
                                     exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
                                   end;
                   LOC_REFERENCE,LOC_MEM :
                                  begin
                                     del_reference(p^.left^.location.reference);
                                     p^.location.register:=getregister32;
                                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                                       newreference(p^.left^.location.reference),
                                       p^.location.register)));
                                     exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
                                  end;
                end;
                {if  p^.left^.location.loc=loc_register then
                  p^.location.register:=p^.left^.location.register
                else
                  begin
                     del_locref(p^.left^.location);
                     p^.location.register:=getregister32;
                     exprasmlist^.concat(new(pai68k,op_loc_reg(A_MOV,S_L,
                       p^.left^.location,
                       p^.location.register)));
                  end;
                exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));}

             end;
      end;

    procedure secondnothing(var p : ptree);

      begin
      end;

    procedure secondassignment(var p : ptree);

      var
         opsize : topsize;
         withresult : boolean;
         otlabel,hlabel,oflabel : plabel;
         hregister : tregister;
         loc : tloc;

      begin
         otlabel:=truelabel;
         oflabel:=falselabel;
         getlabel(truelabel);
         getlabel(falselabel);
         withresult:=false;
         { calculate left sides }
         secondpass(p^.left);
         case p^.left^.location.loc of
            LOC_REFERENCE : begin
                              { in case left operator uses too many registers }
                              { but to few are free then LEA                  }
                              if (p^.left^.location.reference.base<>R_NO) and
                                 (p^.left^.location.reference.index<>R_NO) and
                                 (usablereg32<p^.right^.registers32) then
                                begin
                                   del_reference(p^.left^.location.reference);
                                   hregister:=getaddressreg;
                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(
                                     p^.left^.location.reference),
                                     hregister)));
                                   clear_reference(p^.left^.location.reference);
                                   p^.left^.location.reference.base:=hregister;
                                   p^.left^.location.reference.index:=R_NO;
                                end;
                              loc:=LOC_REFERENCE;
                           end;
            LOC_CREGISTER : loc:=LOC_CREGISTER;
            else
               begin
                  Message(cg_e_illegal_expression);
                  exit;
               end;
         end;
         { lets try to optimize this (PM)             }
         { define a dest_loc that is the location      }
         { and a ptree to verify that it is the right }
         { place to insert it                         }
{$ifdef test_dest_loc}
         if (aktexprlevel<4) then
           begin
              dest_loc_known:=true;
              dest_loc:=p^.left^.location;
              dest_loc_tree:=p^.right;
           end;
{$endif test_dest_loc}

         if (p^.right^.treetype=realconstn) then
           begin
              if p^.left^.resulttype^.deftype=floatdef then
                begin
                   case pfloatdef(p^.left^.resulttype)^.typ of
                     s32real : p^.right^.realtyp:=ait_real_32bit;
                     s64real : p^.right^.realtyp:=ait_real_64bit;
                     s80real : p^.right^.realtyp:=ait_real_extended;
                     { what about f32bit and s64bit }
                     end;
                end;
           end;
         secondpass(p^.right);
{$ifdef test_dest_loc}
         dest_loc_known:=false;
         if in_dest_loc then
           begin
              truelabel:=otlabel;
              falselabel:=oflabel;
              in_dest_loc:=false;
              exit;
           end;
{$endif test_dest_loc}
         if p^.left^.resulttype^.deftype=stringdef then
           begin
             { we do not need destination anymore }
             del_reference(p^.left^.location.reference);
             { only source if withresult is set }
             if not(withresult) then
               del_reference(p^.right^.location.reference);
             loadstring(p);
             ungetiftemp(p^.right^.location.reference);
           end
         else case p^.right^.location.loc of
            LOC_REFERENCE,
            LOC_MEM : begin
                         { handle ordinal constants trimmed }
                         if (p^.right^.treetype in [ordconstn,fixconstn]) or
                            (loc=LOC_CREGISTER) then
                           begin
                              case p^.left^.resulttype^.size of
                                 1 : opsize:=S_B;
                                 2 : opsize:=S_W;
                                 4 : opsize:=S_L;
                              end;
                              if loc=LOC_CREGISTER then
                                exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
                                  newreference(p^.right^.location.reference),
                                  p^.left^.location.register)))
                              else
                                exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,opsize,
                                  p^.right^.location.reference.offset,
                                  newreference(p^.left^.location.reference))));
                              {exprasmlist^.concat(new(pai68k,op_const_loc(A_MOV,opsize,
                                  p^.right^.location.reference.offset,
                                  p^.left^.location)));}
                           end
                         else
                           begin
                              concatcopy(p^.right^.location.reference,
                                p^.left^.location.reference,p^.left^.resulttype^.size,
                                withresult);
                              ungetiftemp(p^.right^.location.reference);
                           end;
                      end;
            LOC_REGISTER,
            LOC_CREGISTER : begin
                              case p^.right^.resulttype^.size of
                                 1 : opsize:=S_B;
                                 2 : opsize:=S_W;
                                 4 : opsize:=S_L;
                              end;
                              { simplified with op_reg_loc         }
                              if loc=LOC_CREGISTER then
                                exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,opsize,
                                  p^.right^.location.register,
                                  p^.left^.location.register)))
                              else
                                exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,opsize,
                                  p^.right^.location.register,
                                  newreference(p^.left^.location.reference))));
                              {exprasmlist^.concat(new(pai68k,op_reg_loc(A_MOV,opsize,
                                  p^.right^.location.register,
                                  p^.left^.location)));             }

                           end;
            LOC_FPU : begin
                              if loc<>LOC_REFERENCE then
                                internalerror(10010)
                              else
                                floatstore(pfloatdef(p^.left^.resulttype)^.typ,
                                  p^.right^.location,p^.left^.location.reference);
                      end;
            LOC_JUMP     : begin
                              getlabel(hlabel);
                              emitl(A_LABEL,truelabel);
                              if loc=LOC_CREGISTER then
                                exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,
                                  1,p^.left^.location.register)))
                              else
                                exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,
                                  1,newreference(p^.left^.location.reference))));
                              {exprasmlist^.concat(new(pai68k,op_const_loc(A_MOV,S_B,
                                  1,p^.left^.location)));}
                              emitl(A_JMP,hlabel);
                              emitl(A_LABEL,falselabel);
                              if loc=LOC_CREGISTER then
                                exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,
                                  p^.left^.location.register)))
                              else
                                exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,
                                  0,newreference(p^.left^.location.reference))));
                              emitl(A_LABEL,hlabel);
                           end;
            LOC_FLAGS    : begin
                              if loc=LOC_CREGISTER then
                               begin
                                exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,
                                  p^.left^.location.register)));
                                exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_B,p^.left^.location.register)));
                               end
                              else
                               begin
                                 exprasmlist^.concat(new(pai68k,op_ref(flag_2_set[p^.right^.location.resflags],S_B,
                                    newreference(p^.left^.location.reference))));
                                 exprasmlist^.concat(new(pai68k,op_ref(A_NEG,S_B,newreference(p^.left^.location.reference))));
                               end;

                           end;
         end;
         truelabel:=otlabel;
         falselabel:=oflabel;
      end;

    procedure secondderef(var p : ptree);

      var
         hr : tregister;

      begin
         secondpass(p^.left);
         clear_reference(p^.location.reference);
         case p^.left^.location.loc of
            LOC_REGISTER : Begin
                             hr := getaddressreg;
                             emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
                             p^.location.reference.base:=hr;
                             ungetregister(p^.left^.location.register);
                           end;
            LOC_CREGISTER : begin
                               { ... and reserve one for the pointer }
                               hr:=getaddressreg;
                               emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
                                      p^.location.reference.base:=hr;
                               { LOC_REGISTER indicates that this is a
                               variable register which should not be freed. }
{                               ungetregister(p^.left^.location.register); }
                            end;
            else
              begin
                 { free register }
                 del_reference(p^.left^.location.reference);

                 { ...and reserve one for the pointer }
                 hr:=getaddressreg;
                 exprasmlist^.concat(new(pai68k,op_ref_reg(
                   A_MOVE,S_L,newreference(p^.left^.location.reference),
                   hr)));
                 p^.location.reference.base:=hr;
              end;
         end;
      end;

    { used D0, D1 as scratch (ok) }
    { arrays ...                  }
    { Sets up the array and string }
    { references .                 }
    procedure secondvecn(var p : ptree);

      var
         pushed : boolean;
         ind : tregister;
         _p : ptree;

      procedure calc_emit_mul;

        var
           l1,l2 : longint;

        begin
           l1:=p^.resulttype^.size;
           case l1 of
              1     : p^.location.reference.scalefactor:=l1;
              2 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,ind)));
              4 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,ind)));
              8 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,ind)));
           else
             begin
               if ispowerof2(l1,l2) then
                 exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,l2,ind)))
                   else
                 begin
                   { use normal MC68000 signed multiply }
                   if (l1 >= -32768) and (l1 <= 32767) then
                     exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_W,l1,ind)))
                   else
                   { use long MC68020 long multiply }
                   if (aktoptprocessor = MC68020) then
                     exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,l1,ind)))
                   else
                   { MC68000 long multiply }
                     begin
                       exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,l1,R_D0)));
                       exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,ind,R_D1)));
                       emitcall('LONGMUL',true);
                       exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,ind)));
                     end;
                 end;
             end; { else case }
            end; { end case }
        end; { calc_emit_mul }

      var
       extraoffset : longint;
         t : ptree;
         hp : preference;
         tai:pai68k;
       reg: tregister;

      begin
         secondpass(p^.left);
         { RESULT IS IN p^.location.reference }
         set_location(p^.location,p^.left^.location);

         { offset can only differ from 0 if arraydef }
         if p^.left^.resulttype^.deftype=arraydef then
           dec(p^.location.reference.offset,
             p^.resulttype^.size*
             parraydef(p^.left^.resulttype)^.lowrange);

         if p^.right^.treetype=ordconstn then
           begin
              { offset can only differ from 0 if arraydef }
              if (p^.left^.resulttype^.deftype=arraydef) then
              begin
                   if not(is_open_array(p^.left^.resulttype)) then
                       begin
                     if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
                        (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
                        Message(parser_e_range_check_error);

                     dec(p^.left^.location.reference.offset,
                        p^.resulttype^.size*parraydef(p^.left^.resulttype)^.lowrange);
                    end
                   else
                     begin
                        { range checking for open arrays }
                     end;
                  end;
              inc(p^.left^.location.reference.offset,
                 p^.right^.value*p^.resulttype^.size);
              p^.left^.resulttype:=p^.resulttype;
              disposetree(p^.right);
              _p:=p^.left;
              putnode(p);
              p:=_p;
           end
         else
           begin
              { quick hack, to overcome Delphi 2 }
              if (cs_maxoptimize in aktglobalswitches) and
                (p^.left^.resulttype^.deftype=arraydef) then
                begin
                   extraoffset:=0;
                   if (p^.right^.treetype=addn) then
                     begin
                        if p^.right^.right^.treetype=ordconstn then
                          begin
                             extraoffset:=p^.right^.right^.value;
                             t:=p^.right^.left;
                             putnode(p^.right);
                             putnode(p^.right^.right);
                             p^.right:=t
                          end
                        else if p^.right^.left^.treetype=ordconstn then
                          begin
                             extraoffset:=p^.right^.left^.value;
                             t:=p^.right^.right;
                                    putnode(p^.right);
                             putnode(p^.right^.left);
                             p^.right:=t
                          end;
                     end
                   else if (p^.right^.treetype=subn) then
                     begin
                              if p^.right^.right^.treetype=ordconstn then
                          begin
                             extraoffset:=p^.right^.right^.value;
                             t:=p^.right^.left;
                             putnode(p^.right);
                             putnode(p^.right^.right);
                             p^.right:=t
                          end
                        else if p^.right^.left^.treetype=ordconstn then
                          begin
                             extraoffset:=p^.right^.left^.value;
                                    t:=p^.right^.right;
                             putnode(p^.right);
                             putnode(p^.right^.left);
                             p^.right:=t
                          end;
                     end;
                   inc(p^.location.reference.offset,
                     p^.resulttype^.size*extraoffset);
                end;
              { calculate from left to right }
              if (p^.location.loc<>LOC_REFERENCE) and
                 (p^.location.loc<>LOC_MEM) then
                Message(cg_e_illegal_expression);

              pushed:=maybe_push(p^.right^.registers32,p);
              secondpass(p^.right);
              if pushed then restore(p);
                 case p^.right^.location.loc of
                LOC_REGISTER : begin
                                 ind:=p^.right^.location.register;
                                 case p^.right^.resulttype^.size of
                                 1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
                                      $ff,ind)));
                                 2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
                                      $ffff,ind)));
                                 end;
                               end;

                LOC_CREGISTER : begin
                                       ind:=getregister32;
                                   emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,ind);
                                   case p^.right^.resulttype^.size of
                                   1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
                                      $ff,ind)));
                                   2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
                                      $ffff,ind)));
                                end;
                                end;
                   LOC_FLAGS:
                     begin
                        ind:=getregister32;
                        exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,ind)));
                        exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,ind)));
                     end
                else { else outer case }
                   begin
                      del_reference(p^.right^.location.reference);
                           ind:=getregister32;

                      exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                        newreference(p^.right^.location.reference),ind)));

                           {Booleans are stored in an 8 bit memory location, so
                           the use of MOVL is not correct.}
                      case p^.right^.resulttype^.size of
                        1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
                          $ff,ind)));
                        2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
                          $ffff,ind)));
                      end; { end case }
                      end; { end else begin }
              end;

              { produce possible range check code: }
              if cs_check_range in aktlocalswitches  then
                begin
                   if p^.left^.resulttype^.deftype=arraydef then
                     begin
                        new(hp);
                        reset_reference(hp^);
                        parraydef(p^.left^.resulttype)^.genrangecheck;
                        hp^.symbol:=stringdup('R_'+tostr(parraydef(p^.left^.resulttype)^.rangenr));
                        emit_bounds_check(hp^,ind);
                     end;
                end;

           { ------------------------ HANDLE INDEXING ----------------------- }
           { In Motorola 680x0 mode, displacement can only be of 64K max.     }
           { Therefore instead of doing a direct displacement, we must first  }
           { load the new address into an address register. Therefore the     }
           { symbol is not used.                                              }
           if assigned(p^.location.reference.symbol) then
           begin
              if p^.location.reference.base <> R_NO then
               Message(cg_f_secondvecn_base_defined_twice);
              p^.location.reference.base:=getaddressreg;
              exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,S_L,newcsymbol(p^.location.reference.symbol^,0),
                p^.location.reference.base)));
              stringdispose(p^.location.reference.symbol);
           end;

              if (p^.location.reference.index=R_NO) then
                begin
                   p^.location.reference.index:=ind;
                   calc_emit_mul;
               { here we must check for the offset      }
               { and if out of bounds for the motorola  }
               { eg: out of signed d8 then reload index }
               { with correct value.                    }
               if p^.location.reference.offset > 127 then
               begin
                  exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,p^.location.reference.offset,ind)));
                  p^.location.reference.offset := 0;
               end
               else
               if p^.location.reference.offset < -128 then
               begin
                  exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,S_L,-p^.location.reference.offset,ind)));
                  p^.location.reference.offset := 0;
               end;
                end
              else
                begin
                   if p^.location.reference.base=R_NO then
                      begin
                          case p^.location.reference.scalefactor of
                       2 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,p^.location.reference.index)));
                       4 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,p^.location.reference.index)));
                       8 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,p^.location.reference.index)));
                       end;
                          calc_emit_mul;

                    { we must use address register to put index in base }
                    { compare with cgi386.pas                           }

                    reg := getaddressreg;
                    p^.location.reference.base := reg;

                    emit_reg_reg(A_MOVE,S_L,p^.location.reference.index,reg);
                    ungetregister(p^.location.reference.index);

                    p^.location.reference.index:=ind;
                 end
               else
                 begin
                    reg := getaddressreg;
                    exprasmlist^.concat(new(pai68k,op_ref_reg(
                      A_LEA,S_L,newreference(p^.location.reference),
                      reg)));

                    ungetregister(p^.location.reference.base);
                    { the symbol offset is loaded,               }
                    { so release the symbol name and set symbol  }
                    { to nil                                     }
                    stringdispose(p^.location.reference.symbol);
                    p^.location.reference.offset:=0;
                    calc_emit_mul;
                    p^.location.reference.base:=reg;
                    ungetregister32(p^.location.reference.index);
                    p^.location.reference.index:=ind;
                 end;
               end;
           end;
      end;

    { *************** Converting Types **************** }

    { produces if necessary rangecheckcode }

    procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);

      var
         hp : preference;
       hregister : tregister;
       neglabel,poslabel : plabel;

      begin
         { convert from p2 to p1 }
         { range check from enums is not made yet !!}
         { and its probably not easy }
         if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
           exit;
           { range checking is different for u32bit }
           { lets try to generate it allways }
           if (cs_check_range in aktlocalswitches)  and
             { with $R+ explicit type conversations in TP aren't range checked! }
             (not(p^.explizit) or not(cs_tp_compatible in aktmoduleswitches)) and
             ((porddef(p1)^.low>porddef(p2)^.low) or
             (porddef(p1)^.high<porddef(p2)^.high) or
             (porddef(p1)^.typ=u32bit) or
             (porddef(p2)^.typ=u32bit)) then
           begin
              porddef(p1)^.genrangecheck;
              if porddef(p2)^.typ=u8bit then
                begin
                   if (p^.location.loc=LOC_REGISTER) or
                      (p^.location.loc=LOC_CREGISTER) then
                     begin
                         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
                         exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FF,R_D6)));
                     end
                   else
                     begin
                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
                         exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FF,R_D6)));
                     end;
                   hregister:=R_D6;
                end
              else if porddef(p2)^.typ=s8bit then
                begin
                   if (p^.location.loc=LOC_REGISTER) or
                      (p^.location.loc=LOC_CREGISTER) then
                     begin
                         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
                         { byte to long }
                         if aktoptprocessor = MC68020 then
                             exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
                         else
                           begin
                             exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,R_D6)));
                             exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
                           end;
                     end
                   else
                     begin
                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
                         { byte to long }
                         if aktoptprocessor = MC68020 then
                             exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
                         else
                           begin
                             exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,R_D6)));
                             exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
                           end;
                     end; { end outermost else }
                   hregister:=R_D6;
                end
               { rangechecking for u32bit ?? !!!!!!}
               { lets try }
               else if (porddef(p2)^.typ=s32bit) or (porddef(p2)^.typ=u32bit)  then
                begin
                   if (p^.location.loc=LOC_REGISTER) or
                      (p^.location.loc=LOC_CREGISTER) then
                     hregister:=p^.location.register
                   else
                     begin
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),R_D6)));
                        hregister:=R_D6;
                     end;
                end
              { rangechecking for u32bit ?? !!!!!!}
              else if porddef(p2)^.typ=u16bit then
                begin
                   if (p^.location.loc=LOC_REGISTER) or
                      (p^.location.loc=LOC_CREGISTER) then
                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,R_D6)))
                   else
                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),R_D6)));
                   { unisgned extend }
                   exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FFFF,R_D6)));
                   hregister:=R_D6;
                end
              else if porddef(p2)^.typ=s16bit then
                begin
                   if (p^.location.loc=LOC_REGISTER) or
                      (p^.location.loc=LOC_CREGISTER) then
                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,R_D6)))
                   else
                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),R_D6)));
                   { sign extend }
                   exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
                   hregister:=R_D6;
                end
              else internalerror(6);
              new(hp);
              reset_reference(hp^);
              hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
              if porddef(p1)^.low>porddef(p1)^.high then
                begin
                   getlabel(neglabel);
                   getlabel(poslabel);
                   exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,hregister)));
                   emitl(A_BLT,neglabel);
                end;
              emit_bounds_check(hp^,hregister);
              if porddef(p1)^.low>porddef(p1)^.high then
                begin
                   new(hp);
                   reset_reference(hp^);
                   hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr+1));
                   emitl(A_JMP,poslabel);
                   emitl(A_LABEL,neglabel);
                   emit_bounds_check(hp^,hregister);
                   emitl(A_LABEL,poslabel);
                end;
           end;
      end;

    type
       tsecondconvproc = procedure(p,hp : ptree;convtyp : tconverttype);

     procedure second_nothing(p,hp : ptree;convtyp : tconverttype);

       begin
       end;



    procedure second_only_rangecheck(p,hp : ptree;convtyp : tconverttype);

      begin
         maybe_rangechecking(p,hp^.resulttype,p^.resulttype);
      end;

    procedure second_bigger(p,hp : ptree;convtyp : tconverttype);

      var
         hregister : tregister;
         opsize : topsize;
         op : tasmop;
         is_register : boolean;

      begin
         is_register:=p^.left^.location.loc=LOC_REGISTER;
           if not(is_register) and (p^.left^.location.loc<>LOC_CREGISTER) then
             begin
                del_reference(p^.left^.location.reference);
                { we can do this here as we need no temp inside second_bigger }
                ungetiftemp(p^.left^.location.reference);
             end;
         { this is wrong !!!
         gives me movl (%eax),%eax
         for the length(string !!!
         use only for constant values }
         {Constanst cannot be loaded into registers using MOVZX!}
         if (p^.left^.location.loc<>LOC_MEM) or (not p^.left^.location.reference.isintvalue) then
             case convtyp of
                     tc_u8bit_2_s32bit,
                tc_u8bit_2_u32bit,
                tc_s8bit_2_u32bit,
                tc_s8bit_2_s16bit,
                tc_s8bit_2_s32bit,
                tc_u8bit_2_u16bit,
                tc_s8bit_2_u16bit,
                tc_u8bit_2_s16bit: begin
                                    if is_register then
                                      hregister := p^.left^.location.register
                                    else
                                      hregister := getregister32;
                                    if is_register then
                                      emit_reg_reg(A_MOVE,S_B,p^.left^.location.register, hregister)
                                    else
                                    begin
                                      if p^.left^.location.loc = LOC_CREGISTER then
                                        emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,hregister)
                                      else
                                        exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_B,
                                         newreference(P^.left^.location.reference), hregister)));
                                    end;

                                    case convtyp of
                                      tc_u8bit_2_s32bit,
                                      tc_u8bit_2_u32bit:
                                                   exprasmlist^.concat(new(pai68k, op_const_reg(
                                                   A_AND,S_L,$FF,hregister)));
                                      tc_s8bit_2_u32bit,
                                      tc_s8bit_2_s32bit:
                                                  begin
                                                    if aktoptprocessor = MC68020 then
                                                      exprasmlist^.concat(new(pai68k,op_reg
                                                        (A_EXTB,S_L,hregister)))
                                                    else { else if aktoptprocessor }
                                                    begin
                                                    { byte to word }
                                                      exprasmlist^.concat(new(pai68k,op_reg
                                                        (A_EXT,S_W,hregister)));
                                                    { word to long }
                                                      exprasmlist^.concat(new(pai68k,op_reg
                                                        (A_EXT,S_L,hregister)));
                                                    end;
                                                  end;
                                      tc_s8bit_2_u16bit,
                                      tc_u8bit_2_s16bit,
                                      tc_u8bit_2_u16bit:
                                                  exprasmlist^.concat(new(pai68k, op_const_reg(
                                                                A_AND,S_W,$FF,hregister)));

                                      tc_s8bit_2_s16bit:
                                                  exprasmlist^.concat(new(pai68k, op_reg(
                                                                A_EXT, S_W, hregister)));

                                    end; { inner case }
                                   end;
                tc_u16bit_2_u32bit,
                tc_u16bit_2_s32bit,
                tc_s16bit_2_u32bit,
                tc_s16bit_2_s32bit: begin
                                     if is_register then
                                       hregister := p^.left^.location.register
                                     else
                                       hregister := getregister32;
                                     if is_register then
                                       emit_reg_reg(A_MOVE,S_W,p^.left^.location.register, hregister)
                                     else
                                     begin
                                       if p^.left^.location.loc = LOC_CREGISTER then
                                         emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,hregister)
                                       else
                                         exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_W,
                                           newreference(P^.left^.location.reference), hregister)));
                                     end;
                                     if (convtyp = tc_u16bit_2_s32bit) or
                                        (convtyp = tc_u16bit_2_u32bit) then
                                         exprasmlist^.concat(new(pai68k, op_const_reg(
                                           A_AND, S_L, $ffff, hregister)))
                                     else { tc_s16bit_2_s32bit }
                                          { tc_s16bit_2_u32bit }
                                         exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_L,
                                           hregister)));
                                    end;
             end { end case }
         else
         begin
             case convtyp of
                tc_u8bit_2_s32bit,
                tc_s8bit_2_s32bit,
                tc_u16bit_2_s32bit,
                tc_s16bit_2_s32bit,
            tc_u8bit_2_u32bit,
            tc_s8bit_2_u32bit,
            tc_u16bit_2_u32bit,
            tc_s16bit_2_u32bit:

                    begin
                        hregister:=getregister32;
                        op:=A_MOVE;
                        opsize:=S_L;
                    end;
                tc_s8bit_2_u16bit,
                tc_s8bit_2_s16bit,
                tc_u8bit_2_s16bit,
                tc_u8bit_2_u16bit:
                    begin
                        hregister:=getregister32;
                        op:=A_MOVE;
                        opsize:=S_W;
                    end;
             end;
            if is_register then
              begin
                emit_reg_reg(op,opsize,p^.left^.location.register,hregister);
              end
            else
              begin
                 if p^.left^.location.loc=LOC_CREGISTER then
                     emit_reg_reg(op,opsize,p^.left^.location.register,hregister)
                 else exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,
                     newreference(p^.left^.location.reference),hregister)));
              end;
         end; { end elseif }

         p^.location.loc:=LOC_REGISTER;
         p^.location.register:=hregister;
         maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
      end;



    procedure second_string_string(p,hp : ptree;convtyp : tconverttype);

      var
         pushedregs : tpushed;

      begin
         stringdispose(p^.location.reference.symbol);
         gettempofsizereference(p^.resulttype^.size,p^.location.reference);
         del_reference(p^.left^.location.reference);
         copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
         ungetiftemp(p^.left^.location.reference);
      end;

    procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);

      begin
         p^.location.loc:=LOC_REGISTER;
         p^.location.register:=getregister32;
         inc(p^.left^.location.reference.offset);
         exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
           R_A0)));
         emit_reg_reg(A_MOVE, S_L, R_A0, p^.location.register);
      end;

    procedure second_cchar_charpointer(p,hp : ptree;convtyp : tconverttype);

      begin
         {!!!!}
         p^.location.loc:=LOC_REGISTER;
         p^.location.register:=getregister32;
         inc(p^.left^.location.reference.offset);
         exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
           R_A0)));
         emit_reg_reg(A_MOVE, S_L, R_A0, p^.location.register);
      end;

    procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);

      begin
         inc(p^.location.reference.offset);
      end;

    procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);

      begin
         del_reference(p^.left^.location.reference);
         p^.location.loc:=LOC_REGISTER;
         p^.location.register:=getregister32;
         exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
           R_A0)));
         emit_reg_reg(A_MOVE,S_L,R_A0, P^.location.register);
      end;

    procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);

      var
       reg: tregister;
      begin
         p^.location.loc:=LOC_REFERENCE;
         clear_reference(p^.location.reference);
         { here, after doing some arithmetic on the pointer }
         { we put it back in an address register            }
         if p^.left^.location.loc=LOC_REGISTER then
         begin
           reg := getaddressreg;
           { move the pointer in a data register back into }
           { an address register.                          }
           emit_reg_reg(A_MOVE, S_L, p^.left^.location.register,reg);

           p^.location.reference.base:=reg;
           ungetregister32(p^.left^.location.register);
         end
         else
           begin
              if p^.left^.location.loc=LOC_CREGISTER then
                begin
                   p^.location.reference.base:=getaddressreg;
                   emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
                     p^.location.reference.base);
                end
              else
                begin
                   del_reference(p^.left^.location.reference);
                   p^.location.reference.base:=getaddressreg;
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
                     p^.location.reference.base)));
                end;
           end;
      end;

    { generates the code for the type conversion from an array of char }
    { to a string                                                        }
    procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);

      var
         l : longint;

      begin
         { this is a type conversion which copies the data, so we can't }
         { return a reference                                             }
         p^.location.loc:=LOC_MEM;

         { first get the memory for the string }
         stringdispose(p^.location.reference.symbol);
         gettempofsizereference(256,p^.location.reference);

         { calc the length of the array }
         l:=parraydef(p^.left^.resulttype)^.highrange-
           parraydef(p^.left^.resulttype)^.lowrange+1;

         if l>255 then
           Message(sym_e_type_mismatch);

         { write the length }
           exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,l,
             newreference(p^.location.reference))));

         { copy to first char of string }
         inc(p^.location.reference.offset);

         { generates the copy code      }
         { and we need the source never }
         concatcopy(p^.left^.location.reference,p^.location.reference,l,true);

         { correct the string location }
         dec(p^.location.reference.offset);
      end;


(*    procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);

      begin
         stringdispose(p^.location.reference.symbol);
         gettempofsizereference(256,p^.location.reference);
         { is it a char const ? }
         if p^.left^.treetype=ordconstn then
           exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_W,p^.left^.value*256+1,newreference(p^.location.reference))))
         else
           begin
              { not so elegant (goes better with extra register     }
              { Here the conversion is done in one shot             }
              { i.e we convert to a string with a single word which }
              { will be stored, the length followed by the char     }
              { This is of course, endian specific.                 }
              if (p^.left^.location.loc=LOC_REGISTER) or
                 (p^.left^.location.loc=LOC_CREGISTER) then
                begin
                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.left^.location.register,R_D6)));
                   exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_W, $FF, R_D6)));
                   ungetregister32(p^.left^.location.register);
                end
              else
                begin
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.left^.location.reference),R_D6)));
                   exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_W, $FF, R_D6)));
                   del_reference(p^.left^.location.reference);
                end;
              if (aktoptprocessor = MC68020) then
              { alignment is not a problem on the 68020 and higher processors }
                Begin
                  { add length of string to word }
                  exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_W,$0100,R_D6)));
                  { put back into mem ...        }
                  exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_W,R_D6,newreference(p^.location.reference))));
                end
              else
                Begin
                 { alignment can cause problems }
                  { add length of string to ref }
                  exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,1,newreference(p^.location.reference))));
                  if abs(p^.location.reference.offset) >= 1 then
                    Begin
                      { temporarily decrease offset }
                      Inc(p^.location.reference.offset);
                      exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_B,R_D6,newreference(p^.location.reference))));
                      Dec(p^.location.reference.offset);
                      { restore offset }
                    end
                  else
                   Begin
                     Comment(V_Debug,'SecondChar2String() internal error.');
                     internalerror(34);
                  end;
                end;
           end;
      end;*)

    procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);

      begin
         stringdispose(p^.location.reference.symbol);
         gettempofsizereference(256,p^.location.reference);
      { call loadstring with correct left and right }
         p^.right:=p^.left;
         p^.left:=p;
         loadstring(p);
         p^.left:=nil; { reset left tree, which is empty }
      end;




    procedure second_int_real(p,hp : ptree;convtyp : tconverttype);

      var
         r : preference;
        reg:tregister;
      begin
        emitloadord2reg(p^.left^.location, porddef(p^.left^.resulttype), R_D6, true);
        ungetiftemp(p^.left^.location.reference);
        if porddef(p^.left^.resulttype)^.typ=u32bit then
           push_int(0);

        emit_reg_reg(A_MOVE, S_L, R_D6, R_SPPUSH);
        new(r);
        reset_reference(r^);
        r^.base := R_SP;
        { no emulation }
{           for u32bit a solution would be to push $0 and to load a
+          comp
+           if porddef(p^.left^.resulttype)^.typ=u32bit then
+             exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IQ,r)))
+           else}
          p^.location.loc := LOC_FPU;
          { get floating point register. }
          if (cs_fp_emulation in aktmoduleswitches) then
          begin
            p^.location.fpureg := getregister32;
            exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L, r, R_D0)));
            emitcall('LONG2SINGLE',true);
            emit_reg_reg(A_MOVE,S_L,R_D0,p^.location.fpureg);
          end
          else
          begin
            p^.location.fpureg := getfloatreg;
            exprasmlist^.concat(new(pai68k, op_ref_reg(A_FMOVE, S_L, r, p^.location.fpureg)))
          end;
        if porddef(p^.left^.resulttype)^.typ=u32bit then
           exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,8,R_SP)))
        else
        { restore the stack to the previous address }
           exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L, 4, R_SP)));
      end;


    procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);

      var
         {hs : string;}
         rreg : tregister;
         ref : treference;

      begin
         rreg:=getregister32;
         { Are we in a LOC_FPU, if not then use scratch registers }
         { instead of allocating reserved registers.              }
         if (p^.left^.location.loc<>LOC_FPU) then
         begin
           if (cs_fp_emulation in aktmoduleswitches) then
           begin
             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),R_D0)));
             exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
             emitcall('LONGMUL',true);
             emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
           end
           else
           begin
             exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,S_L,newreference(p^.left^.location.reference),R_FP0)));
             exprasmlist^.concat(new(pai68k,op_const_reg(A_FMUL,S_L,65536,R_FP0)));
             exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_L,R_FP0,rreg)));
           end;
         end
         else
         begin
           if (cs_fp_emulation in aktmoduleswitches) then
           begin
             exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)));
             exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
             emitcall('LONGMUL',true);
             emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
           end
           else
           begin
             exprasmlist^.concat(new(pai68k,op_const_reg(A_FMUL,S_L,65536,p^.left^.location.fpureg)));
             exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_L,p^.left^.location.fpureg,rreg)));
           end;
         end;
         p^.location.loc:=LOC_REGISTER;
         p^.location.register:=rreg;
      end;


    procedure second_float_float(p,hp : ptree;convtyp : tconverttype);

      begin
         case p^.left^.location.loc of
            LOC_FPU :  begin
                         { reload }
                         p^.location.loc := LOC_FPU;
                         p^.location.fpureg := p^.left^.location.fpureg;
                       end;
            LOC_MEM,
            LOC_REFERENCE : floatload(pfloatdef(p^.left^.resulttype)^.typ,
                              p^.left^.location.reference,p^.location);
         end;
{ ALREADY HANDLED BY FLOATLOAD      }
{         p^.location.loc:=LOC_FPU; }
      end;

    procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);

    var
        startreg : tregister;
        hl : plabel;
        r : treference;
        reg1: tregister;
        hl1,hl2,hl3,hl4,hl5,hl6,hl7,hl8,hl9: plabel;
      begin
         if (p^.left^.location.loc=LOC_REGISTER) or
            (p^.left^.location.loc=LOC_CREGISTER) then
           begin
              startreg:=p^.left^.location.register;
              ungetregister(startreg);
              { move d0,d0 is removed by emit_reg_reg }
              emit_reg_reg(A_MOVE,S_L,startreg,R_D0);
           end
         else
           begin
              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
                p^.left^.location.reference),R_D0)));
              del_reference(p^.left^.location.reference);
              startreg:=R_NO;
           end;

         reg1 := getregister32;

         { Motorola 68000 equivalent of CDQ     }
         { we choose d1:d0 pair for quad word   }
         exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,R_D0)));
         getlabel(hl1);
         emitl(A_BPL,hl1);
         { we copy all bits (-ve number) }
         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,$ffffffff,R_D1)));
         getlabel(hl2);
         emitl(A_BRA,hl2);
         emitl(A_LABEL,hl1);
         exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_D0)));
         emitl(A_LABEL,hl2);
         { end CDQ }

         exprasmlist^.concat(new(pai68k,op_reg_reg(A_EOR,S_L,R_D1,R_D0)));
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,reg1)));
         getlabel(hl3);
         emitl(A_BEQ,hl3);

         { Motorola 68000 equivalent of RCL    }
         getlabel(hl4);
         emitl(A_BCC,hl4);
         exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,reg1)));
         exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_L,1,reg1)));
         getlabel(hl5);
         emitl(A_BRA,hl5);
         emitl(A_LABEL,hl4);
         exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,reg1)));
         emitl(A_LABEL,hl5);
         { end RCL }

         { Motorola 68000 equivalent of BSR }
         { save register }
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_D6)));
         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,31,R_D0)));
         getlabel(hl6);
         emitl(A_LABEL,hl6);
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,R_D0,R_D1)));
         getlabel(hl7);
         emitl(A_BNE,hl7);
         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D0)));
         emitl(A_BPL,hl6);
         { restore register }
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D6,R_D0)));
         emitl(A_LABEL,hl7);
         { end BSR }

         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,32,R_D6)));
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_SUB,S_B,R_D1,R_D6)));
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSL,S_L,R_D6,R_D0)));
         exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_W,1007,R_D1)));
         exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,5,R_D1)));

         { Motorola 68000 equivalent of SHLD }
         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,11,R_D6)));
         { save register }
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D1,R_A0)));
         getlabel(hl8);
         emitl(A_LABEL,hl8);
         exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,R_D1)));
         exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,reg1)));
         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D6)));
         emitl(A_BNE,hl8);
         { restore register }
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_D1)));
         { end Motorola equivalent of SHLD }

         { Motorola 68000 equivalent of SHLD }
         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,20,R_D6)));
         { save register }
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_A0)));
         getlabel(hl9);
         emitl(A_LABEL,hl9);
         exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,R_D0)));
         exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,reg1)));
         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D6)));
         emitl(A_BNE,hl9);
         { restore register }
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_D0)));
         { end Motorola equivalent of SHLD }

         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,20,R_D6)));
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_SUB,S_L,R_D6,R_D0)));
         emitl(A_LABEL, hl3);

         { create temp values and put on stack }
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,reg1,R_SPPUSH)));
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_SPPUSH)));


         reset_reference(r);
         r.base:=R_SP;

         if (cs_fp_emulation in aktmoduleswitches) then
         begin
           p^.location.loc:=LOC_FPU;
           p^.location.fpureg := getregister32;
           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r),
             p^.left^.location.fpureg)))
         end
         else
         begin
           p^.location.loc:=LOC_FPU;
           p^.location.fpureg := getfloatreg;
           exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,S_L,newreference(r),
               p^.left^.location.fpureg)))
         end;
         { clear temporary space }
         exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,8,R_SP)));
         ungetregister32(reg1);
{ Alreadu handled above...          }
{         p^.location.loc:=LOC_FPU; }
      end;

    procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);

      var
         {hs : string;}
         hregister : tregister;

      begin
         if (p^.left^.location.loc=LOC_REGISTER) then
           hregister:=p^.left^.location.register
         else if (p^.left^.location.loc=LOC_CREGISTER) then
           hregister:=getregister32
         else
           begin
              del_reference(p^.left^.location.reference);
              hregister:=getregister32;
              case porddef(p^.left^.resulttype)^.typ of
                s8bit : begin
                           exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_B,
                              newreference(p^.left^.location.reference),hregister)));
                           if aktoptprocessor = MC68020 then
                              exprasmlist^.concat(new(pai68k, op_reg(A_EXTB,S_L,hregister)))
                           else
                            begin
                              exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_W,hregister)));
                              exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_L,hregister)));
                            end;
                        end;
                u8bit : begin
                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.left^.location.reference),
                            hregister)));
                          exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
                        end;
                s16bit :begin
                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.left^.location.reference),
                           hregister)));
                          exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,hregister)));
                        end;
                u16bit : begin
                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.left^.location.reference),
                               hregister)));
                            exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
                         end;
                s32bit,u32bit : exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
                  hregister)));
                {!!!! u32bit }
              end;
           end;
         exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ,S_L,16,R_D1)));
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSL,S_L,R_D1,hregister)));

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

    procedure second_smaller(p,hp : ptree;convtyp : tconverttype);

      var
         hregister,destregister : tregister;
         {opsize : topsize;}
         ref : boolean;
         hpp : preference;

      begin
         { !!!!!!!! Rangechecking }
         ref:=false;
         { problems with enums !! }
           { with $R+ explicit type conversations in TP aren't range checked! }
         if (p^.resulttype^.deftype=orddef) and
           (hp^.resulttype^.deftype=orddef) and
           ((porddef(p^.resulttype)^.low>porddef(hp^.resulttype)^.low) or
           (porddef(p^.resulttype)^.high<porddef(hp^.resulttype)^.high)) then
           begin
              if (cs_check_range in aktlocalswitches) and
                 (not(p^.explizit) or not(cs_tp_compatible in aktmoduleswitches)) then
              porddef(p^.resulttype)^.genrangecheck;
              if porddef(hp^.resulttype)^.typ=s32bit then
                begin
                   if (p^.location.loc=LOC_REGISTER) or
                      (p^.location.loc=LOC_CREGISTER) then
                     hregister:=p^.location.register
                   else
                     begin
                        hregister:=getregister32;
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),hregister)));
                     end;
                end
              { rangechecking for u32bit ?? !!!!!!}
              else if porddef(hp^.resulttype)^.typ=u16bit then
                begin
                   hregister:=getregister32;
                   if (p^.location.loc=LOC_REGISTER) or
                      (p^.location.loc=LOC_CREGISTER) then
                   begin
                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,hregister)));
                   end
                   else
                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),hregister)));
                   { clear unused bits  i.e unsigned extend}
                   exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L, $FFFF, hregister)));
                end
              else if porddef(hp^.resulttype)^.typ=s16bit then
                begin
                   hregister:=getregister32;
                   if (p^.location.loc=LOC_REGISTER) or
                      (p^.location.loc=LOC_CREGISTER) then
                     exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,hregister)))
                   else
                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),hregister)));
                   { sign extend }
                   exprasmlist^.concat(new(pai68k,op_reg(A_EXT, S_L, hregister)));
                end
              else internalerror(6);

              if (cs_check_range in aktlocalswitches) and
                 (not(p^.explizit) or not(cs_tp_compatible in aktmoduleswitches)) then
              Begin
              new(hpp);
              reset_reference(hpp^);
              hpp^.symbol:=stringdup('R_'+tostr(porddef(p^.resulttype)^.rangenr));


              emit_bounds_check(hpp^, hregister);
              end;
              p^.location.loc:=LOC_REGISTER;
              p^.location.register:=hregister;
              exit;
           end;
         if (p^.left^.location.loc=LOC_REGISTER) or
           (p^.left^.location.loc=LOC_CREGISTER) then
           begin
{ handled by secondpas by called routine ??? }
{              p^.location.loc:=p^.left^.location.loc; }
              p^.location.register:=p^.left^.location.register;
           end;
      end;

    procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);far;

    begin
        secondpass(hp);
        p^.location.loc:=LOC_REGISTER;
        del_reference(hp^.location.reference);
        p^.location.register:=getregister32;
        exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
         newreference(hp^.location.reference),R_A0)));

        emit_reg_reg(A_MOVE, S_L, R_A0, P^.location.register);
    end;

      procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);

      var
         oldtruelabel,oldfalselabel,hlabel : plabel;
         hregister : tregister;
         newsize,
         opsize : topsize;
         op     : tasmop;
     begin
         oldtruelabel:=truelabel;
         oldfalselabel:=falselabel;
         getlabel(truelabel);
         getlabel(falselabel);
         secondpass(hp);
         p^.location.loc:=LOC_REGISTER;
         del_reference(hp^.location.reference);
         hregister:=getregister32;
         case porddef(hp^.resulttype)^.typ of
          bool8bit : begin
                       case porddef(p^.resulttype)^.typ of
                     u8bit,s8bit,
                        bool8bit : opsize:=S_B;
                   u16bit,s16bit,
                       bool16bit : opsize:=S_BW;
                   u32bit,s32bit,
                       bool32bit : opsize:=S_BL;
                       end;
                     end;
         bool16bit : begin
                       case porddef(p^.resulttype)^.typ of
                     u8bit,s8bit,
                        bool8bit : opsize:=S_B;
                   u16bit,s16bit,
                       bool16bit : opsize:=S_W;
                   u32bit,s32bit,
                       bool32bit : opsize:=S_WL;
                       end;
                     end;
         bool32bit : begin
                       case porddef(p^.resulttype)^.typ of
                     u8bit,s8bit,
                        bool8bit : opsize:=S_B;
                   u16bit,s16bit,
                       bool16bit : opsize:=S_W;
                   u32bit,s32bit,
                       bool32bit : opsize:=S_L;
                       end;
                     end;
         end;
         op:=A_MOVE;
{         if opsize in [S_B,S_W,S_L] then
          op:=A_MOVE
         else
          if (porddef(p^.resulttype)^.typ in [s8bit,s16bit,s32bit]) then
           op:=A_MOVSX
          else
           op:=A_MOVZX; }
         case porddef(p^.resulttype)^.typ of
          bool8bit,u8bit,s8bit : begin
                                   p^.location.register:=hregister;
                                   newsize:=S_B;
                                 end;
       bool16bit,u16bit,s16bit : begin
                                   p^.location.register:=hregister;
                                   newsize:=S_W;
                                 end;
       bool32bit,u32bit,s32bit : begin
                                   p^.location.register:=hregister;
                                   newsize:=S_L;
                                 end;
         else
          internalerror(10060);
         end;

         case hp^.location.loc of
            LOC_MEM,
      LOC_REFERENCE : exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,
                        newreference(hp^.location.reference),p^.location.register)));
       LOC_REGISTER,
      LOC_CREGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
                        hp^.location.register,p^.location.register)));
          LOC_FLAGS : begin
{                       hregister:=reg32toreg8(hregister); }
                        exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
{ !!!!!!!!
                        case porddef(p^.resulttype)^.typ of
                  bool16bit,
              u16bit,s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
                  bool32bit,
              u32bit,s32bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
                        end; }
                      end;
           LOC_JUMP : begin
                        getlabel(hlabel);
                        emitl(A_LABEL,truelabel);
                        exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,newsize,1,hregister)));
                        emitl(A_JMP,hlabel);
                        emitl(A_LABEL,falselabel);
                        exprasmlist^.concat(new(pai68k,op_reg(A_CLR,newsize,hregister)));
                        emitl(A_LABEL,hlabel);
                      end;
         else
           internalerror(10061);
         end;
         truelabel:=oldtruelabel;
         falselabel:=oldfalselabel;
     end;


     procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
     var
        hregister : tregister;
     begin
         p^.location.loc:=LOC_REGISTER;
         del_reference(hp^.location.reference);
         case hp^.location.loc of
            LOC_MEM,LOC_REFERENCE :
              begin
                hregister:=getregister32;
                exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                  newreference(hp^.location.reference),hregister)));
              end;
            LOC_REGISTER,LOC_CREGISTER :
              begin
                hregister:=hp^.location.register;
              end;
          else
            internalerror(10062);
          end;
         exprasmlist^.concat(new(pai68k,op_reg_reg(A_OR,S_L,hregister,hregister)));
{        hregister:=reg32toreg8(hregister); }
         exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
         case porddef(p^.resulttype)^.typ of
           bool8bit : p^.location.register:=hregister;
{ !!!!!!!!!!!

          bool16bit : begin
                        p^.location.register:=reg8toreg16(hregister);
                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
                      end;
          bool32bit : begin
                        p^.location.register:=reg16toreg32(hregister);
                        exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
                      end; }
         else
          internalerror(10064);
         end;
     end;



    procedure secondtypeconv(var p : ptree);

      const
         secondconvert : array[tc_u8bit_2_s32bit..tc_cchar_charpointer] of
           tsecondconvproc = (second_bigger,second_only_rangecheck,
           second_bigger,second_bigger,second_bigger,
           second_smaller,second_smaller,
           second_smaller,second_string_string,
           second_cstring_charpointer,second_string_chararray,
           second_array_to_pointer,second_pointer_to_array,
           second_char_to_string,second_bigger,
           second_bigger,second_bigger,
           second_smaller,second_smaller,
           second_smaller,second_smaller,
           second_bigger,second_smaller,
           second_only_rangecheck,second_bigger,
           second_bigger,second_bigger,
           second_bigger,second_only_rangecheck,
           second_smaller,second_smaller,
           second_smaller,second_smaller,
           second_bool_to_int,second_int_to_bool,
           second_int_real,second_real_fix,
           second_fix_real,second_int_fix,second_float_float,
           second_chararray_to_string,
           second_proc_to_procvar,
           { is constant char to pchar, is done by firstpass }
           second_nothing);

      begin
         { this isn't good coding, I think tc_bool_2_int, shouldn't be }
         { type conversion (FK)                                        }

         { this is necessary, because second_bool_byte, have to change   }
         { true- and false label before calling secondpass               }
         if p^.convtyp<>tc_bool_2_int then
           begin
              secondpass(p^.left);
              set_location(p^.location,p^.left^.location);
           end;
         if (p^.convtyp<>tc_equal) and (p^.convtyp<>tc_not_possible) then
           {the second argument only is for maybe_range_checking !}
           secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
      end;




    { save the size of pushed parameter }
    var
       pushedparasize : longint;

    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
                push_from_left_to_right : boolean);

      var
         size : longint;
         stackref : treference;
         otlabel,hlabel,oflabel : plabel;

         { temporary variables: }
         tempdeftype : tdeftype;
         tempreference : treference;
         r : preference;
         s : topsize;
         op : tasmop;
         reg: tregister;

      begin
         { push from left to right if specified }
         if push_from_left_to_right and assigned(p^.right) then
           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
         otlabel:=truelabel;
         oflabel:=falselabel;
         getlabel(truelabel);
         getlabel(falselabel);
         secondpass(p^.left);
         { in codegen.handleread.. defcoll^.data is set to nil }
         if assigned(defcoll^.data) and
           (defcoll^.data^.deftype=formaldef) then
           begin
              { allow @var }
              if p^.left^.treetype=addrn then
                begin
                   { allways a register }
                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_SPPUSH)));
                   ungetregister32(p^.left^.location.register);
                end
              else
                begin
                   if (p^.left^.location.loc<>LOC_REFERENCE) and
                      (p^.left^.location.loc<>LOC_MEM) then
                     Message(sym_e_type_mismatch)
                   else
                     begin
                        emitpushreferenceaddr(p^.left^.location.reference);
                        del_reference(p^.left^.location.reference);
                     end;
                end;
              inc(pushedparasize,4);
           end
         { handle call by reference parameter }
         else if (defcoll^.paratyp=vs_var) then
           begin
              if (p^.left^.location.loc<>LOC_REFERENCE) then
                Message(cg_e_var_must_be_reference);
              { open array ? }
              { defcoll^.data can be nil for read/write }
              if assigned(defcoll^.data) and
                is_open_array(defcoll^.data) then
                begin
                   { push high }
                   if is_open_array(p^.left^.resulttype) then
                     begin
                        new(r);
                        reset_reference(r^);
                        r^.base:=highframepointer;
                        r^.offset:=highoffset+4;
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)));
                     end
                   else
                     push_int(parraydef(p^.left^.resulttype)^.highrange-
                              parraydef(p^.left^.resulttype)^.lowrange);
                   inc(pushedparasize,4);
                end;
              emitpushreferenceaddr(p^.left^.location.reference);
              del_reference(p^.left^.location.reference);
              inc(pushedparasize,4);
           end
         else
           begin
              tempdeftype:=p^.resulttype^.deftype;
              if tempdeftype=filedef then
                Message(cg_e_file_must_call_by_reference);
              if (defcoll^.paratyp=vs_const) and
                 dont_copy_const_param(p^.resulttype) then
                begin
                   emitpushreferenceaddr(p^.left^.location.reference);
                   del_reference(p^.left^.location.reference);
                   inc(pushedparasize,4);
                end
              else
                case p^.left^.location.loc of
                   LOC_REGISTER,
                   LOC_CREGISTER : begin
                                   { HERE IS A BIG PROBLEM }
                                   { --> We *MUST* know the data size to push     }
                                   { for the moment, we can say that the savesize }
                                   { indicates the parameter size to push, but    }
                                   { that is CERTAINLY NOT TRUE!                  }
                                   { CAN WE USE LIKE LOC_MEM OR LOC_REFERENCE??   }
                                     case integer(p^.left^.resulttype^.savesize) of
                                     1 : Begin
                                     { A byte sized value normally increments       }
                                     { the SP by 2, BUT because how memory has      }
                                     { been setup OR because of GAS, a byte sized   }
                                     { push CRASHES the Amiga, therefore, we do it  }
                                     { by hand instead.                             }
                                     {  PUSH A WORD SHIFTED LEFT 8                  }
                                           reg := getregister32;
                                           emit_reg_reg(A_MOVE, S_B, p^.left^.location.register, reg);
                                           exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
                                             8, reg)));
                                           exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
                                            reg,R_SPPUSH)));
                                           { offset will be TWO greater              }
                                           inc(pushedparasize,2);
                                           ungetregister32(reg);
                                           ungetregister32(p^.left^.location.register);
                                         end;
                                     2 :
                                              Begin
                                                 exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
                                                   p^.left^.location.register,R_SPPUSH)));
                                                 inc(pushedparasize,2);
                                                 ungetregister32(p^.left^.location.register);
                                              end;
                                      4 : Begin
                                             exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
                                                 p^.left^.location.register,R_SPPUSH)));
                                             inc(pushedparasize,4);
                                             ungetregister32(p^.left^.location.register);
                                          end;
                                      else
                                       Begin
                                         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
                                           p^.left^.location.register,R_SPPUSH)));
                                         inc(pushedparasize,4);
                                         ungetregister32(p^.left^.location.register);
                                       end;
                                     end; { end case }
                                   end;
                   LOC_FPU : begin
                                        size:=pfloatdef(p^.left^.resulttype)^.size;
                                        inc(pushedparasize,size);
                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)));
                                        new(r);
                                        reset_reference(r^);
                                        r^.base:=R_SP;
                                        s:=getfloatsize(pfloatdef(p^.left^.resulttype)^.typ);
                                        if (cs_fp_emulation in aktmoduleswitches) or (s=S_FS) then
                                        begin
                                          { when in emulation mode... }
                                          { only single supported!!!  }
                                          exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
                                             p^.left^.location.fpureg,r)));
                                        end
                                        else
                                          { convert back from extended to normal type }
                                          exprasmlist^.concat(new(pai68k,op_reg_ref(A_FMOVE,s,
                                             p^.left^.location.fpureg,r)));
                                     end;
                   LOC_REFERENCE,LOC_MEM :
                               begin
                                  tempreference:=p^.left^.location.reference;
                                  del_reference(p^.left^.location.reference);
                                  case p^.resulttype^.deftype of
                                     orddef : begin
                                                   case porddef(p^.resulttype)^.typ of
                                                      s32bit,u32bit :
                                                        begin
                                                           emit_push_mem(tempreference);
                                                           inc(pushedparasize,4);
                                                        end;
                                                      s8bit,u8bit,uchar,bool8bit:
                                                      Begin
                                                          { We push a BUT, the SP is incremented by 2      }
                                                          { as specified in the Motorola Prog's Ref Manual }
                                                          { Therefore offet increments BY 2!!!             }
                                                          { BUG??? ...                                     }
                                                          { SWAP OPERANDS:                                 }
                                                          if tempreference.isintvalue then
                                                          Begin
                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,
                                                             tempreference.offset shl 8,R_SPPUSH)));
                                                          end
                                                          else
                                                          Begin
                                                           { A byte sized value normally increments       }
                                                           { the SP by 2, BUT because how memory has      }
                                                           { been setup OR because of GAS, a byte sized   }
                                                           { push CRASHES the Amiga, therefore, we do it  }
                                                           { by hand instead.                             }
                                                           {  PUSH A WORD SHIFTED LEFT 8                  }
                                                            reg:=getregister32;
                                                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
                                                             newreference(tempreference),reg)));
                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
                                                             8, reg)));
                                                            exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
                                                             reg,R_SPPUSH)));
                                                            ungetregister32(reg);
{                                                           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
                                                             newreference(tempreference),R_SPPUSH))); }
                                                          end;
                                                          inc(pushedparasize,2);

                                                      end;
                                                      s16bit,u16bit : begin
                                                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
                                                            newreference(tempreference),R_SPPUSH)));
                                                          inc(pushedparasize,2);
                                                      end;
                                                    end;
                                              end;
                                     floatdef : begin
                                                   case pfloatdef(p^.resulttype)^.typ of
                                                      f32bit,
                                                      s32real :
                                                        begin
                                                           emit_push_mem(tempreference);
                                                           inc(pushedparasize,4);
                                                        end;
                                                      s64real:
                                                      {s64bit }
                                                                begin
                                                                   inc(tempreference.offset,4);
                                                                   emit_push_mem(tempreference);
                                                                   dec(tempreference.offset,4);
                                                                   emit_push_mem(tempreference);
                                                                   inc(pushedparasize,8);
                                                                end;
{$ifdef use48}
                                                      s48real : begin
                                                                end;
{$endif}
                                                      s80real : begin
                                                                    Message(cg_f_extended_cg68k_not_supported);
{                                                                   inc(tempreference.offset,6);
                                                                   emit_push_mem(tempreference);
                                                                   dec(tempreference.offset,4);
                                                                   emit_push_mem(tempreference);
                                                                   dec(tempreference.offset,2);
                                                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
                                                                     newreference(tempreference),R_SPPUSH)));
                                                                   inc(pushedparasize,extended_size);}
                                                                end;
                                                   end;
                                                end;
                                     pointerdef,procvardef,
                                         enumdef,classrefdef:  begin
                                                      emit_push_mem(tempreference);
                                                      inc(pushedparasize,4);
                                                   end;
                                     arraydef,recorddef,stringdef,setdef,objectdef :
                                                begin
                                                   if ((p^.resulttype^.deftype=setdef) and
                                                     (psetdef(p^.resulttype)^.settype=smallset)) then
                                                     begin
                                                        emit_push_mem(tempreference);
                                                        inc(pushedparasize,4);
                                                     end
                                                   else
                                                     begin
                                                        size:=p^.resulttype^.size;

                                                        { Alignment }
                                                        {
                                                        if (size>=4) and ((size and 3)<>0) then
                                                          inc(size,4-(size and 3))
                                                        else if (size>=2) and ((size and 1)<>0) then
                                                          inc(size,2-(size and 1))
                                                        else
                                                        if size=1 then size:=2;
                                                        }
                                                        { create stack space }
                                                        if (size > 0) and (size < 9) then
                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)))
                                                        else
                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBA,
                                                              S_L,size,R_SP)));
                                                        inc(pushedparasize,size);
                                                        { create stack reference }
                                                        stackref.symbol := nil;
                                                        clear_reference(stackref);
                                                        stackref.base:=R_SP;
                                                        { produce copy }
                                                        if p^.resulttype^.deftype=stringdef then
                                                          begin
                                                             copystring(stackref,p^.left^.location.reference,
                                                               pstringdef(p^.resulttype)^.len);
                                                          end
                                                        else
                                                          begin
                                                             concatcopy(p^.left^.location.reference,
                                                             stackref,p^.resulttype^.size,true);
                                                          end;
                                                     end;
                                                end;
                                     else Message(cg_e_illegal_expression);
                                  end;
                               end;
                 LOC_JUMP     : begin
                                   getlabel(hlabel);
                                   inc(pushedparasize,2);
                                   emitl(A_LABEL,truelabel);
                                   exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,1,R_SPPUSH)));
                                   emitl(A_JMP,hlabel);
                                   emitl(A_LABEL,falselabel);
                                   exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,0,R_SPPUSH)));
                                   emitl(A_LABEL,hlabel);
                                end;
                 LOC_FLAGS    : begin
                                   exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
                                     R_D0)));
                                   exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
                                   exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_W,$ff, R_D0)));
                                   inc(pushedparasize,2);
                                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,R_D0,R_SPPUSH)));
                                end;
                end;
           end;
         truelabel:=otlabel;
         falselabel:=oflabel;
         { push from right to left }
         if not push_from_left_to_right and assigned(p^.right) then
           secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
      end;

    procedure secondcalln(var p : ptree);

      var
         unusedregisters : tregisterset;
         pushed : tpushed;
         funcretref : treference;
         hregister : tregister;
         oldpushedparasize : longint;
         { true if a5 must be loaded again after the subroutine }
         loada5 : boolean;
         { true if a virtual method must be called directly }
         no_virtual_call : boolean;
         { true if we produce a con- or destrutor in a call }
         is_con_or_destructor : boolean;
         { true if a constructor is called again }
         extended_new : boolean;
         { adress returned from an I/O-error }
         iolabel : plabel;
         { lexlevel count }
         i : longint;
         { help reference pointer }
         r : preference;
         pp,params : ptree;
         { temp register allocation }
         reg: tregister;
         { help reference pointer }
         ref: preference;

      label
         dont_call;

      begin
         extended_new:=false;
         iolabel:=nil;
         loada5:=true;
         no_virtual_call:=false;
         unusedregisters:=unused;
         if not assigned(p^.procdefinition) then
           exit;
         { only if no proc var }
         if not(assigned(p^.right)) then
           is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
             or ((p^.procdefinition^.options and podestructor)<>0);
         { proc variables destroy all registers }
         if (p^.right=nil) and
         { virtual methods too }
           ((p^.procdefinition^.options and povirtualmethod)=0) then
           begin
              if ((p^.procdefinition^.options and poiocheck)<>0)
                and (cs_check_io in aktlocalswitches) then
                begin
                       getlabel(iolabel);
                   emitl(A_LABEL,iolabel);
                end
              else iolabel:=nil;

              { save all used registers }
              pushusedregisters(pushed,p^.procdefinition^.usedregisters);

              { give used registers through }
              usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
           end
         else
           begin
              pushusedregisters(pushed,$ffff);
              usedinproc:=$ffff;

              { no IO check for methods and procedure variables }
              iolabel:=nil;
           end;

         { generate the code for the parameter and push them }
         oldpushedparasize:=pushedparasize;
         pushedparasize:=0;
         if (p^.resulttype<>pdef(voiddef)) and
            ret_in_param(p^.resulttype) then
           begin
              funcretref.symbol:=nil;
{$ifdef test_dest_loc}
              if dest_loc_known and (dest_loc_tree=p) and
                 (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
                begin
                   funcretref:=dest_loc.reference;
                   if assigned(dest_loc.reference.symbol) then
                     funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
                   in_dest_loc:=true;
                end
              else
{$endif test_dest_loc}
              gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
           end;
         if assigned(p^.left) then
           begin
              pushedparasize:=0;
              { be found elsewhere }
              if assigned(p^.right) then
                secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
                  (p^.procdefinition^.options and poleftright)<>0)
              else
                secondcallparan(p^.left,p^.procdefinition^.para1,
                  (p^.procdefinition^.options and poleftright)<>0);
           end;
         params:=p^.left;
         p^.left:=nil;
         if ret_in_param(p^.resulttype) then
           begin
              emitpushreferenceaddr(funcretref);
              inc(pushedparasize,4);
           end;
         { overloaded operator have no symtable }
         if (p^.right=nil) then
           begin
              { push self }
              if assigned(p^.symtable) and
                (p^.symtable^.symtabletype=withsymtable) then
                begin
                   { dirty trick to avoid the secondcall below }
                   p^.methodpointer:=genzeronode(callparan);
                   p^.methodpointer^.location.loc:=LOC_REGISTER;
                   p^.methodpointer^.location.register:=R_A5;
                   { make a reference }
                   new(r);
                   reset_reference(r^);
                   r^.offset:=p^.symtable^.datasize;
                   r^.base:=procinfo.framepointer;
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
                end;

              { push self }
              if assigned(p^.symtable) and
                ((p^.symtable^.symtabletype=objectsymtable) or
                (p^.symtable^.symtabletype=withsymtable)) then
                begin
                   if assigned(p^.methodpointer) then
                     begin
                        case p^.methodpointer^.treetype of
                           typen : begin
                                      { direct call to inherited method }
                                      if (p^.procdefinition^.options and poabstractmethod)<>0 then
                                        begin
                                           Message(cg_e_cant_call_abstract_method);
                                           goto dont_call;
                                        end;
                                      { generate no virtual call }
                                      no_virtual_call:=true;
                             if (p^.symtableprocentry^.properties and sp_static)<>0 then
                                 begin
                                    { well lets put the VMT address directly into a5 }
                                    { it is kind of dirty but that is the simplest    }
                                    { way to accept virtual static functions (PM)     }
                                    loada5:=true;
                                    exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,S_L,
                                      newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_A5)));
                                    concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
                                    exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
                                 end
                               else

                                  { this is a member call, so A5 isn't modfied }
                                  loada5:=false;

                               if not(is_con_or_destructor and
                                  pobjectdef(p^.methodpointer^.resulttype)^.isclass and
                                  assigned(aktprocsym) and
                                  ((aktprocsym^.definition^.options and
                                  (poconstructor or podestructor))<>0)) then
                                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
                                 { if an inherited con- or destructor should be  }
                                 { called in a con- or destructor then a warning }
                                 { will be made                                  }
                                 { con- and destructors need a pointer to the vmt }
                                 if is_con_or_destructor and
                                   ((pobjectdef(p^.methodpointer^.resulttype)^.options and oois_class)=0) and
                                   assigned(aktprocsym) then
                                   begin
                                    if not ((aktprocsym^.definition^.options
                                      and (poconstructor or podestructor))<>0) then
                                        Message(cg_w_member_cd_call_from_method);
                                   end;
                                      { con- and destructors need a pointer to the vmt }
                                      if is_con_or_destructor then
                                        begin
                                           { classes need the mem ! }
                                           if ((pobjectdef(p^.methodpointer^.resulttype)^.options and

                                            oois_class)=0) then
                                             push_int(0)
                                           else
                                               begin
                                                  exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,
                                                   S_L,newcsymbol(pobjectdef(p^.methodpointer^.
                                                   resulttype)^.vmt_mangledname,0))));
                                                   concat_external(pobjectdef(p^.methodpointer^.resulttype)^.
                                                  vmt_mangledname,EXT_NEAR);
                                               end;
                                        end;
                                   end;
                           hnewn : begin
                                     { extended syntax of new }
                                     { A5 must be zero }
                                     exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,0,R_A5)));
                                     emit_reg_reg(A_MOVE,S_L,R_A5, R_SPPUSH);
                                     { insert the vmt }
                                     exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
                                       newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
                                     concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
                                              extended_new:=true;
                                  end;
                           hdisposen : begin
                                          secondpass(p^.methodpointer);

                                          { destructor with extended syntax called from dispose }
                                          { hdisposen always deliver LOC_REFRENZ }
                                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
                                            newreference(p^.methodpointer^.location.reference),R_A5)));
                                          del_reference(p^.methodpointer^.location.reference);
                                          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
                                          exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
                                            newcsymbol(pobjectdef
                                               (p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
                                          concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
                                       end;
                           else
                             begin
                                { call to a instance member }
                                if (p^.symtable^.symtabletype<>withsymtable) then
                                  begin
                                     secondpass(p^.methodpointer);


                                     case p^.methodpointer^.location.loc of
                                        LOC_REGISTER :
                                           begin
                                             ungetregister32(p^.methodpointer^.location.register);
                                             emit_reg_reg(A_MOVE,S_L,p^.methodpointer^.location.register,R_A5);
                                           end;
                                        else
                                           begin
                                                 if (p^.methodpointer^.resulttype^.deftype=objectdef) and
                                                   pobjectdef(p^.methodpointer^.resulttype)^.isclass then
                                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                                                     newreference(p^.methodpointer^.location.reference),R_A5)))
                                                 else
                                                  Begin
                                                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
                                                     newreference(p^.methodpointer^.location.reference),R_A5)));
                                                  end;

                                                del_reference(p^.methodpointer^.location.reference);
                                             end;
                                     end;
                                  end;
                                    { when calling a class method, we have
                                      to load ESI with the VMT !
                                      But that's wrong, if we call a class method via self
                                    }
                                    if ((p^.procdefinition^.options and poclassmethod)<>0)
                                       and not(p^.methodpointer^.treetype=selfn) then
                                      begin
                                         { class method needs current VMT }
                                         new(r);
                                         reset_reference(r^);
                                         r^.base:=R_A5;
                                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
                                      end;

                                   exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
                                   if is_con_or_destructor then
                                   begin
                                         { classes don't get a VMT pointer pushed }
                                         if (p^.methodpointer^.resulttype^.deftype=objectdef) and
                                           not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
                                           begin

                                            if ((p^.procdefinition^.options and poconstructor)<>0) then
                                              begin
                                               { it's no bad idea, to insert the VMT }
                                                      exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
                                               newcsymbol(pobjectdef(
                                                 p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
                                               concat_external(pobjectdef(
                                                 p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
                                              end
                                            { destructors haven't to dispose the instance, if this is }
                                            { a direct call                                           }
                                            else
                                              push_int(0);
                                           end;
                                  end;
                             end;
                        end;
                     end
                   else
                     begin
                         if ((p^.procdefinition^.options and poclassmethod)<>0) and
                          not(
                            assigned(aktprocsym) and
                            ((aktprocsym^.definition^.options and poclassmethod)<>0)
                          ) then
                          begin
                             { class method needs current VMT }
                             new(r);
                             reset_reference(r^);
                             r^.base:=R_A5;
                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
                          end
                        else
                          begin
                             { member call, A5 isn't modified }
                             loada5:=false;
                          end;
                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
            { but a con- or destructor here would probably almost }
                        { always be placed wrong }
                        if is_con_or_destructor then
                          begin
                             Message(cg_w_member_cd_call_from_method);
                             { not insert VMT pointer }                             { VMT-Zeiger nicht eintragen }
                             push_int(0);
                          end;
                     end;
                end;

              { push base pointer ?}
              if (lexlevel>1) and assigned(pprocdef(p^.procdefinition)^.parast) and
            ((p^.procdefinition^.parast^.symtablelevel)>2) then
                    begin
                   { if we call a nested function in a method, we must      }
                   { push also SELF!                                        }
                   { THAT'S NOT TRUE, we have to load ESI via frame pointer }
                   { access                                                 }
                   {
                     begin
                        loadesi:=false;
                        exprasmlist^.concat(new(pai68k,op_reg(A_PUSH,S_L,R_ESI)));
                     end;
                   }
                   if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
                     begin
                        new(r);
                        reset_reference(r^);
                        r^.offset:=procinfo.framepointer_offset;
                        r^.base:=procinfo.framepointer;
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)))
                     end
                     { this is only true if the difference is one !!
                       but it cannot be more !! }
                   else if lexlevel=(p^.procdefinition^.parast^.symtablelevel)-1 then
                     begin
                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,procinfo.framepointer,R_SPPUSH)))
                     end
                   else if lexlevel>(p^.procdefinition^.parast^.symtablelevel) then
                     begin
                        hregister:=getaddressreg;
                        new(r);
                        reset_reference(r^);
                        r^.offset:=procinfo.framepointer_offset;
                        r^.base:=procinfo.framepointer;
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
                        for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
                          begin
                             new(r);
                             reset_reference(r^);
                             {we should get the correct frame_pointer_offset at each level
                             how can we do this !!! }
                             r^.offset:=procinfo.framepointer_offset;
                             r^.base:=hregister;
                             exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
                          end;
                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,hregister,R_SPPUSH)));
                        ungetregister32(hregister);
                     end
                   else
                     internalerror(25000);
                end;

              { exported methods should be never called direct }
              if (p^.procdefinition^.options and poexports)<>0 then
               Message(cg_e_dont_call_exported_direct);

              if ((p^.procdefinition^.options and povirtualmethod)<>0) and
                 not(no_virtual_call) then
                begin
                   { static functions contain the vmt_address in ESI }
                   { also class methods                              }
                   if assigned(aktprocsym) then
                     begin
                       if ((aktprocsym^.properties and sp_static)<>0) or
                        ((aktprocsym^.definition^.options and poclassmethod)<>0) or
                        ((p^.procdefinition^.options and postaticmethod)<>0) or
                        { A5 is already loaded  }
                        ((p^.procdefinition^.options and poclassmethod)<>0)then
                         begin
                            new(r);
                            reset_reference(r^);
                            r^.base:=R_a5;
                         end
                       else
                         begin
                            new(r);
                            reset_reference(r^);
                            r^.base:=R_a5;
                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
                            new(r);
                            reset_reference(r^);
                            r^.base:=R_a0;
                         end;
                     end
                   else
                     begin
                       new(r);
                       reset_reference(r^);
                         r^.base:=R_a5;
                       exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
                       new(r);
                       reset_reference(r^);
                       r^.base:=R_a0;
                     end;
                  if p^.procdefinition^.extnumber=-1 then
                        internalerror($Da);
                  r^.offset:=p^.procdefinition^.extnumber*4+12;
                  if (cs_check_range in aktlocalswitches) then
                    begin
                     { If the base is already A0, the no instruction will }
                     { be emitted!                                        }
                     emit_reg_reg(A_MOVE,S_L,r^.base,R_A0);
                        emitcall('CHECK_OBJECT',true);
                    end;
                   { This was wrong we must then load the address into the }
                   { register a0 and/or a5                                 }
                   { Because doing an indirect call with offset is NOT     }
                   { allowed on the m68k!                                  }
                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r^),R_A0)));
                   { clear the reference }
                   reset_reference(r^);
                   r^.base := R_A0;
                  exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,r)));
                end
              else
                emitcall(p^.procdefinition^.mangledname,
                  p^.symtableproc^.symtabletype=unitsymtable);
              if ((p^.procdefinition^.options and poclearstack)<>0) then
                begin
                   if (pushedparasize > 0) and (pushedparasize < 9) then
                     { restore the stack, to its initial value }
                     exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,pushedparasize,R_SP)))
                   else
                     { restore the stack, to its initial value }
                     exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDA,S_L,pushedparasize,R_SP)));
                end;
           end
         else
           begin
              secondpass(p^.right);
              case p^.right^.location.loc of
                 LOC_REGISTER,
                 LOC_CREGISTER : begin
                                   if p^.right^.location.register in [R_D0..R_D7] then
                                    begin
                                       reg := getaddressreg;
                                       emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,reg);
                                       new(ref);
                                       reset_reference(ref^);
                                       ref^.base := reg;
                                       exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
                                       ungetregister(reg);
                                    end
                                   else
                                    begin
                                        new(ref);
                                        reset_reference(ref^);
                                        ref^.base := p^.right^.location.register;
                                        exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
                                    end;
                                   ungetregister32(p^.right^.location.register);
                                end
                 else
                    begin
                      if assigned(p^.right^.location.reference.symbol) then
                      { Here we have a symbolic name to the routine, so solve  }
                      { problem by loading the address first, and then emitting }
                      { the call.                                              }
                       begin
                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                           newreference(p^.right^.location.reference),R_A1)));
                         new(ref);
                         reset_reference(ref^);
                         ref^.base := R_A1;
                         exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,newreference(ref^))));
                       end
                       else
                       begin
                         exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                           newreference(p^.right^.location.reference),R_A1)));
                         new(ref);
                         reset_reference(ref^);
                         ref^.base := R_A1;
                         exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,newreference(ref^))));
                       end;
                       del_reference(p^.right^.location.reference);
                    end;
              end;
           end;
      dont_call:
         pushedparasize:=oldpushedparasize;
         unused:=unusedregisters;

         { handle function results }
         if p^.resulttype<>pdef(voiddef) then
           begin

              { a contructor could be a function with boolean result }
              if (p^.right=nil) and
                 ((p^.procdefinition^.options and poconstructor)<>0) and
                 { quick'n'dirty check if it is a class or an object }
                 (p^.resulttype^.deftype=orddef) then
                begin
                   p^.location.loc:=LOC_FLAGS;
                   p^.location.resflags:=F_NE;
                   if extended_new then
                     begin
{$ifdef test_dest_loc}
                        if dest_loc_known and (dest_loc_tree=p) then
                          mov_reg_to_dest(p,S_L,R_EAX)
                        else
{$endif test_dest_loc}
                               hregister:=getregister32;
                               emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
                               p^.location.register:=hregister;
                     end;
                end
              { structed results are easy to handle.... }
              else if ret_in_param(p^.resulttype) then
                begin
                   p^.location.loc:=LOC_MEM;
                   stringdispose(p^.location.reference.symbol);
                   p^.location.reference:=funcretref;
                end
              else
                begin
                   if (p^.resulttype^.deftype=orddef) then
                     begin
                        p^.location.loc:=LOC_REGISTER;
                  case porddef(p^.resulttype)^.typ of
                     s32bit,u32bit :
                        begin
                             hregister:=getregister32;
                             emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
                             p^.location.register:=hregister;
                        end;
                     uchar,u8bit,bool8bit,s8bit :
                        begin
                            hregister:=getregister32;
                            emit_reg_reg(A_MOVE,S_B,R_D0,hregister);
                            p^.location.register:=hregister;
                        end;
                     s16bit,u16bit :
                       begin
                           hregister:=getregister32;
                           emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
                           p^.location.register:=hregister;
                       end;
                           else internalerror(7);
                        end
                     end
                   else if (p^.resulttype^.deftype=floatdef) then
                      case pfloatdef(p^.resulttype)^.typ of
                           f32bit :
                              begin
                                p^.location.loc:=LOC_REGISTER;
                                hregister:=getregister32;
                                emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
                                p^.location.register:=hregister;
                      end;
                     s32real :  Begin
                                   p^.location.loc:=LOC_FPU;
                                   hregister:=getregister32;
                                   emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
                                   p^.location.fpureg:=hregister;
                                end;
                     s64bit,s64real,s80real: begin
                                              if cs_fp_emulation in aktmoduleswitches then
                                              begin
                                                p^.location.loc:=LOC_FPU;
                                                      hregister:=getregister32;
                                                emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
                                                p^.location.fpureg:=hregister;
                                              end
                                              else
                                              begin
                                                { TRUE FPU mode }
                                                p^.location.loc:=LOC_FPU;
                                                { on exit of function result in R_FP0 }
                                                p^.location.fpureg:=R_FP0;
                                              end;
                                             end;
                           else
                      begin
                              p^.location.loc:=LOC_FPU;
                              p^.location.fpureg:=R_FP0;
                      end;
             end {end case }
       else
        begin
            p^.location.loc:=LOC_REGISTER;
            hregister:=getregister32;
            emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
            p^.location.register:=hregister;
                end;
           end;
         end;
         { perhaps i/o check ? }
         if iolabel<>nil then
           begin
              exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
              { this was wrong, probably an error due to diff3
              emitcall(p^.procdefinition^.mangledname);}
              emitcall('IOCHECK',true);
           end;

         { restore registers }
         popusedregisters(pushed);

         { at last, restore instance pointer (SELF) }
         if loada5 then
           maybe_loada5;
         pp:=params;
         while assigned(pp) do
           begin
             if assigned(pp^.left) then
               if (pp^.left^.location.loc=LOC_REFERENCE) or
                 (pp^.left^.location.loc=LOC_MEM) then
                 ungetiftemp(pp^.left^.location.reference);
               pp:=pp^.right;
           end;
         disposetree(params);
      end;

    { reverts the parameter list }
    var nb_para : integer;

    function reversparameter(p : ptree) : ptree;

      var
         hp1,hp2 : ptree;

      begin
         hp1:=nil;
         nb_para := 0;
         while assigned(p) do
           begin
              { pull out }
              hp2:=p;
              p:=p^.right;
              inc(nb_para);
              { pull in }
              hp2^.right:=hp1;
              hp1:=hp2;
           end;
         reversparameter:=hp1;
      end;


    procedure secondloadvmt(var p : ptree);

      begin
         p^.location.loc:=LOC_REGISTER;
         p^.location.register:=getregister32;
         exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
            S_L,newcsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname,0),
            p^.location.register)));
      end;


    procedure secondinline(var p : ptree);
    const
{$ifdef OLDINC}

            in2size:array[in_inc_byte..in_dec_dword] of Topsize=
                    (S_B,S_W,S_L,S_B,S_W,S_L);
            in2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
                    (A_ADDQ,A_ADDQ,A_ADDQ,A_SUBQ,A_SUBQ,A_SUBQ);
{$endif}

            { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
            float_name: array[tfloattype] of string[8]=
             {   ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED'); }
             {  Since we only support the REAL (SINGLE IEEE) FLOAT    }
             {  type, here is what we do...                           }
                ('FIXED','REAL','REAL','REAL','COMP','FIXED');
            addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADDQ,A_SUBQ);
      var
         opsize: topsize;
         asmop: tasmop;

         aktfile : treference;
         ft : tfiletype;
         pushed : tpushed;
         dummycoll : tdefcoll;

       procedure handlereadwrite(doread,doln : boolean);
      { produces code for READ(LN) and WRITE(LN) }

        procedure loadstream;

          const io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
          var     r : preference;

          begin
              new(r);
              reset_reference(r^);
              r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
              if not (cs_compilesystem in aktmoduleswitches) then
                 concat_external(r^.symbol^,EXT_NEAR);

              exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,r,R_A0)))
          end;

        var
           node,hp : ptree;
           typedtyp,pararesult : pdef;
           has_length : boolean;
           dummycoll : tdefcoll;
           iolabel : plabel;
           npara : longint;

        begin
           { I/O check }
           if cs_check_io in aktlocalswitches then
             begin
                getlabel(iolabel);
                emitl(A_LABEL,iolabel);
             end
           else iolabel:=nil;
           { for write of real with the length specified }
           has_length:=false;
           hp:=nil;
           { reserve temporary pointer to data variable }
             aktfile.symbol:=nil;
           gettempofsizereference(4,aktfile);
           { first state text data }
           ft:=ft_text;
           { and state a parameter ? }
           if p^.left=nil then
             begin
                { the following instructions are for "writeln;" }
                loadstream;
                { save @Dateivarible in temporary variable }
                exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
             end
           else
             begin
                { revers paramters }
                node:=reversparameter(p^.left);

                p^.left := node;
                npara := nb_para;
                { calculate data variable }
                { is first parameter a file type ? }
                if node^.left^.resulttype^.deftype=filedef then
                  begin
                     ft:=pfiledef(node^.left^.resulttype)^.filetype;
                     if ft=ft_typed then
                       typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;

                     secondpass(node^.left);
                     if codegenerror then
                       exit;

                     { save reference in temporary variables }                     { reference in tempor„re Variable retten }
                     if node^.left^.location.loc<>LOC_REFERENCE then
                       begin
                          Message(cg_e_illegal_expression);
                          exit;
                       end;

                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_A0)));

                     { skip to the next parameter }
                     node:=node^.right;
                  end
                else
                  begin
                  { load stdin/stdout stream }
                     loadstream;
                  end;

                { save @Dateivarible in temporary variable }
                exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
                if doread then
                  { parameter by READ gives call by reference }
                  dummycoll.paratyp:=vs_var
                else
                  { an WRITE Call by "Const" }
                  dummycoll.paratyp:=vs_const;

                { because of secondcallparan, which otherwise attaches }
                if ft=ft_typed then
                  begin
                    { this is to avoid copy of simple const parameters }
                    dummycoll.data:=new(pformaldef,init);
                     { use var for write also }
                     { avoids problems with const passed by value }
                     { but will not accept untyped const }
                     { dummycoll.paratyp:=vs_var; }
                  end
                else
                  { I think, this isn't a good solution (FK) }
                  dummycoll.data:=nil;

                while assigned(node) do
                  begin
                     pushusedregisters(pushed,$ffff);
                     hp:=node;
                          node:=node^.right;
                     hp^.right:=nil;
                     if hp^.is_colon_para then
                       Message(parser_e_illegal_colon_qualifier);
                     if hp^.is_colon_para then
                       Message(parser_e_illegal_colon_qualifier);
                     if ft=ft_typed then
                       never_copy_const_param:=true;
                     secondcallparan(hp,@dummycoll,false);
                     if ft=ft_typed then
                       never_copy_const_param:=false;
                     hp^.right:=node;
                          if codegenerror then
                       exit;

                     emit_push_mem(aktfile);
                          if (ft=ft_typed) then
                       begin
                            { OK let's try this }
                            { first we must only allow the right type }
                            { we have to call blockread or blockwrite }
                                   { but the real problem is that            }
                            { reset and rewrite should have set       }
                            { the type size                           }
                                   { as recordsize for that file !!!!        }
                            { how can we make that                    }
                            { I think that is only possible by adding }
                            { reset and rewrite to the inline list a call        }
                                   { allways read only one record by element }
                            push_int(typedtyp^.size);
                            if doread then
                                     emitcall('TYPED_READ',true)
                                else
                                     emitcall('TYPED_WRITE',true)
                          {!!!!!!!}
                       end
                     else
                       begin
                          { save current position }
                          pararesult:=hp^.left^.resulttype;
                          { handle possible field width  }
                          { of course only for write(ln) }
                          if not doread then
                                 begin
                                { handle total width parameter }
                               if assigned(node) and node^.is_colon_para then
                                 begin
                                    hp:=node;
                                    node:=node^.right;
                                    hp^.right:=nil;
                                             secondcallparan(hp,@dummycoll,false);
                                    hp^.right:=node;
                                             if codegenerror then
                                      exit;
                                    has_length:=true;
                                 end
                               else
                               if pararesult^.deftype<>floatdef then
                                 push_int(0)
                               else
                                 push_int(-32767);
                              { a second colon para for a float ? }
                              if assigned(node) and node^.is_colon_para then
                                      begin
                                    hp:=node;
                                    node:=node^.right;
                                             hp^.right:=nil;
                                    secondcallparan(hp,@dummycoll,false);
                                             hp^.right:=node;
                                    if pararesult^.deftype<>floatdef then
                                     Message(parser_e_illegal_colon_qualifier);
                                    if codegenerror then
                                      exit;
                              end
                                     else
                              begin
                                if hp^.left^.resulttype^.deftype=floatdef then
                                  push_int(-1);
                              end;
                            end;
                          case pararesult^.deftype of
                       stringdef : begin
                                     if doread then
                                       begin
                                       { push maximum string length }
                                       push_int(pstringdef(pararesult)^.len);
                                       case pstringdef(pararesult)^.string_typ of
                                        st_shortstring: emitcall ('READ_TEXT_STRING',true);
                                        st_ansistring : emitcall ('READ_TEXT_ANSISTRING',true);
                                        st_longstring : emitcall ('READ_TEXT_LONGSTRING',true);
                                        st_widestring : emitcall ('READ_TEXT_ANSISTRING',true);
                                        end
                                       end
                                     else
                                       Case pstringdef(Pararesult)^.string_typ of
                                        st_shortstring: emitcall ('WRITE_TEXT_STRING',true);
                                        st_ansistring : emitcall ('WRITE_TEXT_ANSISTRING',true);
                                        st_longstring : emitcall ('WRITE_TEXT_LONGSTRING',true);
                                        st_widestring : emitcall ('WRITE_TEXT_ANSISTRING',true);
                                        end;
                                   end;
                      pointerdef : begin
                                     if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
                                       begin
                                         if doread then
                                           emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
                                         else
                                           emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
                                       end
                                     else
                                      Message(parser_e_illegal_parameter_list);
                                   end;
                        arraydef : begin
                                     if (parraydef(pararesult)^.lowrange=0) and
                                        is_equal(parraydef(pararesult)^.definition,cchardef) then
                                       begin
                                         if doread then
                                           emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
                                         else
                                           emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
                                       end
                                     else
                                      Message(parser_e_illegal_parameter_list);
                                   end;
                        floatdef : begin
                                     if doread then
                                       emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
                                     else
                                       emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
                                   end;
                          orddef : begin
                                     case porddef(pararesult)^.typ of
                                          u8bit : if doread then
                                                    emitcall('READ_TEXT_BYTE',true);
                                          s8bit : if doread then
                                                    emitcall('READ_TEXT_SHORTINT',true);
                                         u16bit : if doread then
                                                    emitcall('READ_TEXT_WORD',true);
                                         s16bit : if doread then
                                                    emitcall('READ_TEXT_INTEGER',true);
                                         s32bit : if doread then
                                                    emitcall('READ_TEXT_LONGINT',true)
                                                  else
                                                    emitcall('WRITE_TEXT_LONGINT',true);
                                         u32bit : if doread then
                                                    emitcall('READ_TEXT_CARDINAL',true)
                                                  else
                                                    emitcall('WRITE_TEXT_CARDINAL',true);
                                          uchar : if doread then
                                                    emitcall('READ_TEXT_CHAR',true)
                                                  else
                                                    emitcall('WRITE_TEXT_CHAR',true);
                                       bool8bit,
                                      bool16bit,
                                      bool32bit : if  doread then
                                                  { emitcall('READ_TEXT_BOOLEAN',true) }
                                                    Message(parser_e_illegal_parameter_list)
                                                  else
                                                    emitcall('WRITE_TEXT_BOOLEAN',true);
                                     else
                                       Message(parser_e_illegal_parameter_list);
                                     end;
                                   end;
                          else
                            Message(parser_e_illegal_parameter_list);
                          end;
                       end;
                     { load A5 in methods again }
                     popusedregisters(pushed);
                     maybe_loada5;
                  end;
             end;
         { Insert end of writing for textfiles }
           if ft=ft_text then
             begin
               pushusedregisters(pushed,$ffff);
               emit_push_mem(aktfile);
               if doread then
                begin
                  if doln then
                    emitcall('READLN_END',true)
                  else
                    emitcall('READ_END',true);
                end
               else
                begin
                  if doln then
                    emitcall('WRITELN_END',true)
                  else
                    emitcall('WRITE_END',true);
                end;
               popusedregisters(pushed);
               maybe_loada5;
             end;
         { Insert IOCheck if set }
           if iolabel<>nil then
             begin
                { registers are saved in the procedure }
                exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
                emitcall('IOCHECK',true);
             end;
         { Freeup all used temps }
           ungetiftemp(aktfile);
           if assigned(p^.left) then
             begin
                p^.left:=reversparameter(p^.left);
                if npara<>nb_para then
                 Message(cg_f_internal_error_in_secondinline);
                hp:=p^.left;
                while assigned(hp) do
                  begin
                     if assigned(hp^.left) then
                       if (hp^.left^.location.loc=LOC_REFERENCE) or
                         (hp^.left^.location.loc=LOC_MEM) then
                         ungetiftemp(hp^.left^.location.reference);
                     hp:=hp^.right;
                  end;
            end;
        end;

      procedure handle_str;

        var
           hp,node,lentree,paratree : ptree;
           dummycoll : tdefcoll;
           is_real,has_length : boolean;
           real_type : byte;

          begin
           pushusedregisters(pushed,$ffff);
           node:=p^.left;
           is_real:=false;
           has_length:=false;
           while assigned(node^.right) do node:=node^.right;
           { if a real parameter somewhere then call REALSTR }
           if (node^.left^.resulttype^.deftype=floatdef) then
             is_real:=true;

           node:=p^.left;
           { we have at least two args }
           { with at max 2 colon_para in between }

           { first arg longint or float }
           hp:=node;
           node:=node^.right;
           hp^.right:=nil;
           dummycoll.data:=hp^.resulttype;
           { string arg }

           dummycoll.paratyp:=vs_var;
           secondcallparan(hp,@dummycoll,false);
           if codegenerror then
             exit;

           dummycoll.paratyp:=vs_const;
           { second arg }
           hp:=node;
           node:=node^.right;
           hp^.right:=nil;
           { frac  para }
           if hp^.is_colon_para and assigned(node) and
              node^.is_colon_para then
             begin
                dummycoll.data:=hp^.resulttype;
                secondcallparan(hp,@dummycoll,false);
                if codegenerror then
                  exit;
                hp:=node;
                node:=node^.right;
                hp^.right:=nil;
                has_length:=true;
             end
           else
             if is_real then
             push_int(-1);

           { third arg, length only if is_real }
           if hp^.is_colon_para then
             begin
                dummycoll.data:=hp^.resulttype;
                secondcallparan(hp,@dummycoll,false);
                if codegenerror then
                  exit;
                hp:=node;
                node:=node^.right;
                hp^.right:=nil;
             end
           else
             if is_real then
               push_int(-32767)
             else
               push_int(-1);

           { last arg longint or real }
           secondcallparan(hp,@dummycoll,false);
           if codegenerror then
             exit;

           if is_real then
             emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
           else if porddef(hp^.resulttype)^.typ=u32bit then
             emitcall('STR_CARDINAL',true)
           else
             emitcall('STR_LONGINT',true);
           popusedregisters(pushed);
        end;

      var
         r : preference;
         {inc/dec}
         addconstant : boolean;
         addvalue : longint;
         hregister : tregister;

      begin
         case p^.inlinenumber of
            in_lo_word,
            in_hi_word : begin
                       secondpass(p^.left);
                       p^.location.loc:=LOC_REGISTER;
                       if p^.left^.location.loc<>LOC_REGISTER then
                         begin
                            if p^.left^.location.loc=LOC_CREGISTER then
                              begin
                                 p^.location.register:=getregister32;
                                 emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,
                                   p^.location.register);
                              end
                            else
                              begin
                                 del_reference(p^.left^.location.reference);
                                 p^.location.register:=getregister32;
                                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
                                  newreference(p^.left^.location.reference),
                                  p^.location.register)));
                              end;
                         end
                       else p^.location.register:=p^.left^.location.register;
                       if p^.inlinenumber=in_hi_word then
                         exprasmlist^.concat(new(pai68k,op_const_reg(A_LSR,S_W,8,p^.location.register)));
                       p^.location.register:=p^.location.register;
                    end;
            in_high_x :
              begin
                 if is_open_array(p^.left^.resulttype) then
                   begin
                      secondpass(p^.left);
                      del_reference(p^.left^.location.reference);
                      p^.location.register:=getregister32;
                      new(r);
                      reset_reference(r^);
                      r^.base:=highframepointer;
                      r^.offset:=highoffset+4;
                      exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                        r,p^.location.register)));
                   end
              end;
          in_sizeof_x,
          in_typeof_x:
                begin
                   { load vmt }
                   if p^.left^.treetype=typen then
                     begin
                      p^.location.register:=getregister32;
                      exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
                        S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
                        p^.location.register)));
                     end
                   else
                     begin
                        secondpass(p^.left);
                        del_reference(p^.left^.location.reference);
                        p^.location.loc:=LOC_REGISTER;
                        p^.location.register:=getregister32;
                        { load VMT pointer }
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                          newreference(p^.left^.location.reference),
                          p^.location.register)));
                     end;

                   { in sizeof load size }
                   if p^.inlinenumber=in_sizeof_x then
                     begin
                        new(r);
                        reset_reference(r^);
                        { load the address in A0 }
                        { because now supposedly p^.location.register is an }
                        { address.                                          }
                        emit_reg_reg(A_MOVE, S_L, p^.location.register, R_A0);
            r^.base:=R_A0;
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,
                          p^.location.register)));
                     end;
                end;
            in_lo_long,
            in_hi_long : begin
                       secondpass(p^.left);
                       p^.location.loc:=LOC_REGISTER;
                       if p^.left^.location.loc<>LOC_REGISTER then
                         begin
                            if p^.left^.location.loc=LOC_CREGISTER then
                              begin
                                 p^.location.register:=getregister32;
                                 emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
                                   p^.location.register);
                              end
                            else
                              begin
                                 del_reference(p^.left^.location.reference);
                                 p^.location.register:=getregister32;
                                 exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                                  newreference(p^.left^.location.reference),
                                  p^.location.register)));
                              end;
                         end
                       else p^.location.register:=p^.left^.location.register;
                       if p^.inlinenumber=in_hi_long then
                         begin
                           exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ, S_L, 16, R_D1)));
                           exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSR,S_L,R_D1,p^.location.register)));
                         end;
                       p^.location.register:=p^.location.register;
                    end;
            in_length_string :

                     begin
                       secondpass(p^.left);
                       set_location(p^.location,p^.left^.location);
                     end;
            in_dec_x,
            in_inc_x :
              begin
              { set defaults }
                addvalue:=1;
                addconstant:=true;
              { load first parameter, must be a reference }
                secondpass(p^.left^.left);
                case p^.left^.left^.resulttype^.deftype of
                  orddef,
                 enumdef : begin
                             case p^.left^.left^.resulttype^.size of
                              1 : opsize:=S_B;
                              2 : opsize:=S_W;
                              4 : opsize:=S_L;
                             end;
                           end;
              pointerdef : begin
                             opsize:=S_L;
                             addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
                           end;
                else
                 internalerror(10081);
                end;
              { second argument specified?, must be a s32bit in register }
                if assigned(p^.left^.right) then
                 begin
                   secondpass(p^.left^.right^.left);
                 { when constant, just multiply the addvalue }
                   if is_constintnode(p^.left^.right^.left) then
                    addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
                   else
                    begin
                      case p^.left^.right^.left^.location.loc of
                   LOC_REGISTER,
                  LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
                        LOC_MEM,
                  LOC_REFERENCE : begin
                                    hregister:=getregister32;
                                    exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                                      newreference(p^.left^.right^.left^.location.reference),hregister)));
                                  end;
                       else
                        internalerror(10082);
                       end;
                    { insert multiply with addvalue if its >1 }
                      if addvalue>1 then
                       exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,opsize,
                         addvalue,hregister)));
                      addconstant:=false;
                    end;
                 end;
              { write the add instruction }
                if addconstant then
                 begin
                    exprasmlist^.concat(new(pai68k,op_const_ref(addsubop[p^.inlinenumber],opsize,
                      addvalue,newreference(p^.left^.left^.location.reference))));
                 end
                else
                 begin
                   exprasmlist^.concat(new(pai68k,op_reg_ref(addsubop[p^.inlinenumber],opsize,
                      hregister,newreference(p^.left^.left^.location.reference))));
                   ungetregister32(hregister);
                 end;
                emitoverflowcheck(p^.left^.left);
              end;
{$ifdef OLDINC}

            in_inc_byte..in_dec_dword:
                begin
                    secondpass(p^.left);
                    exprasmlist^.concat(new(pai68k,op_const_ref(in2instr[p^.inlinenumber],
                     in2size[p^.inlinenumber],1,newreference(p^.left^.location.reference))));
                     emitoverflowcheck(p^.left);
                end;
{$endif}
            in_pred_x,
            in_succ_x:
              begin
                 secondpass(p^.left);
                 if p^.inlinenumber=in_pred_x then
                   asmop:=A_SUB
                 else
                   asmop:=A_ADD;
                 case p^.resulttype^.size of
                   4 : opsize:=S_L;
                   2 : opsize:=S_W;
                   1 : opsize:=S_B;
                 else
                    internalerror(10080);
                 end;
                 p^.location.loc:=LOC_REGISTER;
                 if p^.left^.location.loc<>LOC_REGISTER then
                   begin
                      p^.location.register:=getregister32;
                      if p^.left^.location.loc=LOC_CREGISTER then
                        emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
                          p^.location.register)
                      else
                      if p^.left^.location.loc=LOC_FLAGS then
                        exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
                                  p^.location.register)))
                      else
                        begin
                           del_reference(p^.left^.location.reference);
                           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.left^.location.reference),
                             p^.location.register)));
                        end;
                   end
                 else p^.location.register:=p^.left^.location.register;
                 exprasmlist^.concat(new(pai68k,op_const_reg(asmop,opsize,1,
                   p^.location.register)))
                 { here we should insert bounds check ? }
                 { and direct call to bounds will crash the program }
                 { if we are at the limit }
                 { we could also simply say that pred(first)=first and succ(last)=last }
                 { could this be usefull I don't think so (PM)
                 emitoverflowcheck;}
              end;

        in_assigned_x:
              begin
         secondpass(p^.left^.left);
         p^.location.loc:=LOC_FLAGS;
         if (p^.left^.left^.location.loc=LOC_REGISTER) or
           (p^.left^.left^.location.loc=LOC_CREGISTER) then
           begin
              exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,
                p^.left^.left^.location.register)));
              ungetregister32(p^.left^.left^.location.register);
           end
         else
           begin
              exprasmlist^.concat(new(pai68k,op_ref(A_TST,S_L,
              newreference(p^.left^.left^.location.reference))));
              del_reference(p^.left^.left^.location.reference);
           end;
         p^.location.resflags:=F_NE;
          end;
             in_reset_typedfile,in_rewrite_typedfile :
               begin
                  pushusedregisters(pushed,$ffff);
                  exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,
                    pfiledef(p^.left^.resulttype)^.typed_as^.size,R_SPPUSH)));
                  secondload(p^.left);
                  emitpushreferenceaddr(p^.left^.location.reference);
                  if p^.inlinenumber=in_reset_typedfile then
                    emitcall('RESET_TYPED',true)
                  else
                    emitcall('REWRITE_TYPED',true);
                  popusedregisters(pushed);
               end;
            in_write_x :
              handlereadwrite(false,false);
            in_writeln_x :
              handlereadwrite(false,true);
            in_read_x :
              handlereadwrite(true,false);
            in_readln_x :
              handlereadwrite(true,true);
            in_str_x_string : begin
                                 handle_str;
                                 maybe_loada5;
                              end;
            else internalerror(9);
         end;
      end;

    procedure secondsubscriptn(var p : ptree);
      var
       hr: tregister;

      begin

         secondpass(p^.left);

         if codegenerror then
           exit;
         { classes must be dereferenced implicit }
         if (p^.left^.resulttype^.deftype=objectdef) and
           pobjectdef(p^.left^.resulttype)^.isclass then
           begin
             clear_reference(p^.location.reference);
             case p^.left^.location.loc of
                LOC_REGISTER:
                  begin
                     { move it to an address register...}
                     hr:=getaddressreg;
                     emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
                     p^.location.reference.base:=hr;
                     { free register }
                     ungetregister(p^.left^.location.register);
                  end;
                LOC_CREGISTER:
                  begin
                     { ... and reserve one for the pointer }
                     hr:=getaddressreg;
                     emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
                       p^.location.reference.base:=hr;
                  end;
                else
                  begin
                     { free register }
                     del_reference(p^.left^.location.reference);

                     { ... and reserve one for the pointer }
                     hr:=getaddressreg;
                     exprasmlist^.concat(new(pai68k,op_ref_reg(
                       A_MOVE,S_L,newreference(p^.left^.location.reference),
                       hr)));
                     p^.location.reference.base:=hr;
                  end;
             end;
           end
         else
           set_location(p^.location,p^.left^.location);

         inc(p^.location.reference.offset,p^.vs^.address);
      end;


    procedure secondselfn(var p : ptree);

      begin
         clear_reference(p^.location.reference);
         p^.location.reference.base:=R_A5;
      end;

    procedure secondhdisposen(var p : ptree);

      begin
         secondpass(p^.left);

         if codegenerror then
           exit;
         clear_reference(p^.location.reference);
         case p^.left^.location.loc of
            LOC_REGISTER,
            LOC_CREGISTER : begin
                               p^.location.reference.base:=getaddressreg;
                               exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
                                 p^.left^.location.register,
                                 p^.location.reference.base)));
                            end;
            LOC_MEM,LOC_REFERENCE :
                            begin
                               del_reference(p^.left^.location.reference);
                               p^.location.reference.base:=getaddressreg;
                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
                                 p^.location.reference.base)));
                            end;
         end;
      end;

    procedure secondhnewn(var p : ptree);

      begin
      end;

    procedure secondnewn(var p : ptree);

      begin
         secondpass(p^.left);

         if codegenerror then
           exit;

         p^.location.register:=p^.left^.location.register;
      end;

    procedure secondsimplenewdispose(var p : ptree);

      var
         pushed : tpushed;
      begin
         secondpass(p^.left);
         if codegenerror then
           exit;

         pushusedregisters(pushed,$ffff);
         { determines the size of the mem block }
         push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);

         { push pointer adress }
         case p^.left^.location.loc of
            LOC_CREGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
              p^.left^.location.register,R_SPPUSH)));
            LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);

         end;

         { call the mem handling procedures }
         case p^.treetype of
            simpledisposen :
                emitcall('FREEMEM',true);
            simplenewn :
                emitcall('GETMEM',true);
         end;

       popusedregisters(pushed);
         { may be load ESI }
         maybe_loada5;
      end;


    procedure secondsetcons(var p : ptree);

      var
         l : plabel;
         i,smallsetvalue : longint;
         hp : ptree;
         href,sref : treference;
         hl1,hl2: plabel;
         j: byte;

      begin
         { this should be reimplemented for smallsets }
         { differently  (PM) }
         { produce constant part }
         j:=0;
         href.symbol := Nil;
         clear_reference(href);
         getlabel(l);
         href.symbol:=stringdup(lab2str(l));
         stringdispose(p^.location.reference.symbol);
         datasegment^.concat(new(pai_label,init(l)));
           {if psetdef(p^.resulttype)=smallset then
           begin
              smallsetvalue:=(p^.constset^[3]*256)+p^.constset^[2];
              smallsetvalue:=((smallset*256+p^.constset^[1])*256+p^.constset^[1];
              datasegment^.concat(new(pai_const,init_32bit(smallsetvalue)));
              hp:=p^.left;
              if assigned(hp) then
                begin
                   sref.symbol:=nil;
                   gettempofsizereference(32,sref);
                     concatcopy(href,sref,32,false);
                   while assigned(hp) do
                     begin
                        secondpass(hp^.left);
                        if codegenerror then
                          exit;

                        pushsetelement(hp^.left);
                        emitpushreferenceaddr(sref);
                         register is save in subroutine
                        emitcall('SET_SET_BYTE',true);
                        hp:=hp^.right;
                     end;
                   p^.location.reference:=sref;
                end
              else p^.location.reference:=href;
           end
         else    }
           begin
             for i:=0 to (31 div 4) do
             Begin
         { This is required because of the ENDIAN of m68k machines }
               datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+3])));
               datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+2])));
               datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+1])));
               datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j])));
               Inc(j,4);
{               datasegment^.concat(new(pai_const,init_8bit(p^.constset^[i])));}
             end;
         hp:=p^.left;
         if assigned(hp) then
           begin
              sref.symbol:=nil;
              gettempofsizereference(32,sref);
                concatcopy(href,sref,32,false);
              while assigned(hp) do
                begin
                   secondpass(hp^.left);
                   if codegenerror then
                     exit;

                     loadsetelement(hp^.left);
                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
                     newreference(sref),R_A0)));;
{                   emitpushreferenceaddr(sref); }
                   { register is save in subroutine }
                   emitcall('SET_SET_BYTE',true);
                   hp:=hp^.right;
                end;
              p^.location.reference:=sref;
           end
             else
                p^.location.reference:=href;
         end;
      end;


    procedure secondcontinuen(var p : ptree);

      begin
         if aktcontinuelabel<>nil then
           emitl(A_JMP,aktcontinuelabel)
         else
           Message(cg_e_continue_not_allowed);
      end;


{    var
       hs : string; }

    procedure secondexitn(var p : ptree);

      var
         is_mem : boolean;
         {op : tasmop;
         s : topsize;}
         otlabel,oflabel : plabel;

      label
         do_jmp;

      begin
         if assigned(p^.left) then
           begin
              otlabel:=truelabel;
              oflabel:=falselabel;
              getlabel(truelabel);
              getlabel(falselabel);
              secondpass(p^.left);
              case p^.left^.location.loc of
                 LOC_FPU : goto do_jmp;
                 LOC_MEM,LOC_REFERENCE : is_mem:=true;
                 LOC_CREGISTER,
                 LOC_REGISTER : is_mem:=false;
                 LOC_FLAGS : begin
                                exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,R_D0)));
                                exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
                                goto do_jmp;
                             end;
                 LOC_JUMP : begin
                               emitl(A_LABEL,truelabel);
                               exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,1,R_D0)));
                               emitl(A_JMP,aktexit2label);
                               exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,R_D0)));
                               goto do_jmp;
                            end;
                 else internalerror(2001);
              end;
              if (procinfo.retdef^.deftype=orddef) then
                begin
                   case porddef(procinfo.retdef)^.typ of
                      s32bit,u32bit : if is_mem then
                                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                                          newreference(p^.left^.location.reference),R_D0)))
                                      else
                                        emit_reg_reg(A_MOVE,S_L,
                                          p^.left^.location.register,R_D0);
                      u8bit,s8bit,uchar,bool8bit : if is_mem then
                                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
                                          newreference(p^.left^.location.reference),R_D0)))
                                      else
                                        emit_reg_reg(A_MOVE,S_B,
                                          p^.left^.location.register,R_D0);
                      s16bit,u16bit : if is_mem then
                                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
                                          newreference(p^.left^.location.reference),R_D0)))
                                      else
                                        emit_reg_reg(A_MOVE,S_W,
                                          p^.left^.location.register,R_D0);
                   end;
                end
               else
                 if (procinfo.retdef^.deftype in
                     [pointerdef,enumdef,procvardef]) then
                   begin
                      if is_mem then
                        exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                          newreference(p^.left^.location.reference),R_D0)))
                      else
                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
                          p^.left^.location.register,R_D0)));
                   end
              else
                if (procinfo.retdef^.deftype=floatdef) then
            { floating point return values .... }
            { single are returned in d0         }
                  begin
                     if (pfloatdef(procinfo.retdef)^.typ=f32bit) or
                   (pfloatdef(procinfo.retdef)^.typ=s32real) then
                       begin
                          if is_mem then
                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                              newreference(p^.left^.location.reference),R_D0)))
                    else
                    begin
                      if pfloatdef(procinfo.retdef)^.typ=f32bit then
                        emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_D0)
                      else
                      begin
                        { single values are in the floating point registers }
                        if cs_fp_emulation in aktmoduleswitches then
                          emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)
                        else
                                        exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_FS,
                                           p^.left^.location.fpureg,R_D0)));
                      end;
                    end;
                  end
                  else
                       Begin
                    { this is only possible in real non emulation mode }
                    { LOC_MEM,LOC_REFERENCE }
                    if is_mem then
                    begin
                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
                                  getfloatsize(pfloatdef(procinfo.retdef)^.typ),
                                    newreference(p^.left^.location.reference),R_FP0)));
                    end
                    else
                    { LOC_FPU }
                    begin
                          { convert from extended to correct type }
                          { when storing                          }
                          exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,
                             getfloatsize(pfloatdef(procinfo.retdef)^.typ),p^.left^.location.fpureg,R_FP0)));
                    end;
              end;
              end;
do_jmp:
              truelabel:=otlabel;
              falselabel:=oflabel;
              emitl(A_JMP,aktexit2label);
           end
         else
           begin
              emitl(A_JMP,aktexitlabel);
           end;
      end;

    procedure secondgoto(var p : ptree);

      begin
         emitl(A_JMP,p^.labelnr);
      end;

    procedure secondlabel(var p : ptree);

      begin
         emitl(A_LABEL,p^.labelnr);
         cleartempgen;
         secondpass(p^.left);
      end;

    procedure secondasm(var p : ptree);

      begin
         exprasmlist^.concatlist(p^.p_asm);
      end;

    procedure secondcase(var p : ptree);

      var
         with_sign : boolean;
         opsize : topsize;
         jmp_gt,jmp_le,jmp_lee : tasmop;
         hp : ptree;
         { register with case expression }
         hregister : tregister;
         endlabel,elselabel : plabel;

         { true, if we can omit the range check of the jump table }
         jumptable_no_range : boolean;

      procedure gentreejmp(p : pcaserecord);

        var
           lesslabel,greaterlabel : plabel;

      begin
         emitl(A_LABEL,p^._at);
         { calculate labels for left and right }
         if (p^.less=nil) then
           lesslabel:=elselabel
         else
           lesslabel:=p^.less^._at;
         if (p^.greater=nil) then
           greaterlabel:=elselabel
         else
           greaterlabel:=p^.greater^._at;
           { calculate labels for left and right }
         { no range label: }
         if p^._low=p^._high then
           begin
              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
              if greaterlabel=lesslabel then
                begin
                   emitl(A_BNE,lesslabel);
                end
              else
                begin
                   emitl(jmp_le,lesslabel);
                   emitl(jmp_gt,greaterlabel);
                end;
              emitl(A_JMP,p^.statement);
           end
         else
           begin
              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
              emitl(jmp_le,lesslabel);
              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._high,hregister)));
              emitl(jmp_gt,greaterlabel);
              emitl(A_JMP,p^.statement);
           end;
         if assigned(p^.less) then
           gentreejmp(p^.less);
         if assigned(p^.greater) then
           gentreejmp(p^.greater);
      end;

      procedure genlinearlist(hp : pcaserecord);

        var
           first : boolean;
           last : longint;

        procedure genitem(t : pcaserecord);

          begin
             if assigned(t^.less) then
               genitem(t^.less);
             if t^._low=t^._high then
               begin
                  if (t^._low-last > 0) and (t^._low-last < 9) then
                     exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last,hregister)))
                  else
                  if (t^._low-last = 0) then
                     exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
                  else
                     exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
                  last:=t^._low;

                  emitl(A_BEQ,t^.statement);
               end
             else
               begin
                  { it begins with the smallest label, if the value }
                  { is even smaller then jump immediately to the    }
                  { ELSE-label                                      }
                  if first then
                    begin
                       if (t^._low-1 > 0) and (t^._low < 9) then
                          exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-1,hregister)))
                       else
                       if t^._low-1=0 then
                         exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
                       else
                         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-1,hregister)));
                       if t^._low = 0 then
                          emitl(A_BLE,elselabel)
                       else
                          emitl(jmp_lee,elselabel);
                    end
                  { if there is no unused label between the last and the }
                  { present label then the lower limit can be checked    }
                  { immediately. else check the range in between:        }
                  else if (t^._low-last>1)then

                    begin
                       if ((t^._low-last-1) > 0) and ((t^._low-last-1) < 9) then
                         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last-1,hregister)))
                       else
                         exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last-1,hregister)));
                       emitl(jmp_lee,elselabel);
                    end;
                  exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._high-t^._low+1,hregister)));
                  emitl(jmp_lee,t^.statement);

                  last:=t^._high;
               end;
             first:=false;
             if assigned(t^.greater) then
               genitem(t^.greater);
          end;

        var
           hr : tregister;

        begin
           { case register is modified by the list evalution }
           if (p^.left^.location.loc=LOC_CREGISTER) then
             begin
                hr:=getregister32;
             end;
           last:=0;
           first:=true;
           genitem(hp);
           emitl(A_JMP,elselabel);
        end;

      procedure genjumptable(hp : pcaserecord;min_,max_ : longint);

        var
           table : plabel;
           last : longint;
           hr : preference;

        procedure genitem(t : pcaserecord);

          var
             i : longint;

          begin
             if assigned(t^.less) then
               genitem(t^.less);
             { fill possible hole }
             for i:=last+1 to t^._low-1 do
               datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
                 (elselabel)))));
             for i:=t^._low to t^._high do
               datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
                (t^.statement)))));
              last:=t^._high;
             if assigned(t^.greater) then
               genitem(t^.greater);
          end;

        begin
           if not(jumptable_no_range) then
             begin
                exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,min_,hregister)));
                { case expr less than min_ => goto elselabel }
                emitl(jmp_le,elselabel);
                exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,max_,hregister)));
                emitl(jmp_gt,elselabel);
             end;
           getlabel(table);
           { extend with sign }
           if opsize=S_W then
             begin
                { word to long - unsigned }
                exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
             end
           else if opsize=S_B then
             begin
                { byte to long - unsigned }
                exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
             end;
           new(hr);
           reset_reference(hr^);
           hr^.symbol:=stringdup(lab2str(table));
           hr^.offset:=(-min_)*4;

           { add scalefactor *4 to index }
           exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,hregister)));
{           hr^.scalefactor:=4; }
           hr^.base:=getaddressreg;
           emit_reg_reg(A_MOVE,S_L,hregister,hr^.base);
           exprasmlist^.concat(new(pai68k,op_ref(A_JMP,S_NO,hr)));
{          if not(cs_littlesize in aktglobalswitches^ ) then
             datasegment^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4))); }
           datasegment^.concat(new(pai_label,init(table)));
             last:=min_;
           genitem(hp);
           if hr^.base <> R_NO then ungetregister(hr^.base);
           { !!!!!!!
           if not(cs_littlesize in aktglobalswitches^ ) then
             exprasmlist^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4)));
           }
        end;

      var
         lv,hv,min_label,max_label,labels : longint;
         max_linear_list : longint;

      begin
         getlabel(endlabel);
         getlabel(elselabel);
         with_sign:=is_signed(p^.left^.resulttype);
         if with_sign then
           begin
              jmp_gt:=A_BGT;
              jmp_le:=A_BLT;
              jmp_lee:=A_BLE;
           end
         else
           begin
              jmp_gt:=A_BHI;
              jmp_le:=A_BCS;
              jmp_lee:=A_BLS;
           end;
         cleartempgen;
         secondpass(p^.left);
         { determines the size of the operand }
         { determines the size of the operand }
         opsize:=bytes2Sxx[p^.left^.resulttype^.size];
         { copy the case expression to a register }
         { copy the case expression to a register }
         case p^.left^.location.loc of
            LOC_REGISTER,
            LOC_CREGISTER : hregister:=p^.left^.location.register;
            LOC_MEM,LOC_REFERENCE : begin
                                       del_reference(p^.left^.location.reference);
                                           hregister:=getregister32;
                                       exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(
                                         p^.left^.location.reference),hregister)));
                                    end;
            else internalerror(2002);
         end;
         { now generate the jumps }
         if cs_optimize in aktglobalswitches  then
           begin
              { procedures are empirically passed on }
              { consumption can also be calculated   }
              { but does it pay on the different     }
              { processors?                          }
              { moreover can the size only be appro- }
              { ximated as it is not known if rel8,  }
              { rel16 or rel32 jumps are used        }
              min_label:=case_get_min(p^.nodes);
              max_label:=case_get_max(p^.nodes);
              labels:=case_count_labels(p^.nodes);
              { can we omit the range check of the jump table }
              getrange(p^.left^.resulttype,lv,hv);
              jumptable_no_range:=(lv=min_label) and (hv=max_label);

              { optimize for size ? }
              if cs_littlesize in aktglobalswitches  then
                begin
                   if (labels<=2) or ((max_label-min_label)>3*labels) then
                     { a linear list is always smaller than a jump tree }
                     genlinearlist(p^.nodes)
                   else
                     { if the labels less or more a continuum then }
                     genjumptable(p^.nodes,min_label,max_label);
                end
              else
                begin
                   if jumptable_no_range then
                     max_linear_list:=4
                   else
                     max_linear_list:=2;

                   if (labels<=max_linear_list) then
                     genlinearlist(p^.nodes)
                   else
                     begin
                        if ((max_label-min_label)>4*labels) then
                          begin
                             if labels>16 then
                               gentreejmp(p^.nodes)
                             else
                               genlinearlist(p^.nodes);
                          end
                        else
                          genjumptable(p^.nodes,min_label,max_label);
                     end;
                end;
           end
         else
           { it's always not bad }
           genlinearlist(p^.nodes);

         { now generate the instructions }
         hp:=p^.right;
         while assigned(hp) do
           begin
              cleartempgen;
              secondpass(hp^.right);
              emitl(A_JMP,endlabel);
              hp:=hp^.left;
           end;
         emitl(A_LABEL,elselabel);
         { ... and the else block }
         if assigned(p^.elseblock) then
           begin
              cleartempgen;
              secondpass(p^.elseblock);
           end;
         emitl(A_LABEL,endlabel);
      end;


    procedure secondtryexcept(var p : ptree);

      begin

      end;

    procedure secondtryfinally(var p : ptree);

      begin
      end;

    procedure secondfail(var p : ptree);

      var hp : preference;

      begin
         {if procinfo.exceptions then
           aktproccode.concat(gennasmrec(CALL,S_NO,'HELP_DESTRUCTOR_E'))
         else }
         { we should know if the constructor is called with a new or not,
         how can we do that ???
         exprasmlist^.concat(new(pai68k,op_csymbol(A_CALL,S_NO,newcsymbol('HELP_DESTRUCTOR',0))));
         }
         exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_A5)));
         { also reset to zero in the stack }
         new(hp);
         reset_reference(hp^);
         hp^.offset:=procinfo.ESI_offset;
         hp^.base:=procinfo.framepointer;
         exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A5,hp)));
         exprasmlist^.concat(new(pai_labeled,init(A_JMP,quickexitlabel)));
      end;

    procedure secondon(var p : ptree);

      var
         nextonlabel,myendexceptlabel : plabel;
         ref : treference;

      begin
{ !!!!!!!!!!!!!!! }
(*         getlabel(nextonlabel);
         { push the vmt }
         exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
           newcsymbol(p^.excepttype^.vmt_mangledname,0))));
         maybe_concat_external(p^.excepttype^.owner,
           p^.excepttype^.vmt_mangledname);

         emitcall('FPC_CATCHES',true);
         exprasmlist^.concat(new(pai386,
           op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
         emitl(A_JE,nextonlabel);
         ref.symbol:=nil;
         gettempofsizereference(4,ref);

         { what a hack ! }
         if assigned(p^.exceptsymtable) then
           pvarsym(p^.exceptsymtable^.root)^.address:=ref.offset;

         exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
           R_EAX,newreference(ref))));

         if assigned(p^.right) then
           secondpass(p^.right);
         { clear some stuff }
         ungetiftemp(ref);
         emitl(A_JMP,endexceptlabel);
         emitl(A_LABEL,nextonlabel);
         { next on node }
         if assigned(p^.left) then
           secondpass(p^.left); *)
      end;


    procedure secondas(var p : ptree);

      var
         pushed : tpushed;

      begin
         set_location(p^.location,p^.left^.location);
         { save all used registers }
         pushusedregisters(pushed,$ffff);
         { push the vmt of the class }
         exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
           S_L,newcsymbol(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,0),R_SPPUSH)));
         concat_external(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,EXT_NEAR);
         emitpushreferenceaddr(p^.location.reference);
          emitcall('DO_AS',true);
         popusedregisters(pushed);
      end;

    procedure secondis(var p : ptree);

      var
         pushed : tpushed;

      begin
         { save all used registers }
         pushusedregisters(pushed,$ffff);
         secondpass(p^.left);
         p^.location.loc:=LOC_FLAGS;
         p^.location.resflags:=F_NE;

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

         { 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_IS',true);
         exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0)));
         popusedregisters(pushed);
      end;

    procedure secondwith(var p : ptree);

       var
          ref : treference;
          symtable : psymtable;
          i : longint;

       begin
          if assigned(p^.left) then
            begin
               secondpass(p^.left);
               ref.symbol:=nil;
               gettempofsizereference(4,ref);
               exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
                 newreference(p^.left^.location.reference),R_A0)));
               exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
                 R_A0,newreference(ref))));
               del_reference(p^.left^.location.reference);
               { the offset relative to (%ebp) is only needed here! }
               symtable:=p^.withsymtable;
               for i:=1 to p^.tablecount do
                 begin
                    symtable^.datasize:=ref.offset;
                    symtable:=symtable^.next;
                 end;

               { p^.right can be optimize out !!! }
               if p^.right<>nil then
                 secondpass(p^.right);
               { clear some stuff }
               ungetiftemp(ref);
            end;
       end;

procedure secondprocinline(var p:ptree);
begin
end;


     procedure secondpass(var p : ptree);
       const
         procedures : array[ttreetyp] of secondpassproc =
            (secondadd,secondadd,secondadd,secondmoddiv,secondadd,
             secondmoddiv,secondassignment,secondload,secondnothing,
             secondadd,secondadd,secondadd,secondadd,
             secondadd,secondadd,secondin,secondadd,
             secondadd,secondshlshr,secondshlshr,secondadd,
             secondadd,secondsubscriptn,secondderef,secondaddr,
             seconddoubleaddr,
             secondordconst,secondtypeconv,secondcalln,secondnothing,
             secondrealconst,secondfixconst,secondumminus,
             secondasm,secondvecn,
             secondstringconst,secondfuncret,secondselfn,
             secondnot,secondinline,secondniln,seconderror,
             secondnothing,secondhnewn,secondhdisposen,secondnewn,
             secondsimplenewdispose,secondnothing,secondsetcons,secondblockn,
             secondstatement,secondnothing,secondifn,secondbreakn,
             secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
             secondexitn,secondwith,secondcase,secondlabel,
             secondgoto,secondsimplenewdispose,secondtryexcept,
             secondraise,
             secondnothing,secondtryfinally,secondon,secondis,
             secondas,seconderror,
             secondfail,secondadd,secondprocinline,
             secondnothing,secondloadvmt);
      var
         oldcodegenerror  : boolean;
         oldlocalswitches : tlocalswitches;
         oldpos           : tfileposinfo;
      begin
         oldcodegenerror:=codegenerror;
         oldlocalswitches:=aktlocalswitches;
         oldpos:=aktfilepos;

         aktfilepos:=p^.fileinfo;
         aktlocalswitches:=p^.localswitches;
         if not(p^.error) then
           begin
              codegenerror:=false;
              procedures[p^.treetype](p);
              p^.error:=codegenerror;
              codegenerror:=codegenerror or oldcodegenerror;
           end
         else
           codegenerror:=true;

         aktlocalswitches:=oldlocalswitches;
         aktfilepos:=oldpos;
      end;


    function do_secondpass(var p : ptree) : boolean;
      begin
         codegenerror:=false;
         if not(p^.error) then
           secondpass(p);
         do_secondpass:=codegenerror;
      end;


    var
       regvars : array[1..maxvarregs] of pvarsym;
       regvars_para : array[1..maxvarregs] of boolean;
       regvars_refs : array[1..maxvarregs] of longint;
       parasym : boolean;

    procedure searchregvars(p : psym);

      var
         i,j,k : longint;

      begin
         if (p^.typ=varsym) and ((pvarsym(p)^.var_options and vo_regable)<>0) then
           begin
              { walk through all momentary register variables }
              for i:=1 to maxvarregs do
                begin
                   { free register ? }
                   if regvars[i]=nil then
                     begin
                        regvars[i]:=pvarsym(p);
                        regvars_para[i]:=parasym;
                        break;
                     end;
                   { else throw out a variable ? }
                   j:=pvarsym(p)^.refs;
                   { parameter get a less value }
                   if parasym then
                     begin
                        if cs_littlesize in aktglobalswitches  then
                          dec(j,1)
                        else
                          dec(j,100);
                     end;
                   if (j>regvars_refs[i]) and (j>0) then
                     begin
                        for k:=maxvarregs-1 downto i do
                          begin
                             regvars[k+1]:=regvars[k];
                             regvars_para[k+1]:=regvars_para[k];
                          end;
                        { calc the new refs
                        pvarsym(p)^.refs:=j; }
                        regvars[i]:=pvarsym(p);
                        regvars_para[i]:=parasym;
                        regvars_refs[i]:=j;
                        break;
                     end;
                end;
           end;
      end;


    procedure generatecode(var p : ptree);
      var
         i       : longint;
         regsize : topsize;
         regi    : tregister;
         hr      : preference;
      label
         nextreg;
      begin
         cleartempgen;
         { when size optimization only count occurrence }
         if cs_littlesize in aktglobalswitches then
           t_times:=1
         else
         { reference for repetition is 100 }
           t_times:=100;
         { clear register count }
         for regi:=R_D0 to R_A6 do
           begin
              reg_pushes[regi]:=0;
              is_reg_var[regi]:=false;
           end;

         use_esp_stackframe:=false;

         if not(do_firstpass(p)) then
           begin
              { max. optimizations     }
              { only if no asm is used }
              if (cs_maxoptimize in aktglobalswitches) and
                ((procinfo.flags and pi_uses_asm)=0) then
                begin
                   { can we omit the stack frame ? }
                   { conditions:
                     1. procedure (not main block)
                     2. no constructor or destructor
                     3. no call to other procedures
                     4. no interrupt handler
                   }
                   if assigned(aktprocsym) then
                     begin
                      if (aktprocsym^.definition^.options and (poconstructor+podestructor+poinline+pointerrupt)=0) and
                       ((procinfo.flags and pi_do_call)=0) and (lexlevel>1) then
                       begin
                          { use ESP as frame pointer }
                          procinfo.framepointer:=R_SP;
                          use_esp_stackframe:=true;

                          { calc parameter distance new }
                          dec(procinfo.framepointer_offset,4);
                          dec(procinfo.ESI_offset,4);

                          dec(procinfo.retoffset,4);

                          dec(procinfo.call_offset,4);
                          aktprocsym^.definition^.parast^.call_offset:=procinfo.call_offset;
                       end;
                          end; { endif assigned }
                   if (p^.registers32<4) then
                     begin
                        for i:=1 to maxvarregs do
                          regvars[i]:=nil;
                        parasym:=false;
{$ifdef tp}
                        symtablestack^.foreach(searchregvars);
{$else}
                        symtablestack^.foreach(@searchregvars);
{$endif}
                        { copy parameter into a register ? }
                        parasym:=true;
{$ifdef tp}
                        symtablestack^.next^.foreach(searchregvars);
{$else}
                        symtablestack^.next^.foreach(@searchregvars);
{$endif}

                        { hold needed registers free }
                        for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
                          regvars[i]:=nil;
                        { now assign register }
                        for i:=1 to maxvarregs do
                          begin
                             if assigned(regvars[i]) then
                               begin
                                  { it is nonsens, to copy the variable to }
                                  { a register because we need then much   }
                                  { pushes ?                               }
                                  if reg_pushes[varregs[i]]>=regvars[i]^.refs then
                                    begin
                                       regvars[i]:=nil;
                                       goto nextreg;
                                    end;

                                  { register is no longer available for }
                                  { expressions                         }
                                  { search the register which is the most }
                                  { unused                                }
                                  usableregs:=usableregs-[varregs[i]];
                                  is_reg_var[varregs[i]]:=true;
                                  dec(c_usableregs);

                                  { possibly no 32 bit register are needed }
                                  if  (regvars[i]^.definition^.deftype=orddef) and
                                      (
                                       (porddef(regvars[i]^.definition)^.typ=bool8bit) or
                                       (porddef(regvars[i]^.definition)^.typ=uchar) or
                                       (porddef(regvars[i]^.definition)^.typ=u8bit) or
                                       (porddef(regvars[i]^.definition)^.typ=s8bit)
                                      ) then
                                    begin
                                       regvars[i]^.reg:=varregs[i];
                                       regsize:=S_B;
                                    end
                                  else if  (regvars[i]^.definition^.deftype=orddef) and
                                      (
                                       (porddef(regvars[i]^.definition)^.typ=u16bit) or
                                       (porddef(regvars[i]^.definition)^.typ=s16bit)
                                      ) then
                                    begin
                                       regvars[i]^.reg:=varregs[i];
                                       regsize:=S_W;
                                    end
                                  else
                                    begin
                                       regvars[i]^.reg:=varregs[i];
                                       regsize:=S_L;
                                    end;
                                  { parameter must be load }
                                  if regvars_para[i] then
                                    begin
                                       { procinfo is there actual,      }
                                       { because we can't never be in a }
                                       { nested procedure               }
                                       { when loading parameter to reg  }
                                       new(hr);
                                       reset_reference(hr^);
                                       hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
                                       hr^.base:=procinfo.framepointer;
                                       procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
                                         hr,regvars[i]^.reg)));
                                       unused:=unused - [regvars[i]^.reg];
                                    end;
                                  { procedure uses this register }
                                  usedinproc:=usedinproc or ($800 shr word(varregs[i]));
                               end;
                             nextreg:
                               { dummy }
                               regsize:=S_W;
                          end;
                        if (status.verbosity and v_debug)=v_debug then
                          begin
                             for i:=1 to maxvarregs do
                               begin
                                  if assigned(regvars[i]) then
                                   Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
                                           tostr(regvars[i]^.refs),regvars[i]^.name);
                               end;
                          end;
                     end;
                end;
              do_secondpass(p);

              { all registers can be used again }
              { contains both information on Address registers and data registers }
              { even if they are allocated separately.                            }
              usableregs:=[R_D0,R_D1,R_D2,R_D3,R_D4,R_D5,R_D6,R_D7,R_A0,R_A1,R_A2,R_A3,R_A4,
                  R_FP0,R_FP1,R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,R_FP7];
              c_usableregs:=4;
           end;
         procinfo.aktproccode^.concatlist(exprasmlist);
      end;

end.


{
  $Log$
  Revision 1.13  1998-08-10 14:43:14  peter
    * string type st_ fixed

  Revision 1.12  1998/07/15 16:41:01  jonas
  * fixed bug that caused the stackframe never to be omitted

  Revision 1.11  1998/07/14 14:46:43  peter
    * released NEWINPUT

  Revision 1.10  1998/07/10 10:50:57  peter
    * m68k updates

  Revision 1.9  1998/07/06 15:51:16  michael
  Added length checking for string reading

  Revision 1.8  1998/06/12 10:32:22  pierre
    * column problem hopefully solved
    + C vars declaration changed

  Revision 1.7  1998/06/09 16:01:36  pierre
    + added procedure directive parsing for procvars
      (accepted are popstack cdecl and pascal)
    + added C vars with the following syntax
      var C calias 'true_c_name';(can be followed by external)
      reason is that you must add the Cprefix

      which is target dependent

  Revision 1.6  1998/06/08 13:13:36  pierre
    + temporary variables now in temp_gen.pas unit
      because it is processor independent
    * mppc68k.bat modified to undefine i386 and support_mmx
      (which are defaults for i386)

  Revision 1.5  1998/06/04 23:51:34  peter
    * m68k compiles
    + .def file creation moved to gendef.pas so it could also be used
      for win32

  Revision 1.4  1998/04/29 10:33:44  pierre
    + added some code for ansistring (not complete nor working yet)
    * corrected operator overloading
    * corrected nasm output
    + started inline procedures
    + added starstarn : use ** for exponentiation (^ gave problems)
    + started UseTokenInfo cond to get accurate positions

  Revision 1.3  1998/04/07 22:45:03  florian
    * bug0092, bug0115 and bug0121 fixed
    + packed object/class/array
}