paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 01:29:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* some m68k stuff updated

Browse Source
This commit is contained in:
florian 2004-11-27 16:16:02 +00:00
parent 1fcd2cd8ad
commit 54ceea9e60
2 changed files with 81 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
compiler/m68k/cgcpu.pas
View File

@ -29,56 +29,57 @@ unit cgcpu;
uses uses
cgbase,cgobj,globtype, cgbase,cgobj,globtype,
aasmbase,aasmtai,aasmcpu, aasmbase,aasmtai,aasmcpu,
cpubase,cpuinfo,cpupara, cpubase,cpuinfo,
parabase,cpupara,
node,symconst,symtype, node,symconst,symtype,
cgutils,cg64f32; cgutils,cg64f32;
type type
tcg68k = class(tcg) tcg68k = class(tcg)
procedure init_register_allocators;override; procedure init_register_allocators;override;
procedure done_register_allocators;override; procedure done_register_allocators;override;
procedure a_call_name(list : taasmoutput;const s : string);override; procedure a_call_name(list : taasmoutput;const s : string);override;
procedure a_call_reg(list : taasmoutput;reg : tregister);override; procedure a_call_reg(list : taasmoutput;reg : tregister);override;
procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aint;register : tregister);override; procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aint;register : tregister);override;
procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override; procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override; procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override; procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override; procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override; procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override;
procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override; procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override; procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
procedure a_loadmm_reg_reg(list: taasmoutput;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override; procedure a_loadmm_reg_reg(list: taasmoutput;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override;
procedure a_loadmm_ref_reg(list: taasmoutput;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override; procedure a_loadmm_ref_reg(list: taasmoutput;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
procedure a_loadmm_reg_ref(list: taasmoutput;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override; procedure a_loadmm_reg_ref(list: taasmoutput;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle); override; procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle); override;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: tcgsize; a: aint; reg: TRegister); override; procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: tcgsize; a: aint; reg: TRegister); override;
procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override; procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister; procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
l : tasmlabel);override; l : tasmlabel);override;
procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override; procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override; procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override; procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override;
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint;delsource,loadref : boolean);override; procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint;delsource,loadref : boolean);override;
{ generates overflow checking code for a node } { generates overflow checking code for a node }
procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); override; procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); override;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint); override; procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint); override;
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override; procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
procedure g_restore_frame_pointer(list : taasmoutput);override; procedure g_restore_frame_pointer(list : taasmoutput);override;
procedure g_return_from_proc(list : taasmoutput;parasize : aint);override; procedure g_return_from_proc(list : taasmoutput;parasize : aint);override;
procedure g_restore_standard_registers(list:Taasmoutput);override; procedure g_restore_standard_registers(list:Taasmoutput);override;
procedure g_save_standard_registers(list:Taasmoutput);override; procedure g_save_standard_registers(list:Taasmoutput);override;
procedure g_save_all_registers(list : taasmoutput);override; procedure g_save_all_registers(list : taasmoutput);override;
procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);override; procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:TCGPara);override;
protected protected
function fixref(list: taasmoutput; var ref: treference): boolean; function fixref(list: taasmoutput; var ref: treference): boolean;
private private
{ # Sign or zero extend the register to a full 32-bit value. { # Sign or zero extend the register to a full 32-bit value.
The new value is left in the same register. The new value is left in the same register.
} }
procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister); procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
end; end;
@ -380,7 +381,7 @@ unit cgcpu;
end; end;
procedure tcg68k.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle); procedure tcg68k.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle);
begin begin
internalerror(20020729); internalerror(20020729);
end; end;
@ -1134,7 +1135,7 @@ unit cgcpu;
begin begin
end; end;
procedure tcg68k.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation); procedure tcg68k.g_restore_all_registers(list : taasmoutput;const funcretparaloc:TCGPara);
begin begin
end; end;
@ -1313,7 +1314,10 @@ end.
{ {
$Log$ $Log$
Revision 1.31 2004-11-09 22:32:59 peter Revision 1.32 2004-11-27 16:16:02 florian
* some m68k stuff updated
Revision 1.31 2004/11/09 22:32:59 peter
* small m68k updates to bring it up2date * small m68k updates to bring it up2date
* give better error for external local variable * give better error for external local variable

44
compiler/m68k/cpupara.pas
View File

@ -31,7 +31,7 @@ unit cpupara;
uses uses
globtype, globtype,
cpubase, cpubase,
symconst,symdef, symconst,symdef,symsym,
parabase,paramgr; parabase,paramgr;
type type
@ -44,7 +44,7 @@ unit cpupara;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override; procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override; function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
private private
function parseparaloc(p : tparaitem;const s : string) : boolean;override; function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
end; end;
implementation implementation
@ -81,24 +81,42 @@ unit cpupara;
function tm68kparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; function tm68kparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
var var
paraloc : pcgparalocation; paraloc : pcgparalocation;
hp : tparaitem; hp : tparavarsym;
paracgsize : tcgsize; paracgsize : tcgsize;
paralen : longint; paralen : longint;
parasize : longint; parasize : longint;
i : longint;
begin begin
parasize:=0; parasize:=0;
hp:=tparaitem(p.para.first); for i:=0 to p.paras.count-1 do
while assigned(hp) do
begin begin
if push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption) then hp:=tparavarsym(p.paras[i]);
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(hp.vartype.def) then
begin
paraloc:=hp.paraloc[side].add_location;
{ hack: the paraloc must be valid, but is not actually used }
paraloc^.loc:=LOC_REFERENCE;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
paraloc^.size:=OS_ADDR;
paraloc^.reference.offset:=0;
break;
end;
if push_addr_param(hp.varspez,hp.vartype.def,p.proccalloption) then
paracgsize:=OS_ADDR paracgsize:=OS_ADDR
else else
begin begin
paracgsize:=def_cgSize(hp.paratype.def); paracgsize:=def_cgsize(hp.vartype.def);
if paracgsize=OS_NO then if paracgsize=OS_NO then
paracgsize:=OS_ADDR; paracgsize:=OS_ADDR;
end; end;
hp.paraloc[side].reset;
hp.paraloc[side].size:=paracgsize; hp.paraloc[side].size:=paracgsize;
hp.paraloc[side].Alignment:=std_param_align; hp.paraloc[side].Alignment:=std_param_align;
paraloc:=hp.paraloc[side].add_location; paraloc:=hp.paraloc[side].add_location;
@ -109,13 +127,12 @@ unit cpupara;
else else
paraloc^.reference.index:=NR_FRAME_POINTER_REG; paraloc^.reference.index:=NR_FRAME_POINTER_REG;
paraloc^.reference.offset:=target_info.first_parm_offset+parasize; paraloc^.reference.offset:=target_info.first_parm_offset+parasize;
hp:=TParaItem(hp.Next);
end; end;
result:=parasize; result:=parasize;
end; end;
function tm68kparamanager.parseparaloc(p : tparaitem;const s : string) : boolean; function tm68kparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean;
var var
paraloc : pcgparalocation; paraloc : pcgparalocation;
begin begin
@ -126,7 +143,7 @@ unit cpupara;
p.paraloc[callerside].alignment:=4; p.paraloc[callerside].alignment:=4;
paraloc:=p.paraloc[callerside].add_location; paraloc:=p.paraloc[callerside].add_location;
paraloc^.loc:=LOC_REGISTER; paraloc^.loc:=LOC_REGISTER;
paraloc^.size:=def_cgsize(p.paratype.def); paraloc^.size:=def_cgsize(p.vartype.def);
{ pattern is always uppercase'd } { pattern is always uppercase'd }
if s='D0' then if s='D0' then
paraloc^.register:=NR_D0 paraloc^.register:=NR_D0
@ -179,7 +196,10 @@ end.
{ {
$Log$ $Log$
Revision 1.8 2004-11-09 22:32:59 peter Revision 1.9 2004-11-27 16:16:02 florian
* some m68k stuff updated
Revision 1.8 2004/11/09 22:32:59 peter
* small m68k updates to bring it up2date * small m68k updates to bring it up2date
* give better error for external local variable * give better error for external local variable