indexing
	description: "Eiffel Call and Access"
	date: "$Date$"
	version: "$Revision$"

deferred class
	CALL_ACCESS_B 

inherit
	ACCESS_B
		redefine
			make_byte_code, generate_il
		end

	SHARED_NAMES_HEAP
		export
			{NONE} all
		end

	DEBUG_OUTPUT
		export
			{NONE} all
		end

feature -- Access

	feature_id: INTEGER
			-- Feature id of the called feature.

	feature_name_id: INTEGER
			-- Feature name ID of called feature.

	feature_name: STRING is
			-- Feature name called
		require
			feature_name_id_set: feature_name_id > 0
		do
			Result := Names_heap.item (feature_name_id)
		ensure
			result_not_void: Result /= Void
			result_not_empty: not Result.is_empty
		end

	routine_id: INTEGER
			-- Routine ID for the access (used in final mode generation)

	written_in: INTEGER
			-- Class ID where Current is written.

	precursor_type : CL_TYPE_I
			-- Type of parent in a precursor call if any.

feature -- Setting

	set_precursor_type (p_type : CL_TYPE_I) is
			-- Assign `p_type' to `precursor_type'.
		require
			p_type_not_void: p_type /= Void
			not_attribute: not is_attribute
		do
			precursor_type := p_type
		ensure
			precursor_set : precursor_type = p_type
		end

feature -- IL code generation

	generate_il is
			-- Generate IL code for feature call.
		do
			generate_il_call (False)
		end

	generate_il_call (invariant_checked: BOOLEAN) is
			-- Generate IL code for feature call.
			-- If `invariant_checked' generates invariant check
			-- before call.
		require
			il_generation: System.il_generation
		deferred
		end

	need_real_metamorphose (a_type: CL_TYPE_I): BOOLEAN is
			-- Does call originate from a reference type?
		require
			a_type_not_void: a_type /= Void
			a_type_has_associated_class: a_type.base_class /= Void
		local
			class_c: CLASS_C
		do
			class_c := a_type.base_class
			Result := written_in /= class_c.class_id
		end

feature -- Byte code generation

	make_byte_code (ba: BYTE_ARRAY) is
			-- Generate byte code for a feature call
		do
			make_code (ba, False)
		end

	make_creation_byte_code (ba: BYTE_ARRAY) is
			-- Generate call as a creation procedure
		do
			make_code (ba, True)
		end

	make_code (ba: BYTE_ARRAY; flag: BOOLEAN) is
			-- Generate byte code for a feature call. 
			-- If not `flag', generate
			-- an invariant check before the call.
			-- Doesn't process the parameters
		require
			ba_not_void: ba /= Void
		deferred
		end

	standard_make_code (ba: BYTE_ARRAY; flag: BOOLEAN) is
			-- Generate byte code for a feature call. If not `flag', generate
			-- an invariant check before the call.
			-- if `meta', metamorphose the feature call.
			-- Doesn't process the parameters
		require
			ba_not_void: ba /= Void
		local
			basic_type: BASIC_I
			cl_type: CL_TYPE_I
			static_type: INTEGER
			real_feat_id: INTEGER
			associated_class: CLASS_C
			feat_tbl: FEATURE_TABLE
			inst_cont_type: TYPE_I
			metamorphosed: BOOLEAN
			origin, offset: INTEGER
			r_id: INTEGER
			rout_info: ROUT_INFO
		do
			inst_cont_type := context_type
			metamorphosed := inst_cont_type.is_basic 
							and then not inst_cont_type.is_bit
				-- Note: Manu 08/08/2002: if `precursor_type' is not Void, it can only means
				-- that we are currently performing a static access call on a feature
				-- from a basic class. Assuming otherwise is not correct as you
				-- cannot seriously inherit from a basic class.
			if metamorphosed and precursor_type = Void then
				basic_type ?= inst_cont_type
				if is_feature_special (False, basic_type) then
					make_special_byte_code (ba, basic_type)
				else
						-- Process the feature id of `feature_name' in the
						-- associated reference type
					associated_class :=
								basic_type.reference_type.base_class
					feat_tbl := associated_class.feature_table
