diff --git a/compiler/cgbase.pas b/compiler/cgbase.pas index 9c64a66a75..476def33c6 100644 --- a/compiler/cgbase.pas +++ b/compiler/cgbase.pas @@ -37,6 +37,15 @@ unit cgbase; aasm,cpubase ; + type + TOpCg = (OP_ADD,OP_AND,OP_DIV,OP_IDIV,OP_IMUL,OP_MUL,OP_NEG,OP_NOT, + OP_OR,OP_SAR,OP_SHL,OP_SHR,OP_SUB,OP_XOR); + + TOpCmp = (OC_NONE,OC_EQ,OC_GT,OC_LT,OC_GTE,OC_LTE,OC_NE,OC_BE,OC_B, + OC_AE,OC_A); + + TCgSize = (OS_NO,OS_8,OS_16,OS_32,OS_64,OS_S8,OS_S16,OS_S32,OS_S64); + const pi_uses_asm = $1; { set, if the procedure uses asm } pi_is_global = $2; { set, if the procedure is exported by an unit } @@ -49,6 +58,26 @@ unit cgbase; => don't optimize} pi_needs_implicit_finally = $80; { set, if the procedure contains data which } { needs to be finalized } + + { defines the default address size for a processor } + { and defines the natural int size for a processor } +{$ifdef i386} + OS_ADDR = OS_32; + OS_INT = OS_32; +{$endif i386} +{$ifdef alpha} + OS_ADDR = OS_64; + OS_INT = OS_64; +{$endif alpha} +{$ifdef powerpc} + OS_ADDR = OS_32; + OS_INT = OS_32; +{$endif powercc} +{$ifdef ia64} + OS_ADDR = OS_64; + OS_INT = OS_64; +{$endif ia64} + type pprocinfo = ^tprocinfo; tprocinfo = object @@ -154,11 +183,22 @@ unit cgbase; procedure codegen_newmodule; procedure codegen_newprocedure; + + function def_cgsize(const p1: tdef): tcgsize; + + { return the inverse condition of opcmp } + function inverse_opcmp(opcmp: topcmp): topcmp; + + { return whether op is commutative } + function commutativeop(op: topcg): boolean; + + implementation uses systems, - cresstr + cresstr, + types {$ifdef fixLeaksOnError} ,comphook {$endif fixLeaksOnError} @@ -402,6 +442,41 @@ implementation ResourceStrings.free; end; + + function def_cgsize(const p1: tdef): tcgsize; + begin + case p1.size of + 1: result := OS_8; + 2: result := OS_16; + 4: result := OS_32; + else + internalerror(2001092311); + end; + if is_signed(p1) then + result := tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8))); + end; + + + function inverse_opcmp(opcmp: topcmp): topcmp; + const + list: array[TOpCmp] of TOpCmp = + (OC_NONE,OC_NE,OC_LTE,OC_GTE,OC_LT,OC_GT,OC_EQ,OC_A,OC_AE, + OC_B,OC_BE); + begin + inverse_opcmp := list[opcmp]; + end; + + + function commutativeop(op: topcg): boolean; + const + list: array[topcg] of boolean = + (true,true,false,false,true,true,false,false, + true,false,false,false,false,true); + begin + commutativeop := list[op]; + end; + + {$ifdef fixLeaksOnError} procedure hcodegen_do_stop; var p: pprocinfo; @@ -425,7 +500,17 @@ begin end. { $Log$ - Revision 1.1 2001-08-26 13:36:36 florian + Revision 1.2 2001-09-28 20:39:33 jonas + * changed all flow control structures (except for exception handling + related things) to processor independent code (in new ncgflw unit) + + generic cgobj unit which contains lots of code generator helpers with + global "cg" class instance variable + + cgcpu unit for i386 (implements processor specific routines of the above + unit) + * updated cgbase and cpubase for the new code generator units + * include ncgflw unit in cpunode unit + + Revision 1.1 2001/08/26 13:36:36 florian * some cg reorganisation * some PPC updates diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index a1ad5fcb61..72fb851812 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -23,27 +23,25 @@ } unit cgobj; +{$i defines.inc} + interface uses - cclasses,aasm,cpuasm,cpubase,cpuinfo, - cgconst,cgbase, - tainst, - symtable,symconst,symbase,symtype,symsym; + cclasses,aasm,symtable,cpuasm,cpubase,cgbase,cpuinfo, + symconst,symbase,symtype; type talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE); - pcg = ^tcg; - tcg = object + tcg = class scratch_register_array_pointer : aword; unusedscratchregisters : tregisterset; alignment : talignment; {************************************************} { basic routines } - constructor init; - destructor done;virtual; + constructor create; procedure a_label(list : taasmoutput;l : tasmlabel);virtual; @@ -73,14 +71,14 @@ unit cgobj; { helper routines } procedure g_initialize_data(list : taasmoutput;p : tsym); procedure g_incr_data(list : taasmoutput;p : tsym); - procedure g_finalize_data(list : taasmoutput;p : tindexarray); - procedure g_copyvalueparas(list : taasmoutput;p : tindexarray); + procedure g_finalize_data(list : taasmoutput;p : tnamedindexitem); + procedure g_copyvalueparas(list : taasmoutput;p : tnamedindexitem); procedure g_finalizetempansistrings(list : taasmoutput); - procedure g_entrycode(list : taasmoutput; - const proc_names : tstringlist;make_global : boolean; - stackframe : longint;var parasize : longint; - var nostackframe : boolean;inlined : boolean); + procedure g_entrycode(alist : TAAsmoutput;make_global:boolean; + stackframe:longint; + var parasize:longint;var nostackframe:boolean; + inlined : boolean); procedure g_exitcode(list : taasmoutput;parasize : longint; nostackframe,inlined : boolean); @@ -95,7 +93,7 @@ unit cgobj; { left to right), this allows to move the parameter to } { register, if the cpu supports register calling } { conventions } - procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);virtual; + procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);virtual; abstract; procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);virtual; procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);virtual; procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);virtual; @@ -121,41 +119,63 @@ unit cgobj; } procedure a_call_name(list : taasmoutput;const s : string; - offset : longint);virtual; + offset : longint);virtual; abstract; { move instructions } - procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);virtual; + procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);virtual; abstract; procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);virtual; - procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);virtual; - procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual; - procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; + procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);virtual; abstract; + procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual; abstract; + procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; abstract; + procedure a_load_loc_reg(list : taasmoutput;size : tcgsize;const loc: tlocation; reg : tregister); + + + { basic arithmetic operations } + { note: for operators which require only one argument (not, neg), use } + { the op_reg_reg, op_reg_reg or op_reg_loc methods and keep in mind } + { that in this case the *second* operand is used as both source and } + { destination (JM) } + procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); virtual; abstract; + procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); virtual; + procedure a_op_const_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const loc: tlocation); + procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract; + procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual; + procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual; + procedure a_op_reg_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: tregister; const loc: tlocation); + procedure a_op_ref_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; const loc: tlocation); { comparison operations } - procedure a_cmp_reg_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; - l : tasmlabel);virtual; - procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); - procedure a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel); - procedure a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + l : tasmlabel);virtual; abstract; + procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference; + l : tasmlabel); virtual; + procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; a: aword; const loc: tlocation; + l : tasmlabel); virtual; + procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract; + procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual; + procedure a_cmp_ref_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation; l : tasmlabel); - procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); + procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); virtual; abstract; - procedure a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);virtual; - procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; + procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); virtual; abstract; + + procedure a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);virtual; abstract; + procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; abstract; { restores the frame pointer at procedure exit, for the } { i386 it generates a simple leave } - procedure g_restore_frame_pointer(list : taasmoutput);virtual; + procedure g_restore_frame_pointer(list : taasmoutput);virtual; abstract; { some processors like the PPC doesn't allow to change the stack in } { a procedure, so we need to maintain an extra stack for the } { result values of setjmp in exception code } { this two procedures are for pushing an exception value, } { they can use the scratch registers } - procedure g_push_exception_value_reg(list : taasmoutput;reg : tregister);virtual; - procedure g_push_exception_value_const(list : taasmoutput;reg : tregister);virtual; + procedure g_push_exception_value_reg(list : taasmoutput;reg : tregister);virtual; abstract; + procedure g_push_exception_value_const(list : taasmoutput;reg : tregister);virtual; abstract; { that procedure pops a exception value } - procedure g_pop_exception_value_reg(list : taasmoutput;reg : tregister);virtual; - procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; + procedure g_pop_exception_value_reg(list : taasmoutput;reg : tregister);virtual; abstract; + procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract; {********************************************************} { these methods can be overriden for extra functionality } @@ -166,46 +186,50 @@ unit cgobj; procedure g_profilecode(list : taasmoutput);virtual; procedure g_stackcheck(list : taasmoutput;stackframesize : longint);virtual; - procedure g_maybe_loadself(list : taasmoutput);virtual; + procedure g_maybe_loadself(list : taasmoutput);virtual; abstract; { copies len bytes from the source to destination, if } { loadref is true, it assumes that it first must load } { the source address from the memory location where } { source points to } - procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual; + procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);virtual; abstract; - { uses the addr of ref as param, was emitpushreferenceaddr } - procedure a_param_ref_addr(list : taasmoutput;r : treference;nr : longint);virtual; +{$ifdef i386} + { this one is only necessary due the the restrictions of the 80x86, } + { so make it a special case (JM) } + function makeregsize(var reg: tregister; size: tcgsize): topsize; virtual; abstract; +{$endif i386} end; var - cg : pcg; { this is the main code generator class } + cg : tcg; { this is the main code generator class } implementation uses - strings,globals,globtype,options,gdb,systems, - ppu,verbose,types,temp_gen,tgcpu; + strings,globals,globtype,options,{files,}gdb,systems, + ppu,verbose,types,{tgobj,}tgcpu,symdef,symsym,cga + {$IFDEF NEWST} + ,symbols,defs,symtablt + {$ENDIF NEWST}; + + const + max_scratch_regs = high(scratch_regs) - low(scratch_regs) + 1; {***************************************************************************** basic functionallity ******************************************************************************} - constructor tcg.init; + constructor tcg.create; var i : longint; begin scratch_register_array_pointer:=1; - for i:=1 to max_scratch_regs do + for i:=low(scratch_regs) to high(scratch_regs) do include(unusedscratchregisters,scratch_regs[i]); end; - destructor tcg.done; - - begin - end; - procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister); begin @@ -235,7 +259,7 @@ unit cgobj; internalerror(68996); for i:=scratch_register_array_pointer to - (scratch_register_array_pointer+max_scratch_regs) do + (scratch_register_array_pointer+max_scratch_regs-1) do if scratch_regs[(i mod max_scratch_regs)+1] in unusedscratchregisters then begin r:=scratch_regs[(i mod max_scratch_regs)+1]; @@ -252,7 +276,7 @@ unit cgobj; procedure tcg.free_scratch_reg(list : taasmoutput;r : tregister); begin - include(unusedscratchregisters,r); + include(unusedscratchregisters,makereg32(r)); a_reg_dealloc(list,r); end; @@ -303,7 +327,7 @@ unit cgobj; free_scratch_reg(list,hr); end; - procedure tcg.a_param_ref_addr(list : taasmoutput;r : treference;nr : longint); + procedure tcg.a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint); var hr : tregister; @@ -322,51 +346,36 @@ unit cgobj; a_call_name(list,'FPC_STACKCHECK',0); end; - procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference); - - var - hr : tregister; - - begin - hr:=get_scratch_reg(list); - a_load_const_reg(list,size,a,hr); - a_load_reg_ref(list,size,hr,ref); - free_scratch_reg(list,hr); - end; - - - procedure tcg.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;loadref : boolean); - - begin - abstract; - end; - - {***************************************************************************** String helper routines *****************************************************************************} procedure tcg.g_removetemps(list : taasmoutput;p : tlinkedlist); +(* var hp : ptemptodestroy; pushedregs : tpushed; +*) begin - hp:=ttemptodestroy(p.first); +(* + hp:=ptemptodestroy(p^.first); if not(assigned(hp)) then exit; - pushusedregisters(pushedregs,$ff); + tg.pushusedregisters(pushedregs,$ff); while assigned(hp) do begin if is_ansistring(hp^.typ) then begin - g_decrstrref(list,hp.address,hp^.typ); - ungetiftemp(hp^.address); + g_decrstrref(list,hp^.address,hp^.typ); + tg.ungetiftemp(hp^.address); end; hp:=ptemptodestroy(hp^.next); end; - popusedregisters(pushedregs); + tg.popusedregisters(pushedregs); +*) + runerror(211); end; procedure tcg.g_decrstrref(list : taasmoutput;const ref : treference;t : tdef); @@ -375,14 +384,17 @@ unit cgobj; pushedregs : tpushed; begin - pushusedregisters(pushedregs,$ff); +(* + tg.pushusedregisters(pushedregs,$ff); a_param_ref_addr(list,ref,1); if is_ansistring(t) then a_call_name(list,'FPC_ANSISTR_DECR_REF',0) else if is_widestring(t) then a_call_name(list,'FPC_WIDESTR_DECR_REF',0) else internalerror(58993); - popusedregisters(pushedregs); + tg.popusedregisters(pushedregs); +*) + runerror(211); end; {***************************************************************************** @@ -398,6 +410,7 @@ unit cgobj; hr : treference; begin +(* if is_ansistring(t) or is_widestring(t) then a_load_const_ref(list,OS_8,0,ref) @@ -412,6 +425,8 @@ unit cgobj; a_param_ref_addr(list,ref,1); a_call_name(list,'FPC_INITIALIZE',0); end; +*) + runerror(211); end; procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference;is_already_ref : boolean); @@ -420,6 +435,7 @@ unit cgobj; r : treference; begin +(* if is_ansistring(t) or is_widestring(t) then begin @@ -436,6 +452,8 @@ unit cgobj; a_param_ref_addr(list,ref,1); a_call_name(list,'FPC_FINALIZE',0); end; +*) + runerror(211); end; { generates the code for initialisation of local data } @@ -445,25 +463,50 @@ unit cgobj; hr : treference; begin - if (tsym(p).typ=varsym) and - assigned(tvarsym(p).vartype.def) and - not((tvarsym(p).vartype.def^.deftype=objectdef) and - tobjectdef(tvarsym(p).vartype.def)^.is_class) and - tvarsym(p).vartype.def.needs_inittable then +(* + {$IFDEF NEWST} + if (typeof(p^)=typeof(Tvarsym)) and + assigned(pvarsym(p)^.definition) and + not((typeof((pvarsym(p)^.definition^))=typeof(Tobjectdef)) and + (oo_is_class in pobjectdef(pvarsym(p)^.definition)^.options)) and + pvarsym(p)^.definition^.needs_inittable then + begin + procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; + reset_reference(hr); + if typeof((tsym(p)^.owner^))=typeof(Tprocsymtable) then + begin + hr.base:=procinfo^.framepointer; + hr.offset:=-pvarsym(p)^.address; + end + else + begin + hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname); + end; + g_initialize(list,pvarsym(p)^.definition,hr,false); + end; + {$ELSE} + if (tsym(p)^.typ=varsym) and + assigned(pvarsym(p)^.vartype.def) and + not((pvarsym(p)^.vartype.def^.deftype=objectdef) and + pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and + pvarsym(p)^.vartype.def^.needs_inittable then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hr); if tsym(p)^.owner^.symtabletype=localsymtable then begin hr.base:=procinfo^.framepointer; - hr.offset:=-tvarsym(p)^.address; + hr.offset:=-pvarsym(p)^.address; end else begin - hr.symbol:=newasmsymbol(tvarsym(p)^.mangledname); + hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname); end; - g_initialize(list,tvarsym(p)^.vartype.def,hr,false); + g_initialize(list,pvarsym(p)^.vartype.def,hr,false); end; + {$ENDIF NEWST} +*) + runerror(211); end; @@ -474,72 +517,130 @@ unit cgobj; hr : treference; begin - if (tsym(p).typ=varsym) and - not((tvarsym(p).vartype.def.deftype=objectdef) and - tobjectdef(tvarsym(p).vartype.def).is_class) and - tvarsym(p).vartype.def.needs_inittable and - ((tvarsym(p).varspez=vs_value)) then +(* + {$IFDEF NEWST} + if (typeof((tsym(p)^))=typeof(Tparamsym)) and + not((typeof((Pparamsym(p)^.definition^))=typeof(Tobjectdef)) and + (oo_is_class in pobjectdef(pvarsym(p)^.definition)^.options)) and + Pparamsym(p)^.definition^.needs_inittable and + ((Pparamsym(p)^.varspez=vs_value)) then begin procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hr); - hr.symbol:=tvarsym(p)^.vartype.def^.get_inittable_label; + hr.symbol:=pvarsym(p)^.definition^.get_inittable_label; a_param_ref_addr(list,hr,2); reset_reference(hr); hr.base:=procinfo^.framepointer; - hr.offset:=tvarsym(p)^.address+procinfo^.para_offset; + hr.offset:=pvarsym(p)^.address+procinfo^.para_offset; a_param_ref_addr(list,hr,1); reset_reference(hr); a_call_name(list,'FPC_ADDREF',0); end; + {$ELSE} + if (tsym(p)^.typ=varsym) and + not((pvarsym(p)^.vartype.def^.deftype=objectdef) and + pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and + pvarsym(p)^.vartype.def^.needs_inittable and + ((pvarsym(p)^.varspez=vs_value)) then + begin + procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; + reset_reference(hr); + hr.symbol:=pvarsym(p)^.vartype.def^.get_inittable_label; + a_param_ref_addr(list,hr,2); + reset_reference(hr); + hr.base:=procinfo^.framepointer; + hr.offset:=pvarsym(p)^.address+procinfo^.para_offset; + a_param_ref_addr(list,hr,1); + reset_reference(hr); + a_call_name(list,'FPC_ADDREF',0); + end; + {$ENDIF NEWST} +*) + runerror(211); end; { generates the code for finalisation of local data } - procedure tcg.g_finalize_data(list : taasmoutput;p : tnamedindex); + procedure tcg.g_finalize_data(list : taasmoutput;p : tnamedindexitem); var hr : treference; begin - if (tsym(p).typ=varsym) and - assigned(tvarsym(p).vartype.def) and - not((tvarsym(p).vartype.def.deftype=objectdef) and - tobjectdef(tvarsym(p).vartype.def).is_class) and - tvarsym(p).vartype.def.needs_inittable then +(* + {$IFDEF NEWST} + if (typeof((tsym(p)^))=typeof(Tvarsym)) and + assigned(pvarsym(p)^.definition) and + not((typeof((pvarsym(p)^.definition^))=typeof(Tobjectdef)) and + (oo_is_class in pobjectdef(pvarsym(p)^.definition)^.options)) and + pvarsym(p)^.definition^.needs_inittable then begin { not all kind of parameters need to be finalized } - if (tsym(p).owner.symtabletype=parasymtable) and - ((tvarsym(p).varspez=vs_var) or - (tvarsym(p).varspez=vs_const) { and - (dont_copy_const_param(tvarsym(p)^.definition)) } ) then + if (typeof((tsym(p)^.owner^))=typeof(Tprocsymtable)) and + ((pparamsym(p)^.varspez=vs_var) or + (Pparamsym(p)^.varspez=vs_const) { and + (dont_copy_const_param(pvarsym(p)^.definition)) } ) then exit; procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; reset_reference(hr); - case tsym(p).owner^.symtabletype of + if typeof((tsym(p)^.owner^))=typeof(Tprocsymtable) then + begin + hr.base:=procinfo^.framepointer; + hr.offset:=-pvarsym(p)^.address; + end + else if typeof((tsym(p)^.owner^))=typeof(Tprocsymtable) then + begin + hr.base:=procinfo^.framepointer; + hr.offset:=pvarsym(p)^.address+procinfo^.para_offset; + end + else + hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname); + g_finalize(list,pvarsym(p)^.definition,hr,false); + end; + {$ELSE} + if (tsym(p)^.typ=varsym) and + assigned(pvarsym(p)^.vartype.def) and + not((pvarsym(p)^.vartype.def^.deftype=objectdef) and + pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and + pvarsym(p)^.vartype.def^.needs_inittable then + begin + { not all kind of parameters need to be finalized } + if (tsym(p)^.owner^.symtabletype=parasymtable) and + ((pvarsym(p)^.varspez=vs_var) or + (pvarsym(p)^.varspez=vs_const) { and + (dont_copy_const_param(pvarsym(p)^.definition)) } ) then + exit; + procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally; + reset_reference(hr); + case tsym(p)^.owner^.symtabletype of localsymtable: begin hr.base:=procinfo^.framepointer; - hr.offset:=-tvarsym(p).address; + hr.offset:=-pvarsym(p)^.address; end; parasymtable: begin hr.base:=procinfo^.framepointer; - hr.offset:=tvarsym(p).address+procinfo^.para_offset; + hr.offset:=pvarsym(p)^.address+procinfo^.para_offset; end; else - hr.symbol:=newasmsymbol(tvarsym(p).mangledname); + hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname); end; - g_finalize(list,tvarsym(p).vartype.def,hr,false); + g_finalize(list,pvarsym(p)^.vartype.def,hr,false); end; + {$ENDIF NEWST} +*) + runerror(211); end; { generates the code to make local copies of the value parameters } - procedure tcg.g_copyvalueparas(list : taasmoutput;p : pnamedindexobject); + procedure tcg.g_copyvalueparas(list : taasmoutput;p : tnamedindexitem); begin runerror(255); end; +(* var _list : taasmoutput; @@ -547,21 +648,25 @@ unit cgobj; { of objects } {$IFNDEF NEWST} - procedure _copyvalueparas(s : pnamedindexobject);{$ifndef FPC}far;{$endif} + procedure _copyvalueparas(s : tnamedindexitem);{$ifndef FPC}far;{$endif} begin cg^.g_copyvalueparas(_list,s); end; {$ENDIF NEWST} +*) procedure tcg.g_finalizetempansistrings(list : taasmoutput); +(* var hp : ptemprecord; hr : treference; +*) begin - hp:=templist; +(* + hp:=tg.templist; while assigned(hp) do begin if hp^.temptype in [tt_ansistring,tt_freeansistring] then @@ -575,31 +680,65 @@ unit cgobj; end; hp:=hp^.next; end; +*) + runerror(211); end; - procedure _finalize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif} +(* + {$IFDEF NEWST} + procedure _initialize_local(s:tnamedindexitem);{$IFNDEF FPC}far;{$ENDIF} + + begin + if typeof(s^)=typeof(Tparamsym) then + cg^.g_incr_data(_list,tsym(s)) + else + cg^.g_initialize_data(_list,tsym(s)); + end; + + procedure _finalize_data(s : tnamedindexitem);{$ifndef FPC}far;{$endif} + + begin + if typeof(s^)=typeof(Tvarsym) then + cg^.g_finalize_data(_list,s); + end; + + {$ELSE} + procedure _finalize_data(s : tnamedindexitem);{$ifndef FPC}far;{$endif} begin cg^.g_finalize_data(_list,s); end; - procedure _incr_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif} + procedure _incr_data(s : tnamedindexitem);{$ifndef FPC}far;{$endif} begin cg^.g_incr_data(_list,tsym(s)); end; - procedure _initialize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif} + procedure _initialize_data(s : tnamedindexitem);{$ifndef FPC}far;{$endif} begin cg^.g_initialize_data(_list,tsym(s)); end; + {$ENDIF NEWST} +*) { generates the entry code for a procedure } - procedure tcg.g_entrycode(list : taasmoutput;const proc_names:Tstringcontainer;make_global:boolean; - stackframe:longint;var parasize:longint;var nostackframe:boolean; - inlined : boolean); + procedure tcg.g_entrycode(alist : TAAsmoutput;make_global:boolean; + stackframe:longint; + var parasize:longint;var nostackframe:boolean; + inlined : boolean); + + {$IFDEF NEWST} + procedure _copyvalueparas(s:Pparamsym);{$ifndef FPC}far;{$endif} + + begin + cg^.g_copyvalueparas(_list,s); + end; + {$ENDIF NEWST} + +(* var hs : string; hp : pused_unit; @@ -609,8 +748,10 @@ unit cgobj; {$endif GDB} hr : treference; r : tregister; +*) begin +(* { Align } if (not inlined) then begin @@ -844,6 +985,8 @@ unit cgobj; aktprocsym^.isstabwritten:=true; end; {$endif GDB} +*) + runerror(211); end; procedure tcg.g_exitcode(list : taasmoutput;parasize:longint;nostackframe,inlined:boolean); @@ -858,6 +1001,7 @@ unit cgobj; r : tregister; begin +(* if aktexitlabel^.is_used then list^.insert(new(pai_label,init(aktexitlabel))); @@ -927,7 +1071,7 @@ unit cgobj; a_call_name(list,'FPC_POPADDRSTACK',0); a_reg_alloc(list,accumulator); g_pop_exception_value_reg(list,accumulator); - a_cmp_reg_const_label(list,OS_32,OC_EQ,0,accumulator,noreraiselabel); + a_cmp_const_reg_label(list,OS_32,OC_EQ,0,accumulator,noreraiselabel); a_reg_dealloc(list,accumulator); {$IFDEF NEWST} @@ -1086,279 +1230,260 @@ unit cgobj; +aktprocsym^.definition^.mangledname+'_end'))));} end; {$endif GDB} +*) + runerror(211); end; {***************************************************************************** - some abstract definitions + some generic implementations ****************************************************************************} - procedure tcg.a_call_name(list : taasmoutput;const s : string; - offset : longint); + + procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference); + + var + tmpreg: tregister; begin - abstract; + tmpreg := get_scratch_reg(list); + a_load_const_reg(list,size,a,tmpreg); + a_load_reg_ref(list,size,tmpreg,ref); + free_scratch_reg(list,tmpreg); end; - procedure tcg.g_stackframe_entry(list : taasmoutput;localsize : longint); + procedure tcg.a_load_loc_reg(list : taasmoutput;size : tcgsize;const loc: tlocation; reg : tregister); begin - abstract; + case loc.loc of + LOC_REFERENCE,LOC_MEM: + a_load_ref_reg(list,size,loc.reference,reg); + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_reg(list,size,loc.register,reg); + else + internalerror(200109092); + end; end; - procedure tcg.g_maybe_loadself(list : taasmoutput); + + procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); + + var + tmpreg: tregister; begin - abstract; + tmpreg := get_scratch_reg(list); + a_load_ref_reg(list,size,ref,tmpreg); + a_op_const_reg(list,op,a,tmpreg); + a_load_reg_ref(list,size,tmpreg,ref); + free_scratch_reg(list,tmpreg); end; - procedure tcg.g_restore_frame_pointer(list : taasmoutput); + + procedure tcg.a_op_const_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const loc: tlocation); begin - abstract; + case loc.loc of + LOC_REGISTER, LOC_CREGISTER: + a_op_const_reg(list,op,a,loc.register); + LOC_REFERENCE, LOC_MEM: + a_op_const_ref(list,op,size,a,loc.reference); + else + internalerror(200109061); + end; end; - procedure g_return_from_proc(list : taasmoutput;parasize : aword); + + procedure tcg.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); + + var + tmpreg: tregister; begin - abstract; + tmpreg := get_scratch_reg(list); + a_load_ref_reg(list,size,ref,tmpreg); + a_op_reg_reg(list,op,size,reg,tmpreg); + a_load_reg_ref(list,size,tmpreg,ref); + free_scratch_reg(list,tmpreg); end; - procedure tcg.a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister); + + procedure tcg.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); + + var + tmpreg: tregister; begin - abstract; + case op of + OP_NOT,OP_NEG: + { handle it as "load ref,reg; op reg" } + begin + a_load_ref_reg(list,size,ref,reg); + a_op_reg_reg(list,op,size,reg,reg); + end; + else + begin + tmpreg := get_scratch_reg(list); + a_load_ref_reg(list,size,ref,tmpreg); + a_op_reg_reg(list,op,size,tmpreg,reg); + free_scratch_reg(list,tmpreg); + end; + end; end; - procedure tcg.g_push_exception_value_reg(list : taasmoutput;reg : tregister); + + procedure tcg.a_op_reg_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: tregister; const loc: tlocation); begin - abstract; + case loc.loc of + LOC_REGISTER, LOC_CREGISTER: + a_op_reg_reg(list,op,size,reg,loc.register); + LOC_REFERENCE, LOC_MEM: + a_op_reg_ref(list,op,size,reg,loc.reference); + else + internalerror(200109061); + end; end; - procedure tcg.g_push_exception_value_const(list : taasmoutput;reg : tregister); + + procedure tcg.a_op_ref_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; const loc: tlocation); + + var + tmpreg: tregister; begin - abstract; + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + a_op_ref_reg(list,op,size,ref,loc.register); + LOC_REFERENCE,LOC_MEM: + begin + tmpreg := get_scratch_reg(list); +{$ifdef i386} + makeregsize(tmpreg,size); +{$endif i386} + a_load_ref_reg(list,size,ref,tmpreg); + a_op_reg_ref(list,op,size,tmpreg,loc.reference); + free_scratch_reg(list,tmpreg); + end; + else + internalerror(200109061); + end; end; - procedure tcg.g_pop_exception_value_reg(list : taasmoutput;reg : tregister); + + procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference; + l : tasmlabel); + + var + tmpreg: tregister; begin - abstract; + tmpreg := get_scratch_reg(list); + a_load_ref_reg(list,size,ref,tmpreg); + a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l); + free_scratch_reg(list,tmpreg); end; - procedure tcg.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister); - - begin - abstract; - end; - - procedure tcg.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference); - - begin - abstract; - end; - - procedure tcg.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister); - - begin - abstract; - end; - - procedure tcg.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister); - - begin - abstract; - end; - - procedure tcg.a_cmp_reg_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation; l : tasmlabel); begin - abstract; + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l); + LOC_REFERENCE,LOC_MEM: + a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l); + else + internalerror(200109061); + end; end; - procedure tcg.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); + procedure tcg.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); + + var + tmpreg: tregister; begin - abstract; + tmpreg := get_scratch_reg(list); + a_load_ref_reg(list,size,ref,tmpreg); + a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l); + free_scratch_reg(list,tmpreg); end; - procedure tcg.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel); + procedure tcg.a_cmp_ref_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation; + l : tasmlabel); + + var + tmpreg: tregister; begin - abstract; - end; - - procedure tcg.a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; - l : tasmlabel); - - begin - abstract; - end; - - procedure tcg.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); - - begin - abstract; - end; - - procedure tcg.g_return_from_proc(list : taasmoutput;parasize : aword); - - begin - abstract; - end; - - procedure tcg.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint); - - begin - abstract; - end; - - procedure tcg.a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint); - - begin - abstract; + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l); + LOC_REFERENCE,LOC_MEM: + begin +{$ifdef i386} + { the following is done with defines to avoid a speed penalty, } + { since all this is only necessary for the 80x86 (because EDI } + { doesn't have an 8bit component which is directly addressable) } + if size in [OS_8,OS_S8] then + tmpreg := getregister32 + else +{$endif i386} + tmpreg := get_scratch_reg(list); +{$ifdef i386} + makeregsize(tmpreg,size); +{$endif i386} + a_load_ref_reg(list,size,loc.reference,tmpreg); + a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l); +{$ifdef i386} + if makereg32(tmpreg) <> R_EDI then + ungetregister(tmpreg) + else +{$endif i386} + free_scratch_reg(list,tmpreg); + end + else + internalerror(200109061); + end; end; +finalization + cg.free; end. { $Log$ - Revision 1.1 2001-08-26 13:36:37 florian + Revision 1.2 2001-09-28 20:39:32 jonas + * changed all flow control structures (except for exception handling + related things) to processor independent code (in new ncgflw unit) + + generic cgobj unit which contains lots of code generator helpers with + global "cg" class instance variable + + cgcpu unit for i386 (implements processor specific routines of the above + unit) + * updated cgbase and cpubase for the new code generator units + * include ncgflw unit in cpunode unit + + Revision 1.5 2001/09/09 17:10:26 jonas + * some more things implemented + + Revision 1.4 2001/09/06 15:25:55 jonas + * changed type of tcg from object to class -> abstract methods are now + a lot cleaner :) + + more updates: load_*_loc methods, op_*_* methods, g_flags2reg method + (if possible with geenric implementation and necessary ppc + implementations) + * worked a bit further on cgflw, now working on exitnode + + Revision 1.3 2001/09/05 20:21:03 jonas + * new cgflow based on n386flw with all nodes until forn "translated" + + a_cmp_loc_*_label methods for tcg + + base implementatino for a_cmp_ref_*_label methods + * small bugfixes to powerpc cg + + Revision 1.2 2001/08/26 13:37:04 florian * some cg reorganisation * some PPC updates Revision 1.1 2000/07/13 06:30:07 michael + Initial import - Revision 1.38 2000/04/29 09:01:06 jonas - * nmem compiles again (at least for powerpc) - - Revision 1.37 2000/04/22 14:25:03 jonas - * aasm.pas: pai_align instead of pai_align_abstract if cpu <> i386 - + systems.pas: info for macos/ppc - * new/cgobj.pas: compiles again without newst define - * new/powerpc/cgcpu: generate different entry/exit code depending on - whether target_os is MacOs or Linux - - Revision 1.36 2000/03/11 21:11:24 daniel - * Ported hcgdata to new symtable. - * Alignment code changed as suggested by Peter - + Usage of my is operator replacement, is_object - - Revision 1.35 2000/03/01 15:36:13 florian - * some new stuff for the new cg - - Revision 1.34 2000/02/20 20:49:46 florian - * newcg is compiling - * fixed the dup id problem reported by Paul Y. - - Revision 1.33 2000/01/07 01:14:53 peter - * updated copyright to 2000 - - Revision 1.32 1999/12/01 12:42:33 peter - * fixed bug 698 - * removed some notes about unused vars - - Revision 1.31 1999/11/05 13:15:00 florian - * some fixes to get the new cg compiling again - - Revision 1.30 1999/11/05 07:05:56 jonas - + a_jmp_cond() - - Revision 1.29 1999/10/21 16:41:41 florian - * problems with readln fixed: esi wasn't restored correctly when - reading ordinal fields of objects futher the register allocation - didn't take care of the extra register when reading ordinal values - * enumerations can now be used in constant indexes of properties - - Revision 1.28 1999/10/12 21:20:46 florian - * new codegenerator compiles again - - Revision 1.27 1999/09/29 11:46:20 florian - * fixed bug 292 from bugs directory - - Revision 1.26 1999/09/14 11:16:09 florian - * only small updates to work with the current compiler - - Revision 1.25 1999/09/03 13:09:09 jonas - * fixed typo regarding scratchregs pointer - - Revision 1.24 1999/08/26 14:51:54 jonas - * changed get_scratch_reg so it actually uses the - scratch_reg_array_pointer - - Revision 1.23 1999/08/25 12:00:11 jonas - * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu) - - Revision 1.22 1999/08/18 17:05:55 florian - + implemented initilizing of data for the new code generator - so it should compile now simple programs - - Revision 1.21 1999/08/07 14:21:08 florian - * some small problems fixed - - Revision 1.20 1999/08/06 18:05:52 florian - * implemented some stuff for assignments - - Revision 1.19 1999/08/06 17:00:54 florian - + definition of concatcopy - - Revision 1.18 1999/08/06 16:37:45 jonas - * completed bugfix done by Florian o I wouldn't get conflicts :) - - Revision 1.17 1999/08/06 16:27:26 florian - * for Jonas: else he will get conflicts - - Revision 1.16 1999/08/06 16:04:05 michael - + introduced tainstruction - - Revision 1.15 1999/08/06 15:53:50 florian - * made the alpha version compilable - - Revision 1.14 1999/08/06 14:15:51 florian - * made the alpha version compilable - - Revision 1.13 1999/08/06 13:26:50 florian - * more changes ... - - Revision 1.12 1999/08/05 17:10:56 florian - * some more additions, especially procedure - exit code generation - - Revision 1.11 1999/08/05 14:58:11 florian - * some fixes for the floating point registers - * more things for the new code generator - - Revision 1.10 1999/08/04 00:23:52 florian - * renamed i386asm and i386base to cpuasm and cpubase - - Revision 1.9 1999/08/02 23:13:21 florian - * more changes to compile for the Alpha - - Revision 1.8 1999/08/02 17:14:07 florian - + changed the temp. generator to an object - - Revision 1.7 1999/08/01 23:05:55 florian - * changes to compile with FPC - - Revision 1.6 1999/08/01 18:22:33 florian - * made it again compilable - - Revision 1.5 1999/01/23 23:29:46 florian - * first running version of the new code generator - * when compiling exceptions under Linux fixed - - Revision 1.4 1999/01/13 22:52:36 florian - + YES, finally the new code generator is compilable, but it doesn't run yet :( - - Revision 1.3 1998/12/26 15:20:30 florian - + more changes for the new version - - Revision 1.2 1998/12/15 22:18:55 florian - * some code added - - Revision 1.1 1998/12/15 16:32:58 florian - + first version, derived from old routines - } diff --git a/compiler/i386/cgcpu.pas b/compiler/i386/cgcpu.pas new file mode 100644 index 0000000000..ef8b5f4bbc --- /dev/null +++ b/compiler/i386/cgcpu.pas @@ -0,0 +1,683 @@ +{ + $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl + + This unit implements the code generator for the i386 + + 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 cgcpu; + +{$i defines.inc} + + interface + + uses + cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo; + + type + tcg386 = class(tcg) + + { passing parameters, per default the parameter is pushed } + { nr gives the number of the parameter (enumerated from } + { left to right), this allows to move the parameter to } + { register, if the cpu supports register calling } + { conventions } + procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);override; + procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);override; + procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);override; + procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);override; + + + procedure a_call_name(list : taasmoutput;const s : string; + offset : longint);override; + + + procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override; + procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); override; + procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; + procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override; + procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); override; + + { move instructions } + procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override; + procedure a_load_const_ref(list : taasmoutput; size: tcgsize; a : aword;const ref : treference);override; + procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override; + procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;reg : tregister);override; + procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override; + + { comparison operations } + procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + l : tasmlabel);override; + procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference; + 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_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister; l : tasmlabel); override; + + procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override; + procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); override; + + + procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override; + procedure g_restore_frame_pointer(list : taasmoutput);override; + procedure g_push_exception_value_reg(list : taasmoutput;reg : tregister);override; + procedure g_push_exception_value_const(list : taasmoutput;reg : tregister);override; + procedure g_pop_exception_value_reg(list : taasmoutput;reg : tregister);override; + procedure g_return_from_proc(list : taasmoutput;parasize : aword); override; + + procedure a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override; + + procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override; + + function makeregsize(var reg: tregister; size: tcgsize): topsize; override; + + private + + procedure sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize); + + + end; + + const + + TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_ADD,A_AND,A_DIV, + A_IDIV,A_MUL, A_IMUL, A_NEG,A_NOT,A_OR, + A_SAR,A_SHL,A_SHR,A_SUB,A_XOR); + + TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_NONE,C_E,C_G, + C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A); + + TCGSize2OpSize: Array[tcgsize] of topsize = (S_NO,S_B,S_W,S_L,S_L, + S_B,S_W,S_L,S_L); + + + implementation + + uses + globtype,globals,verbose,systems,cutils,cga; + + + { we implement the following routines because otherwise we can't } + { instantiate the class since it's abstract } + + procedure tcg386.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint); + + begin + runerror(211); + end; + + + procedure tcg386.a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint); + + begin + runerror(211); + end; + + + procedure tcg386.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint); + + begin + runerror(211); + end; + + + procedure tcg386.a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint); + + begin + runerror(211); + end; + + procedure tcg386.a_call_name(list : taasmoutput;const s : string; + offset : longint); + + begin + { how can we create asmsymbols which contain a name and an offset? } + { (JM) } + runerror(211); + end; + + + +{********************** load instructions ********************} + + procedure tcg386.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister); + + begin + { the optimizer will change it to "xor reg,reg" when loading zero, } + { no need to do it here too (JM) } + list.concat(taicpu.op_const_reg(A_MOV,TCGSize2OpSize[size], + longint(a),reg)) + end; + + procedure tcg386.a_load_const_ref(list : taasmoutput; size: tcgsize; a : aword;const ref : treference); + + begin + list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[size], + longint(a),newreference(ref))); + end; + + procedure tcg386.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref : treference); + + begin + list.concat(taicpu.op_reg_ref(A_MOV,TCGSize2OpSize[size],reg, + newreference(ref))); + End; + + procedure tcg386.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref: treference;reg : tregister); + + var + op: tasmop; + s: topsize; + + begin + if ref.is_immediate then + a_load_const_reg(list,size,ref.offset,reg) + else + begin + sizes2load(size,regsize(reg),op,s); + list.concat(taicpu.op_ref_reg(op,s,newreference(ref),reg)); + end; + end; + + procedure tcg386.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister); + + var + op: tasmop; + s: topsize; + begin + sizes2load(size,regsize(reg1),op,s); + if (reg1 = reg2) then + { "mov reg1, reg1" doesn't make sense } + if op = A_MOV then + exit + else if (op = A_MOVZX) then + case size of + OS_8: + begin + list.concat(taicpu.op_const_reg(A_AND,S_L,255,makereg32(reg1))); + exit; + end; + OS_16: + begin + list.concat(taicpu.op_const_reg(A_AND,S_L,65535,reg2)); + exit; + end; + end; + list.concat(taicpu.op_reg_reg(op,s,reg1,reg2)); + end; + + procedure tcg386.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); + + var + opcode: tasmop; + power: longint; + scratch_register: TRegister; + + begin + Case Op of + OP_DIV, OP_IDIV: + Begin + if ispowerof2(longint(a),power) then + begin + case op of + OP_DIV: + opcode := A_SHR; + OP_IDIV: + opcode := A_SAR; + end; + list.concat(taicpu.op_const_reg(opcode,regsize(reg),power, + reg)); + exit; + end; + { the rest should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109224); + End; + OP_MUL,OP_IMUL: + begin + if not(cs_check_overflow in aktlocalswitches) and + ispowerof2(longint(a),power) then + begin + list.concat(taicpu.op_const_reg(A_SHL,regsize(reg),power, + reg)); + exit; + end; + if op = OP_IMUL then + list.concat(taicpu.op_const_reg(A_IMUL,regsize(reg), + longint(a),reg)) + else + { OP_MUL should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109225); + end; + OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR: + if (a = 1) and + (op in [OP_ADD,OP_SUB]) then + if op = OP_ADD then + list.concat(taicpu.op_reg(A_INC,regsize(reg),reg)) + else + list.concat(taicpu.op_reg(A_DEC,regsize(reg),reg)) + else + list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],regsize(reg), + longint(a),reg)); + OP_SHL,OP_SHR,OP_SAR: + begin + if (a and 31) <> 0 Then + list.concat(taicpu.op_const_reg( + TOpCG2AsmOp[op],regsize(reg),a and 31,reg)); + if (a shr 5) <> 0 Then + internalerror(68991); + end + else internalerror(68992); + end; + end; + + procedure tcg386.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); + + var + opcode: tasmop; + power: longint; + scratch_register: TRegister; + + begin + Case Op of + OP_DIV, OP_IDIV: + Begin + if ispowerof2(longint(a),power) then + begin + case op of + OP_DIV: + opcode := A_SHR; + OP_IDIV: + opcode := A_SAR; + end; + list.concat(taicpu.op_const_ref(opcode, + TCgSize2OpSize[size],power,newreference(ref))); + exit; + end; + { the rest should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109231); + End; + OP_MUL,OP_IMUL: + begin + if not(cs_check_overflow in aktlocalswitches) and + ispowerof2(longint(a),power) then + begin + list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size], + power,newreference(ref))); + exit; + end; + { can't multiply a memory location directly with a constant } + if op = OP_IMUL then + inherited a_op_const_ref(list,op,size,a,ref) + else + { OP_MUL should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109232); + end; + OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR: + if (a = 1) and + (op in [OP_ADD,OP_SUB]) then + if op = OP_ADD then + list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size], + newreference(ref))) + else + list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size], + newreference(ref))) + else + list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op], + TCgSize2OpSize[size],longint(a),newreference(ref))); + OP_SHL,OP_SHR,OP_SAR: + begin + if (a and 31) <> 0 Then + list.concat(taicpu.op_const_ref( + TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,newreference(ref))); + if (a shr 5) <> 0 Then + internalerror(68991); + end + else internalerror(68992); + end; + end; + + + procedure tcg386.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); + + var + dstsize: topsize; + + begin + dstsize := makeregsize(dst,size); + case op of + OP_NEG,OP_NOT: + begin + list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst)); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109233); + else + begin + if regsize(src) <> dstsize then + internalerror(200109226); + list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize, + src,dst)); + end; + end; + end; + + procedure tcg386.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); + + var + opsize: topsize; + + begin + if ref.is_immediate then + a_op_const_reg(list,op,ref.offset,reg) + else + begin + case op of + OP_NEG,OP_NOT,OP_IMUL: + begin + inherited a_op_ref_reg(list,op,size,ref,reg); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109239); + else + begin + opsize := makeregsize(reg,size); + list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],opsize, + newreference(ref),reg)); + end; + end; + end; + end; + + + procedure tcg386.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); + + var + opsize: topsize; + + begin + case op of + OP_NEG,OP_NOT: + begin + if reg <> R_NO then + internalerror(200109237); + list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size], + newreference(ref))); + end; + OP_IMUL: + begin + { this one needs a load/imul/store, which is the default } + inherited a_op_ref_reg(list,op,size,ref,reg); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109238); + else + begin + opsize := tcgsize2opsize[size]; + list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],opsize,reg, + newreference(ref))); + end; + end; + end; + +{*************** compare instructructions ****************} + + procedure tcg386.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + l : tasmlabel); + + begin + if a <> 0 then + list.concat(taicpu.op_const_reg(A_CMP,regsize(reg),longint(a), + reg)) + else + list.concat(taicpu.op_reg_reg(A_TEST,regsize(reg),reg,reg)); + a_jmp_cond(list,cmp_op,l); + end; + + procedure tcg386.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference; + l : tasmlabel); + + begin + list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size], + longint(a),newreference(ref))); + a_jmp_cond(list,cmp_op,l); + end; + + procedure tcg386.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; + reg1,reg2 : tregister;l : tasmlabel); + + begin + if regsize(reg1) <> regsize(reg2) then + internalerror(200109226); + list.concat(taicpu.op_reg_reg(A_CMP,regsize(reg1),reg1,reg2)); + a_jmp_cond(list,cmp_op,l); + end; + + procedure tcg386.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister;l : tasmlabel); + + var + opsize: topsize; + + begin + opsize := makeregsize(reg,size); + list.concat(taicpu.op_ref_reg(A_CMP,opsize,newreference(ref),reg)); + a_jmp_cond(list,cmp_op,l); + end; + + procedure tcg386.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); + + var + ai : taicpu; + + begin + if cond=OC_None then + ai := Taicpu.Op_sym(A_JMP,S_NO,l) + else + begin + ai:=Taicpu.Op_sym(A_Jcc,S_NO,l); + ai.SetCondition(TOpCmp2AsmCond[cond]); + end; + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcg386.g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); + + var + ai : taicpu; + hreg : tregister; + begin + hreg := makereg8(reg); + ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg); + ai.SetCondition(flag_2_cond[f]); + list.concat(ai); + if hreg<>reg then + begin + if reg in regset16bit then + emit_to_reg16(hreg) + else + emit_to_reg32(hreg); + end; + end; + + +{ *********** entry/exit code and address loading ************ } + + procedure tcg386.g_stackframe_entry(list : taasmoutput;localsize : longint); + + begin + runerror(211); + end; + + + procedure tcg386.g_restore_frame_pointer(list : taasmoutput); + + begin + runerror(211); + end; + + + procedure tcg386.g_push_exception_value_reg(list : taasmoutput;reg : tregister); + + begin + runerror(211); + end; + + + procedure tcg386.g_push_exception_value_const(list : taasmoutput;reg : tregister); + + begin + runerror(211); + end; + + + procedure tcg386.g_pop_exception_value_reg(list : taasmoutput;reg : tregister); + + begin + runerror(211); + end; + + + procedure tcg386.g_return_from_proc(list : taasmoutput;parasize : aword); + + begin + runerror(211); + end; + + procedure tcg386.a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister); + + begin + list.concat(taicpu.op_ref_reg(A_LEA,S_L,newreference(ref),r)); + end; + + function tcg386.makeregsize(var reg: tregister; size: tcgsize): topsize; + + begin + { this function only allows downsizing a register, because otherwise } + { we may start working with garbage (JM) } + case size of + OS_32,OS_S32: + begin + if not (reg in [R_EAX..R_EDI]) then + internalerror(2001092313); + result := S_L; + end; + OS_8,OS_S8: + begin + reg := makereg8(reg); + result := S_B; + end; + OS_16,OS_S16: + begin + if reg in [R_AL..R_BH] then + internalerror(2001092314); + reg := makereg16(reg); + result := S_W; + end; + else + internalerror(2001092312); + end; + end; + + + +{ ************* concatcopy ************ } + + procedure tcg386.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean); + + { temp implementation, until it's permanenty moved here from cga.pas } + + var + oldlist: taasmoutput; + + begin + if list <> exprasmlist then + begin + oldlist := exprasmlist; + exprasmlist := list; + end; + cga.concatcopy(source,dest,len,delsource,loadref); + if list <> exprasmlist then + list := oldlist; + end; + + +{***************** This is private property, keep out! :) *****************} + + procedure tcg386.sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize); + + begin + case s2 of + S_B: + if S1 in [OS_8,OS_S8] then + s3 := S_B + else internalerror(200109221); + S_W: + case s1 of + OS_8,OS_S8: + s3 := S_BW; + OS_16,OS_S16: + s3 := S_W; + else internalerror(200109222); + end; + S_L: + case s1 of + OS_8,OS_S8: + s3 := S_BL; + OS_16,OS_S16: + s3 := S_WL; + OS_32,OS_S32: + s3 := S_L; + else internalerror(200109223); + end; + else internalerror(200109227); + end; + if s3 in [S_B,S_W,S_L] then + op := A_MOV + else if s1 in [OS_8,OS_16,OS_32] then + op := A_MOVZX + else + op := A_MOVSX; + end; + + +begin + cg := tcg386.create; +end. +{ + $Log$ + Revision 1.1 2001-09-28 20:39:33 jonas + * changed all flow control structures (except for exception handling + related things) to processor independent code (in new ncgflw unit) + + generic cgobj unit which contains lots of code generator helpers with + global "cg" class instance variable + + cgcpu unit for i386 (implements processor specific routines of the above + unit) + * updated cgbase and cpubase for the new code generator units + * include ncgflw unit in cpunode unit + +} diff --git a/compiler/i386/cpubase.pas b/compiler/i386/cpubase.pas index b61578158c..bcded27679 100644 --- a/compiler/i386/cpubase.pas +++ b/compiler/i386/cpubase.pas @@ -528,14 +528,13 @@ const frame_pointer = R_EBP; self_pointer = R_ESI; accumulator = R_EAX; + accumulatorhigh = R_EDX; { the register where the vmt offset is passed to the destructor } { helper routine } vmt_offset_reg = R_EDI; scratch_regs : array[1..1] of tregister = (R_EDI); - max_scratch_regs = 1; - { low and high of the available maximum width integer general purpose } { registers } LoGPReg = R_EAX; @@ -926,7 +925,17 @@ end; end. { $Log$ - Revision 1.5 2001-05-18 23:01:13 peter + Revision 1.6 2001-09-28 20:39:33 jonas + * changed all flow control structures (except for exception handling + related things) to processor independent code (in new ncgflw unit) + + generic cgobj unit which contains lots of code generator helpers with + global "cg" class instance variable + + cgcpu unit for i386 (implements processor specific routines of the above + unit) + * updated cgbase and cpubase for the new code generator units + * include ncgflw unit in cpunode unit + + Revision 1.5 2001/05/18 23:01:13 peter * portable constants Revision 1.4 2001/04/13 01:22:18 peter diff --git a/compiler/i386/cpunode.pas b/compiler/i386/cpunode.pas index 080c6f4217..55be0911f1 100644 --- a/compiler/i386/cpunode.pas +++ b/compiler/i386/cpunode.pas @@ -29,7 +29,7 @@ unit cpunode; implementation uses - ncgbas, + ncgbas,ncgflw, n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem, n386set,n386inl,n386opt, { this not really a node } @@ -38,7 +38,17 @@ unit cpunode; end. { $Log$ - Revision 1.4 2001-05-18 22:31:06 peter + Revision 1.5 2001-09-28 20:39:33 jonas + * changed all flow control structures (except for exception handling + related things) to processor independent code (in new ncgflw unit) + + generic cgobj unit which contains lots of code generator helpers with + global "cg" class instance variable + + cgcpu unit for i386 (implements processor specific routines of the above + unit) + * updated cgbase and cpubase for the new code generator units + * include ncgflw unit in cpunode unit + + Revision 1.4 2001/05/18 22:31:06 peter * tasmnode.pass_2 is independent of cpu, moved to ncgbas * include ncgbas for independent nodes diff --git a/compiler/i386/n386flw.pas b/compiler/i386/n386flw.pas index 2f082404e9..ddf3661081 100644 --- a/compiler/i386/n386flw.pas +++ b/compiler/i386/n386flw.pas @@ -30,6 +30,7 @@ interface node,nflw; type +(* ti386whilerepeatnode = class(twhilerepeatnode) procedure pass_2;override; end; @@ -61,6 +62,7 @@ interface ti386labelnode = class(tlabelnode) procedure pass_2;override; end; +*) ti386raisenode = class(traisenode) procedure pass_2;override; @@ -92,6 +94,10 @@ implementation pass_1,nld,ncon, cga,tgcpu,n386util,regvars; +(* + + all implemented in ncgflw now (JM) + {***************************************************************************** Second_While_RepeatN *****************************************************************************} @@ -655,6 +661,8 @@ do_jmp: secondpass(left); end; +*) + {***************************************************************************** SecondRaise @@ -1324,6 +1332,7 @@ do_jmp: begin +(* cwhilerepeatnode:=ti386whilerepeatnode; cifnode:=ti386ifnode; cfornode:=ti386fornode; @@ -1332,6 +1341,7 @@ begin ccontinuenode:=ti386continuenode; cgotonode:=ti386gotonode; clabelnode:=ti386labelnode; +*) craisenode:=ti386raisenode; ctryexceptnode:=ti386tryexceptnode; ctryfinallynode:=ti386tryfinallynode; @@ -1340,7 +1350,17 @@ begin end. { $Log$ - Revision 1.15 2001-08-26 13:36:58 florian + Revision 1.16 2001-09-28 20:39:33 jonas + * changed all flow control structures (except for exception handling + related things) to processor independent code (in new ncgflw unit) + + generic cgobj unit which contains lots of code generator helpers with + global "cg" class instance variable + + cgcpu unit for i386 (implements processor specific routines of the above + unit) + * updated cgbase and cpubase for the new code generator units + * include ncgflw unit in cpunode unit + + Revision 1.15 2001/08/26 13:36:58 florian * some cg reorganisation * some PPC updates diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas new file mode 100644 index 0000000000..8996ad1687 --- /dev/null +++ b/compiler/ncgflw.pas @@ -0,0 +1,613 @@ +{ + $Id$ + Copyright (c) 1998-2000 by Florian Klaempfl + + Generate assembler for nodes that influence the flow which are + the same for all (most?) processors + + 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 ncgflw; + +{$i defines.inc} + +interface + + uses + node,nflw; + + type + tcgwhilerepeatnode = class(twhilerepeatnode) + procedure pass_2;override; + end; + + tcgifnode = class(tifnode) + procedure pass_2;override; + end; + + tcgfornode = class(tfornode) + procedure pass_2;override; + end; + + tcgexitnode = class(texitnode) + procedure pass_2;override; + end; + + tcgbreaknode = class(tbreaknode) + procedure pass_2;override; + end; + + tcgcontinuenode = class(tcontinuenode) + procedure pass_2;override; + end; + + tcggotonode = class(tgotonode) + procedure pass_2;override; + end; + + tcglabelnode = class(tlabelnode) + procedure pass_2;override; + end; + +implementation + + uses + verbose,globtype,globals,systems, + symconst,symdef,symsym,aasm,types, + cgbase,temp_gen,pass_2, + cpubase,cpuasm, + pass_1,nld,ncon, + cga,tgcpu, +{$ifdef i386} + n386util, +{$endif} + regvars,cgobj,cgcpu; + +{***************************************************************************** + Second_While_RepeatN +*****************************************************************************} + + procedure tcgwhilerepeatnode.pass_2; + var + lcont,lbreak,lloop, + oldclabel,oldblabel : tasmlabel; + otlabel,oflabel : tasmlabel; + + begin + getlabel(lloop); + getlabel(lcont); + getlabel(lbreak); + { arrange continue and breaklabels: } + oldclabel:=aktcontinuelabel; + oldblabel:=aktbreaklabel; + + load_all_regvars(exprasmlist); + { handling code at the end as it is much more efficient, and makes + while equal to repeat loop, only the end true/false is swapped (PFV) } + if nodetype=whilen then + cg.a_jmp_cond(exprasmlist,OC_None,lcont); + + { align loop target } + exprasmList.concat(Tai_align.Create(aktalignment.loopalign)); + cg.a_label(exprasmlist,lloop); + + aktcontinuelabel:=lcont; + aktbreaklabel:=lbreak; + cleartempgen; + if assigned(right) then + secondpass(right); + + load_all_regvars(exprasmlist); + + cg.a_label(exprasmlist,lcont); + otlabel:=truelabel; + oflabel:=falselabel; + if nodetype=whilen then + begin + truelabel:=lloop; + falselabel:=lbreak; + end + { repeatn } + else + begin + truelabel:=lbreak; + falselabel:=lloop; + end; + cleartempgen; + secondpass(left); + + load_all_regvars(exprasmlist); + + maketojumpbool(left); + cg.a_label(exprasmlist,lbreak); + truelabel:=otlabel; + falselabel:=oflabel; + + aktcontinuelabel:=oldclabel; + aktbreaklabel:=oldblabel; + { a break/continue in a while/repeat block can't be seen outside } + flowcontrol:=flowcontrol-[fc_break,fc_continue]; + end; + + +{***************************************************************************** + tcgIFNODE +*****************************************************************************} + + procedure tcgifnode.pass_2; + + var + hl,otlabel,oflabel : tasmlabel; + + begin + otlabel:=truelabel; + oflabel:=falselabel; + getlabel(truelabel); + getlabel(falselabel); + cleartempgen; + secondpass(left); + load_all_regvars(exprasmlist); + maketojumpbool(left); + if assigned(right) then + begin + cg.a_label(exprasmlist,truelabel); + cleartempgen; + secondpass(right); + { automatically done for blocks, but not for statements (JM) } + load_all_regvars(exprasmlist); + end; + if assigned(t1) then + begin + if assigned(right) then + begin + getlabel(hl); + { do go back to if line !! } + aktfilepos:=exprasmList.getlasttaifilepos^; + cg.a_jmp_cond(exprasmlist,OC_None,hl); + end; + cg.a_label(exprasmlist,falselabel); + cleartempgen; + secondpass(t1); + load_all_regvars(exprasmlist); + if assigned(right) then + cg.a_label(exprasmlist,hl); + end + else + begin + cg.a_label(exprasmlist,falselabel); + end; + if not(assigned(right)) then + begin + cg.a_label(exprasmlist,truelabel); + end; + truelabel:=otlabel; + falselabel:=oflabel; + end; + + +{***************************************************************************** + SecondFor +*****************************************************************************} + + procedure tcgfornode.pass_2; + var + l3,oldclabel,oldblabel : tasmlabel; + omitfirstcomp,temptovalue : boolean; + hs : byte; + temp1 : treference; + hop : topcg; + hcond : topcmp; + opsize : tcgsize; + count_var_is_signed : boolean; + + begin + oldclabel:=aktcontinuelabel; + oldblabel:=aktbreaklabel; + getlabel(aktcontinuelabel); + getlabel(aktbreaklabel); + getlabel(l3); + + { could we spare the first comparison ? } + omitfirstcomp:=false; + if right.nodetype=ordconstn then + if tassignmentnode(left).right.nodetype=ordconstn then + omitfirstcomp:=((nf_backward in flags) and + (tordconstnode(tassignmentnode(left).right).value>=tordconstnode(right).value)) + or (not(nf_backward in flags) and + (tordconstnode(tassignmentnode(left).right).value<=tordconstnode(right).value)); + + { only calculate reference } + cleartempgen; + secondpass(t2); + hs := t2.resulttype.def.size; + opsize := def_cgsize(t2.resulttype.def); + + { first set the to value + because the count var can be in the expression !! } + cleartempgen; + secondpass(right); + { calculate pointer value and check if changeable and if so } + { load into temporary variable } + if right.nodetype<>ordconstn then + begin + temp1.symbol:=nil; + gettempofsizereference(hs,temp1); + temptovalue:=true; + if (right.location.loc=LOC_REGISTER) or + (right.location.loc=LOC_CREGISTER) then + begin + cg.a_load_reg_ref(exprasmlist,opsize, + right.location.register,temp1); + ungetregister(right.location.register); + end + else + cg.g_concatcopy(exprasmlist,right.location.reference,temp1, + hs,true,false); + end + else + temptovalue:=false; + + { produce start assignment } + cleartempgen; + secondpass(left); + count_var_is_signed:=is_signed(torddef(t2.resulttype.def)); + + if nf_backward in flags then + if count_var_is_signed then + hcond:=OC_LT + else + hcond:=OC_B + else + if count_var_is_signed then + hcond:=OC_GT + else + hcond:=OC_A; + + load_all_regvars(exprasmlist); + + if temptovalue then + begin + cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond, + temp1,t2.location,aktbreaklabel); + end + else + begin + if not(omitfirstcomp) then + begin + cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond, + tordconstnode(right).value,t2.location,aktbreaklabel); + end; + end; + + { align loop target } + exprasmList.concat(Tai_align.Create(aktalignment.loopalign)); + cg.a_label(exprasmlist,l3); + + { help register must not be in instruction block } + cleartempgen; + if assigned(t1) then + begin + secondpass(t1); + load_all_regvars(exprasmlist); + end; + + cg.a_label(exprasmlist,aktcontinuelabel); + + { makes no problems there } + cleartempgen; + + if nf_backward in flags then + if count_var_is_signed then + hcond:=OC_LTE + else + hcond:=OC_BE + else + if count_var_is_signed then + hcond:=OC_GTE + else + hcond:=OC_AE; + load_all_regvars(exprasmlist); + + { produce comparison and the corresponding } + { jump } + if temptovalue then + begin + cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,temp1, + t2.location,aktbreaklabel); + end + else + begin + cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond, + tordconstnode(right).value,t2.location,aktbreaklabel); + end; + { according to count direction DEC or INC... } + { must be after the test because of 0 to 255 for bytes !! } + if nf_backward in flags then + hop:=OP_SUB + else + hop:=OP_ADD; + cg.a_op_const_loc(exprasmlist,hop,opsize,1,t2.location); + cg.a_jmp_cond(exprasmlist,OC_None,l3); + + if temptovalue then + ungetiftemp(temp1); + + { this is the break label: } + cg.a_label(exprasmlist,aktbreaklabel); + + aktcontinuelabel:=oldclabel; + aktbreaklabel:=oldblabel; + { a break/continue in a for block can't be seen outside } + flowcontrol:=flowcontrol-[fc_break,fc_continue]; + end; + + +{***************************************************************************** + SecondExitN +*****************************************************************************} + + procedure tcgexitnode.pass_2; + + var + {op : tasmop; + s : topsize;} + otlabel,oflabel : tasmlabel; + r : treference; + is_mem, + allocated_acc, + allocated_acchigh: boolean; + + procedure cleanleft; + begin + if is_mem then + begin + del_reference(left.location.reference); + ungetiftemp(left.location.reference); + end + else + begin + ungetregister(left.location.register); + if left.location.registerhigh <> R_NO then + ungetregister(left.location.registerhigh); + end; + end; + + label + do_jmp; + begin + load_all_regvars(exprasmlist); + include(flowcontrol,fc_exit); + if assigned(left) then + if left.nodetype=assignn then + begin + { just do a normal assignment followed by exit } + secondpass(left); + cg.a_jmp_cond(exprasmlist,OC_NONE,aktexitlabel); + end + else + begin + allocated_acc := false; + allocated_acchigh := false; + otlabel:=truelabel; + oflabel:=falselabel; + getlabel(truelabel); + getlabel(falselabel); + secondpass(left); + case left.location.loc of + LOC_FPU : goto do_jmp; + LOC_MEM, + LOC_REFERENCE : is_mem:=true; + LOC_CREGISTER, + LOC_REGISTER : is_mem:=false; + LOC_FLAGS : begin + cg.a_reg_alloc(exprasmlist,accumulator); + allocated_acc := true; + cg.g_flags2reg(exprasmlist,left.location.resflags,accumulator); + goto do_jmp; + end; + LOC_JUMP : begin + exprasmlist.concat(tairegalloc.alloc(accumulator)); + allocated_acc := true; + cg.a_label(exprasmlist,truelabel); + cg.a_load_const_reg(exprasmlist,OS_8,1, + makereg8(accumulator)); + cg.a_jmp_cond(exprasmlist,OC_NONE,aktexit2label); + cg.a_label(exprasmlist,falselabel); + cg.a_load_const_reg(exprasmlist,OS_8,0, + makereg8(accumulator)); + goto do_jmp; + end; + else + internalerror(2001); + end; + case aktprocsym.definition.rettype.def.deftype of + pointerdef, + procvardef : begin + cleanleft; + cg.a_reg_alloc(exprasmlist,accumulator); + allocated_acc := true; + if is_mem then + cg.a_load_ref_reg(exprasmlist,OS_ADDR, + left.location.reference,accumulator) + else + cg.a_load_reg_reg(exprasmlist,OS_ADDR, + left.location.register,accumulator); + end; + floatdef : begin + cleanleft; + if is_mem then + floatload(tfloatdef(aktprocsym.definition.rettype.def).typ,left.location.reference); + end; + { orddef, + enumdef : } + else + { it can be anything shorter than 4 bytes PM + this caused form bug 711 } + begin + cleanleft; + cg.a_reg_alloc(exprasmlist,accumulator); + allocated_acc := true; + case aktprocsym.definition.rettype.def.size of + { it can be a qword/int64 too ... } + 8 : + if is_mem then + begin + cg.a_load_ref_reg(exprasmlist,OS_32, + left.location.reference,accumulator); + r:=left.location.reference; + inc(r.offset,4); + cg.a_reg_alloc(exprasmlist,accumulatorhigh); + allocated_acchigh := true; + cg.a_load_ref_reg(exprasmlist,OS_32,r,accumulatorhigh); + end + else + begin + cg.a_load_reg_reg(exprasmlist,OS_32,left.location.registerlow,accumulator); + cg.a_reg_alloc(exprasmlist,accumulatorhigh); + allocated_acchigh := true; + cg.a_load_reg_reg(exprasmlist,OS_32,left.location.registerhigh,accumulatorhigh); + end; + { if its 3 bytes only we can still + copy one of garbage ! PM } + 4,3 : + cg.a_load_loc_reg(exprasmlist,OS_32,left.location, + accumulator); + 2 : + cg.a_load_loc_reg(exprasmlist,OS_16,left.location, + makereg16(accumulator)); + 1 : + cg.a_load_loc_reg(exprasmlist,OS_8,left.location, + makereg8(accumulator)); + else internalerror(605001); + end; + end; + end; +do_jmp: + truelabel:=otlabel; + falselabel:=oflabel; + cg.a_jmp_cond(exprasmlist,OC_None,aktexit2label); + if allocated_acc then + cg.a_reg_dealloc(exprasmlist,accumulator); + if allocated_acchigh then + cg.a_reg_dealloc(exprasmlist,accumulator); + end + else + cg.a_jmp_cond(exprasmlist,OC_None,aktexitlabel); + end; + + +{***************************************************************************** + SecondBreakN +*****************************************************************************} + + procedure tcgbreaknode.pass_2; + begin + include(flowcontrol,fc_break); + if aktbreaklabel<>nil then + begin + load_all_regvars(exprasmlist); + cg.a_jmp_cond(exprasmlist,OC_None,aktbreaklabel) + end + else + CGMessage(cg_e_break_not_allowed); + end; + + +{***************************************************************************** + SecondContinueN +*****************************************************************************} + + procedure tcgcontinuenode.pass_2; + begin + include(flowcontrol,fc_continue); + if aktcontinuelabel<>nil then + begin + load_all_regvars(exprasmlist); + cg.a_jmp_cond(exprasmlist,OC_None,aktcontinuelabel) + end + else + CGMessage(cg_e_continue_not_allowed); + end; + + +{***************************************************************************** + SecondGoto +*****************************************************************************} + + procedure tcggotonode.pass_2; + + begin + load_all_regvars(exprasmlist); + cg.a_jmp_cond(exprasmlist,OC_None,labelnr) + end; + + +{***************************************************************************** + SecondLabel +*****************************************************************************} + + procedure tcglabelnode.pass_2; + begin + load_all_regvars(exprasmlist); + cg.a_label(exprasmlist,labelnr); + cleartempgen; + secondpass(left); + end; + + +begin + cwhilerepeatnode:=tcgwhilerepeatnode; + cifnode:=tcgifnode; + cfornode:=tcgfornode; + cexitnode:=tcgexitnode; + cbreaknode:=tcgbreaknode; + ccontinuenode:=tcgcontinuenode; + cgotonode:=tcggotonode; + clabelnode:=tcglabelnode; +end. +{ + $Log$ + Revision 1.1 2001-09-28 20:39:33 jonas + * changed all flow control structures (except for exception handling + related things) to processor independent code (in new ncgflw unit) + + generic cgobj unit which contains lots of code generator helpers with + global "cg" class instance variable + + cgcpu unit for i386 (implements processor specific routines of the above + unit) + * updated cgbase and cpubase for the new code generator units + * include ncgflw unit in cpunode unit + + Revision 1.4 2001/09/09 17:10:25 jonas + * some more things implemented + + Revision 1.3 2001/09/06 15:25:55 jonas + * changed type of tcg from object to class -> abstract methods are now + a lot cleaner :) + + more updates: load_*_loc methods, op_*_* methods, g_flags2reg method + (if possible with geenric implementation and necessary ppc + implementations) + * worked a bit further on cgflw, now working on exitnode + + Revision 1.2 2001/09/05 20:21:03 jonas + * new cgflow based on n386flw with all nodes until forn "translated" + + a_cmp_*_loc_label methods for tcg + + base implementatino for a_cmp_ref_*_label methods + * small bugfixes to powerpc cg + + +} +