note description: "Representation of a once procedure" legal: "See notice at end of class." status: "See notice at end of class." date: "$Date$" revision: "$Revision$" class ONCE_PROC_I inherit DYN_PROC_I rename is_object_relative_once as is_object_relative redefine case_value, is_object_relative, is_once, is_once_creation, is_process_relative, is_valid_case, pattern_type, prepare_object_relative_once, replicated, selected, transfer_from, transfer_to, unselected, update_api end feature -- Status report is_once: BOOLEAN = True -- Is the current feature a once one? is_process_relative: BOOLEAN -- Is once routine process-wide (rather than thread-specific)? is_thread_relative: BOOLEAN -- Is once routine thread-specific? do Result := not (is_process_relative or is_object_relative) end is_object_relative: BOOLEAN -- Is once routine per object? is_once_creation (c: CLASS_C): BOOLEAN -- Is it a creation procedure in a once class `c`? do Result := c.is_once and then attached c.creators as cs and then cs.has (feature_name_id) end is_valid_case (c: CLASS_C; t: TYPE_A): BOOLEAN -- do Result := is_once_creation (c) and then attached t.base_class as b and then b.class_id = c.class_id end feature -- C code generation: pattern pattern_type: TYPE_A -- do Result := if is_once_creation (access_class) then system.any_type else Precursor end ensure then is_once_creation: is_once_creation (access_class) ⇒ Result.same_as (system.any_type) end feature -- Access: code generation case_value (c: CLASS_C; t: TYPE_A): INTERVAL_VAL_B -- do if attached c.feature_of_name_id (names_heap.inspect_attribute_name_id) as i and then attached {NATURAL_A} i.type as n and then n.size > 32 then create {NAT64_VAL_B} Result.make (creator_position.as_natural_64) else create {NAT_VAL_B} Result.make (creator_position.as_natural_32) end end feature -- Status setting set_is_process_relative -- Set `is_process_relative'. do is_object_relative := False is_process_relative := True ensure is_process_relative_set: is_process_relative end set_is_thread_relative -- Set `is_thread_relative'. do is_object_relative := False is_process_relative := False ensure is_thread_relative_set: is_thread_relative end set_is_object_relative -- Set `is_object_relative'. do is_process_relative := False is_object_relative := True ensure is_object_relative_set: is_object_relative end feature -- Adaptation transfer_to (other: ONCE_PROC_I) -- Transfer data from Current into `other'. do Precursor (other) if is_process_relative then other.set_is_process_relative elseif is_object_relative then other.set_is_object_relative else other.set_is_thread_relative end end transfer_from (other: ONCE_PROC_I) -- Transfer data from Current into `other'. do Precursor (other) if other.is_process_relative then set_is_process_relative elseif other.is_object_relative then set_is_object_relative else set_is_thread_relative end end replicated (in: INTEGER): FEATURE_I -- Replication local rep: R_ONCE_PROC_I do create rep transfer_to (rep) rep.set_code_id (new_code_id) rep.set_access_in (in) Result := rep end selected: ONCE_PROC_I -- do create Result Result.transfer_from (Current) end unselected (in: INTEGER): FEATURE_I -- Unselected feature local unselect: D_ONCE_PROC_I do create unselect transfer_to (unselect) unselect.set_access_in (in) Result := unselect end feature -- Object relative once prepare_object_relative_once (a_byte_code: BYTE_CODE) -- --| Warning: the code relies on the presence of --| ISE_EXCEPTION_MANAGER.default_create --| and ISE_EXCEPTION_MANAGER.once_raise (an_exception: EXCEPTION) local l_rescue: DO_RESCUE_B l_hidden_if_called_b: HIDDEN_IF_B l_if_b: IF_B l_bin_ne_b: BIN_NE_B l_excep_attr_b: ATTRIBUTE_B l_ISE_EXCEPTION_MANAGER_default_create_feature_b: ANY_FEATURE_B l_ISE_EXCEPTION_MANAGER_once_raise_feature_b: FEATURE_B l_ISE_EXCEPTION_MANAGER_last_exception_feature_b: FEATURE_B l_nested_b: NESTED_B l_access_expr_b: ACCESS_EXPR_B l_creation_expr_b: CREATION_EXPR_B l_result_attr_b: ATTRIBUTE_B l_called_attr_b: ATTRIBUTE_B l_compound: BYTE_LIST [BYTE_NODE] l_body_compound: BYTE_LIST [BYTE_NODE] l_then_compound, l_wrapper_compound: HIDDEN_B l_parameters: BYTE_LIST [PARAMETER_B] l_param: PARAMETER_B l_try_b: TRY_B l_ISE_EXCEPTION_MANAGER_type: CL_TYPE_A l_ISE_EXCEPTION_MANAGER_class_c: CLASS_C l_default_create_fi: FEATURE_I n: INTEGER do if is_object_relative and then attached written_class.object_relative_once_info_of_rout_id_set (rout_id_set) as l_obj_once_info and then attached {STD_BYTE_CODE} a_byte_code as bc then l_compound := a_byte_code.compound --| Build new body compound --| --| attr_called := True --| ... body ... --| attr_result := Result --| if l_compound /= Void and then not l_compound.is_empty then n := 2 --| called + compound else n := 1 --| called end if has_return_value then --| To generate `attr_result := Result' n := n + 1 --| attr_result := Result end create l_body_compound.make (n) --| attr_called := True create l_called_attr_b.make (l_obj_once_info.called_attribute_i) l_called_attr_b.set_type (l_obj_once_info.called_type_a) l_called_attr_b.set_is_attachment l_body_compound.extend (create {HIDDEN_B}.make_wrapper (create {ASSIGN_B}.make (l_called_attr_b, create {BOOL_CONST_B}.make (True)))) --| reuse existing compound / body if l_compound /= Void and then not l_compound.is_empty then if l_compound.count = 1 then l_body_compound.extend (l_compound.first) else check l_compound.count > 0 end l_body_compound.extend (l_compound) end end if has_return_value then create l_result_attr_b.make (l_obj_once_info.result_attribute_i) l_result_attr_b.set_type (a_byte_code.real_type (l_obj_once_info.result_type_a)) l_result_attr_b.set_is_attachment l_body_compound.extend (create {HIDDEN_B}.make_wrapper (create {ASSIGN_B}.make (l_result_attr_b, create {RESULT_B}))) --| attr_result := Result end --| --| if called then --| if attached attr_exception as l_attr_exception then --| (create {ISE_EXCEPTION_MANAGER}).raise (l_attr_exception) --| end --| Result := attr_result --| else --/ Not called yet --| attr_called := True --| ... body ... --| attr_result := Result --| end --| --| if called then create l_hidden_if_called_b create l_called_attr_b.make (l_obj_once_info.called_attribute_i) l_called_attr_b.set_type (l_obj_once_info.called_type_a) l_hidden_if_called_b.set_condition (l_called_attr_b) create l_if_b create l_excep_attr_b.make (l_obj_once_info.exception_attribute_i) l_excep_attr_b.set_type (a_byte_code.real_type (l_obj_once_info.exception_type_a)) create l_bin_ne_b l_bin_ne_b.set_left (l_excep_attr_b) l_bin_ne_b.set_right (create {VOID_B}) l_if_b.set_condition (l_bin_ne_b) l_ISE_EXCEPTION_MANAGER_class_c := system.ise_exception_manager_class.compiled_class check ise_exception_manager_class_compiled: l_ISE_EXCEPTION_MANAGER_class_c /= Void end l_default_create_fi := l_ISE_EXCEPTION_MANAGER_class_c.feature_of_name_id (Names_heap.default_create_name_id) check default_create_exists: l_default_create_fi /= Void end if l_ISE_EXCEPTION_MANAGER_class_c /= Void and then attached l_ISE_EXCEPTION_MANAGER_class_c.feature_of_name_id (Names_heap.once_raise_name_id) as l_once_raise_fi then --| (create {ISE_EXCEPTION_MANAGER}) create l_creation_expr_b l_ISE_EXCEPTION_MANAGER_type := l_ISE_EXCEPTION_MANAGER_class_c.types.first.type l_creation_expr_b.set_type (l_ISE_EXCEPTION_MANAGER_type) l_creation_expr_b.set_info (create {CREATE_TYPE}.make (l_ISE_EXCEPTION_MANAGER_type)) l_creation_expr_b.set_creation_instruction (False) --| default_create create l_ISE_EXCEPTION_MANAGER_default_create_feature_b.make (l_default_create_fi, l_default_create_fi.type, Void, False) l_creation_expr_b.set_call (l_ISE_EXCEPTION_MANAGER_default_create_feature_b) --| {ISE_EXCEPTION_MANAGER}.once_raise (EXCEPTION) create l_ISE_EXCEPTION_MANAGER_once_raise_feature_b.make (l_once_raise_fi, a_byte_code.real_type (l_once_raise_fi.type), Void, False) create l_excep_attr_b.make (l_obj_once_info.exception_attribute_i) l_excep_attr_b.set_type (a_byte_code.real_type (l_obj_once_info.exception_type_a)) create l_parameters.make (1) create l_param l_param.set_expression (l_excep_attr_b) l_param.set_attachment_type (l_excep_attr_b.type) l_parameters.extend (l_param) l_ISE_EXCEPTION_MANAGER_once_raise_feature_b.set_parameters (l_parameters) l_param.set_parent (l_ISE_EXCEPTION_MANAGER_once_raise_feature_b) --| Build ... (create {ISE_EXCEPTION_MANAGER}).once_raise (EXCEPTION) create l_nested_b create l_access_expr_b.make (l_creation_expr_b) l_nested_b.set_target (l_access_expr_b) l_nested_b.set_message (l_ISE_EXCEPTION_MANAGER_once_raise_feature_b) l_ISE_EXCEPTION_MANAGER_once_raise_feature_b.set_parent (l_nested_b) create l_wrapper_compound.make (1) l_wrapper_compound.extend (l_nested_b) l_if_b.set_compound (l_wrapper_compound) end if has_return_value then create l_then_compound.make (2) l_then_compound.extend (l_if_b) create l_result_attr_b.make (l_obj_once_info.result_attribute_i) l_result_attr_b.set_type (a_byte_code.real_type (l_obj_once_info.result_type_a)) l_then_compound.extend (create {ASSIGN_B}.make (create {RESULT_B}, l_result_attr_b)) else create l_then_compound.make_wrapper (l_if_b) end l_hidden_if_called_b.set_compound (l_then_compound) --| else --/ Not called yet --| use l_body_compound inside a TRY_B if l_ISE_EXCEPTION_MANAGER_class_c /= Void and then attached l_ISE_EXCEPTION_MANAGER_class_c.feature_of_name_id (Names_heap.last_exception_name_id) as l_last_exception_fi then create {HIDDEN_B} l_compound.make (1) --| Get last exception --| attr_except := (create {ISE_EXCEPTION_MANAGER}).last_exception --| *(EIF_REFERENCE *)(Current + _REFACS_2_) = RTLA; create l_excep_attr_b.make (l_obj_once_info.exception_attribute_i) l_excep_attr_b.set_type (l_obj_once_info.exception_type_a) l_excep_attr_b.set_is_attachment create l_creation_expr_b l_ISE_EXCEPTION_MANAGER_type := l_ISE_EXCEPTION_MANAGER_class_c.types.first.type l_creation_expr_b.set_type (l_ISE_EXCEPTION_MANAGER_type) l_creation_expr_b.set_info (create {CREATE_TYPE}.make (l_ISE_EXCEPTION_MANAGER_type)) l_creation_expr_b.set_creation_instruction (False) --| default_create create l_ISE_EXCEPTION_MANAGER_default_create_feature_b.make (l_default_create_fi, l_default_create_fi.type, Void, False) l_creation_expr_b.set_call (l_ISE_EXCEPTION_MANAGER_default_create_feature_b) --| {ISE_EXCEPTION_MANAGER}.last_exception: EXCEPTION create l_ISE_EXCEPTION_MANAGER_last_exception_feature_b.make (l_last_exception_fi, a_byte_code.real_type (l_last_exception_fi.type), Void, False) --| Build ... (create {ISE_EXCEPTION_MANAGER}).last_exception returning an EXCEPTION object create l_nested_b create l_access_expr_b.make (l_creation_expr_b) l_nested_b.set_target (l_access_expr_b) l_nested_b.set_message (l_ISE_EXCEPTION_MANAGER_last_exception_feature_b) l_ISE_EXCEPTION_MANAGER_last_exception_feature_b.set_parent (l_nested_b) l_compound.extend (create {ASSIGN_B}.make (l_excep_attr_b, l_nested_b)) else l_compound := Void check False end end create l_try_b if attached a_byte_code.rescue_clause as rc then create l_rescue.make (l_body_compound, rc) l_try_b.set_compound (l_rescue.wrapped_into_byte_list) else l_try_b.set_compound (l_body_compound) end if l_compound /= Void then l_try_b.set_except_part (l_compound) end l_try_b.propagate_exception l_hidden_if_called_b.set_else_part (l_try_b.wrapped_into_byte_list) create l_compound.make (1) l_compound.extend (l_hidden_if_called_b) bc.set_compound (l_compound) end end feature {NONE} -- Implementation update_api (f: E_ROUTINE) -- Update api feature `f' attribute features. do Precursor {DYN_PROC_I} (f) f.set_once (True) f.set_object_relative_once (is_object_relative) end invariant one_of_process_thread_object: ( is_process_relative and not is_thread_relative and not is_object_relative) or (not is_process_relative and is_thread_relative and not is_object_relative) or (not is_process_relative and not is_thread_relative and is_object_relative) note copyright: "Copyright (c) 1984-2020, Eiffel Software" license: "GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)" licensing_options: "http://www.eiffel.com/licensing" copying: "[ This file is part of Eiffel Software's Eiffel Development Environment. Eiffel Software's Eiffel Development Environment 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, version 2 of the License (available at the URL listed under "license" above). Eiffel Software's Eiffel Development Environment 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 Eiffel Software's Eiffel Development Environment; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ]" source: "[ Eiffel Software 5949 Hollister Ave., Goleta, CA 93117 USA Telephone 805-685-1006, Fax 805-685-6869 Website http://www.eiffel.com Customer support http://support.eiffel.com ]" end