debug ("BYTE_CODE")
io.error.put_string ("Associated class: ")
io.error.put_string (associated_class.name)
io.error.put_string (", feature name: ")
io.error.put_string (feature_name)
io.error.put_string ("%NFEATURE_TABLE: ")
feat_tbl.trace
io.error.put_new_line
end
					if parameters /= Void then
						ba.append (Bc_rotate)
						ba.append_short_integer (parameters.count + 1)
					end
					ba.append (Bc_metamorphose)
					if associated_class.is_precompiled then
						r_id := feat_tbl.item_id (feature_name_id).rout_id_set.first
						rout_info := System.rout_info_table.item (r_id)
						origin := rout_info.origin
						offset := rout_info.offset
						make_end_precomp_byte_code (ba, flag, origin, offset)
					else
						real_feat_id := feat_tbl.item_id (feature_name_id).feature_id
						static_type := basic_type.associated_reference_class_type.static_type_id - 1
						make_end_byte_code (ba, flag, real_feat_id, static_type)
					end
				end
			else
				cl_type ?= inst_cont_type
				if is_first then 
						--! Cannot melt basic calls hence is_first
						--! is not used in the above if meta statement.
					ba.append (Bc_current)
				else
					if parameters /= Void then
						ba.append (Bc_rotate)
						ba.append_short_integer (parameters.count + 1)
					end
				end
				associated_class := cl_type.base_class
				if associated_class.is_precompiled then
					r_id := associated_class.feature_table.item_id
						(feature_name_id).rout_id_set.first
					rout_info := System.rout_info_table.item (r_id)
					origin := rout_info.origin
					offset := rout_info.offset
					make_end_precomp_byte_code (ba, flag, origin, offset)
				else
					static_type := cl_type.associated_class_type.static_type_id - 1
					real_feat_id := real_feature_id
					make_end_byte_code (ba, flag, real_feat_id, static_type)
				end
			end
		end

	make_end_byte_code (ba: BYTE_ARRAY; flag: BOOLEAN; 
					real_feat_id: INTEGER; static_type: INTEGER) is
			-- Make final portion of the standard byte code.
		require
			ba_not_void: ba /= Void
		do
			if 	is_first or flag then
				ba.append (code_first)
			else
				ba.append (code_next)
					-- Generate feature name for test of void reference
				ba.append_raw_string (feature_name)
			end
				-- Generate feature id
			ba.append_integer (real_feat_id)
			ba.append_short_integer (static_type)
			make_precursor_byte_code (ba)
		end

	make_end_precomp_byte_code (ba: BYTE_ARRAY; flag: BOOLEAN; 
					origin: INTEGER; offset: INTEGER) is
			-- Make final portion of the standard byte code
			-- for a precompiled call.
		require
			ba_not_void: ba /= Void
		do
			if 	is_first or flag then
				ba.append (precomp_code_first)
			else
				ba.append (precomp_code_next)
					-- Generate feature name for test of void reference
				ba.append_raw_string (feature_name)
			end
			ba.append_integer (origin)
			ba.append_integer (offset)
			make_precursor_byte_code (ba)
		end

	make_precursor_byte_code (ba: BYTE_ARRAY) is
			-- Add dynamic type of parent, if necessary.
		require
			ba_not_void: ba /= Void
		do
			-- Nothing by default.
		end

	make_special_byte_code (ba: BYTE_ARRAY; basic_type: BASIC_I) is
			-- Make byte code for special calls.
			-- (To be redefined in FEATURE_B).
		require
			ba_not_void: ba /= Void
			basic_type_not_void: basic_type /= Void
		do
			-- Do nothing
		end

	real_feature_id: INTEGER is
			-- The feature ID in INTEGER is not necessarily the same as
			-- in the INTEGER_REF class. And likewise for other simple types.
			-- But also for generic derivation which contains an expanded type
			-- as a generic parameter.
		local
			associated_class: CLASS_C
			feat_tbl: FEATURE_TABLE
			instant_context_type: TYPE_I
			basic_type: BASIC_I
			cl_type: CL_TYPE_I
			gen: GEN_TYPE_I
		do
			Result := feature_id
			if precursor_type = Void then
				instant_context_type := context_type
				if
					instant_context_type.is_basic
					and then not instant_context_type.is_bit
				then
						-- We perform a non-optimized call on a basic type
					basic_type ?= instant_context_type
						-- Process the feature id of `feature_name' in the
						-- associated reference type
					associated_class := basic_type.reference_type.base_class
					feat_tbl := associated_class.feature_table
					Result := feat_tbl.item_id (feature_name_id).feature_id
				else
						-- A generic parameter of current class has been derived
						-- into an expanded type, so we need to find the `feature_id'
						-- of the feature we want to call in the context of the 
						-- expanded class.
						-- FIXME: Manu 01/24/2000
						-- We do the search even for a generic class which do not
						-- have a generic parameter who has been derived into an expanded type
						-- We could maybe find a way for not performing the check in the
						-- above case.
					gen ?= context.current_type
					if gen /= Void and then instant_context_type.is_true_expanded then
						cl_type ?= instant_context_type
						associated_class := cl_type.base_class
						feat_tbl := associated_class.feature_table
						Result := feat_tbl.item_id (feature_name_id).feature_id
					end
				end
			end
		end

	code_first: CHARACTER is
			-- Byte code when call is first (no invariant)
		deferred
		end

	code_next: CHARACTER is
			-- Byte code when call is nested (invariant)
		deferred
		end

	precomp_code_first: CHARACTER is
			-- Byte code when precompiled call is first (no invariant)
		deferred
		end

	precomp_code_next: CHARACTER is
			-- Byte code when precompiled call is nested (invariant)
		deferred
		end

	basic_register: REGISTRABLE is
			-- Register used to store the metamorphosed simple type
		do
		end

	is_feature_call: BOOLEAN is
			-- Is access a feature call?
		do
		end

	generate_parameters_list is
			-- Only for routines and externals
		do
		end

	generate_access_on_type (reg: REGISTRABLE; typ: CL_TYPE_I) is
			-- Generate access on `reg' in a `typ' context\
		require
			reg_not_void: reg /= Void
			typ_not_void: typ /= Void
		do
		end

	generate_special_feature (reg: REGISTRABLE; basic_type: BASIC_I) is
			-- Generate code for special routines (is_equal, copy ...).
			-- (Only for feature calls)
		require
			reg_not_void: reg /= Void
			basic_type_not_void: basic_type /= Void
		do
		end

	is_il_feature_special (target_type: CL_TYPE_I): BOOLEAN is
			-- Is feature optimized in IL code generation?
		do
		end

	is_feature_special (compilation_type: BOOLEAN; target_type: BASIC_I): BOOLEAN is
			-- Is feature a special routine of class of `target_type'?
			-- (Only for feature calls)
		do
		end

	do_generate (reg: REGISTRABLE) is
			-- Generate call of feature on `reg'
		require
			valid_register: reg /= Void
		local
			type_i: TYPE_I
			class_type: CL_TYPE_I
			basic_type: BASIC_I
			buf: GENERATION_BUFFER
		do
			type_i := context_type
				-- Special provision is made for calls on basic types
				-- (they have to be themselves known by the compiler).
				-- Note: Manu 08/08/2002: if `precursor_type' is not Void, it can only means
				-- that we are currently performing a static access call on a feature
				-- from a basic class. Assuming otherwise is not correct as you
				-- cannot seriously inherit from a basic class.
			if type_i.is_basic and then precursor_type = Void then
				basic_type ?= type_i
				if not basic_type.is_bit and then is_feature_special (True, basic_type) then
					generate_special_feature (reg, basic_type)
				else
					buf := buffer
						-- Generation of metamorphosis is enclosed between (), and
						-- the expressions are separated with ',' which means the C
						-- keeps only the last expression, i.e. the function call.
						-- That way, statements like "s := i.out" are correctly
						-- generated with a minimum of temporaries.
					class_type := basic_type.reference_type
						-- If an invariant is to be checked however, the
						-- metamorphosis was already made by the invariant
						-- checking routine.
					buf.put_character ('(')
					basic_type.metamorphose (basic_register, reg,
									buf, context.workbench_mode)
					buf.put_character (',')
					buf.put_new_line
					buf.put_character ('%T')
					generate_metamorphose_end (basic_register, reg,
									class_type, basic_type, buf)
				end
			else
				class_type ?= type_i;	-- Cannot fail
				generate_end (reg, class_type)
			end
		end

	generate_end (gen_reg: REGISTRABLE; class_type: CL_TYPE_I) is
			-- Generate final portion of C code.
		require
			gen_reg_not_void: gen_reg /= Void
			class_type_not_void: class_type /= Void
		local
			buf: GENERATION_BUFFER
		do
			generate_access_on_type (gen_reg, class_type)
				-- Now generate the parameters of the call, if needed.
			if not is_attribute then
				buf := buffer
				buf.put_character ('(')
			end
			if is_feature_call then
				gen_reg.print_register
			end
			if parameters /= Void then
				generate_parameters_list
			end
			if not is_attribute then
				buf.put_character (')')
			end
		end

	generate_metamorphose_end (gen_reg, meta_reg: REGISTRABLE; class_type: CL_TYPE_I;
		basic_type: BASIC_I; buf: GENERATION_BUFFER) is
			-- Generate final portion of C code.
		require
			gen_reg_not_void: gen_reg /= Void
			meta_reg_not_void: meta_reg /= Void
			basic_type_not_void: basic_type /= Void
			buf_not_void: buf /= Void
		do
			generate_end (gen_reg, class_type)

				-- Now generate the parameters of the call, if needed.
			buf.put_string (");")
			buf.put_new_line
			basic_type.end_of_metamorphose (basic_register, meta_reg, buf)
		end

feature {NONE} -- Debug

	debug_output: STRING is
			-- String that should be displayed in debugger to represent `Current'.
		do
			if feature_name_id > 0 then
				Result := Names_heap.item (feature_name_id)
			else
				Result := "Not yet set"
			end
		end

end -- class CALL_ACCESS_B