mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 12:23:24 +01:00 
			
		
		
		
	the IInterface implementation to be XPCom-compatible --- Merging r15997 through r16179 into '.': U rtl/inc/variants.pp U rtl/inc/objpash.inc U rtl/inc/objpas.inc U rtl/objpas/classes/persist.inc U rtl/objpas/classes/compon.inc U rtl/objpas/classes/classesh.inc A tests/test/tconstref1.pp A tests/test/tconstref2.pp A tests/test/tconstref3.pp U tests/test/tinterface4.pp A tests/test/tconstref4.pp U tests/webtbs/tw10897.pp U tests/webtbs/tw4086.pp U tests/webtbs/tw15363.pp U tests/webtbs/tw2177.pp U tests/webtbs/tw16592.pp U tests/tbs/tb0546.pp U compiler/sparc/cpupara.pas U compiler/i386/cpupara.pas U compiler/pdecsub.pas U compiler/symdef.pas U compiler/powerpc/cpupara.pas U compiler/avr/cpupara.pas U compiler/browcol.pas U compiler/defcmp.pas U compiler/powerpc64/cpupara.pas U compiler/ncgrtti.pas U compiler/x86_64/cpupara.pas U compiler/opttail.pas U compiler/htypechk.pas U compiler/tokens.pas U compiler/objcutil.pas U compiler/ncal.pas U compiler/symtable.pas U compiler/symsym.pas U compiler/m68k/cpupara.pas U compiler/regvars.pas U compiler/arm/cpupara.pas U compiler/symconst.pas U compiler/mips/cpupara.pas U compiler/paramgr.pas U compiler/psub.pas U compiler/pdecvar.pas U compiler/dbgstabs.pas U compiler/options.pas U packages/fcl-fpcunit/src/testutils.pp git-svn-id: trunk@16180 -
		
			
				
	
	
		
			583 lines
		
	
	
		
			20 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			583 lines
		
	
	
		
			20 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    Copyright (c) 2002 by Florian Klaempfl
 | 
						|
 | 
						|
    Generates the argument location information for 680x0
 | 
						|
 | 
						|
    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.
 | 
						|
 | 
						|
 ****************************************************************************
 | 
						|
}
 | 
						|
{ Generates the argument location information for 680x0.
 | 
						|
}
 | 
						|
