home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 3 / AACD03.BIN / AACD / Programming / sofa / archive / SmallEiffel.lha / SmallEiffel / lib_se / run_feature.e < prev    next >
Text File  |  1999-06-05  |  31KB  |  1,110 lines

  1. --          This file is part of SmallEiffel The GNU Eiffel Compiler.
  2. --          Copyright (C) 1994-98 LORIA - UHP - CRIN - INRIA - FRANCE
  3. --            Dominique COLNET and Suzanne COLLIN - colnet@loria.fr
  4. --                       http://SmallEiffel.loria.fr
  5. -- SmallEiffel is  free  software;  you can  redistribute it and/or modify it
  6. -- under the terms of the GNU General Public License as published by the Free
  7. -- Software  Foundation;  either  version  2, or (at your option)  any  later
  8. -- version. SmallEiffel is distributed in the hope that it will be useful,but
  9. -- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10. -- or  FITNESS FOR A PARTICULAR PURPOSE.   See the GNU General Public License
  11. -- for  more  details.  You  should  have  received a copy of the GNU General
  12. -- Public  License  along  with  SmallEiffel;  see the file COPYING.  If not,
  13. -- write to the  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  14. -- Boston, MA 02111-1307, USA.
  15. --
  16. deferred class RUN_FEATURE
  17.    --
  18.    -- A feature at run time : assertions collected and only run types.
  19.    --
  20.    --   RUN_FEATURE_1  : constant attribute.
  21.    --   RUN_FEATURE_2  : attribute.
  22.    --   RUN_FEATURE_3  : procedure.
  23.    --   RUN_FEATURE_4  : function.
  24.    --   RUN_FEATURE_5  : once procedure.
  25.    --   RUN_FEATURE_6  : once function.
  26.    --   RUN_FEATURE_7  : external procedure.
  27.    --   RUN_FEATURE_8  : external function.
  28.    --   RUN_FEATURE_9  : deferred routine.
  29.    --   RUN_FEATURE_10 : Precursor procedure.
  30.    --   RUN_FEATURE_11 : Precursor function.
  31.    --
  32.  
  33. inherit GLOBALS;
  34.  
  35. feature
  36.  
  37.    current_type: TYPE;
  38.          -- The type of Current in the corresponding feature.
  39.  
  40. feature {NONE}
  41.  
  42.    clients_memory: CLIENT_LIST;
  43.  
  44. feature
  45.  
  46.    name: FEATURE_NAME;
  47.          -- Final name (the only one really used) of the feature.
  48.  
  49.    base_feature: E_FEATURE;
  50.          -- Original base feature definition.
  51.  
  52.    arguments: FORMAL_ARG_LIST is
  53.          -- Runnable arguments list if any.
  54.       deferred
  55.       end;
  56.  
  57.    result_type: TYPE is
  58.          -- Runnable Result type if any.
  59.       deferred
  60.       end;
  61.  
  62.    require_assertion: RUN_REQUIRE is
  63.          -- Runnable collected require assertion if any.
  64.       deferred
  65.       end;
  66.  
  67.    local_vars: LOCAL_VAR_LIST is
  68.          -- Runnable local var list if any.
  69.       deferred
  70.       end;
  71.  
  72.    routine_body: COMPOUND is
  73.          -- Runnable routine body if any.
  74.       deferred
  75.       end;
  76.  
  77.    ensure_assertion: E_ENSURE is
  78.          -- Runnable collected ensure assertion if any.
  79.       deferred
  80.       end;
  81.  
  82.    rescue_compound: COMPOUND is
  83.          -- Runnable rescue compound if any.
  84.       deferred
  85.       end;
  86.  
  87. feature {NONE}
  88.  
  89.    frozen make(t: like current_type; n: like name; bf: like base_feature) is
  90.       require
  91.          t.run_type = t;
  92.          n /= Void;
  93.          bf /= void;
  94.          not small_eiffel.is_ready
  95.       do
  96.          current_type := t;
  97.          name := n;
  98.          base_feature := bf;
  99.          run_class.add_rf(Current,n.to_key);
  100.          small_eiffel.incr_magic_count;
  101.          use_current_state := ucs_not_computed;
  102.          small_eiffel.push(Current);
  103.          initialize;
  104.          small_eiffel.pop;
  105.       ensure
  106.          run_class.get_feature(name) = Current
  107.       end;
  108.  
  109. feature
  110.  
  111.    is_once_function: BOOLEAN is
  112.       deferred
  113.       end;
  114.  
  115.    frozen is_deferred: BOOLEAN is
  116.       do
  117.          Result := base_feature.is_deferred;
  118.       end;
  119.  
  120.    is_pre_computable: BOOLEAN is
  121.       require
  122.          small_eiffel.is_ready
  123.       deferred
  124.       end;
  125.  
  126.    can_be_dropped: BOOLEAN is
  127.       -- If calling has no side effect at all.
  128.       require
  129.          small_eiffel.is_ready
  130.       deferred
  131.       end;
  132.  
  133.    frozen use_current: BOOLEAN is
  134.       require
  135.          small_eiffel.is_ready
  136.       do
  137.          inspect
  138.             use_current_state
  139.          when ucs_true then
  140.             Result := true;
  141.          when ucs_false then
  142.          when ucs_not_computed then
  143.             use_current_state := ucs_in_computation;
  144.             compute_use_current;
  145.             Result := use_current;
  146.          when ucs_in_computation then
  147.             Result := true;
  148.          end;
  149.       end;
  150.  
  151.    fall_down is
  152.       local
  153.          running: ARRAY[RUN_CLASS];
  154.          i: INTEGER;
  155.          current_rc, sub_rc: RUN_CLASS;
  156.          current_bc, sub_bc: BASE_CLASS;
  157.          sub_name: FEATURE_NAME;
  158.          rf: RUN_FEATURE;
  159.       do
  160.          current_rc := current_type.run_class;
  161.          running := current_rc.running;
  162.          if running /= Void then
  163.             from
  164.                current_bc := current_type.base_class;
  165.                i := running.lower;
  166.             until
  167.                i > running.upper
  168.             loop
  169.                sub_rc := running.item(i);
  170.                if sub_rc /= current_rc then
  171.                   sub_bc := sub_rc.current_type.base_class;
  172.                   sub_name := sub_bc.new_name_of(current_bc,name);
  173.                   rf := sub_rc.get_feature(sub_name);
  174.                end;
  175.                i := i + 1;
  176.             end;
  177.          end;
  178.       end;
  179.  
  180.    afd_check is
  181.       deferred
  182.       end;
  183.  
  184.    frozen is_exported_in(cn: CLASS_NAME): BOOLEAN is
  185.          -- True if using of the receiver is legal when written in `cn'.
  186.          -- When false, `eh' is updated with the beginning of the
  187.          -- error message.
  188.       require
  189.          cn /= Void
  190.       do
  191.          Result := clients.gives_permission_to(cn);
  192.       end;
  193.  
  194.    frozen start_position: POSITION is
  195.       do
  196.          Result := base_feature.start_position;
  197.       end;
  198.  
  199.    frozen run_class: RUN_CLASS is
  200.       do
  201.          Result := current_type.run_class;
  202.       end;
  203.  
  204.    c_define is
  205.          -- Produce C code for definition.
  206.       require
  207.          run_class.at_run_time;
  208.          cpp.on_c
  209.       deferred
  210.       ensure
  211.          cpp.on_c
  212.       end;
  213.  
  214.    mapping_c is
  215.          -- Produce C code when current is called and when the
  216.          -- concrete type of target is unique (`cpp' is in charge
  217.          -- of the context).
  218.       require
  219.          run_class.at_run_time;
  220.          cpp.on_c
  221.       deferred
  222.       ensure
  223.          cpp.on_c
  224.       end;
  225.  
  226.    mapping_jvm is
  227.       require
  228.          run_class.at_run_time
  229.       deferred
  230.       end;
  231.  
  232.    frozen id: INTEGER is
  233.       do
  234.          Result := current_type.id;
  235.       end;
  236.  
  237.    mapping_name is
  238.       do
  239.          c_code.clear;
  240.          c_code.extend('r');
  241.          id.append_in(c_code);
  242.          name.mapping_c_in(c_code);
  243.          cpp.put_string(c_code);
  244.       end;
  245.  
  246.    frozen jvm_max_locals: INTEGER is
  247.       do
  248.          Result := current_type.jvm_stack_space;
  249.          if arguments /= Void then
  250.             Result := Result + arguments.jvm_stack_space;
  251.          end;
  252.          if local_vars /= Void then
  253.             Result := Result + local_vars.jvm_stack_space;
  254.          end;
  255.          if result_type /= Void then
  256.             Result := Result + result_type.jvm_stack_space;
  257.          end;
  258.       end;
  259.  
  260. feature {CALL}
  261.  
  262.    frozen vape_check_from(call_site: POSITION) is
  263.          -- Check VAPE rule for this `call_site'.
  264.       require
  265.          call_site /= Void
  266.       do
  267.          small_eiffel.top_rf.clients.vape_check(call_site,clients);
  268.       end;
  269.  
  270. feature {ADDRESS_OF_POOL}
  271.  
  272.    address_of_c_define(caller: ADDRESS_OF) is
  273.          -- Corresponding `caller' is used for error messages.
  274.       require
  275.          caller /= Void
  276.       deferred
  277.       end;
  278.  
  279. feature {ADDRESS_OF}
  280.  
  281.    address_of_c_mapping is
  282.          -- Produce C code for operator $<feature_name>
  283.       require
  284.          run_class.at_run_time;
  285.          cpp.on_c
  286.       deferred
  287.       ensure
  288.          cpp.on_c
  289.       end;
  290.  
  291. feature {EXPRESSION}
  292.  
  293.    is_static: BOOLEAN is
  294.       require
  295.          small_eiffel.is_ready
  296.       deferred
  297.       end;
  298.  
  299.    static_value_mem: INTEGER is
  300.       require
  301.          is_static;
  302.       deferred
  303.       end;
  304.  
  305. feature {CALL_PROC_CALL, E_PRECURSOR}
  306.  
  307.    collect_c_tmp is
  308.       deferred
  309.       end;
  310.  
  311. feature {E_RETRY,ASSERTION_LIST}
  312.  
  313.    c_assertion_flag is
  314.       do
  315.          c_code.clear;
  316.          c_frame_descriptor_name_in(c_code);
  317.          c_code.append(".assertion_flag");
  318.          cpp.put_string(c_code);
  319.       end;
  320.  
  321. feature {NATIVE}
  322.  
  323.    frozen default_mapping_procedure is
  324.          -- Default mapping for procedure calls with target.
  325.       do
  326.          default_mapping_function;
  327.          cpp.put_string(fz_00);
  328.       end;
  329.  
  330.    frozen default_mapping_function is
  331.          -- Default mapping for function calls with target.
  332.       local
  333.          no_check, uc, tcbd: BOOLEAN;
  334.       do
  335.          no_check := run_control.no_check;
  336.          uc := use_current;
  337.          if not uc then
  338.             tcbd := cpp.target_cannot_be_dropped;
  339.             if tcbd then
  340.                cpp.put_character(',');
  341.             end;
  342.          end;
  343.          mapping_name;
  344.          cpp.put_character('(');
  345.          if no_check then
  346.             cpp.put_string("&ds");
  347.          end;
  348.          if uc then
  349.             if no_check then
  350.                cpp.put_character(',');
  351.             end;
  352.             cpp.put_target_as_target;
  353.          end;
  354.          if arguments /= Void then
  355.             if uc or else no_check then
  356.                cpp.put_character(',');
  357.             end;
  358.             cpp.put_arguments;
  359.          end;
  360.          cpp.put_character(')');
  361.          if not uc and then tcbd then
  362.             cpp.put_character(')');
  363.          end;
  364.       end;
  365.  
  366.    routine_mapping_jvm is
  367.       local
  368.          rt, ct: TYPE;
  369.          idx, stack_level: INTEGER;
  370.       do
  371.          ct := current_type;
  372.          jvm.push_target_as_target;
  373.          stack_level := -(1 + jvm.push_arguments);
  374.          rt := result_type;
  375.          if rt /= Void then
  376.             stack_level := stack_level + rt.jvm_stack_space;
  377.          end
  378.          idx := constant_pool.idx_methodref(Current);
  379.          ct.run_class.jvm_invoke(idx,stack_level);
  380.       end;
  381.  
  382. feature {RUN_CLASS}
  383.  
  384.    jvm_field_or_method is
  385.          -- Update jvm's `fields' or `methods' if needed.
  386.       deferred
  387.       end;
  388.  
  389. feature {CONSTANT_POOL,SWITCH_COLLECTION}
  390.  
  391.    frozen jvm_descriptor: STRING is
  392.       do
  393.          tmp_jvm_descriptor.clear;
  394.          update_tmp_jvm_descriptor;
  395.          Result := tmp_jvm_descriptor;
  396.       end;
  397.  
  398. feature {JVM}
  399.  
  400.    jvm_define is
  401.          -- To compute the constant pool, the number of fields,
  402.          -- the number of methods, etc.
  403.       require
  404.          small_eiffel.is_ready
  405.       deferred
  406.       end;
  407.  
  408.    frozen jvm_result_offset: INTEGER is
  409.          -- Offset of the Result local variable if any.
  410.       require
  411.          result_type /= Void
  412.       do
  413.          Result := current_type.jvm_stack_space;
  414.          if arguments /= Void then
  415.             Result := Result + arguments.jvm_stack_space;
  416.          end;
  417.          if local_vars /= Void then
  418.             Result := Result + local_vars.jvm_stack_space;
  419.          end;
  420.       end;
  421.  
  422.    frozen jvm_argument_offset(a: ARGUMENT_NAME): INTEGER is
  423.       require
  424.          arguments /= Void
  425.       do
  426.          Result := current_type.jvm_stack_space;
  427.          Result := Result + arguments.jvm_offset_of(a);
  428.       ensure
  429.          Result >= a.rank - 1
  430.       end;
  431.  
  432.    frozen jvm_local_variable_offset(ln: LOCAL_NAME): INTEGER is
  433.       require
  434.          local_vars /= Void
  435.       do
  436.          Result := current_type.jvm_stack_space;
  437.          if arguments /= Void then
  438.             Result := Result + arguments.jvm_stack_space;
  439.          end;
  440.          Result := Result + local_vars.jvm_offset_of(ln);
  441.       ensure
  442.          Result >= ln.rank - 1
  443.       end;
  444.  
  445. feature {NATIVE}
  446.  
  447.    frozen c_define_with_body(body: STRING) is
  448.       require
  449.          body /= Void
  450.       do
  451.          define_prototype;
  452.          c_define_opening;
  453.          cpp.put_string(body);
  454.          c_define_closing;
  455.          if result_type = Void then
  456.             cpp.put_string(fz_12);
  457.          else
  458.             cpp.put_string(fz_15);
  459.          end;
  460.          c_frame_descriptor;
  461.       end;
  462.  
  463. feature {ONCE_ROUTINE_POOL}
  464.  
  465.    frozen once_result_in(str: STRING) is
  466.          -- Produce the C name of the once Result.
  467.       require
  468.          is_once_function
  469.       do
  470.          str.extend('o');
  471.          base_feature.mapping_c_name_in(str);
  472.       end;
  473.  
  474. feature {RUN_FEATURE}
  475.  
  476.    is_in_computation: BOOLEAN is
  477.       do
  478.          Result := use_current_state = ucs_in_computation;
  479.       end;
  480.  
  481.    clients: like clients_memory is
  482.          -- Effective client list for the receiver (inherited "export"
  483.          -- clauses are also considered)..
  484.       local
  485.          bc, bfbc: BASE_CLASS;
  486.       do
  487.          if clients_memory = Void then
  488.             bc := current_type.base_class;
  489.             bfbc := base_feature.base_class;
  490.             if bc = bfbc then
  491.                Result := base_feature.clients;
  492.             else
  493.                check
  494.                   bc.is_subclass_of(bfbc)
  495.                end;
  496.                Result := bc.clients_for(name);
  497.             end;
  498.             clients_memory := Result;
  499.          else
  500.             Result := clients_memory;
  501.          end;
  502.       ensure
  503.          Result /= Void
  504.       end;
  505.  
  506. feature {NONE}
  507.  
  508.    frozen put_c_name_tag is
  509.       require
  510.          run_control.no_check
  511.       local
  512.          fn: FEATURE_NAME;
  513.       do
  514.          cpp.put_character('%"');
  515.          fn := base_feature.first_name;
  516.          if fn.to_key /= name.to_key then
  517.             name.put_cpp_tag;
  518.             cpp.put_string(name.to_string);
  519.             cpp.put_character(' ');
  520.             cpp.put_character('(');
  521.          end;
  522.          fn.put_cpp_tag;
  523.          cpp.put_string(fn.to_string);
  524.          cpp.put_string(" of ");
  525.          cpp.put_string(base_feature.base_class_name.to_string);
  526.          if fn.to_key /= name.to_key then
  527.             cpp.put_character(')');
  528.          end;
  529.          cpp.put_character('%"');
  530.       end;
  531.  
  532.    frozen run_require: RUN_REQUIRE is
  533.       do
  534.          Result := current_type.base_class.run_require(Current);
  535.       end;
  536.  
  537.    frozen run_ensure: E_ENSURE is
  538.       do
  539.          Result := current_type.base_class.run_ensure(Current);
  540.       end;
  541.  
  542.    address_of_wrapper_name_in(str: STRING) is
  543.       do
  544.          str.extend('W');
  545.          id.append_in(str);
  546.          name.mapping_c_in(str);
  547.       end;
  548.  
  549.    address_of_c_define_wrapper(caller: ADDRESS_OF) is
  550.       require
  551.          cpp.on_c
  552.       do
  553.          c_code.clear;
  554.          if result_type = Void then
  555.             c_code.append(fz_void);
  556.          else
  557.             result_type.c_type_for_external_in(c_code);
  558.          end;
  559.          c_code.extend(' ');
  560.          address_of_wrapper_name_in(c_code);
  561.          c_code.extend('(');
  562.          current_type.c_type_for_external_in(c_code);
  563.          c_code.extend(' ');
  564.          c_code.extend('C');
  565.          if arguments /= Void then
  566.             c_code.extend(',');
  567.             arguments.external_prototype_in(c_code);
  568.          end;
  569.          c_code.extend(')');
  570.          cpp.put_c_heading(c_code);
  571.          cecil_pool.define_body_of(Current);
  572.       end;
  573.  
  574.    address_of_c_mapping_wrapper is
  575.       do
  576.          c_code.clear;
  577.          address_of_wrapper_name_in(c_code);
  578.          cpp.put_string(c_code);
  579.       end;
  580.  
  581.    c_frame_descriptor_name_in(str: STRING) is
  582.       do
  583.          str.extend('f');
  584.          id.append_in(str);
  585.          name.mapping_c_in(str);
  586.       end;
  587.  
  588.    c_frame_descriptor is
  589.       do
  590.          if run_control.no_check then
  591.             c_code.copy("se_frame_descriptor ");
  592.             c_frame_descriptor_name_in(c_code);
  593.             cpp.put_extern7(c_code);
  594.             cpp.put_character('{');
  595.             put_c_name_tag;
  596.             c_code.clear;
  597.             c_code.extend(',');
  598.             if use_current then
  599.                c_code.extend('1');
  600.             else
  601.                c_code.extend('0');
  602.             end;
  603.             c_code.extend(',');
  604.             c_frame_descriptor_local_count.append_in(c_code);
  605.             c_code.extend(',');
  606.             c_code.append(c_frame_descriptor_format);
  607.             c_code.append("%",1};%N");
  608.             cpp.put_string(c_code);
  609.          end;
  610.       end;
  611.  
  612.    define_prototype is
  613.       require
  614.          run_class.at_run_time;
  615.          cpp.on_c
  616.       local
  617.          mem_id: INTEGER;
  618.          no_check: BOOLEAN;
  619.       do
  620.          no_check := run_control.no_check;
  621.          if run_control.no_check then
  622.             c_frame_descriptor_local_count.reset;
  623.             c_frame_descriptor_format.clear;
  624.             c_frame_descriptor_format.extend('%"');
  625.             c_frame_descriptor_locals.clear;
  626.          end;
  627.          mem_id := id;
  628.          -- Define heading of corresponding C function.
  629.          c_code.clear;
  630.          if result_type = Void then
  631.             c_code.append(fz_void);
  632.          else
  633.             result_type.run_type.c_type_for_result_in(c_code);
  634.          end;
  635.          c_code.extend(' ');
  636.          c_code.extend('r');
  637.          mem_id.append_in(c_code);
  638.          name.mapping_c_in(c_code);
  639.          c_code.extend('(');
  640.          if no_check then
  641.             c_code.append("se_dump_stack*caller");
  642.             if use_current or else arguments /= Void then
  643.                c_code.extend(',');
  644.             end;
  645.          end;
  646.          if use_current then
  647.             current_type.c_type_for_target_in(c_code);
  648.             c_code.extend(' ');
  649.             c_code.extend('C');
  650.             current_type.c_frame_descriptor;
  651.             if arguments /= Void then
  652.                c_code.extend(',');
  653.             end;
  654.          end;
  655.          if arguments = Void then
  656.             if no_check then
  657.             elseif not use_current then
  658.                c_code.append(fz_void);
  659.             end;
  660.          else
  661.             arguments.compile_to_c_in(c_code);
  662.          end;
  663.          c_code.extend(')');
  664.          cpp.put_c_heading(c_code);
  665.          cpp.swap_on_c;
  666.       ensure
  667.          cpp.on_c
  668.       end;
  669.  
  670.    c_define_opening is
  671.          -- Define opening section in C function.
  672.       local
  673.          t: TYPE;
  674.       do
  675.          -- (0) --------------------------- Exception handling :
  676.          if rescue_compound /= Void then
  677.             cpp.put_string("struct rescue_context rc;%N");
  678.          end;
  679.          -- (1) -------------------- Local variable for Result :
  680.          if is_once_function then
  681.             if run_control.no_check then
  682.                t := result_type.run_type;
  683.                c_frame_descriptor_locals.append("(void**)&");
  684.                once_result_in(c_frame_descriptor_locals);
  685.                c_frame_descriptor_locals.extend(',');
  686.                c_frame_descriptor_local_count.increment;
  687.                c_frame_descriptor_format.append(as_result);
  688.                t.c_frame_descriptor;
  689.             end;
  690.          elseif result_type /= Void then
  691.             t := result_type.run_type;
  692.             c_code.clear;
  693.             t.c_type_for_result_in(c_code);
  694.             c_code.append(" R=");
  695.             t.c_initialize_in(c_code);
  696.             c_code.append(fz_00);
  697.             cpp.put_string(c_code);
  698.             if run_control.no_check then
  699.                c_frame_descriptor_locals.append("(void**)&R,");
  700.                c_frame_descriptor_local_count.increment;
  701.                c_frame_descriptor_format.append(as_result);
  702.                t.c_frame_descriptor;
  703.             end;
  704.          end;
  705.          -- (2) ----------------------- User's local variables :
  706.          if local_vars /= Void then
  707.             local_vars.c_declare;
  708.          end;
  709.          -- (3) ---------------- Local variable for old/ensure :
  710.          if run_control.ensure_check then
  711.             if ensure_assertion /= Void then
  712.                ensure_assertion.c_declare_for_old;
  713.             end;
  714.          end;
  715.          if run_control.no_check then
  716.          -- (4) ------------------------------- Prepare locals :
  717.             if c_frame_descriptor_local_count.value > 0 then
  718.                c_code.copy("void**locals[");
  719.                c_frame_descriptor_local_count.append_in(c_code);
  720.                c_code.extend(']');
  721.                c_code.append(fz_00);
  722.                cpp.put_string(c_code);
  723.             end;
  724.          -- (5) ----------------------------------- Prepare ds :
  725.             c_initialize_ds_one_by_one;
  726.             c_initialize_locals_one_by_one;
  727.          -- (6) ------------------------ Initialise Dump Stack :
  728.             cpp.put_string("se_dst=&ds;/*link*/%N");
  729.          end;
  730.          -- (7) ----------------------- Execute old for ensure :
  731.          if run_control.ensure_check then
  732.             if ensure_assertion /= Void then
  733.                ensure_assertion.compile_to_c_old;
  734.             end;
  735.          end;
  736.          -- (8) --------------------------- Exception handling :
  737.          if rescue_compound /= Void then
  738.             cpp.put_string("if(SETJMP(rc.jb)!=0){/*rescue*/%N");
  739.             if run_control.no_check then
  740.                cpp.put_string(
  741.                   "while(se_dst!=&ds){%N%
  742.                   %if(se_dst->fd!=NULL)se_dst->fd->assertion_flag=1;%N%
  743.                   %se_dst = se_dst->caller;%N}%N");
  744.             end;
  745.             rescue_compound.compile_to_c;
  746.             cpp.put_string("internal_exception_handler(Routine_failure);%N}%N");
  747.          end;
  748.          -- (9) -------------------- Initialize local expanded :
  749.          if local_vars /= Void then
  750.             local_vars.initialize_expanded;
  751.          end;
  752.          -- (10) --------------------------- Retry start label :
  753.          if rescue_compound /= Void then
  754.             cpp.put_string("retry_tag:%N");
  755.          end;
  756.          -- (11) ---------------------- Require assertion code :
  757.          if require_assertion /= Void then
  758.             require_assertion.compile_to_c;
  759.          end;
  760.          -- (12) ------------------------- Save rescue context :
  761.          if rescue_compound /= Void then
  762.             cpp.put_string("rc.next = rescue_context_top;%N%
  763.                            %rescue_context_top = &rc;%N");
  764.             if run_control.no_check then
  765.                cpp.put_string("se_dst=&ds;/*link*/%N");
  766.             end;
  767.          end;
  768.       end;
  769.  
  770.    c_define_closing is
  771.          -- Define closing section in C function :
  772.          --    - code for ensure checking.
  773.          --    - free memory of expanded.
  774.          --    - run stack pop.
  775.       do
  776.          -- (1) --------------------------- Ensure Check Code :
  777.          if run_control.ensure_check then
  778.             if ensure_assertion /= Void then
  779.                ensure_assertion.compile_to_c;
  780.             end;
  781.          end;
  782.          -- (2) ----------------------------- Class Invariant :
  783.          if use_current then
  784.             cpp.current_class_invariant(current_type);
  785.          end;
  786.          -- (3) ---------------------------------- For rescue :
  787.          if rescue_compound /= Void then
  788.             cpp.put_string("rescue_context_top = rc.next;%N");
  789.          end;
  790.          -- (4) ------------------------------- Run Stack Pop :
  791.          if run_control.no_check then
  792.             cpp.put_string("se_dst=caller;/*unlink*/%N");
  793.          end;
  794.       end;
  795.  
  796.    external_prototype(er: EXTERNAL_ROUTINE) is
  797.          -- Define prototype for an external routine.
  798.       require
  799.          cpp.on_c;
  800.          er = base_feature
  801.       local
  802.          t: TYPE;
  803.       do
  804.          c_code.clear;
  805.          c_code.append("/*external*/");
  806.          -- Define heading of corresponding C function.
  807.          t := result_type;
  808.          if t = Void then
  809.             c_code.append(fz_void);
  810.          else
  811.             t.c_type_for_external_in(c_code);
  812.          end;
  813.          c_code.extend(' ');
  814.          c_code.append(er.external_c_name);
  815.          c_code.extend('(');
  816.          if er.use_current then
  817.             current_type.c_type_for_external_in(c_code);
  818.             c_code.extend(' ');
  819.             c_code.extend('C');
  820.             if arguments /= Void then
  821.                c_code.extend(',');
  822.             end;
  823.          end;
  824.          if arguments = Void then
  825.             if not er.use_current then
  826.                c_code.append(fz_void);
  827.             end;
  828.          else
  829.             arguments.external_prototype_in(c_code);
  830.          end;
  831.          c_code.append(");%N");
  832.          cpp.swap_on_h;
  833.          cpp.put_string(c_code);
  834.          cpp.swap_on_c;
  835.       ensure
  836.          cpp.on_c
  837.       end;
  838.  
  839.    once_mark: STRING is
  840.       do
  841.          Result := base_feature.first_name.to_string;
  842.       end;
  843.  
  844.    once_flag_in(str: STRING) is
  845.          -- Produce the C name of the once flag.
  846.       do
  847.          str.extend('f');
  848.          base_feature.mapping_c_name_in(str);
  849.       end;
  850.  
  851.    once_flag is
  852.          -- Produce the C name of the once flag.
  853.       do
  854.          c_code.clear;
  855.          once_flag_in(c_code);
  856.          cpp.put_string(c_code);
  857.       end;
  858.  
  859.    once_boolean is
  860.          -- Produce C code for the boolean flag definition
  861.          -- and initialisation.
  862.       do
  863.          c_code.copy(fz_int);
  864.          c_code.extend(' ');
  865.          once_flag_in(c_code);
  866.          cpp.put_extern2(c_code,'0');
  867.       end;
  868.  
  869.    use_current_state: INTEGER;
  870.  
  871.    ucs_false,
  872.    ucs_true,
  873.    ucs_not_computed,
  874.    ucs_in_computation: INTEGER is unique;
  875.  
  876.    std_compute_use_current is
  877.       require
  878.          is_in_computation
  879.       do
  880.          if use_current_state = ucs_in_computation then
  881.             if require_assertion /= Void then
  882.                if require_assertion.use_current then
  883.                   use_current_state := ucs_true;
  884.                end;
  885.             end;
  886.          end;
  887.          if use_current_state = ucs_in_computation then
  888.             if routine_body /= Void then
  889.                if routine_body.use_current then
  890.                   use_current_state := ucs_true;
  891.                end;
  892.             end;
  893.          end;
  894.          if use_current_state = ucs_in_computation then
  895.             if rescue_compound /= Void then
  896.                if rescue_compound.use_current then
  897.                   use_current_state := ucs_true;
  898.                end;
  899.             end;
  900.          end;
  901.          if use_current_state = ucs_in_computation then
  902.             if ensure_assertion /= Void then
  903.                if ensure_assertion.use_current then
  904.                   use_current_state := ucs_true;
  905.                end;
  906.             end;
  907.          end;
  908.          if use_current_state = ucs_in_computation then
  909.             use_current_state := ucs_false;
  910.          end;
  911.       ensure
  912.          use_current_state = ucs_false or else
  913.          use_current_state = ucs_true;
  914.       end;
  915.  
  916.    compute_use_current is
  917.       require
  918.          is_in_computation
  919.       deferred
  920.       ensure
  921.          use_current_state = ucs_true or else
  922.          use_current_state = ucs_false;
  923.       end;
  924.  
  925.    c_code, c_code2: STRING is
  926.             "................................................................%
  927.             %................................................................%
  928.             %................................................................%
  929.             %................................................................";
  930.  
  931.    nothing_comment is
  932.          -- Useful for incremental recompilation.
  933.       do
  934.          cpp.put_string(fz_open_c_comment);
  935.          cpp.put_string("No:");
  936.          cpp.put_string(current_type.run_time_mark);
  937.          cpp.put_character('.');
  938.          cpp.put_string(name.to_string);
  939.          cpp.put_string(fz_close_c_comment);
  940.          cpp.put_character('%N');
  941.       end;
  942.  
  943.    update_tmp_jvm_descriptor is
  944.       deferred
  945.       end;
  946.  
  947.    tmp_jvm_descriptor: STRING is
  948.       once
  949.          !!Result.make(128);
  950.       end;
  951.  
  952.    routine_update_tmp_jvm_descriptor is
  953.          -- For RUN_FEATURE_3/4/5/6/7/8/9/10/11 :
  954.       local
  955.          ct, rt: TYPE;
  956.       do
  957.          tmp_jvm_descriptor.extend('(');
  958.          ct := current_type;
  959.          ct.jvm_target_descriptor_in(tmp_jvm_descriptor);
  960.          if arguments /= Void then
  961.             arguments.jvm_descriptor_in(tmp_jvm_descriptor);
  962.          end;
  963.          rt := result_type;
  964.          if rt = Void then
  965.             tmp_jvm_descriptor.append(fz_19);
  966.          else
  967.             rt := rt.run_type;
  968.             tmp_jvm_descriptor.extend(')');
  969.             rt.jvm_descriptor_in(tmp_jvm_descriptor);
  970.          end;
  971.       end;
  972.  
  973.    method_info_start is
  974.       local
  975.          flags: INTEGER;
  976.       do
  977.          flags := current_type.jvm_method_flags;
  978.          method_info.start(flags,name.to_key,jvm_descriptor);
  979.       end;
  980.  
  981.    jvm_define_opening is
  982.       require
  983.          jvm.current_frame = Current
  984.       local
  985.          space: INTEGER;
  986.       do
  987.          -- (1) -------------------- Local variable for Result :
  988.          if result_type /= Void then
  989.             space := result_type.jvm_push_default;
  990.             jvm_result_store;
  991.          end;
  992.          -- (2) ----------------------- User's local variables :
  993.          if local_vars /= Void then
  994.             local_vars.jvm_initialize;
  995.          end;
  996.          -- (3) ---------------- Local variable for old/ensure :
  997.          if run_control.ensure_check then
  998.             if ensure_assertion /= Void then
  999.                ensure_assertion.compile_to_jvm_old;
  1000.             end;
  1001.          end;
  1002.          -- (4) ----------------------- Require assertion code :
  1003.          if require_assertion /= Void then
  1004.             require_assertion.compile_to_jvm;
  1005.          end;
  1006.       end;
  1007.  
  1008.    jvm_define_closing is
  1009.       require
  1010.          jvm.current_frame = Current
  1011.       do
  1012.          -- (0) ----------------------------- Class Invariant :
  1013.          -- (1) --------------------------- Ensure Check Code :
  1014.          if run_control.ensure_check then
  1015.             if ensure_assertion /= Void then
  1016.                ensure_assertion.compile_to_jvm(true);
  1017.                code_attribute.opcode_pop;
  1018.             end;
  1019.          end;
  1020.          -- (2) --------------------- Free for local expanded :
  1021.       end;
  1022.  
  1023.    routine_afd_check is
  1024.       do
  1025.          if require_assertion /= Void then
  1026.             require_assertion.afd_check;
  1027.          end;
  1028.          if routine_body /= Void then
  1029.             routine_body.afd_check;
  1030.          end;
  1031.          if rescue_compound /= Void then
  1032.             rescue_compound.afd_check;
  1033.          end;
  1034.          if ensure_assertion /= Void then
  1035.             ensure_assertion.afd_check;
  1036.          end;
  1037.       end;
  1038.  
  1039.    c_initialize_ds_one_by_one is
  1040.       require
  1041.          run_control.no_check
  1042.       do
  1043.          c_code.copy("se_dump_stack ds;%Nds.fd=&");
  1044.          c_frame_descriptor_name_in(c_code);
  1045.          c_code.append(fz_00);
  1046.          if use_current then
  1047.             c_code.append("ds.current=((void**)&C);%N");
  1048.          else
  1049.             c_code.append("ds.current=NULL;%N");
  1050.          end;
  1051.          cpp.put_string(c_code);
  1052.          cpp.put_position_in_ds(start_position);
  1053.          cpp.put_string("ds.caller=caller;%N");
  1054.          if c_frame_descriptor_local_count.value > 0 then
  1055.             cpp.put_string("ds.locals=locals;%N");
  1056.          end;
  1057.       end;
  1058.  
  1059.    c_initialize_locals_one_by_one is
  1060.       require
  1061.          run_control.no_check
  1062.       local
  1063.          i, j: INTEGER;
  1064.          c: CHARACTER;
  1065.       do
  1066.          from
  1067.             j := 1;
  1068.          until
  1069.             c_frame_descriptor_local_count.value = i
  1070.          loop
  1071.             cpp.put_string("locals[");
  1072.             cpp.put_integer(i);
  1073.             cpp.put_string("]=");
  1074.             from
  1075.                c := c_frame_descriptor_locals.item(j);
  1076.             until
  1077.                c = ','
  1078.             loop
  1079.                cpp.put_character(c);
  1080.                j := j + 1;
  1081.                c := c_frame_descriptor_locals.item(j);
  1082.             end;
  1083.             j := j + 1;
  1084.             cpp.put_string(fz_00);
  1085.             i := i + 1;
  1086.          end;
  1087.       end;
  1088.  
  1089.    initialize is
  1090.       deferred
  1091.       end;
  1092.  
  1093.    jvm_result_store is
  1094.          -- Store the pushed Result.
  1095.       require
  1096.          result_type /= Void
  1097.       deferred
  1098.       end;
  1099.  
  1100. invariant
  1101.  
  1102.    current_type /= Void;
  1103.  
  1104.    name /= Void;
  1105.  
  1106.    base_feature /= Void;
  1107.  
  1108. end -- RUN_FEATURE
  1109.  
  1110.