freepascal.compiler/compiler/sparc/naddcpu.pas

{*****************************************************************************}
{ File                   : naddcpu.pas                                        }
{ Author                 : Mazen NEIFER                                       }
{ Project                : Free Pascal Compiler (FPC)                         }
{ Creation date          : 2002\07\14                                         }
{ Last modification date : 2002\07\26                                         }
{ Licence                : GPL                                                }
{ Bug report             : [email protected]                        }
{*****************************************************************************}
{
		$Id$
		Copyright (c) 2000-2002 by Florian Klaempfl

		Code generation for add nodes on 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 naddcpu;
{$INCLUDE fpcdefs.inc}
INTERFACE
USES
	node,nadd,cpubase,cginfo;
TYPE
	TSparcAddNode=CLASS(TAddNode)
		procedure pass_2;override;
	PRIVATE
		FUNCTION GetResFlags(unsigned:Boolean):TResFlags;
		procedure left_must_be_reg(OpSize:TOpSize;NoSwap:Boolean);
		procedure emit_generic_code(op:TAsmOp;OpSize:TOpSize;unsigned,extra_not,mboverflow:Boolean);
		procedure emit_op_right_left(op:TAsmOp;OpSize:TOpsize);
		procedure pass_left_and_right;
		procedure set_result_location(cmpOp,unsigned:Boolean);
	end;
implementation
uses
	globtype,systems,
	cutils,verbose,globals,
	symconst,symdef,paramgr,
	aasmbase,aasmtai,aasmcpu,defbase,htypechk,
	cgbase,pass_2,regvars,
	cpupara,
	ncon,nset,
	cga,ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
const
	opsize_2_cgSize:array[S_B..S_L]of TCgSize=(OS_8,OS_16,OS_32);
function TSparcAddNode.GetResFlags(unsigned:Boolean):TResFlags;
	begin
		case NodeType of
			equaln:
				GetResFlags:=F_E;
			unequaln:
				GetResFlags:=F_NE;
			else
				if not(unsigned)
				then
					if nf_swaped IN flags
					then
						case NodeType of
							ltn:
								GetResFlags:=F_G;
							lten:
								GetResFlags:=F_GE;
							gtn:
								GetResFlags:=F_L;
							gten:
								GetResFlags:=F_LE;
						end
					else
						case NodeType of
							ltn:
								GetResFlags:=F_L;
							lten:
								GetResFlags:=F_LE;
							gtn:
								GetResFlags:=F_G;
							gten:
								GetResFlags:=F_GE;
						end
				else
					if nf_swaped IN Flags
					then
						case NodeType of
							ltn:
								GetResFlags:=F_A;
							lten:
								GetResFlags:=F_AE;
							gtn:
								GetResFlags:=F_B;
							gten:
								GetResFlags:=F_BE;
						end
					else
						case NodeType of
							ltn:
								GetResFlags:=F_B;
							lten:
								GetResFlags:=F_BE;
							gtn:
								GetResFlags:=F_A;
							gten:
								GetResFlags:=F_AE;
						end;
		end;
	end;
procedure TSparcAddNode.left_must_be_reg(OpSize:TOpSize;NoSwap:Boolean);
	begin
		if(left.location.loc<>LOC_REGISTER)
		then{left location is not a register}
			begin
				if(not NoSwap)and(right.location.loc=LOC_REGISTER)
				then{right is register so we can swap the locations}
					begin
						location_swap(left.location,right.location);
						toggleflag(nf_swaped);
					end
				else
					begin
{maybe we can reuse a constant register when the operation is a comparison that
doesn't change the value of the register}
						location_force_reg(exprasmlist,left.location,opsize_2_cgsize[opsize],(nodetype IN [ltn,lten,gtn,gten,equaln,unequaln]));
					end;
			end;
	end;
procedure TSparcAddNode.emit_generic_code(op:TAsmOp;OpSize:TOpSize;unsigned,extra_not,mboverflow:Boolean);
	VAR
		power:LongInt;
		hl4:TAsmLabel;
	begin
		{ at this point, left.location.loc should be LOC_REGISTER }
		IF right.location.loc=LOC_REGISTER
		THEN
			begin
					{ right.location is a LOC_REGISTER }
					{ when swapped another result register }
				IF(nodetype=subn)AND(nf_swaped IN flags)
				THEN
					begin
						IF extra_not
						THEN
							emit_reg(A_NOT,S_L,left.location.register);
							emit_reg_reg(op,opsize,left.location.register,right.location.register);
						{ newly swapped also set swapped flag }
						location_swap(left.location,right.location);
						toggleflag(nf_swaped);
					end
				ELSE
					begin
						IF extra_not
						THEN
							emit_reg(A_NOT,S_L,right.location.register);
						emit_reg_reg(op,opsize,right.location.register,left.location.register);
					end;
			end
		ELSE
			begin
				{ right.location is not a LOC_REGISTER }
				IF(nodetype=subn)AND(nf_swaped IN flags)
				THEN
					begin
						IF extra_not
						THEN
							emit_reg(A_NOT,opsize,left.location.register);
//          rg.getexplicitregisterint(exprasmlist,R_EDI);
//          cg.a_load_loc_reg(exprasmlist,right.location,R_EDI);
//          emit_reg_reg(op,opsize,left.location.register,R_EDI);
//          emit_reg_reg(A_MOV,opsize,R_EDI,left.location.register);
//          rg.ungetregisterint(exprasmlist,R_EDI);
					end
				ELSE
					begin
						{ Optimizations when right.location is a constant value }
						IF(op=A_CMP)AND(nodetype IN [equaln,unequaln])AND(right.location.loc=LOC_CONSTANT)AND(right.location.value=0)
						THEN
							begin
//                emit_reg_reg(A_TEST,opsize,left.location.register,left.location.register);
							end
						ELSE IF(op=A_ADD)AND(right.location.loc=LOC_CONSTANT)AND(right.location.value=1)AND NOT(cs_check_overflow in aktlocalswitches)
						THEN
							begin
								emit_reg(A_INC,opsize,left.location.register);
							end
						ELSE IF(op=A_SUB)AND(right.location.loc=LOC_CONSTANT)AND(right.location.value=1)AND NOT(cs_check_overflow in aktlocalswitches)
						THEN
							begin
								emit_reg(A_DEC,opsize,left.location.register);
							end
						ELSE IF(op=A_SMUL)AND(right.location.loc=LOC_CONSTANT)AND(ispowerof2(right.location.value,power))AND NOT(cs_check_overflow in aktlocalswitches)
						THEN
							begin
								emit_const_reg(A_SLL,opsize,power,left.location.register);
							end
						ELSE
							begin
								IF extra_not
								THEN
									begin
//                  rg.getexplicitregisterint(exprasmlist,R_EDI);
//                  cg.a_load_loc_reg(exprasmlist,right.location,R_EDI);
//                  emit_reg(A_NOT,S_L,R_EDI);
//                  emit_reg_reg(A_AND,S_L,R_EDI,left.location.register);
//                  rg.ungetregisterint(exprasmlist,R_EDI);
									end
								ELSE
									begin
										emit_op_right_left(op,opsize);
									end;
							end;
					end;
			end;
		{ only in case of overflow operations }
		{ produce overflow code }
		{ we must put it here directly, because sign of operation }
		{ is in unsigned VAR!!                                   }
		IF mboverflow
		THEN
			begin
				IF cs_check_overflow IN aktlocalswitches
				THEN
					begin
			//      getlabel(hl4);
						IF unsigned
						THEN
							emitjmp(C_NB,hl4)
						ELSE
							emitjmp(C_NO,hl4);
						cg.a_call_name(exprasmlist,'FPC_OVERFLOW');
						cg.a_label(exprasmlist,hl4);
					end;
			end;
	end;
procedure TSparcAddNode.emit_op_right_left(op:TAsmOp;OpSize:TOpsize);
	begin
		{left must be a register}
		with exprasmlist do
			case right.location.loc of
				LOC_REGISTER,LOC_CREGISTER:
					concat(taicpu.op_reg_reg(op,opsize,right.location.register,left.location.register));
				LOC_REFERENCE,LOC_CREFERENCE :
					concat(taicpu.op_ref_reg(op,opsize,right.location.reference,left.location.register));
				LOC_CONSTANT:
					concat(taicpu.op_const_reg(op,opsize,right.location.value,left.location.register));
				else
					InternalError(200203232);
			end;
	end;
procedure TSparcAddNode.set_result_location(cmpOp,unsigned:Boolean);
	begin
		IF cmpOp
		THEN
			begin
				location_reset(location,LOC_FLAGS,OS_NO);
				location.resflags:=GetResFlags(unsigned);
			end
		ELSE
			location_copy(location,left.location);
	end;
procedure TSparcAddNode.pass_2;
{is also being used for "xor", and "mul", "sub", or and comparative operators}
	VAR
		popeax,popedx,pushedfpu,mboverflow,cmpop:Boolean;
		op:TAsmOp;
		power:LongInt;
		OpSize:TOpSize;
		unsigned:Boolean;{true, if unsigned types are compared}
				{ is_in_dest if the result is put directly into }
				{ the resulting refernce or varregister }
				{is_in_dest : boolean;}
				{ true, if for sets subtractions the extra not should generated }
		extra_not:Boolean;
	begin
{to make it more readable, string and set (not smallset!) have their own
procedures }
		case left.resulttype.def.deftype of
			orddef:
				if is_boolean(left.resulttype.def)and is_boolean(right.resulttype.def)
				then{handling boolean expressions}
					begin
						InternalError(20020726);//second_addboolean;
						exit;
					end
				else if is_64bitint(left.resulttype.def)
				then{64bit operations}
					begin
						InternalError(20020726);//second_add64bit;
						exit;
					end;
			stringdef:
				begin
					InternalError(20020726);//second_addstring;
					exit;
				end;
			setdef:
				begin
					{normalsets are already handled in pass1}
					IF(tsetdef(left.resulttype.def).settype<>smallset)
					THEN
						internalerror(200109041);
					InternalError(20020726);//second_addsmallset;
					exit;
				end;
			arraydef :
				begin
				end;
			floatdef :
				begin
					InternalError(20020726);//second_addfloat;
					exit;
				end;
		end;
{defaults}
		{is_in_dest:=false;}
		extra_not:=false;
		mboverflow:=false;
		cmpop:=false;
		unsigned:=not(is_signed(left.resulttype.def))or not(is_signed(right.resulttype.def));
		opsize:=def_opsize(left.resulttype.def);
		pass_left_and_right;
		IF(left.resulttype.def.deftype=pointerdef)OR
			(right.resulttype.def.deftype=pointerdef) or
			(is_class_or_interface(right.resulttype.def) and is_class_or_interface(left.resulttype.def)) or
			(left.resulttype.def.deftype=classrefdef) or
			(left.resulttype.def.deftype=procvardef) or
			((left.resulttype.def.deftype=enumdef)and(left.resulttype.def.size=4)) or
			((left.resulttype.def.deftype=orddef)and(torddef(left.resulttype.def).typ in [s32bit,u32bit])) or
			((right.resulttype.def.deftype=orddef)and(torddef(right.resulttype.def).typ in [s32bit,u32bit]))
		THEN
			begin
				CASE NodeType OF
					addn:
						begin
							op:=A_ADD;
							mboverflow:=true;
						end;
					muln:
						begin
							IF unsigned
							THEN
								op:=A_UMUL
							ELSE
								op:=A_SMUL;
							mboverflow:=true;
						end;
					subn:
						begin
							op:=A_SUB;
							mboverflow:=true;
						end;
					ltn,lten,
					gtn,gten,
					equaln,unequaln:
						begin
							op:=A_CMP;
							cmpop:=true;
						end;
					xorn:
						op:=A_XOR;
					orn:
						op:=A_OR;
					andn:
						op:=A_AND;
				ELSE
					CGMessage(type_e_mismatch);
				end;
	{ filter MUL, which requires special handling }
				IF op=A_UMUL
				THEN
					begin
						popeax:=false;
						popedx:=false;
							{ here you need to free the symbol first }
							{ left.location and right.location must }
							{ only be freed when they are really released,  }
							{ because the optimizer NEEDS correct regalloc  }
							{ info!!! (JM)                                  }
							{ the location.register will be filled in later (JM) }
						location_reset(location,LOC_REGISTER,OS_INT);
{$IfNDef NoShlMul}
						IF right.nodetype=ordconstn
						THEN
							swapleftright;
						IF(left.nodetype=ordconstn)and
							ispowerof2(tordconstnode(left).value, power)and
							not(cs_check_overflow in aktlocalswitches)
						THEN
							begin
									{ This release will be moved after the next }
									{ instruction by the optimizer. No need to  }
									{ release left.location, since it's a   }
									{ constant (JM)                             }
								location_release(exprasmlist,right.location);
								location.register:=rg.getregisterint(exprasmlist);
								cg.a_load_loc_reg(exprasmlist,right.location,location.register);
								cg.a_op_const_reg(exprasmlist,OP_SHL,power,location.register);
							end
						ELSE
							begin
{$EndIf NoShlMul}
{In SPARC there is no push/pop mechanism. There is a windowing mechanism using
 SAVE and RESTORE instructions.}
								//regstopush:=all_registers;
								//remove_non_regvars_from_loc(right.location,regstopush);
								//remove_non_regvars_from_loc(left.location,regstopush);
								{left.location can be R_EAX !!!}
//              rg.GetExplicitRegisterInt(exprasmlist,R_EDI);
								{load the left value}
//                cg.a_load_loc_reg(exprasmlist,left.location,R_EDI);
//                location_release(exprasmlist,left.location);
									{ allocate EAX }
//                if R_EAX in rg.unusedregsint then
//                  exprasmList.concat(tai_regalloc.Alloc(R_EAX));
									{ load he right value }
//                cg.a_load_loc_reg(exprasmlist,right.location,R_EAX);
//                location_release(exprasmlist,right.location);
									{ allocate EAX if it isn't yet allocated (JM) }
//                if (R_EAX in rg.unusedregsint) then
//                  exprasmList.concat(tai_regalloc.Alloc(R_EAX));
									{ also allocate EDX, since it is also modified by }
									{ a mul (JM)                                      }
{                if R_EDX in rg.unusedregsint then
										exprasmList.concat(tai_regalloc.Alloc(R_EDX));
									emit_reg(A_MUL,S_L,R_EDI);
									rg.ungetregisterint(exprasmlist,R_EDI);
									if R_EDX in rg.unusedregsint then
										exprasmList.concat(tai_regalloc.DeAlloc(R_EDX));
									if R_EAX in rg.unusedregsint then
										exprasmList.concat(tai_regalloc.DeAlloc(R_EAX));
									location.register:=rg.getregisterint(exprasmlist);
									emit_reg_reg(A_MOV,S_L,R_EAX,location.register);
									if popedx then
									emit_reg(A_POP,S_L,R_EDX);
									if popeax then
									emit_reg(A_POP,S_L,R_EAX);}
{$IfNDef NoShlMul}
								End;
{$endif NoShlMul}
							location_freetemp(exprasmlist,left.location);
							location_freetemp(exprasmlist,right.location);
							exit;
						end;

						{ Convert flags to register first }
						if (left.location.loc=LOC_FLAGS) then
						location_force_reg(exprasmlist,left.location,opsize_2_cgsize[opsize],false);
						if (right.location.loc=LOC_FLAGS) then
						location_force_reg(exprasmlist,right.location,opsize_2_cgsize[opsize],false);

						left_must_be_reg(OpSize,false);
						emit_generic_code(op,opsize,unsigned,extra_not,mboverflow);
						location_freetemp(exprasmlist,right.location);
						location_release(exprasmlist,right.location);
						if cmpop and
							(left.location.loc<>LOC_CREGISTER) then
						begin
							location_freetemp(exprasmlist,left.location);
							location_release(exprasmlist,left.location);
						end;
						set_result_location(cmpop,unsigned);
					end

				{ 8/16 bit enum,char,wchar types }
{         else
					if ((left.resulttype.def.deftype=orddef) and
							(torddef(left.resulttype.def).typ in [uchar,uwidechar])) or
						((left.resulttype.def.deftype=enumdef) and
							((left.resulttype.def.size=1) or
							(left.resulttype.def.size=2))) then
					begin
						case nodetype of
							ltn,lten,gtn,gten,
							equaln,unequaln :
								cmpop:=true;
							else
								CGMessage(type_e_mismatch);
						end;
						left_must_be_reg(opsize,false);
						emit_op_right_left(A_CMP,opsize);
						location_freetemp(exprasmlist,right.location);
						location_release(exprasmlist,right.location);
						if left.location.loc<>LOC_CREGISTER then
							begin
								location_freetemp(exprasmlist,left.location);
								location_release(exprasmlist,left.location);
							end;
						set_result_location(true,true);
					end
				else
					CGMessage(type_e_mismatch);}
			end;
procedure TSparcAddNode.pass_left_and_right;
	var
		pushedregs:tmaybesave;
		tmpreg:tregister;
		pushedfpu:boolean;
	begin
		{ calculate the operator which is more difficult }
		firstcomplex(self);
		{ in case of constant put it to the left }
		if (left.nodetype=ordconstn)
		then
			swapleftright;
		secondpass(left);
		{ are too few registers free? }
		maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
		if location.loc=LOC_FPUREGISTER
		then
			pushedfpu:=maybe_pushfpu(exprasmlist,right.registersfpu,left.location)
		else
			pushedfpu:=false;
		secondpass(right);
		maybe_restore(exprasmlist,left.location,pushedregs);
		if pushedfpu
		then
			begin
				tmpreg := rg.getregisterfpu(exprasmlist);
				cg.a_loadfpu_loc_reg(exprasmlist,left.location,tmpreg);
				location_reset(left.location,LOC_FPUREGISTER,left.location.size);
				left.location.register := tmpreg;
			end;
	end;
begin
	cAddNode:=TSparcAddNode;
end.