unit cpupara;
 | 
						|
 | 
						|
{$i fpcdefs.inc}
 | 
						|
 | 
						|
  interface
 | 
						|
 | 
						|
    uses
 | 
						|
      globtype,
 | 
						|
      cpubase,
 | 
						|
      aasmdata,
 | 
						|
      symconst,symtype,symdef,symsym,
 | 
						|
      parabase,paramgr,cgbase;
 | 
						|
 | 
						|
    type
 | 
						|
       { Returns the location for the nr-st 32 Bit int parameter
 | 
						|
         if every parameter before is an 32 Bit int parameter as well
 | 
						|
         and if the calling conventions for the helper routines of the
 | 
						|
         rtl are used.
 | 
						|
       }
 | 
						|
       tm68kparamanager = class(tparamanager)
 | 
						|
          procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
 | 
						|
          function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
 | 
						|
          function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
 | 
						|
          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
 | 
						|
          procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
 | 
						|
          procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
 | 
						|
         private
 | 
						|
          procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword);
 | 
						|
          function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
 | 
						|
                                               var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint;
 | 
						|
          function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
 | 
						|
          function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
 | 
						|
       end;
 | 
						|
 | 
						|
  implementation
 | 
						|
 | 
						|
    uses
 | 
						|
       verbose,
 | 
						|
       globals,
 | 
						|
       systems,
 | 
						|
       cpuinfo,cgutils,
 | 
						|
       defutil;
 | 
						|
 | 
						|
    procedure tm68kparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);
 | 
						|
      var
 | 
						|
        paraloc : pcgparalocation;
 | 
						|
      begin
 | 
						|
         if nr<1 then
 | 
						|
           internalerror(2002070801);
 | 
						|
         cgpara.reset;
 | 
						|
         cgpara.size:=OS_INT;
 | 
						|
         cgpara.alignment:=std_param_align;
 | 
						|
         paraloc:=cgpara.add_location;
 | 
						|
         with paraloc^ do
 | 
						|
           begin
 | 
						|
              { warning : THIS ONLY WORKS WITH INTERNAL ROUTINES,
 | 
						|
                WHICH MUST ALWAYS PASS 4-BYTE PARAMETERS!!
 | 
						|
              }
 | 
						|
              loc:=LOC_REFERENCE;
 | 
						|
              reference.index:=NR_STACK_POINTER_REG;
 | 
						|
              reference.offset:=target_info.first_parm_offset+nr*4;
 | 
						|
           end;
 | 
						|
      end;
 | 
						|
 | 
						|
    function getparaloc(p : tdef) : tcgloc;
 | 
						|
 | 
						|
      begin
 | 
						|
         result:=LOC_REFERENCE;
 | 
						|
         { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
 | 
						|
           if push_addr_param for the def is true
 | 
						|
         case p.typ of
 | 
						|
            orddef:
 | 
						|
              result:=LOC_REGISTER;
 | 
						|
            floatdef:
 | 
						|
              result:=LOC_FPUREGISTER;
 | 
						|
            enumdef:
 | 
						|
              result:=LOC_REGISTER;
 | 
						|
            pointerdef:
 | 
						|
              result:=LOC_REGISTER;
 | 
						|
            formaldef:
 | 
						|
              result:=LOC_REGISTER;
 | 
						|
            classrefdef:
 | 
						|
              result:=LOC_REGISTER;
 | 
						|
            recorddef:
 | 
						|
              if (target_info.abi<>abi_powerpc_aix) then
 | 
						|
                result:=LOC_REFERENCE
 | 
						|
              else
 | 
						|
                result:=LOC_REGISTER;
 | 
						|
            objectdef:
 | 
						|
              if is_object(p) then
 | 
						|
                result:=LOC_REFERENCE
 | 
						|
              else
 | 
						|
                result:=LOC_REGISTER;
 | 
						|
            stringdef:
 | 
						|
              if is_shortstring(p) or is_longstring(p) then
 | 
						|
                result:=LOC_REFERENCE
 | 
						|
              else
 | 
						|
                result:=LOC_REGISTER;
 | 
						|
            procvardef:
 | 
						|
              if (po_methodpointer in tprocvardef(p).procoptions) then
 | 
						|
                result:=LOC_REFERENCE
 | 
						|
              else
 | 
						|
                result:=LOC_REGISTER;
 | 
						|
            filedef:
 | 
						|
              result:=LOC_REGISTER;
 | 
						|
            arraydef:
 | 
						|
              result:=LOC_REFERENCE;
 | 
						|
            setdef:
 | 
						|
              if is_smallset(p) then
 | 
						|
                result:=LOC_REGISTER
 | 
						|
              else
 | 
						|
                result:=LOC_REFERENCE;
 | 
						|
            variantdef:
 | 
						|
              result:=LOC_REFERENCE;
 | 
						|
            { avoid problems with errornous definitions }
 | 
						|
            errordef:
 | 
						|
              result:=LOC_REGISTER;
 | 
						|
            else
 | 
						|
              internalerror(2002071001);
 | 
						|
         end;
 | 
						|
         }
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
{ TODO: copied from ppc cg, needs work}
 | 
						|
    function tm68kparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
 | 
						|
      begin
 | 
						|
        result:=false;
 | 
						|
        { var,out,constref always require address }
 | 
						|
        if varspez in [vs_var,vs_out,vs_constref] then
 | 
						|
          begin
 | 
						|
            result:=true;
 | 
						|
            exit;
 | 
						|
          end;
 | 
						|
        case def.typ of
 | 
						|
          variantdef,
 | 
						|
          formaldef :
 | 
						|
            result:=true;
 | 
						|
          recorddef:
 | 
						|
            result:=true;
 | 
						|
          arraydef:
 | 
						|
            result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
 | 
						|
                             is_open_array(def) or
 | 
						|
                             is_array_of_const(def) or
 | 
						|
                             is_array_constructor(def);
 | 
						|
          objectdef :
 | 
						|
            result:=is_object(def);
 | 
						|
          setdef :
 | 
						|
            result:=not is_smallset(def);
 | 
						|
          stringdef :
 | 
						|
            result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
 | 
						|
          procvardef :
 | 
						|
            result:=po_methodpointer in tprocvardef(def).procoptions;
 | 
						|
        end;
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure tm68kparamanager.init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword);
 | 
						|
      begin
 | 
						|
        cur_stack_offset:=8;
 | 
						|
        curintreg:=RS_D0;
 | 
						|
        curfloatreg:=RS_FP0;
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure tm68kparamanager.create_funcretloc_info(p: tabstractprocdef; side: tcallercallee);
 | 
						|
      begin
 | 
						|
        p.funcretloc[side]:=get_funcretloc(p,side,p.returndef);
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    function tm68kparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;
 | 
						|
      var
 | 
						|
        paraloc : pcgparalocation;
 | 
						|
        retcgsize  : tcgsize;
 | 
						|
      begin
 | 
						|
        result.init;
 | 
						|
        result.alignment:=get_para_align(p.proccalloption);
 | 
						|
        { void has no location }
 | 
						|
        if is_void(def) then
 | 
						|
          begin
 | 
						|
            paraloc:=result.add_location;
 | 
						|
            result.size:=OS_NO;
 | 
						|
            result.intsize:=0;
 | 
						|
            paraloc^.size:=OS_NO;
 | 
						|
            paraloc^.loc:=LOC_VOID;
 | 
						|
            exit;
 | 
						|
          end;
 | 
						|
        { Constructors return self instead of a boolean }
 | 
						|
        if (p.proctypeoption=potype_constructor) then
 | 
						|
          begin
 | 
						|
            retcgsize:=OS_ADDR;
 | 
						|
            result.intsize:=sizeof(pint);
 | 
						|
          end
 | 
						|
        else
 | 
						|
          begin
 | 
						|
            retcgsize:=def_cgsize(def);
 | 
						|
            result.intsize:=def.size;
 | 
						|
          end;
 | 
						|
        result.size:=retcgsize;
 | 
						|
        { Return is passed as var parameter }
 | 
						|
        if ret_in_param(def,p.proccalloption) then
 | 
						|
          begin
 | 
						|
            paraloc:=result.add_location;
 | 
						|
            paraloc^.loc:=LOC_REFERENCE;
 | 
						|
            paraloc^.size:=retcgsize;
 | 
						|
            exit;
 | 
						|
          end;
 | 
						|
 | 
						|
        paraloc:=result.add_location;
 | 
						|
        { Return in FPU register? }
 | 
						|
        if not(cs_fp_emulation in current_settings.moduleswitches) and (p.returndef.typ=floatdef) then
 | 
						|
          begin
 | 
						|
            paraloc^.loc:=LOC_FPUREGISTER;
 | 
						|
            paraloc^.register:=NR_FPU_RESULT_REG;
 | 
						|
            paraloc^.size:=retcgsize;
 | 
						|
          end
 | 
						|
        else
 | 
						|
         { Return in register }
 | 
						|
          begin
 | 
						|
            if retcgsize in [OS_64,OS_S64] then
 | 
						|
             begin
 | 
						|
               { low 32bits }
 | 
						|
               paraloc^.loc:=LOC_REGISTER;
 | 
						|
               paraloc^.size:=OS_32;
 | 
						|
               if side=callerside then
 | 
						|
                 paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
 | 
						|
               else
 | 
						|
                 paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
 | 
						|
               { high 32bits }
 | 
						|
               paraloc:=result.add_location;
 | 
						|
               paraloc^.loc:=LOC_REGISTER;
 | 
						|
               paraloc^.size:=OS_32;
 | 
						|
               if side=calleeside then
 | 
						|
                 paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
 | 
						|
               else
 | 
						|
                 paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
 | 
						|
             end
 | 
						|
            else
 | 
						|
             begin
 | 
						|
               paraloc^.loc:=LOC_REGISTER;
 | 
						|
               paraloc^.size:=retcgsize;
 | 
						|
               if side=callerside then
 | 
						|
                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
 | 
						|
               else
 | 
						|
                 paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
 | 
						|
             end;
 | 
						|
          end;
 | 
						|
      end;
 | 
						|
 | 
						|
    function tm68kparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
 | 
						|
      var
 | 
						|
        cur_stack_offset: aword;
 | 
						|
        curintreg, curfloatreg: tsuperregister;
 | 
						|
      begin
 | 
						|
        init_values(curintreg,curfloatreg,cur_stack_offset);
 | 
						|
 | 
						|
        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,cur_stack_offset);
 | 
						|
 | 
						|
        create_funcretloc_info(p,side);
 | 
						|
      end;
 | 
						|
 | 
						|
    function tm68kparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
 | 
						|
                               var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint;
 | 
						|
      var
 | 
						|
        paraloc      : pcgparalocation;
 | 
						|
        hp           : tparavarsym;
 | 
						|
        paracgsize   : tcgsize;
 | 
						|
        paralen      : aint;
 | 
						|
        parasize     : longint;
 | 
						|
	paradef      : tdef;
 | 
						|
        i            : longint;
 | 
						|
	loc          : tcgloc;
 | 
						|
	nextintreg,
 | 
						|
	nextfloatreg : tsuperregister;
 | 
						|
	stack_offset : longint;
 | 
						|
 | 
						|
      begin
 | 
						|
        result:=0;
 | 
						|
	nextintreg:=curintreg;
 | 
						|
	nextfloatreg:=curfloatreg;
 | 
						|
	stack_offset:=cur_stack_offset;
 | 
						|
 | 
						|
        parasize:=0;
 | 
						|
 | 
						|
        for i:=0 to p.paras.count-1 do
 | 
						|
          begin
 | 
						|
            hp:=tparavarsym(paras[i]);
 | 
						|
	    paradef:=hp.vardef;
 | 
						|
 | 
						|
	    { syscall for AmigaOS can have already a paraloc set }
 | 
						|
            if (vo_has_explicit_paraloc in hp.varoptions) then
 | 
						|
              begin
 | 
						|
                if not(vo_is_syscall_lib in hp.varoptions) then
 | 
						|
                  internalerror(200506051);
 | 
						|
                continue;
 | 
						|
              end;
 | 
						|
            hp.paraloc[side].reset;
 | 
						|
 | 
						|
            { currently only support C-style array of const }
 | 
						|
            if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
 | 
						|
               is_array_of_const(paradef) then
 | 
						|
              begin
 | 
						|
{$ifdef DEBUG_CHARLIE}
 | 
						|
                writeln('loc register');
 | 
						|
{$endif DEBUG_CHARLIE}
 | 
						|
                paraloc:=hp.paraloc[side].add_location;
 | 
						|
                { hack: the paraloc must be valid, but is not actually used }
 | 
						|
                paraloc^.loc:=LOC_REGISTER;
 | 
						|
		paraloc^.register:=NR_D0;
 | 
						|
                paraloc^.size:=OS_ADDR;
 | 
						|
                break;
 | 
						|
              end;
 | 
						|
 | 
						|
            if (hp.varspez in [vs_var,vs_out]) or
 | 
						|
               push_addr_param(hp.varspez,paradef,p.proccalloption) or
 | 
						|
               is_open_array(paradef) or
 | 
						|
               is_array_of_const(paradef) then
 | 
						|
              begin
 | 
						|
{$ifdef DEBUG_CHARLIE}
 | 
						|
                writeln('loc register');
 | 
						|
{$endif DEBUG_CHARLIE}
 | 
						|
                paradef:=voidpointertype;
 | 
						|
                loc:=LOC_REGISTER;
 | 
						|
                paracgsize := OS_ADDR;
 | 
						|
                paralen := tcgsize2size[OS_ADDR];
 | 
						|
              end
 | 
						|
            else
 | 
						|
              begin
 | 
						|
                if not is_special_array(paradef) then
 | 
						|
                  paralen:=paradef.size
 | 
						|
                else
 | 
						|
                  paralen:=tcgsize2size[def_cgsize(paradef)];
 | 
						|
 | 
						|
                loc:=getparaloc(paradef);
 | 
						|
                paracgsize:=def_cgsize(paradef);
 | 
						|
                { for things like formaldef }
 | 
						|
                if (paracgsize=OS_NO) then
 | 
						|
                  begin
 | 
						|
                    paracgsize:=OS_ADDR;
 | 
						|
                    paralen := tcgsize2size[OS_ADDR];
 | 
						|
                  end;
 | 
						|
              end;
 | 
						|
 | 
						|
            hp.paraloc[side].alignment:=std_param_align;
 | 
						|
            hp.paraloc[side].size:=paracgsize;
 | 
						|
            hp.paraloc[side].intsize:=paralen;
 | 
						|
 | 
						|
            if (paralen = 0) then
 | 
						|
              if (paradef.typ = recorddef) then
 | 
						|
                begin
 | 
						|
                  paraloc:=hp.paraloc[side].add_location;
 | 
						|
                  paraloc^.loc := LOC_VOID;
 | 
						|
                end
 | 
						|
              else
 | 
						|
                internalerror(200506052);
 | 
						|
            { can become < 0 for e.g. 3-byte records }
 | 
						|
            while (paralen > 0) do
 | 
						|
              begin
 | 
						|
                paraloc:=hp.paraloc[side].add_location;
 | 
						|
                {
 | 
						|
                  by default, the m68k doesn't know any register parameters  (FK)
 | 
						|
                if (loc = LOC_REGISTER) and
 | 
						|
                   (nextintreg <= RS_D2) then
 | 
						|
                  begin
 | 
						|
		    //writeln('loc register');
 | 
						|
                    paraloc^.loc := loc;
 | 
						|
                    { make sure we don't lose whether or not the type is signed }
 | 
						|
                    if (paradef.typ <> orddef) then
 | 
						|
                      paracgsize := int_cgsize(paralen);
 | 
						|
                    if (paracgsize in [OS_NO,OS_64,OS_S64]) then
 | 
						|
                      paraloc^.size := OS_INT
 | 
						|
                    else
 | 
						|
                      paraloc^.size := paracgsize;
 | 
						|
                    paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE);
 | 
						|
                    inc(nextintreg);
 | 
						|
                    dec(paralen,tcgsize2size[paraloc^.size]);
 | 
						|
                  end
 | 
						|
                else if (loc = LOC_FPUREGISTER) and
 | 
						|
                        (nextfloatreg <= RS_FP2) then
 | 
						|
                  begin
 | 
						|
//		    writeln('loc fpuregister');
 | 
						|
                    paraloc^.loc:=loc;
 | 
						|
                    paraloc^.size := paracgsize;
 | 
						|
                    paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE);
 | 
						|
                    inc(nextfloatreg);
 | 
						|
                    dec(paralen,tcgsize2size[paraloc^.size]);
 | 
						|
                  end
 | 
						|
                else { LOC_REFERENCE }
 | 
						|
}
 | 
						|
                  begin
 | 
						|
{$ifdef DEBUG_CHARLIE}
 | 
						|
		    writeln('loc reference');
 | 
						|
{$endif DEBUG_CHARLIE}
 | 
						|
                    paraloc^.loc:=LOC_REFERENCE;
 | 
						|
                    paraloc^.size:=int_cgsize(paralen);
 | 
						|
                    if (side = callerside) then
 | 
						|
                      paraloc^.reference.index:=NR_STACK_POINTER_REG
 | 
						|
                    else
 | 
						|
                      paraloc^.reference.index:=NR_FRAME_POINTER_REG;
 | 
						|
                    paraloc^.reference.offset:=stack_offset;
 | 
						|
                    inc(stack_offset,align(paralen,4));
 | 
						|
                    paralen := 0;
 | 
						|
                  end;
 | 
						|
              end;
 | 
						|
          end;
 | 
						|
         result:=stack_offset;
 | 
						|
