mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 11:39:40 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			1185 lines
		
	
	
		
			61 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			1185 lines
		
	
	
		
			61 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    $Id$
 | 
						|
    Copyright (c) 1998-2000 by Florian Klaempfl
 | 
						|
 | 
						|
    Generate m68k assembler for in call nodes
 | 
						|
 | 
						|
    This program is free software; you can redistribute it and/or modify
 | 
						|
    it under the terms of the GNU General Public License as published by
 | 
						|
    the Free Software Foundation; either version 2 of the License, or
 | 
						|
    (at your option) any later version.
 | 
						|
 | 
						|
    This program is distributed in the hope that it will be useful,
 | 
						|
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
						|
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
						|
    GNU General Public License for more details.
 | 
						|
 | 
						|
    You should have received a copy of the GNU General Public License
 | 
						|
    along with this program; if not, write to the Free Software
 | 
						|
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 | 
						|
 | 
						|
 ****************************************************************************
 | 
						|
}
 | 
						|
unit cg68kcal;
 | 
						|
interface
 | 
						|
 | 
						|
    uses
 | 
						|
      symtable,tree;
 | 
						|
 | 
						|
    { save the size of pushed parameter }
 | 
						|
    var
 | 
						|
       pushedparasize : longint;
 | 
						|
 | 
						|
    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
 | 
						|
                push_from_left_to_right : boolean);
 | 
						|
    procedure secondcalln(var p : ptree);
 | 
						|
    procedure secondprocinline(var p : ptree);
 | 
						|
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
    uses
 | 
						|
      globtype,systems,symconst,
 | 
						|
      cobjects,verbose,globals,
 | 
						|
      aasm,types,
 | 
						|
      hcodegen,temp_gen,pass_2,
 | 
						|
      cpubase,cga68k,tgen68k,cg68kld;
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                             SecondCallParaN
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
 | 
						|
    procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
 | 
						|
                push_from_left_to_right : boolean);
 | 
						|
 | 
						|
      procedure maybe_push_open_array_high;
 | 
						|
        var
 | 
						|
           r : preference;
 | 
						|
        begin
 | 
						|
           { open array ? }
 | 
						|
           { defcoll^.data can be nil for read/write }
 | 
						|
           if assigned(defcoll^.data) and
 | 
						|
              is_open_array(defcoll^.data) then
 | 
						|
             begin
 | 
						|
                inc(pushedparasize,4);
 | 
						|
                { 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(paicpu,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)));
 | 
						|
                 end
 | 
						|
                else
 | 
						|
                 push_int(parraydef(p^.left^.resulttype)^.highrange-parraydef(p^.left^.resulttype)^.lowrange);
 | 
						|
             end;
 | 
						|
        end;
 | 
						|
 | 
						|
      var
 | 
						|
         size : longint;
 | 
						|
         stackref : treference;
 | 
						|
         otlabel,hlabel,oflabel : pasmlabel;
 | 
						|
         { temporary variables: }
 | 
						|
         reg : tregister;
 | 
						|
         tempdeftype : tdeftype;
 | 
						|
         tempreference : treference;
 | 
						|
         r : preference;
 | 
						|
         s : topsize;
 | 
						|
         op : tasmop;
 | 
						|
 | 
						|
      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(paicpu,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
 | 
						|
                     CGMessage(type_e_mismatch)
 | 
						|
                   else
 | 
						|
                     begin
 | 
						|
                        emitpushreferenceaddr(exprasmlist,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
 | 
						|
                CGMessage(cg_e_var_must_be_reference);
 | 
						|
              maybe_push_open_array_high;
 | 
						|
              inc(pushedparasize,4);
 | 
						|
              emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
 | 
						|
              del_reference(p^.left^.location.reference);
 | 
						|
           end
 | 
						|
         else
 | 
						|
           begin
 | 
						|
              tempdeftype:=p^.resulttype^.deftype;
 | 
						|
              if tempdeftype=filedef then
 | 
						|
               CGMessage(cg_e_file_must_call_by_reference);
 | 
						|
              if (assigned(defcoll^.data) and
 | 
						|
                  is_open_array(defcoll^.data)) or
 | 
						|
                 push_addr_param(p^.resulttype) then
 | 
						|
                begin
 | 
						|
                   maybe_push_open_array_high;
 | 
						|
                   inc(pushedparasize,4);
 | 
						|
                   emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
 | 
						|
                   del_reference(p^.left^.location.reference);
 | 
						|
                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^.size) 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(paicpu,op_const_reg(A_LSL,S_W,
 | 
						|
                                             8, reg)));
 | 
						|
                                           exprasmlist^.concat(new(paicpu,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(paicpu,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(paicpu,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(paicpu,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);
 | 
						|
                                        { how now how long a FPU is !! }
 | 
						|
                                        if (size > 0) and (size < 9) then
 | 
						|
                                          exprasmlist^.concat(new(paicpu,op_const_reg(A_SUBQ,S_L,size,R_SP)))
 | 
						|
                                        else
 | 
						|
                                          exprasmlist^.concat(new(paicpu,op_const_reg(A_SUBA,
 | 
						|
                                            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(paicpu,op_reg_ref(A_MOVE,S_L,
 | 
						|
                                             p^.left^.location.fpureg,r)));
 | 
						|
                                        end
 | 
						|
                                        else
 | 
						|
                                          { convert back from extended to normal type }
 | 
						|
                                          exprasmlist^.concat(new(paicpu,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
 | 
						|
                                    enumdef,
 | 
						|
                                     orddef : begin
 | 
						|
                                                   case p^.resulttype^.size of
 | 
						|
                                                    4 : begin
 | 
						|
                                                           emit_push_mem(tempreference);
 | 
						|
                                                           inc(pushedparasize,4);
 | 
						|
                                                        end;
 | 
						|
                                                    1 : 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(paicpu,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(paicpu,op_ref_reg(A_MOVE,S_B,
 | 
						|
                                                             newreference(tempreference),reg)));
 | 
						|
                                                            exprasmlist^.concat(new(paicpu,op_const_reg(A_LSL,S_W,
 | 
						|
                                                             8, reg)));
 | 
						|
                                                            exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_W,
 | 
						|
                                                             reg,R_SPPUSH)));
 | 
						|
                                                            ungetregister32(reg);
 | 
						|
{                                                           exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_W,
 | 
						|
                                                             newreference(tempreference),R_SPPUSH))); }
 | 
						|
                                                          end;
 | 
						|
                                                          inc(pushedparasize,2);
 | 
						|
                                                        end;
 | 
						|
                                                    2 : begin
 | 
						|
                                                          exprasmlist^.concat(new(paicpu,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
 | 
						|
                                                                    CGMessage(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(paicpu,op_ref_reg(A_MOVE,S_W,
 | 
						|
                                                                     newreference(tempreference),R_SPPUSH)));
 | 
						|
                                                                   inc(pushedparasize,extended_size);}
 | 
						|
                                                                end;
 | 
						|
                                                   end;
 | 
						|
                                                end;
 | 
						|
                                     pointerdef,procvardef,
 | 
						|
                                         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(paicpu,op_const_reg(A_SUBQ,S_L,size,R_SP)))
 | 
						|
                                                        else
 | 
						|
                                                            exprasmlist^.concat(new(paicpu,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 CGMessage(cg_e_illegal_expression);
 | 
						|
                                  end;
 | 
						|
                               end;
 | 
						|
                 LOC_JUMP     : begin
 | 
						|
                                   getlabel(hlabel);
 | 
						|
                                   inc(pushedparasize,2);
 | 
						|
                                   emitl(A_LABEL,truelabel);
 | 
						|
                                   exprasmlist^.concat(new(paicpu,op_const_reg(A_MOVE,S_W,1 shl 8,R_SPPUSH)));
 | 
						|
                                   emitl(A_JMP,hlabel);
 | 
						|
                                   emitl(A_LABEL,falselabel);
 | 
						|
                                   exprasmlist^.concat(new(paicpu,op_const_reg(A_MOVE,S_W,0,R_SPPUSH)));
 | 
						|
                                   emitl(A_LABEL,hlabel);
 | 
						|
                                end;
 | 
						|
                 LOC_FLAGS    : begin
 | 
						|
                                   exprasmlist^.concat(new(paicpu,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
 | 
						|
                                     R_D0)));
 | 
						|
                                   exprasmlist^.concat(new(paicpu,op_reg(A_NEG, S_B, R_D0)));
 | 
						|
                                   exprasmlist^.concat(new(paicpu,op_const_reg(A_AND,S_W,$ff, R_D0)));
 | 
						|
                                   inc(pushedparasize,2);
 | 
						|
                                   { ----------------- HACK ----------------------- }
 | 
						|
                                   { HERE IS THE BYTE SIZED PUSH HACK ONCE AGAIN    }
 | 
						|
                                   { SHIFT LEFT THE BYTE TO MAKE IT WORK!           }
 | 
						|
                                   exprasmlist^.concat(new(paicpu,op_const_reg(A_LSL,S_W,8, R_D0)));
 | 
						|
                                   exprasmlist^.concat(new(paicpu,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;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                             SecondCallN
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
    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 : pasmlabel;
 | 
						|
         { 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:=(potype_constructor=p^.procdefinition^.proctypeoption)
 | 
						|
             or (potype_destructor=p^.procdefinition^.proctypeoption);
 | 
						|
         { proc variables destroy all registers }
 | 
						|
         if (p^.right=nil) and
 | 
						|
         { virtual methods too }
 | 
						|
           (po_virtualmethod in p^.procdefinition^.procoptions) then
 | 
						|
           begin
 | 
						|
              if (po_iocheck in p^.procdefinition^.procoptions) and
 | 
						|
                 not(po_iocheck in aktprocsym^.definition^.procoptions) and
 | 
						|
                 (cs_check_io in aktlocalswitches) then
 | 
						|
                begin
 | 
						|
                       getlabel(iolabel);
 | 
						|
                   emitl(A_LABEL,iolabel);
 | 
						|
                end
 | 
						|
              else iolabel:=nil;
 | 
						|
 | 
						|
              { save all used registers }
 | 
						|
              pushusedregisters(pushed,pprocdef(p^.procdefinition)^.usedregisters);
 | 
						|
 | 
						|
              { give used registers through }
 | 
						|
              usedinproc:=usedinproc or pprocdef(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,
 | 
						|
                  (pocall_leftright in p^.procdefinition^.proccalloptions))
 | 
						|
              else
 | 
						|
                secondcallparan(p^.left,p^.procdefinition^.para1,
 | 
						|
                  (pocall_leftright in p^.procdefinition^.proccalloptions));
 | 
						|
           end;
 | 
						|
         params:=p^.left;
 | 
						|
         p^.left:=nil;
 | 
						|
         if ret_in_param(p^.resulttype) then
 | 
						|
           begin
 | 
						|
              emitpushreferenceaddr(exprasmlist,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;
 | 
						|
                   { change dispose type !! }
 | 
						|
                   p^.disposetyp:=dt_mbleft_and_method;
 | 
						|
                   { make a reference }
 | 
						|
                   new(r);
 | 
						|
                   reset_reference(r^);
 | 
						|
                   r^.offset:=p^.symtable^.datasize;
 | 
						|
                   r^.base:=procinfo^.framepointer;
 | 
						|
                   exprasmlist^.concat(new(paicpu,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 po_abstractmethod in p^.procdefinition^.procoptions then
 | 
						|
                                  begin
 | 
						|
                                     CGMessage(cg_e_cant_call_abstract_method);
 | 
						|
                                     goto dont_call;
 | 
						|
                                  end;
 | 
						|
                                { generate no virtual call }
 | 
						|
                                no_virtual_call:=true;
 | 
						|
                                if (sp_static in p^.symtableprocentry^.symoptions) 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(paicpu,op_csymbol_reg(A_MOVE,S_L,
 | 
						|
                                      newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_A5)));
 | 
						|
                                    exprasmlist^.concat(new(paicpu,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;
 | 
						|
 | 
						|
                                    { a class destructor needs a flag }
 | 
						|
                                    if pobjectdef(p^.methodpointer^.resulttype)^.is_class and
 | 
						|
                                       assigned(aktprocsym) and
 | 
						|
                                       (aktprocsym^.definition^.proctypeoption=potype_destructor) then
 | 
						|
                                      begin
 | 
						|
                                        push_int(0);
 | 
						|
                                        exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
 | 
						|
                                      end;
 | 
						|
 | 
						|
                                    if not(is_con_or_destructor and
 | 
						|
                                           pobjectdef(p^.methodpointer^.resulttype)^.is_class and
 | 
						|
                                           assigned(aktprocsym) and
 | 
						|
                                           (aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor])
 | 
						|
                                          ) then
 | 
						|
                                      exprasmlist^.concat(new(paicpu,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
 | 
						|
                                    not(pobjectdef(p^.methodpointer^.resulttype)^.is_class) and
 | 
						|
                                    assigned(aktprocsym) then
 | 
						|
                                      begin
 | 
						|
                                         if not(aktprocsym^.definition^.proctypeoption in
 | 
						|
                                                [potype_constructor,potype_destructor]) then
 | 
						|
                                          CGMessage(cg_w_member_cd_call_from_method);
 | 
						|
                                      end;
 | 
						|
                                    { class destructors get there flag below }
 | 
						|
                                    if is_con_or_destructor and
 | 
						|
                                        not(pobjectdef(p^.methodpointer^.resulttype)^.is_class and
 | 
						|
                                        assigned(aktprocsym) and
 | 
						|
                                        (aktprocsym^.definition^.proctypeoption=potype_destructor)) then
 | 
						|
                                       push_int(0);
 | 
						|
                                   end;
 | 
						|
                           hnewn : begin
 | 
						|
                                     { extended syntax of new }
 | 
						|
                                     { A5 must be zero }
 | 
						|
                                     exprasmlist^.concat(new(paicpu,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(paicpu,op_csymbol(A_PEA,S_L,
 | 
						|
                                       newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
 | 
						|
                                     extended_new:=true;
 | 
						|
                                  end;
 | 
						|
                           hdisposen : begin
 | 
						|
                                          secondpass(p^.methodpointer);
 | 
						|
 | 
						|
                                          { destructor with extended syntax called from dispose }
 | 
						|
                                          { hdisposen always deliver LOC_REFRENZ }
 | 
						|
                                          exprasmlist^.concat(new(paicpu,op_ref_reg(A_LEA,S_L,
 | 
						|
                                            newreference(p^.methodpointer^.location.reference),R_A5)));
 | 
						|
                                          del_reference(p^.methodpointer^.location.reference);
 | 
						|
                                          exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
 | 
						|
                                          exprasmlist^.concat(new(paicpu,op_csymbol(A_PEA,S_L,
 | 
						|
                                            newcsymbol(pobjectdef
 | 
						|
                                               (p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
 | 
						|
                                       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)^.is_class then
 | 
						|
                                                   exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
 | 
						|
                                                     newreference(p^.methodpointer^.location.reference),R_A5)))
 | 
						|
                                                 else
 | 
						|
                                                  Begin
 | 
						|
                                                   exprasmlist^.concat(new(paicpu,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, not for a class method via self }
 | 
						|
                                if not(po_containsself in p^.procdefinition^.procoptions) then
 | 
						|
                                  begin
 | 
						|
                                    if (po_classmethod in p^.procdefinition^.procoptions) and
 | 
						|
                                       not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
 | 
						|
                                  begin
 | 
						|
                                     { class method needs current VMT }
 | 
						|
                                     new(r);
 | 
						|
                                     reset_reference(r^);
 | 
						|
                                     r^.base:=R_A5;
 | 
						|
                                     r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
 | 
						|
                                     exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,r,R_A5)));
 | 
						|
                                  end;
 | 
						|
                                    { direct call to destructor: don't remove data! }
 | 
						|
                                    if (p^.procdefinition^.proctypeoption=potype_destructor) and
 | 
						|
                                       (p^.methodpointer^.resulttype^.deftype=objectdef) and
 | 
						|
                                       (pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
 | 
						|
                                      push_int(1);
 | 
						|
 | 
						|
                                    { direct call to class constructor, don't allocate memory }
 | 
						|
                                    if (p^.procdefinition^.proctypeoption=potype_constructor) and
 | 
						|
                                       (p^.methodpointer^.resulttype^.deftype=objectdef) and
 | 
						|
                                       (pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
 | 
						|
                                      push_int(0)
 | 
						|
                                    else
 | 
						|
                                      exprasmlist^.concat(new(paicpu,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)^.is_class) then
 | 
						|
                                           begin
 | 
						|
 | 
						|
                                            if (p^.procdefinition^.proctypeoption=potype_constructor) then
 | 
						|
                                              begin
 | 
						|
                                               { it's no bad idea, to insert the VMT }
 | 
						|
                                                      exprasmlist^.concat(new(paicpu,op_csymbol(A_PEA,S_L,
 | 
						|
                                               newcsymbol(pobjectdef(
 | 
						|
                                                 p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
 | 
						|
                                              end
 | 
						|
                                            { destructors haven't to dispose the instance, if this is }
 | 
						|
                                            { a direct call                                           }
 | 
						|
                                            else
 | 
						|
                                              push_int(0);
 | 
						|
                                           end;
 | 
						|
                                   end;
 | 
						|
                                  end;
 | 
						|
                             end;
 | 
						|
                        end;
 | 
						|
                     end
 | 
						|
                   else
 | 
						|
                     begin
 | 
						|
                        if (po_classmethod in p^.procdefinition^.procoptions) and
 | 
						|
                          not(
 | 
						|
                            assigned(aktprocsym) and
 | 
						|
                            (po_classmethod in aktprocsym^.definition^.procoptions)
 | 
						|
                          ) then
 | 
						|
                          begin
 | 
						|
                             { class method needs current VMT }
 | 
						|
                             new(r);
 | 
						|
                             reset_reference(r^);
 | 
						|
                             r^.base:=R_A5;
 | 
						|
                             r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
 | 
						|
                             exprasmlist^.concat(new(paicpu,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(paicpu,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
 | 
						|
                             CGMessage(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>=normal_function_level) and assigned(pprocdef(p^.procdefinition)^.parast) and
 | 
						|
            ((pprocdef(p^.procdefinition)^.parast^.symtablelevel)>normal_function_level) then
 | 
						|
                    begin
 | 
						|
                   { if we call a nested function in a method, we must      }
 | 
						|
                   { push also SELF!                                        }
 | 
						|
                   { THAT'S NOT TRUE, we have to load ESI via frame pointer }
 | 
						|
                   { access                                                 }
 | 
						|
                   {
 | 
						|
                     begin
 | 
						|
                        loadesi:=false;
 | 
						|
                        exprasmlist^.concat(new(paicpu,op_reg(A_PUSH,S_L,R_ESI)));
 | 
						|
                     end;
 | 
						|
                   }
 | 
						|
                   if lexlevel=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
 | 
						|
                     begin
 | 
						|
                        new(r);
 | 
						|
                        reset_reference(r^);
 | 
						|
                        r^.offset:=procinfo^.framepointer_offset;
 | 
						|
                        r^.base:=procinfo^.framepointer;
 | 
						|
                        exprasmlist^.concat(new(paicpu,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=(pprocdef(p^.procdefinition)^.parast^.symtablelevel)-1 then
 | 
						|
                     begin
 | 
						|
                        exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,procinfo^.framepointer,R_SPPUSH)))
 | 
						|
                     end
 | 
						|
                   else if lexlevel>(pprocdef(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(paicpu,op_ref_reg(A_MOVE,S_L,r,hregister)));
 | 
						|
                        for i:=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
 | 
						|
                          begin
 | 
						|
                             new(r);
 | 
						|
                             reset_reference(r^);
 | 
						|
                             {we should get the correct frame_pointer_offset at each level
 | 
						|
                             how can we do this !!! }
 | 
						|
                             r^.offset:=procinfo^.framepointer_offset;
 | 
						|
                             r^.base:=hregister;
 | 
						|
                             exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,r,hregister)));
 | 
						|
                          end;
 | 
						|
                        exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,hregister,R_SPPUSH)));
 | 
						|
                        ungetregister32(hregister);
 | 
						|
                     end
 | 
						|
                   else
 | 
						|
                     internalerror(25000);
 | 
						|
                end;
 | 
						|
 | 
						|
              if (po_virtualmethod in p^.procdefinition^.procoptions) and
 | 
						|
                 not(no_virtual_call) then
 | 
						|
                begin
 | 
						|
                   { static functions contain the vmt_address in ESI }
 | 
						|
                   { also class methods                              }
 | 
						|
                   if assigned(aktprocsym) then
 | 
						|
                     begin
 | 
						|
                       if (((sp_static in aktprocsym^.symoptions) or
 | 
						|
                        (po_classmethod in aktprocsym^.definition^.procoptions)) and
 | 
						|
                        ((p^.methodpointer=nil) or (p^.methodpointer^.treetype=typen)))
 | 
						|
                        or
 | 
						|
                        (po_staticmethod in p^.procdefinition^.procoptions) or
 | 
						|
                        (p^.procdefinition^.proctypeoption=potype_constructor) or
 | 
						|
                        { A5 is loaded earlier }
 | 
						|
                        (po_classmethod in p^.procdefinition^.procoptions) then
 | 
						|
                         begin
 | 
						|
                            new(r);
 | 
						|
                            reset_reference(r^);
 | 
						|
                            r^.base:=R_a5;
 | 
						|
                         end
 | 
						|
                       else
 | 
						|
                         begin
 | 
						|
                            new(r);
 | 
						|
                            reset_reference(r^);
 | 
						|
                            r^.base:=R_a5;
 | 
						|
                            r^.offset:= pprocdef(p^.procdefinition)^._class^.vmt_offset;
 | 
						|
                            exprasmlist^.concat(new(paicpu,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(paicpu,op_ref_reg(A_MOVE,S_L,r,R_a0)));
 | 
						|
                       new(r);
 | 
						|
                       reset_reference(r^);
 | 
						|
                       r^.base:=R_a0;
 | 
						|
                     end;
 | 
						|
                  if pprocdef(p^.procdefinition)^.extnumber=-1 then
 | 
						|
                    internalerror(1609991);
 | 
						|
                  r^.offset:=pprocdef(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('FPC_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(paicpu,op_ref_reg(A_MOVE,S_L,newreference(r^),R_A0)));
 | 
						|
                   { clear the reference }
 | 
						|
                   reset_reference(r^);
 | 
						|
                   r^.base := R_A0;
 | 
						|
                  exprasmlist^.concat(new(paicpu,op_ref(A_JSR,S_NO,r)));
 | 
						|
                end
 | 
						|
              else if pocall_palmossyscall in p^.procdefinition^.proccalloptions then
 | 
						|
                begin
 | 
						|
                   exprasmlist^.concat(new(paicpu,op_const(A_TRAP,S_NO,15)));
 | 
						|
                   exprasmlist^.concat(new(pai_const,init_16bit(pprocdef(p^.procdefinition)^.extnumber)));
 | 
						|
                end
 | 
						|
              else
 | 
						|
                emitcall(pprocdef(p^.procdefinition)^.mangledname,
 | 
						|
                  (p^.symtableproc^.symtabletype=unitsymtable) or
 | 
						|
                  ((p^.symtableproc^.symtabletype=objectsymtable) and
 | 
						|
                  (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable))or
 | 
						|
                  ((p^.symtableproc^.symtabletype=withsymtable) and
 | 
						|
                  (pobjectdef(p^.symtableproc^.defowner)^.owner^.symtabletype=unitsymtable)));
 | 
						|
              if (pocall_clearstack in p^.procdefinition^.proccalloptions) then
 | 
						|
                begin
 | 
						|
                   if (pushedparasize > 0) and (pushedparasize < 9) then
 | 
						|
                     { restore the stack, to its initial value }
 | 
						|
                     exprasmlist^.concat(new(paicpu,op_const_reg(A_ADDQ,S_L,pushedparasize,R_SP)))
 | 
						|
                   else
 | 
						|
                     { restore the stack, to its initial value }
 | 
						|
                     exprasmlist^.concat(new(paicpu,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(paicpu,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(paicpu,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(paicpu,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(paicpu,op_ref(A_JSR,S_NO,ref)));
 | 
						|
                       end
 | 
						|
                       else
 | 
						|
                       begin
 | 
						|
                         exprasmlist^.concat(new(paicpu,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(paicpu,op_ref(A_JSR,S_NO,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^.proctypeoption=potype_constructor) 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 in [orddef,enumdef]) then
 | 
						|
                     begin
 | 
						|
                        p^.location.loc:=LOC_REGISTER;
 | 
						|
                  case p^.resulttype^.size of
 | 
						|
                     4 :
 | 
						|
                        begin
 | 
						|
                             hregister:=getregister32;
 | 
						|
                             emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
 | 
						|
                             p^.location.register:=hregister;
 | 
						|
                        end;
 | 
						|
                     1 :
 | 
						|
                        begin
 | 
						|
                            hregister:=getregister32;
 | 
						|
                            emit_reg_reg(A_MOVE,S_B,R_D0,hregister);
 | 
						|
                            p^.location.register:=hregister;
 | 
						|
                        end;
 | 
						|
                     2:
 | 
						|
                       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;
 | 
						|
                     s64comp,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(paicpu,op_csymbol(A_PEA,S_L,newcsymbol(iolabel^.name,0))));
 | 
						|
              emitcall('FPC_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;
 | 
						|
 | 
						|
 | 
						|
{*****************************************************************************
 | 
						|
                             SecondProcInlineN
 | 
						|
*****************************************************************************}
 | 
						|
 | 
						|
    procedure secondprocinline(var p : ptree);
 | 
						|
       begin
 | 
						|
         InternalError(132421);
 | 
						|
       end;
 | 
						|
 | 
						|
 | 
						|
 | 
						|
end.
 | 
						|
{
 | 
						|
  $Log$
 | 
						|
  Revision 1.23  2000-01-07 01:14:21  peter
 | 
						|
    * updated copyright to 2000
 | 
						|
 | 
						|
  Revision 1.22  1999/12/22 01:01:47  peter
 | 
						|
    - removed freelabel()
 | 
						|
    * added undefined label detection in internal assembler, this prevents
 | 
						|
      a lot of ld crashes and wrong .o files
 | 
						|
    * .o files aren't written anymore if errors have occured
 | 
						|
    * inlining of assembler labels is now correct
 | 
						|
 | 
						|
  Revision 1.21  1999/11/06 14:34:18  peter
 | 
						|
    * truncated log to 20 revs
 | 
						|
 | 
						|
  Revision 1.20  1999/09/27 23:44:48  peter
 | 
						|
    * procinfo is now a pointer
 | 
						|
    * support for result setting in sub procedure
 | 
						|
 | 
						|
  Revision 1.19  1999/09/16 23:05:51  florian
 | 
						|
    * m68k compiler is again compilable (only gas writer, no assembler reader)
 | 
						|
 | 
						|
  Revision 1.18  1999/09/16 11:34:52  pierre
 | 
						|
   * typo correction
 | 
						|
 | 
						|
  Revision 1.17  1998/12/11 00:02:58  peter
 | 
						|
    + globtype,tokens,version unit splitted from globals
 | 
						|
 | 
						|
  Revision 1.16  1998/11/13 15:40:15  pierre
 | 
						|
    + added -Se in Makefile cvstest target
 | 
						|
    + lexlevel cleanup
 | 
						|
      normal_function_level main_program_level and unit_init_level defined
 | 
						|
    * tins_cache grown to A_EMMS (gave range check error in asm readers)
 | 
						|
      (test added in code !)
 | 
						|
    * -Un option was wrong
 | 
						|
    * _FAIL and _SELF only keyword inside
 | 
						|
      constructors and methods respectively
 | 
						|
 | 
						|
  Revision 1.15  1998/11/12 11:19:41  pierre
 | 
						|
   * fix for first line of function break
 | 
						|
 | 
						|
  Revision 1.14  1998/10/21 15:12:51  pierre
 | 
						|
    * bug fix for IOCHECK inside a procedure with iocheck modifier
 | 
						|
    * removed the GPF for unexistant overloading
 | 
						|
      (firstcall was called with procedinition=nil !)
 | 
						|
    * changed typen to what Florian proposed
 | 
						|
      gentypenode(p : pdef) sets the typenodetype field
 | 
						|
      and resulttype is only set if inside bt_type block !
 | 
						|
 | 
						|
  Revision 1.13  1998/10/20 08:06:45  pierre
 | 
						|
    * several memory corruptions due to double freemem solved
 | 
						|
      => never use p^.loc.location:=p^.left^.loc.location;
 | 
						|
    + finally I added now by default
 | 
						|
      that ra386dir translates global and unit symbols
 | 
						|
    + added a first field in tsymtable and
 | 
						|
      a nextsym field in tsym
 | 
						|
      (this allows to obtain ordered type info for
 | 
						|
      records and objects in gdb !)
 | 
						|
 | 
						|
  Revision 1.12  1998/10/19 08:54:53  pierre
 | 
						|
    * wrong stabs info corrected once again !!
 | 
						|
    + variable vmt offset with vmt field only if required
 | 
						|
      implemented now !!!
 | 
						|
 | 
						|
  Revision 1.11  1998/10/16 13:12:46  pierre
 | 
						|
    * added vmt_offsets in destructors code also !!!
 | 
						|
    * vmt_offset code for m68k
 | 
						|
 | 
						|
  Revision 1.10  1998/10/15 12:41:16  pierre
 | 
						|
    * last memory leaks found when compiler
 | 
						|
      a native atari compiler fixed
 | 
						|
 | 
						|
  Revision 1.9  1998/10/14 11:28:16  florian
 | 
						|
    * emitpushreferenceaddress gets now the asmlist as parameter
 | 
						|
    * m68k version compiles with -duseansistrings
 | 
						|
 | 
						|
  Revision 1.8  1998/10/13 16:50:04  pierre
 | 
						|
    * undid some changes of Peter that made the compiler wrong
 | 
						|
      for m68k (I had to reinsert some ifdefs)
 | 
						|
    * removed several memory leaks under m68k
 | 
						|
    * removed the meory leaks for assembler readers
 | 
						|
    * cross compiling shoud work again better
 | 
						|
      ( crosscompiling sysamiga works
 | 
						|
       but as68k still complain about some code !)
 | 
						|
 | 
						|
  Revision 1.7  1998/10/13 08:19:27  pierre
 | 
						|
    + source_os is now set correctly for cross-processor compilers
 | 
						|
      (tos contains all target_infos and
 | 
						|
       we use CPU86 and CPU68 conditionals to
 | 
						|
       get the source operating system
 | 
						|
       this only works if you do not undefine
 | 
						|
       the source target  !!)
 | 
						|
    * several cg68k memory leaks fixed
 | 
						|
    + started to change the code so that it should be possible to have
 | 
						|
      a complete compiler (both for m68k and i386 !!)
 | 
						|
 | 
						|
  Revision 1.6  1998/09/20 12:26:38  peter
 | 
						|
    * merged fixes
 | 
						|
 | 
						|
  Revision 1.5  1998/09/17 09:42:22  peter
 | 
						|
    + pass_2 for cg386
 | 
						|
    * Message() -> CGMessage() for pass_1/pass_2
 | 
						|
 | 
						|
  Revision 1.4  1998/09/14 10:43:55  peter
 | 
						|
    * all internal RTL functions start with FPC_
 | 
						|
 | 
						|
  Revision 1.3.2.1  1998/09/20 12:20:09  peter
 | 
						|
    * Fixed stack not on 4 byte boundary when doing a call
 | 
						|
 | 
						|
  Revision 1.3  1998/09/04 08:41:43  peter
 | 
						|
    * updated some error CGMessages
 | 
						|
 | 
						|
  Revision 1.2  1998/09/01 12:47:59  peter
 | 
						|
    * use pdef^.size instead of orddef^.typ
 | 
						|
 | 
						|
}
 | 
						|
 |