-- This file is part of SmallEiffel The GNU Eiffel Compiler. -- Copyright (C) 1994-98 LORIA - UHP - CRIN - INRIA - FRANCE -- Dominique COLNET and Suzanne COLLIN - colnet@loria.fr -- http://www.loria.fr/SmallEiffel -- SmallEiffel 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, or (at your option) any later -- version. SmallEiffel 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 SmallEiffel; see the file COPYING. If not, -- write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- Boston, MA 02111-1307, USA. -- class RUN_CLASS -- -- Only for class with objects at execution time. -- inherit GLOBALS; creation {SMALL_EIFFEL} make feature current_type: TYPE; -- Runnable corresponding one. id: INTEGER; -- Id of the receiver to produce C code. at_run_time: BOOLEAN; -- True if `current_type' is really created (only when -- direct instances of `current_type' exists at run time). running: ARRAY[RUN_CLASS]; -- Void or the set of all `at_run_time' directly compatible -- run classes. A run class is directly compatible with one -- another only when it can be directly substitute with -- current run class. -- Thus, if current run class is reference, `running' are all -- reference run classes. If current run class is expanded, -- `running' has only one element (the current class itself). class_invariant: CLASS_INVARIANT; -- Collected Runnable invariant if any. compile_to_c_done: BOOLEAN; -- True if `compile_to_c' has already be called. feature {RUN_CLASS} feature_dictionary: DICTIONARY[RUN_FEATURE,STRING]; -- Access to the runnable version of a feature. -- To avoid clash between infix and prefix names, -- `to_key' of class NAME is used as entry. feature {NONE} tagged_mem: INTEGER; -- 0 when not computed, 1 when tagged or -1 feature {NONE} make(t: like current_type) is require t.run_type = t local run_string: STRING; rcd: DICTIONARY[RUN_CLASS,STRING]; rc: RUN_CLASS; i: INTEGER; do compile_to_c_done := true; current_type := t; !!actuals_clients.with_capacity(16); run_string := t.run_time_mark; id := id_provider.item(run_string); check not small_eiffel.run_class_dictionary.has(run_string); end; small_eiffel.run_class_dictionary.put(Current,run_string); !!feature_dictionary.make; small_eiffel.incr_magic_count; if t.is_expanded then set_at_run_time; t.base_class.check_expanded_with(t); else from rcd := small_eiffel.run_class_dictionary; i := 1; until i > rcd.count loop rc := rcd.item(i); if rc.at_run_time and then rc.current_type.is_reference and then rc.is_running_of(Current) then add_running(rc); end; i := i + 1; end; end; ensure current_type = t end; feature is_tagged: BOOLEAN is require small_eiffel.is_ready do if tagged_mem = 0 then if current_type.is_expanded then tagged_mem := -1; elseif at_run_time then if run_control.boost then if small_eiffel.is_tagged(Current) then tagged_mem := 1; else tagged_mem := -1; end; else tagged_mem := 1; end; end; end; Result := tagged_mem = 1; ensure tagged_mem /= 0 end; is_expanded: BOOLEAN is do Result := current_type.is_expanded; end; writable_attributes: ARRAY[RUN_FEATURE_2] is -- Computed and ordered array of writable attributes. -- Storage in C struct is to be done in reverse -- order (from `upper' to `lower'). -- Order is done according to the level of attribute -- definition in the inheritance graph to allow more -- stupid switch to be removed. require small_eiffel.is_ready; at_run_time local rf2: RUN_FEATURE_2; i: INTEGER; do if writable_attributes_mem = Void then from i := 1; until i > feature_dictionary.count loop rf2 ?= feature_dictionary.item(i); if rf2 /= Void then if writable_attributes_mem = Void then writable_attributes_mem := <>; else writable_attributes_mem.add_last(rf2); end; end; i := i + 1; end; if writable_attributes_mem /= Void then sort_wam(writable_attributes_mem); end; end; Result := writable_attributes_mem; ensure Result /= Void implies Result.lower = 1 end; feature -- For implicit conversion from expanded to reference : used_as_reference is require current_type.is_expanded; not current_type.is_basic_eiffel_expanded local rtm: STRING; type_ref_to_exp: TYPE_REF_TO_EXP; do rtm := current_type.run_time_mark; if not to_reference_memory.has(rtm) then !!type_ref_to_exp.make(current_type); to_reference_memory.put(type_ref_to_exp,rtm); end; end; to_reference: TYPE is do Result := to_reference_memory.at(current_type.run_time_mark); end; feature {TYPE} jvm_to_reference is -- Produce code to convert the pushed expanded into the -- corresponding TYPE_REF_TO_EXP type. require current_type.is_expanded local ref_type: TYPE; do ref_type := to_reference; ref_type.run_class.jvm_reference_from(current_type); end; feature {RUN_CLASS} jvm_reference_from(exp_type: TYPE) is require exp_type.is_expanded local idx: INTEGER; ca: like code_attribute; cp: like constant_pool; do ca := code_attribute; cp := constant_pool; idx := jvm_constant_pool_index; ca.opcode_new(idx); ca.opcode_dup; idx := cp.idx_methodref1(idx,fz_35,fz_29); ca.opcode_invokespecial(idx,-1); ca.opcode_dup_x1; ca.opcode_swap; tmp_string.clear; exp_type.jvm_descriptor_in(tmp_string); idx := cp.idx_fieldref3(fully_qualified_name,us_item,tmp_string); ca.opcode_putfield(idx,-2); end; feature {NONE} to_reference_memory: DICTIONARY[TYPE_REF_TO_EXP,STRING] is once !!Result.make; end; feature {CALL_PROC_CALL} get_rf(target: EXPRESSION; fn1: FEATURE_NAME; ct: TYPE): RUN_FEATURE is -- Compute or simply fetch the corresponding RUN_FEATURE for -- `target' and `fn1' in context `ct' (the type of Current). -- Exporting rules are automatically checked and possible -- rename are also done using `start_position' of `fn1'. -- No return when an error occurs because `fatal_error' is called. local is_current: BOOLEAN; fn2: FEATURE_NAME; wbc, wbc2: BASE_CLASS; target_type, constraint: TYPE; tfg: TYPE_FORMAL_GENERIC; bcn: CLASS_NAME; do target_type := target.result_type; is_current := target.is_current; wbc := fn1.start_position.base_class; if is_current or else target_type.is_like_current then fn2 := target_type.base_class.new_name_of(wbc,fn1); if fn2 /= fn1 then eh.add_position(fn1.start_position); Result := get_or_fatal_error(fn2); eh.cancel; else Result := get_or_fatal_error(fn1); end; elseif target_type.is_formal_generic then tfg ?= target_type; check tfg /= Void end; constraint := tfg.constraint; if constraint = Void then Result := get_or_fatal_error(fn1); elseif not tfg.is_a(constraint) then eh.print_as_error; eh.add_position(fn1.start_position); fatal_error("Constraint genericity violation."); else wbc2 := constraint.start_position.base_class; if wbc2 = wbc or else wbc.is_subclass_of(wbc2) then fn2 := tfg.base_class.new_name_of(constraint.base_class,fn1); Result := get_or_fatal_error(fn2); else Result := get_or_fatal_error(fn1); end; end; else Result := get_or_fatal_error(fn1); end; Result.add_client(Current); if nb_errors = 0 and then not is_current then bcn := ct.base_class.name; if not Result.is_exported_in(bcn) then eh.add_position(Result.start_position); eh.append(" Cannot use feature %""); eh.append(fn1.to_string); error(fn1.start_position,"%" here."); eh.add_position(fn1.start_position); eh.append("Forbidden call when type of Current is "); eh.append(ct.run_time_mark); fatal_error(fz_dot); end; end; ensure Result /= Void end; feature {TYPE_LIKE_FEATURE} get_result_type(fn: FEATURE_NAME): TYPE is -- Computes only the result type of `fn' when this feature -- is not yet runnable. -- Possible rename is also done using the `start_position' of -- `fn'. No return when an error occurs because `fatal_error' -- is called. require not small_eiffel.is_ready local fn2: FEATURE_NAME; wbc: BASE_CLASS; rf: RUN_FEATURE; fn2_key: STRING; f: E_FEATURE; bc: BASE_CLASS; do wbc := fn.start_position.base_class; fn2 := base_class.new_name_of(wbc,fn); fn2_key := fn2.to_key; if feature_dictionary.has(fn2_key) then rf := feature_dictionary.at(fn2_key); Result := rf.result_type; if Result.is_run_type then Result := Result.run_type; else Result := Result.to_runnable(current_type); Result := Result.run_type; end; else bc := base_class; f := bc.look_up_for(Current,fn2); if f = Void then efnf(bc,fn2); eh.add_position(fn.start_position); eh.add_position(fn2.start_position); fatal_error(" Anchor not found."); else Result := f.result_type; if Result = Void then eh.add_position(f.start_position); eh.add_position(fn.start_position); eh.add_position(fn2.start_position); fatal_error(" Anchor found is a procedure."); else Result := Result.to_runnable(current_type); Result := Result.run_type; end; end; end; ensure Result = Result.run_type end; feature get_rf_with(fn: FEATURE_NAME): RUN_FEATURE is -- Compute or simply fetch the corresponding RUN_FEATURE. -- Possible rename are also done using `start_position' of -- `fn'. No return when an error occurs because `fatal_error' -- is called. require base_class = fn.start_position.base_class or else base_class.is_subclass_of(fn.start_position.base_class) local fn2: FEATURE_NAME; wbc: BASE_CLASS; do wbc := fn.start_position.base_class; fn2 := base_class.new_name_of(wbc,fn); if fn2 /= fn then eh.add_position(fn.start_position); Result := get_or_fatal_error(fn2); eh.cancel; else Result := get_or_fatal_error(fn2); end; ensure Result /= Void end; dynamic(up_rf: RUN_FEATURE): RUN_FEATURE is -- Assume the current type of `up_rf' is a kind of -- `current_type'. The result is the concrete one -- according to dynamic dispatch rules. require up_rf /= Void; is_running_of(up_rf.run_class) local fn, up_fn: FEATURE_NAME; up_type: TYPE; do up_type := up_rf.current_type; if Current = up_type.run_class then Result := up_rf; else up_fn := up_rf.name; fn := base_class.new_name_of(up_type.base_class,up_fn); Result := get_or_fatal_error(fn); end; ensure Result /= Void; Result.run_class = Current; end; feature base_class: BASE_CLASS is -- Corresponding base class. do Result := current_type.base_class; ensure Result /= Void end; base_class_name: CLASS_NAME is -- Corresponding base class name. do Result := current_type.base_class_name; ensure Result /= Void end; feature set_at_run_time is -- Set Current `at_run_time' and do needed update of others -- instances of RUN_CLASS. require not base_class.is_deferred local rcd: DICTIONARY[RUN_CLASS,STRING]; rc: RUN_CLASS; i: INTEGER; do if not at_run_time then check not small_eiffel.is_ready end; at_run_time := true; compile_to_c_done := false; runnable_class_invariant_done := false; add_running(Current); small_eiffel.incr_magic_count; if current_type.is_reference then from rcd := small_eiffel.run_class_dictionary; i := 1; until i > rcd.count loop rc := rcd.item(i); if Current.is_running_of(rc) then rc.add_running(Current); end; i := i + 1; end; end; end; ensure at_run_time; running.has(Current) end; feature {TYPE} gc_mark_to_follow: BOOLEAN is -- *** TO REMOVE *** local i: INTEGER; r: like running; rc: like Current; do r := running; if r /= Void then from i := r.upper; until Result or else i = 0 loop rc := r.item(i); if rc = Current then Result := need_gc_mark; else Result := rc.current_type.need_gc_mark_function; end; i := i - 1; end; end; end; feature {TYPE} c_print_function is require run_control.no_check local body: STRING; ct, t: TYPE; i: INTEGER; wa: like writable_attributes; rf2: RUN_FEATURE_2; do body := "... (to change ;-)"; ct := current_type; tmp_string.copy("void se_prinT"); id.append_in(tmp_string); tmp_string.append("(T"); id.append_in(tmp_string); if ct.is_reference then tmp_string.extend('*'); end; tmp_string.append("*o)"); body.clear; if ct.is_reference then body.append("if(*o==NULL){%N% %fprintf(SE_ERR,%"Void%");%N% %return;%N}%N"); end; body.append("fprintf(SE_ERR,%""); body.append(ct.run_time_mark); body.append("%");%N"); if ct.is_reference or else ct.is_native_array then body.append("fprintf(SE_ERR,%"#%%p%",*o);%N"); end; wa := writable_attributes; if wa /= Void then body.append("fprintf(SE_ERR,%"\n\t[ %");%N"); from i := wa.upper; until i = 0 loop rf2 := wa.item(i); t := rf2.result_type; body.append("fprintf(SE_ERR,%""); body.append(rf2.name.to_string); body.append(" = %");%Nse_prinT"); if t.is_expanded then t.id.append_in(body); elseif t.is_string then body.extend('7'); else body.extend('0'); end; body.append("((void*)(&((*o)"); if ct.is_reference then body.append("->"); else body.extend('.'); end; body.extend('_'); body.append(rf2.name.to_string); body.append(")));%N"); i := i - 1; if i > 0 then body.append("fprintf(SE_ERR,%"\n\t %");%N"); end; end; body.append("fprintf(SE_ERR,%"\n\t]%");%N"); end; cpp.put_c_function(tmp_string,body); end; c_object_model_in(str: STRING) is local wa: like writable_attributes; i: INTEGER; rf2: RUN_FEATURE_2; t: TYPE; do wa := writable_attributes; if wa = Void then if is_tagged then str.extend('{'); id.append_in(str); str.extend('}'); else current_type.c_initialize_in(str); end; else str.extend('{'); if is_tagged then id.append_in(str); str.extend(','); end; from i := wa.upper; until i = 0 loop rf2 := wa.item(i); t := rf2.result_type; t.c_initialize_in(str); i := i - 1; if i > 0 then str.extend(','); end; end; str.extend('}'); end; end; feature {SMALL_EIFFEL} falling_down is -- Falling down of Current `feature_dictionary' in `running'. local rf: RUN_FEATURE; i: INTEGER; do from i := 1; until i > feature_dictionary.count loop rf := feature_dictionary.item(i); rf.fall_down; i := i + 1; end; prepare_strip; end; afd_check is -- After Falling Down Check. local rf: RUN_FEATURE; i: INTEGER; rc: like Current; rt: TYPE; do runnable_class_invariant; from i := 1; until i > feature_dictionary.count loop rf := feature_dictionary.item(i); rf.afd_check; rt := rf.result_type; if rt /= Void then if rt.is_none then else rc := rt.run_class; end; end; i := i + 1; end; if class_invariant /= Void then class_invariant.afd_check; end; end; feature {NONE} runnable_class_invariant_done: BOOLEAN; runnable_class_invariant is local r: like runnable; do if not runnable_class_invariant_done then runnable_class_invariant_done := true; if run_control.invariant_check then if at_run_time then ci_collector.clear; base_class.collect_invariant(Current); r := runnable(ci_collector,current_type,Void); if r /= Void then small_eiffel.incr_magic_count; !!class_invariant.make_runnable(r,current_type,Void); end; end; end; end; end; feature {NONE} c_header_pass_level_done: INTEGER; feature c_header_pass1 is require cpp.on_h do if at_run_time then if c_header_pass_level_done < 1 then current_type.c_header_pass1; c_header_pass_level_done := 1; end; end; ensure cpp.on_h end; c_header_pass2 is require cpp.on_h do if at_run_time then if c_header_pass_level_done < 2 then current_type.c_header_pass2; c_header_pass_level_done := 2; end; end; ensure cpp.on_h end; c_header_pass3 is require cpp.on_h local i: INTEGER; attribute_type: TYPE; do if at_run_time then if c_header_pass_level_done < 3 then if current_type.is_user_expanded and then writable_attributes /= Void then from i := writable_attributes.upper; until i = 0 loop attribute_type := writable_attributes.item(i).result_type; if attribute_type.is_expanded then attribute_type.run_class.c_header_pass3; end; i := i - 1; end; end; current_type.c_header_pass3; c_header_pass_level_done := 3; end; end; ensure cpp.on_h end; c_header_pass4 is require cpp.on_h do if at_run_time then if c_header_pass_level_done < 4 then current_type.c_header_pass4; c_header_pass_level_done := 4; end; end; ensure cpp.on_h end; feature {GC_HANDLER} gc_define1 is require not gc_handler.is_off do if at_run_time then current_type.gc_define1; end; end; gc_define2 is require not gc_handler.is_off do if at_run_time then current_type.gc_define2; end; end; gc_info_in(str: STRING) is -- Produce C code to print GC information. require not gc_handler.is_off; gc_handler.info_flag do if at_run_time then current_type.gc_info_in(str); end; end; just_before_gc_mark_in(body: STRING) is require not gc_handler.is_off do if at_run_time then current_type.just_before_gc_mark_in(body); end; end; gc_initialize is -- Produce code to initialize GC in the main C function. require not gc_handler.is_off do if at_run_time then current_type.gc_initialize; end; end; feature {TYPE} gc_mark_fixed_size(is_unmarked: BOOLEAN; body: STRING) is -- The main purpose is to compute for example the best -- body for the gc_markXXX function. In fact, this -- feature may be called to produce C code when C variable -- `o' is not NULL and when `o' is of some concrete type -- (Tid*) where `id' is the one of the current RUN_CLASS. -- Finally, when `is_unmarked' is true, object `o' is unmarked. require not gc_handler.is_off; not current_type.is_native_array; at_run_time local rf2: RUN_FEATURE_2; t: TYPE; rc: RUN_CLASS; i: INTEGER; do wa_buf.clear; wa_cyclic_buf.clear; if writable_attributes /= Void then from i := writable_attributes.upper; until i = 0 loop rf2 := writable_attributes.item(i); t := rf2.result_type; if t.need_gc_mark_function then rc := t.run_class; wa_cycle.clear; wa_cycle.add_last(rf2); if rc.is_wa_cycle(Current) then wa_cyclic_buf.add_last(rf2); else wa_buf.add_last(rf2); end; end; i := i - 1; end; end; if wa_buf.empty and then wa_cyclic_buf.empty then gc_set_fsoh_marked_in(body); else if wa_cyclic_buf.upper >= 0 then body.append("begin:%N"); end; if not is_unmarked then body.append( "if(((gc"); id.append_in(body); body.append( "*)o)->header.flag==FSOH_UNMARKED){%N"); end; gc_set_fsoh_marked_in(body); from -- Ordinary attributes : i := wa_buf.upper; until i < 0 loop rf2 := wa_buf.item(i); mark_attribute(body,rf2); i := i - 1; end; from -- Cyclic attributes : i := wa_cyclic_buf.upper; until i < 0 loop rf2 := wa_cyclic_buf.item(i); t := rf2.result_type; rc := t.run_class; wa_cycle.clear; wa_cycle.add_last(rf2); if rc.is_wa_cycle(Current) then end; if i = 0 and then wa_cycle.count = 1 and then rc.running /= Void and then rc.running.count = 1 and then rc.running.first = Current then body.append("o=(void*)o->_"); body.append(rf2.name.to_string); body.append(";%Nif((o!=NULL)"); if is_unmarked then body.append("&&(((gc"); id.append_in(body); body.append( "*)o)->header.flag==FSOH_UNMARKED))"); else body.extend(')'); end; body.append("goto begin;%N"); else mark_attribute(body,rf2); end; i := i - 1; end; if not is_unmarked then body.extend('}'); end; end; end; feature {TYPE} gc_align_mark_fixed_size(body: STRING) is -- Compute the best body for gc_align_markXXX of -- a fixed_size object. require not gc_handler.is_off; not current_type.is_native_array; at_run_time do body.append("gc"); id.append_in(body); body.append( "*b=(void*)&(c->first_object);%N% %if(c->header.state_type==FSO_STORE_CHUNK){%N% %if(p>=store"); id.append_in(body); body.append( ")return;}%N% %else{%N% %if(p>(b+(c->count_minus_one)))return;}%N% %if(pheader.flag==FSOH_UNMARKED){%N% %T"); id.append_in(body); body.append("*o=(void*)p;%N"); gc_mark_fixed_size(true,body); body.append("}%N}%N"); end; feature {RUN_CLASS} fill_up_with(rc: RUN_CLASS; fd: like feature_dictionary) is -- Fill up `feature_dictionary' with all features coming from -- `rc' X `fd'. require rc /= Current; is_running_of(rc); fd /= Void; local bc1, bc2: BASE_CLASS; fn1, fn2: FEATURE_NAME; rf: RUN_FEATURE; i: INTEGER; do from i := 1; bc1 := rc.base_class; bc2 := base_class; until i > fd.count loop rf := fd.item(i); if rf.fall_in(Current) then fn1 := rf.name; fn2 := bc2.name_of(bc1,fn1); rf := get_feature(fn2); end; i := i + 1; end; end; add_running(rc: RUN_CLASS) is require rc /= Void; do if running = Void then running := <>; else if not running.fast_has(rc) then running.add_last(rc); end; end; end; feature {RUN_CLASS} is_running_of(other: like Current): BOOLEAN is -- Can the Current RUN_CLASS be used in place of `other'. require other /= Void local t1, t2: TYPE; do if other = Current then Result := true; else t1 := current_type; t2 := other.current_type; if t1.is_basic_eiffel_expanded and then t2.is_basic_eiffel_expanded then else Result := t1.is_a(t2); if not Result then eh.cancel; end; end; end; ensure nb_errors = old nb_errors end; feature {E_FEATURE} at(fn: FEATURE_NAME): RUN_FEATURE is -- Simple look in the dictionary to see if the feature -- is already computed. require fn /= Void; local to_key: STRING; do to_key := fn.to_key; if feature_dictionary.has(to_key) then Result := feature_dictionary.at(to_key); end; end; feature {E_STRIP} set_strip_used is do strip_used := true; end; feature {NONE} strip_used: BOOLEAN; prepare_strip is local rf2: RUN_FEATURE_2; i: INTEGER; do if strip_used then from i := 1; until i > feature_dictionary.count loop rf2 ?= feature_dictionary.item(i); if rf2 /= Void then rf2.result_type.used_as_reference; end; i := i + 1; end; end; end; feature get_feature_with(n: STRING): RUN_FEATURE is -- Assume that `n' is really the final name in -- current RUN_CLASS. require n /= Void; local sfn: SIMPLE_FEATURE_NAME; do if feature_dictionary.has(n) then Result := feature_dictionary.at(n); else !!sfn.make(n,Void); Result := get_feature(sfn); end; end; feature get_copy: RUN_FEATURE is do Result := get_rf_with(class_general.get_copy.first_name); end; feature get_feature(fn: FEATURE_NAME): RUN_FEATURE is -- Assume that `fn' is really the final name in current -- RUN_CLASS. Don't look for rename. require fn /= Void local f: E_FEATURE; fn_key: STRING; bc: BASE_CLASS; do fn_key := fn.to_key; if feature_dictionary.has(fn_key) then Result := feature_dictionary.at(fn_key); else check not small_eiffel.is_ready; end; bc := base_class; f := bc.look_up_for(Current,fn); if f = Void then efnf(bc,fn); else Result := f.to_run_feature(current_type,fn); if Result /= Void then store_feature(Result); else efnf(bc,fn); end; end; end; end; feature {NONE} get_or_fatal_error(fn: FEATURE_NAME): RUN_FEATURE is do Result := get_feature(fn); if Result = Void then eh.add_position(fn.start_position); eh.append("Feature "); eh.append(fn.to_string); eh.append(" not found when starting look up from "); eh.add_type(current_type,fz_dot); eh.print_as_fatal_error; end; end; feature {NONE} store_feature(rf: like get_feature) is -- To update the dictionary from outside. -- Note : this routine is necessary because of recursive call. require rf.run_class = Current local rf_key: STRING; do rf_key := rf.name.to_key; if feature_dictionary.has(rf_key) then check feature_dictionary.at(rf_key) = rf end; else feature_dictionary.put(rf,rf_key); small_eiffel.incr_magic_count; end; ensure get_feature(rf.name) = rf end; feature {JVM} jvm_define_class_invariant is -- If needed, call the invariant for the pushed value. local ia: like class_invariant; do if run_control.invariant_check then ia := class_invariant; if ia /= Void then jvm.define_class_invariant_method(ia); end; end; end; feature {JVM,TYPE} jvm_check_class_invariant is -- If needed, call the invariant for the stack-top object. -- If invariant is correct, the same stack-top object is left -- on the stack. local ia: like class_invariant; idx: INTEGER; ca: like code_attribute; cp: like constant_pool; do if run_control.invariant_check then ia := class_invariant; if ia /= Void then ca := code_attribute; cp := constant_pool; ca.opcode_dup; opcode_checkcast; idx := cp.idx_methodref3(fully_qualified_name,fz_invariant,fz_29); ca.opcode_invokevirtual(idx,-1); end; end; end; feature {SMALL_EIFFEL} compile_to_jvm is require at_run_time local i: INTEGER; rf: RUN_FEATURE; type_ref_to_exp: TYPE_REF_TO_EXP; do echo.put_character('%T'); echo.put_string(current_type.run_time_mark); echo.put_character('%N'); jvm.start_new_class(Current); from i := 1; until i > feature_dictionary.count loop rf := feature_dictionary.item(i); jvm.set_current_frame(rf); rf.jvm_field_or_method; i := i + 1; end; type_ref_to_exp ?= current_type; if type_ref_to_exp = Void then jvm.prepare_fields; else type_ref_to_exp.jvm_prepare_item_field; end; jvm.prepare_methods; jvm.finish_class; end; feature {MANIFEST_ARRAY} fully_qualified_name: STRING is do if fully_qualified_name_memory = Void then fully_qualified_name_memory2.copy(jvm.output_name); fully_qualified_name_memory2.extend('/'); fully_qualified_name_memory2.append(unqualified_name); !!fully_qualified_name_memory.copy(fully_qualified_name_memory2); end; Result := fully_qualified_name_memory; end; feature {NONE} -- To speed up `fully_qualified_name' : fully_qualified_name_memory: STRING; fully_qualified_name_memory2: STRING is once !!Result.make(256); end; feature {TYPE} jvm_type_descriptor_in(str: STRING) is -- Append in `str' the appropriate JVM type descriptor. require at_run_time; running.fast_has(Current) do check current_type.is_user_expanded end; str.extend('L'); str.append(fully_qualified_name); str.extend(';'); end; feature {RUN_FEATURE} jvm_invoke(idx, stack_level: INTEGER) is local ct: like current_type; do ct := current_type; inspect ct.jvm_method_flags when 17 then code_attribute.opcode_invokevirtual(idx,stack_level); when 9 then code_attribute.opcode_invokestatic(idx,stack_level); end; end; feature jvm_basic_new is -- Poduce bytecode to push a new created object with the -- basic default value (the corresponding creation procedure -- if any is not called). local i, idx: INTEGER; wa: ARRAY[RUN_FEATURE_2]; rf2: RUN_FEATURE_2; t2: TYPE; ca: like code_attribute; cp: like constant_pool; do ca := code_attribute; cp := constant_pool; idx := jvm_constant_pool_index; ca.opcode_new(idx); ca.opcode_dup; idx := cp.idx_methodref1(idx,fz_35,fz_29); ca.opcode_invokespecial(idx,-1); wa := writable_attributes; if wa /= Void then from i := wa.upper; until i = 0 loop rf2 := wa.item(i); t2 := rf2.result_type.run_type; if t2.is_user_expanded then ca.opcode_dup; t2.run_class.jvm_expanded_push_default; idx := cp.idx_fieldref(rf2); ca.opcode_putfield(idx,-2); elseif t2.is_bit then ca.opcode_dup; idx := t2.jvm_push_default; idx := cp.idx_fieldref(rf2); ca.opcode_putfield(idx,-2); end; i := i - 1; end; end; end; feature {TYPE,RUN_CLASS,NATIVE_SMALL_EIFFEL} jvm_expanded_push_default is -- Push the corresponding new user's expanded (either dummy -- or not, initializer is automatically applied). require current_type.is_user_expanded local rf: RUN_FEATURE; do jvm_basic_new; rf := base_class.expanded_initializer(current_type); if rf /= Void then jvm.push_expanded_initialize(rf); rf.mapping_jvm; jvm.pop; end; end; feature {JVM} unqualified_name: STRING is -- Also used for the corresponding file name. local ct: TYPE; do ct := current_type; unqualified_name_memory.copy(ct.run_time_mark); unqualified_name_memory.to_lower; unqualified_name_memory.replace_all('[','O'); unqualified_name_memory.replace_all(']','F'); unqualified_name_memory.replace_all(' ','_'); unqualified_name_memory.replace_all(',','_'); Result := unqualified_name_memory; end; feature {NONE} unqualified_name_memory: STRING is once !!Result.make(32); end; feature jvm_constant_pool_index: INTEGER is -- The fully qualified index in the constant pool. do Result := constant_pool.idx_class2(fully_qualified_name); end; feature {SMALL_EIFFEL,TYPE} demangling is require cpp.on_h local str: STRING; r: like running; i: INTEGER; do str := ""; str.clear; if at_run_time then str.extend('A'); if current_type.is_reference and then not is_tagged then str.extend('*'); else str.extend(' '); end; else str.extend('D'); str.extend(' '); end; r := running; if r /= Void then r.count.append_in(str); end; from until str.count > 4 loop str.extend(' '); end; str.extend('T'); id.append_in(str); from until str.count > 10 loop str.extend(' '); end; current_type.demangling_in(str); if r /= Void then from str.extend(' '); i := r.upper; until i = 0 loop r.item(i).id.append_in(str); i := i - 1; if i > 0 then str.extend(','); end; end; end; str.extend('%N'); cpp.put_string(str); ensure cpp.on_h end; feature {SMALL_EIFFEL,RUN_CLASS} compile_to_c(deep: INTEGER) is -- Produce C code for features of Current. The `deep' -- indicator is used to sort the C output in the best order -- (more C inlinings are possible when basic functions are -- produced first). As there is not always a total order -- between clients, the `deep' avoid infinite track. -- When `deep' is greater than 0, C code writting -- is produced whatever the real client relation is. require cpp.on_c; deep >= 0 local i: INTEGER; rc1, rc2: like Current; cc1, cc2: INTEGER; do if compile_to_c_done then elseif not at_run_time then compile_to_c_done := true; elseif deep = 0 then really_compile_to_c; else i := actuals_clients.upper; if i >= 0 then from rc1 := Current; cc1 := i + 1; until i = 0 loop rc2 := actuals_clients.item(i); if not rc2.compile_to_c_done then cc2 := rc2.actuals_clients.count; if cc2 > cc1 then rc1 := rc2; cc1 := cc2; end; end; i := i - 1; end; if rc1 = Current then really_compile_to_c; else rc1.compile_to_c(deep - 1); end; end; end; ensure cpp.on_c end; feature {NONE} really_compile_to_c is require at_run_time local i: INTEGER; rf: RUN_FEATURE; do compile_to_c_done := true; cpp.split_c_start_run_class; echo.put_character('%T'); echo.put_string(current_type.run_time_mark); echo.put_character('%N'); from i := 1; until i > feature_dictionary.count loop rf := feature_dictionary.item(i); rf.c_define; i := i + 1; end; if run_control.invariant_check then if class_invariant /= Void then class_invariant.c_define; end; end; ensure compile_to_c_done end; feature {RUN_CLASS} actuals_clients: FIXED_ARRAY[RUN_CLASS]; feature {RUN_FEATURE} add_client(rc: RUN_CLASS) is require rc /= Void local i: INTEGER; do i := actuals_clients.fast_index_of(rc); if i > actuals_clients.upper then actuals_clients.add_last(rc); end; end; feature {BASE_CLASS} collect_invariant(ia: like class_invariant) is require ia /= Void; do ia.add_into(ci_collector); end; feature {NONE} writable_attributes_mem: like writable_attributes; ci_collector: ARRAY[ASSERTION] is -- The Class Invariant Collector. once !!Result.make(1,10); end; feature offset_of(rf2: RUN_FEATURE_2): INTEGER is -- Compute the displacement to access `rf2' in the corresponding -- C struct to remove a possible stupid switch. -- Result is in number of bytes. require at_run_time; writable_attributes.fast_has(rf2); small_eiffel.is_ready local wa: like writable_attributes; t: TYPE; i: INTEGER; do if is_tagged then Result := (1).object_size; end; from wa := writable_attributes; i := wa.upper; invariant i > 0 until wa.item(i) = rf2 loop t := wa.item(i).result_type; Result := Result + t.space_for_variable; i := i - 1; end; end; feature {NONE} sort_wam(wam: like writable_attributes) is -- Sort `wam' to common attribute at the end. require wam.lower = 1 local min, max, buble: INTEGER; moved: BOOLEAN; do from max := wam.upper; min := 1; moved := true; until not moved loop moved := false; if max - min > 0 then from buble := min + 1; until buble > max loop if gt(wam.item(buble - 1),wam.item(buble)) then wam.swap(buble - 1,buble); moved := true; end; buble := buble + 1; end; max := max - 1; end; if moved and then max - min > 0 then from moved := false; buble := max - 1; until buble < min loop if gt(wam.item(buble),wam.item(buble + 1)) then wam.swap(buble,buble + 1); moved := true; end; buble := buble - 1; end; min := min + 1; end; end; end; gt(rf1, rf2: RUN_FEATURE_2): BOOLEAN is -- True if it is better to set attribute `rf1' before -- attribute `rf2'. local bc1, bc2: BASE_CLASS; bf1, bf2: E_FEATURE; bcn1, bcn2: CLASS_NAME; do bf1 := rf1.base_feature; bf2 := rf2.base_feature; bc1 := bf1.base_class; bc2 := bf2.base_class; bcn1 := bc1.name; bcn2 := bc2.name; if bcn1.to_string = bcn2.to_string then Result := bf1.start_position.before(bf2.start_position); elseif bcn2.is_subclass_of(bcn1) then Result := true; elseif bcn1.is_subclass_of(bcn2) then elseif bc1.parent_list = Void then if bc2.parent_list = Void then Result := bcn1.to_string < bcn2.to_string; else Result := true; end; elseif bc2.parent_list = Void then else Result := bc2.parent_list.count < bc1.parent_list.count end; end; feature {NONE} efnf(bc: BASE_CLASS; fn: FEATURE_NAME) is require bc /= Void; fn /= Void do eh.append("Current type is "); eh.append(current_type.run_time_mark); eh.append(". There is no feature "); eh.append(fn.to_string); eh.append(" in class "); eh.append(bc.name.to_string); error(fn.start_position,fz_dot); end; feature {NONE} tmp_string: STRING is once !!Result.make(32); end; feature wa_buf: FIXED_ARRAY[RUN_FEATURE_2] is once !!Result.with_capacity(24); end; wa_cyclic_buf: FIXED_ARRAY[RUN_FEATURE_2] is once !!Result.with_capacity(24); end; feature {RUN_CLASS} is_wa_cycle(origin: like Current): BOOLEAN is do if Current = origin then Result := true; end; end; feature {NONE} wa_cycle: FIXED_ARRAY[RUN_FEATURE_2] is once !!Result.with_capacity(24); end; feature {NONE} need_gc_mark: BOOLEAN is require at_run_time local i: INTEGER; wa: like writable_attributes; rf2: RUN_FEATURE_2; t: TYPE; do wa := writable_attributes; if wa /= Void then from i := wa.upper; until Result or else i = 0 loop rf2 := wa.item(i); t := rf2.result_type; Result := t.need_gc_mark_function; i := i - 1; end; end; end; feature {NONE} gc_set_fsoh_marked_in(body: STRING) is do if current_type.is_reference then body.append("((gc"); id.append_in(body); body.append("*)o)->header.flag=FSOH_MARKED;%N"); end; end; feature {NONE} mark_attribute(body: STRING; rf2: RUN_FEATURE_2) is do tmp_string.copy("o->_"); tmp_string.append(rf2.name.to_string); tmp_string.append(fz_open_c_comment); offset_of(rf2).append_in(tmp_string); tmp_string.append(fz_close_c_comment); gc_handler.mark_for(body,tmp_string,rf2.result_type.run_class); end; feature {RUN_FEATURE_2} force_c_recompilation_comment(rf2: RUN_FEATURE_2) is require at_run_time; writable_attributes.fast_has(rf2); small_eiffel.is_ready do cpp.put_recompilation_comment(offset_of(rf2)); end; feature -- Some usefull JVM opcode : opcode_checkcast is -- May produce a `checkcast' opcode depending on -- `current_type' Java byte-code mapping. local ct: TYPE; idx: INTEGER; do ct := current_type; if ct.is_basic_eiffel_expanded then elseif ct.is_native_array then tmp_string.clear; ct.jvm_target_descriptor_in(tmp_string); idx := constant_pool.idx_class2(tmp_string); code_attribute.opcode_checkcast(idx); elseif ct.is_bit then else idx := jvm_constant_pool_index; code_attribute.opcode_checkcast(idx); end; end; opcode_instanceof is require not current_type.is_basic_eiffel_expanded local idx: INTEGER; do idx := jvm_constant_pool_index; code_attribute.opcode_instanceof(idx); end; opcode_getfield(rf2: RUN_FEATURE_2): INTEGER is -- Produce a `checkcast'/`getfield' for the given -- attribute of the top object of the stack. -- stack: ... object => ... value local idx: INTEGER; do opcode_checkcast; idx := constant_pool.idx_fieldref(rf2); Result := rf2.result_type.jvm_stack_space - 1; code_attribute.opcode_getfield(idx,Result); end; feature {RUN_FEATURE} add_rf(rf: RUN_FEATURE; key: STRING) is require not feature_dictionary.has(key) do feature_dictionary.put(rf,key); end; invariant current_type.run_type = current_type; end -- RUN_CLASS