//	 writeln('stack offset:',stack_offset);
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
{
 | 
						|
 | 
						|
            if push_addr_param(hp.varspez,paradef,p.proccalloption) then
 | 
						|
              paracgsize:=OS_ADDR
 | 
						|
            else
 | 
						|
              begin
 | 
						|
                paracgsize:=def_cgsize(paradef);
 | 
						|
                if paracgsize=OS_NO then
 | 
						|
                  paracgsize:=OS_ADDR;
 | 
						|
              end;
 | 
						|
            hp.paraloc[side].size:=paracgsize;
 | 
						|
            hp.paraloc[side].Alignment:=std_param_align;
 | 
						|
            paraloc:=hp.paraloc[side].add_location;
 | 
						|
            paraloc^.size:=paracgsize;
 | 
						|
            paraloc^.loc:=LOC_REFERENCE;
 | 
						|
            if side=callerside then
 | 
						|
              paraloc^.reference.index:=NR_STACK_POINTER_REG
 | 
						|
            else
 | 
						|
              paraloc^.reference.index:=NR_FRAME_POINTER_REG;
 | 
						|
            paraloc^.reference.offset:=target_info.first_parm_offset+parasize;
 | 
						|
          end;
 | 
						|
	create_funcretloc_info(p,side);
 | 
						|
        result:=parasize;
 | 
						|
      end;
 | 
						|
}
 | 
						|
 | 
						|
    function tm68kparamanager.parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;
 | 
						|
      begin
 | 
						|
        result:=false;
 | 
						|
        case target_info.system of
 | 
						|
          system_m68k_amiga:
 | 
						|
            begin
 | 
						|
              if s='D0' then
 | 
						|
                p.exp_funcretloc:=NR_D0
 | 
						|
              else if s='D1' then
 | 
						|
                p.exp_funcretloc:=NR_D1
 | 
						|
              else if s='D2' then
 | 
						|
                p.exp_funcretloc:=NR_D2
 | 
						|
              else if s='D3' then
 | 
						|
                p.exp_funcretloc:=NR_D3
 | 
						|
              else if s='D4' then
 | 
						|
                p.exp_funcretloc:=NR_D4
 | 
						|
              else if s='D5' then
 | 
						|
                p.exp_funcretloc:=NR_D5
 | 
						|
              else if s='D6' then
 | 
						|
                p.exp_funcretloc:=NR_D6
 | 
						|
              else if s='D7' then
 | 
						|
                p.exp_funcretloc:=NR_D7
 | 
						|
              else if s='A0' then
 | 
						|
                p.exp_funcretloc:=NR_A0
 | 
						|
              else if s='A1' then
 | 
						|
                p.exp_funcretloc:=NR_A1
 | 
						|
              else if s='A2' then
 | 
						|
                p.exp_funcretloc:=NR_A2
 | 
						|
              else if s='A3' then
 | 
						|
                p.exp_funcretloc:=NR_A3
 | 
						|
              else if s='A4' then
 | 
						|
                p.exp_funcretloc:=NR_A4
 | 
						|
              else if s='A5' then
 | 
						|
                p.exp_funcretloc:=NR_A5
 | 
						|
              { 'A6' is problematic, since it's the frame pointer in fpc,
 | 
						|
                so it should be saved before a call! }
 | 
						|
              else if s='A6' then
 | 
						|
                p.exp_funcretloc:=NR_A6
 | 
						|
              { 'A7' is the stack pointer on 68k, can't be overwritten by API calls }
 | 
						|
              else
 | 
						|
                p.exp_funcretloc:=NR_NO;
 | 
						|
 | 
						|
              if p.exp_funcretloc<>NR_NO then result:=true;
 | 
						|
            end;
 | 
						|
          else
 | 
						|
            internalerror(2005121801);
 | 
						|
        end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    function tm68kparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
 | 
						|
      var
 | 
						|
        paraloc : pcgparalocation;
 | 
						|
      begin
 | 
						|
        result:=false;
 | 
						|
        case target_info.system of
 | 
						|
          system_m68k_amiga:
 | 
						|
            begin
 | 
						|
              p.paraloc[callerside].alignment:=4;
 | 
						|
              paraloc:=p.paraloc[callerside].add_location;
 | 
						|
              paraloc^.loc:=LOC_REGISTER;
 | 
						|
              paraloc^.size:=def_cgsize(p.vardef);
 | 
						|
              { pattern is always uppercase'd }
 | 
						|
              if s='D0' then
 | 
						|
                paraloc^.register:=NR_D0
 | 
						|
              else if s='D1' then
 | 
						|
                paraloc^.register:=NR_D1
 | 
						|
              else if s='D2' then
 | 
						|
                paraloc^.register:=NR_D2
 | 
						|
              else if s='D3' then
 | 
						|
                paraloc^.register:=NR_D3
 | 
						|
              else if s='D4' then
 | 
						|
                paraloc^.register:=NR_D4
 | 
						|
              else if s='D5' then
 | 
						|
                paraloc^.register:=NR_D5
 | 
						|
              else if s='D6' then
 | 
						|
                paraloc^.register:=NR_D6
 | 
						|
              else if s='D7' then
 | 
						|
                paraloc^.register:=NR_D7
 | 
						|
              else if s='A0' then
 | 
						|
                paraloc^.register:=NR_A0
 | 
						|
              else if s='A1' then
 | 
						|
                paraloc^.register:=NR_A1
 | 
						|
              else if s='A2' then
 | 
						|
                paraloc^.register:=NR_A2
 | 
						|
              else if s='A3' then
 | 
						|
                paraloc^.register:=NR_A3
 | 
						|
              else if s='A4' then
 | 
						|
                paraloc^.register:=NR_A4
 | 
						|
              else if s='A5' then
 | 
						|
                paraloc^.register:=NR_A5
 | 
						|
              { 'A6' is problematic, since it's the frame pointer in fpc,
 | 
						|
                so it should be saved before a call! }
 | 
						|
              else if s='A6' then
 | 
						|
                paraloc^.register:=NR_A6
 | 
						|
              { 'A7' is the stack pointer on 68k, can't be overwritten by API calls }
 | 
						|
              else
 | 
						|
                exit;
 | 
						|
 | 
						|
              { copy to callee side }
 | 
						|
              p.paraloc[calleeside].add_location^:=paraloc^;
 | 
						|
            end;
 | 
						|
          else
 | 
						|
            internalerror(200405092);
 | 
						|
        end;
 | 
						|
        result:=true;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure tm68kparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
 | 
						|
      var
 | 
						|
        paraloc : pcgparalocation;
 | 
						|
      begin
 | 
						|
        paraloc:=parasym.paraloc[callerside].location;
 | 
						|
        { Never a need for temps when value is pushed (calls inside parameters
 | 
						|
          will simply allocate even more stack space for their parameters) }
 | 
						|
        if not(use_fixed_stack) then
 | 
						|
          can_use_final_stack_loc:=true;
 | 
						|
        inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara);
 | 
						|
      end;
 | 
						|
 | 
						|
begin
 | 
						|
  paramanager:=tm68kparamanager.create;
 | 
						|
end.
 |