/[eiffelstudio]/FreeELKS/trunk/library/kernel/routine.e
ViewVC logotype

Contents of /FreeELKS/trunk/library/kernel/routine.e

Parent Directory Parent Directory | Revision Log Revision Log


Revision 91424 - (show annotations)
Tue Oct 26 18:39:32 2004 UTC (15 years, 2 months ago) by manus_eiffel
File size: 13264 byte(s)
Initial revision

1 indexing
2
3 description: "[
4 Objects representing delayed calls to a routine,
5 with some operands possibly still open
6 ]"
7
8 status: "See notice at end of class"
9 date: "$Date$"
10 revision: "$Revision$"
11
12 deferred class
13 ROUTINE [BASE_TYPE, OPEN_ARGS -> TUPLE create default_create end]
14
15 inherit
16 HASHABLE
17 redefine
18 copy,
19 is_equal
20 end
21
22 feature -- Initialization
23
24 adapt (other: like Current) is
25 -- Initialize from `other'.
26 -- Useful in descendants.
27 require
28 other_exists: other /= Void
29 conforming: conforms_to (other)
30 do
31 internal_operands := other.internal_operands
32 open_map := other.open_map
33 rout_disp := other.rout_disp
34 eiffel_rout_disp := other.eiffel_rout_disp
35 is_cleanup_needed := other.is_cleanup_needed
36 ensure
37 same_call_status: other.callable implies callable
38 end
39
40 feature -- Access
41
42 operands: OPEN_ARGS is
43 -- Open operands.
44 local
45 i, nb: INTEGER
46 l_open_map: like open_map
47 do
48 l_open_map := open_map
49 if l_open_map /= Void then
50 from
51 create Result
52 i := 0
53 nb := l_open_map.count - 1
54 until
55 i > nb
56 loop
57 Result.put (internal_operands.item (l_open_map.item (i)), i + 1)
58 i := i + 1
59 end
60 end
61 end
62
63 target: ANY is
64 -- Target of call.
65 do
66 Result := internal_operands.item (1)
67 end
68
69 hash_code: INTEGER is
70 -- Hash code value.
71 do
72 Result := rout_disp.hash_code
73 end
74
75 precondition (args: like operands): BOOLEAN is
76 -- Do `args' satisfy routine's precondition
77 -- in current state?
78 do
79 Result := True
80 --| FIXME compiler support needed!
81 end
82
83 postcondition (args: like operands): BOOLEAN is
84 -- Does current state satisfy routine's
85 -- postcondition for `args'?
86 do
87 Result := True
88 --| FIXME compiler support needed!
89 end
90
91 feature -- Status report
92
93 callable: BOOLEAN is
94 -- Can routine be called on current object?
95 local
96 null_ptr: POINTER
97 do
98 Result := (rout_disp /= null_ptr)
99 end
100
101 is_equal (other: like Current): BOOLEAN is
102 -- Is associated routine the same as the one
103 -- associated with `other'.
104 do
105 --| Do not compare implementation data
106 Result := equal (internal_operands, other.internal_operands)
107 and then equal (open_map, other.open_map)
108 and then (rout_disp = other.rout_disp)
109 and then (eiffel_rout_disp = other.eiffel_rout_disp)
110 and then (is_cleanup_needed = other.is_cleanup_needed)
111 end
112
113 valid_operands (args: OPEN_ARGS): BOOLEAN is
114 -- Are `args' valid operands for this routine?
115 local
116 i: INTEGER
117 mismatch: BOOLEAN
118 arg: ANY
119 arg_type_code: INTEGER_8
120 open_arg_type_code: INTEGER
121 a_boolean_ref: BOOLEAN_REF
122 a_character_ref: CHARACTER_REF
123 a_double_ref: DOUBLE_REF
124 an_integer_ref: INTEGER_REF
125 an_integer_8_ref: INTEGER_8_REF
126 an_integer_16_ref: INTEGER_16_REF
127 an_integer_64_ref: INTEGER_64_REF
128 a_pointer_ref: POINTER_REF
129 a_real_ref: REAL_REF
130 int: INTERNAL
131 open_type_codes: STRING
132 do
133 create int
134 open_type_codes := eif_gen_typecode_str ($Current)
135 if args = Void or open_map = Void then
136 -- Void operands are only allowed
137 -- if object has no open operands.
138 Result := (open_map = Void)
139 elseif open_map /= Void and then int.generic_count (args) >= open_map.count then
140 from
141 i := 1
142 until
143 i > open_map.count or mismatch
144 loop
145 arg := args.item (i)
146 arg_type_code := args.arg_item_code (i)
147 open_arg_type_code := open_type_codes.item (i + 1).code
148 if arg_type_code = feature {TUPLE}.reference_code then
149 inspect open_arg_type_code
150 when feature {TUPLE}.boolean_code then
151 a_boolean_ref ?= arg
152 mismatch := a_boolean_ref = Void
153 when feature {TUPLE}.character_code then
154 a_character_ref ?= arg
155 mismatch := a_character_ref = Void
156 when feature {TUPLE}.double_code then
157 a_double_ref ?= arg
158 mismatch := a_double_ref = Void
159 when feature {TUPLE}.integer_64_code then
160 an_integer_64_ref ?= arg
161 an_integer_ref ?= arg
162 an_integer_16_ref ?= arg
163 an_integer_8_ref ?= arg
164 mismatch := an_integer_64_ref = Void and then an_integer_ref = Void
165 and then an_integer_16_ref = Void and then an_integer_8_ref = Void
166 when feature {TUPLE}.integer_32_code then
167 an_integer_ref ?= arg
168 an_integer_16_ref ?= arg
169 an_integer_8_ref ?= arg
170 mismatch := an_integer_ref = Void and then
171 an_integer_16_ref = Void and then an_integer_8_ref = Void
172 when feature {TUPLE}.integer_16_code then
173 an_integer_16_ref ?= arg
174 an_integer_8_ref ?= arg
175 mismatch := an_integer_16_ref = Void and then an_integer_8_ref = Void
176 when feature {TUPLE}.integer_8_code then
177 an_integer_8_ref ?= arg
178 mismatch := an_integer_8_ref = Void
179 when feature {TUPLE}.pointer_code then
180 a_pointer_ref ?= arg
181 mismatch := a_pointer_ref = Void
182 when feature {TUPLE}.real_code then
183 a_real_ref ?= arg
184 mismatch := a_real_ref = Void
185 when feature {TUPLE}.reference_code then
186 if arg /= Void and then not int.type_conforms_to (
187 int.dynamic_type (arg),
188 open_operand_type (i))
189 then
190 mismatch := True
191 end
192 else
193 -- Must be NONE open type
194 mismatch := arg /= Void
195 end
196 else
197 if arg_type_code /= open_arg_type_code then
198 inspect
199 open_arg_type_code
200 when feature {TUPLE}.integer_64_code then
201 mismatch :=
202 arg_type_code /= feature {TUPLE}.integer_32_code and then
203 arg_type_code /= feature {TUPLE}.integer_16_code and then
204 arg_type_code /= feature {TUPLE}.integer_8_code
205 when feature {TUPLE}.integer_32_code then
206 mismatch :=
207 arg_type_code /= feature {TUPLE}.integer_16_code and then
208 arg_type_code /= feature {TUPLE}.integer_8_code
209 when feature {TUPLE}.integer_16_code then
210 mismatch := arg_type_code /= feature {TUPLE}.integer_8_code
211 when feature {TUPLE}.integer_8_code then
212 -- As seen in above if statement, `arg_type_code' is not
213 -- equal to `open_arg_type_code'.
214 mismatch := True
215 else
216 mismatch :=
217 (open_arg_type_code = feature {TUPLE}.reference_code implies
218 open_operand_type (i) > 0)
219 end
220 end
221 end
222 i := i + 1
223 end
224 Result := not mismatch
225 end
226 end
227
228 feature -- Measurement
229
230 open_count: INTEGER is
231 -- Number of open operands.
232 do
233 if open_map /= Void then
234 Result := open_map.count
235 end
236 end
237
238 feature -- Settings
239
240 frozen set_operands (args: OPEN_ARGS) is
241 -- Use `args' as operands for next call.
242 require
243 valid_operands: valid_operands (args)
244 local
245 i, nb: INTEGER
246 l_open_map: like open_map
247 l_internal: like internal_operands
248 do
249 l_open_map := open_map
250 if l_open_map /= Void then
251 from
252 i := 0
253 nb := l_open_map.count - 1
254 l_internal := internal_operands
255 until
256 i > nb
257 loop
258 rout_tuple_item_copy ($l_internal, l_open_map.item (i), $args, i + 1)
259 i := i + 1
260 end
261 end
262 ensure
263 operands_set: (operands /= Void implies equal (operands, args)) or
264 (operands = Void implies (args = Void or else args.is_empty))
265 end
266
267 feature -- Duplication
268
269 copy (other: like Current) is
270 -- Use same routine as `other'.
271 do
272 internal_operands := other.internal_operands
273 open_map := other.open_map
274 rout_disp := other.rout_disp
275 eiffel_rout_disp := other.eiffel_rout_disp
276 is_cleanup_needed := other.is_cleanup_needed
277 ensure then
278 same_call_status: other.callable implies callable
279 end
280
281 feature -- Basic operations
282
283 call (args: OPEN_ARGS) is
284 -- Call routine with operands `args'.
285 require
286 valid_operands: valid_operands (args)
287 callable: callable
288 do
289 set_operands (args)
290 apply
291 if is_cleanup_needed then
292 remove_gc_reference
293 end
294 end
295
296 apply is
297 -- Call routine with `args' as last set.
298 require
299 valid_operands: valid_operands (operands)
300 callable: callable
301 deferred
302 end
303
304 feature -- Obsolete
305
306 adapt_from (other: like Current) is
307 -- Adapt from `other'. Useful in descendants.
308 obsolete
309 "Please use `adapt' instead (it's also a creation procedure)"
310 require
311 other_exists: other /= Void
312 conforming: conforms_to (other)
313 do
314 adapt (other)
315 ensure
316 same_call_status: other.callable implies callable
317 end
318
319 feature {ROUTINE, E_FEATURE} -- Implementation
320
321 frozen internal_operands: TUPLE
322 -- All open and closed arguments provided at creation time
323
324 frozen open_map: SPECIAL [INTEGER]
325 -- Index map for open arguments
326
327 frozen rout_disp: POINTER
328 -- Routine dispatcher
329
330 frozen eiffel_rout_disp: POINTER
331 -- Eiffel routine dispatcher
332
333 frozen is_cleanup_needed: BOOLEAN
334 -- If open arguments contain some references, we need
335 -- to clean them up after call.
336
337 frozen set_rout_disp (p: POINTER; tp: POINTER; args: TUPLE;
338 omap: ARRAY [INTEGER]) is
339 -- Initialize object.
340 require
341 p_not_void: p /= Default_pointer
342 tp_not_void: tp /= Default_pointer
343 args_not_void: args /= Void
344 do
345 rout_disp := p
346 eiffel_rout_disp := tp
347 internal_operands := args
348 if omap /= Void then
349 open_map := omap.area
350 else
351 open_map := Void
352 end
353 compute_is_cleanup_needed
354 ensure
355 rout_disp_set: rout_disp = p
356 eiffel_rout_disp_set: eiffel_rout_disp = tp
357 internal_operands_set: internal_operands = args
358 open_map_set: (omap = Void and open_map = Void) or
359 (omap /= Void and then open_map = omap.area)
360 end
361
362 feature {NONE} -- Implementation
363
364 frozen open_types: ARRAY [INTEGER]
365 -- Types of open operands
366
367 frozen remove_gc_reference is
368 -- Remove all references from `internal_operands' so that GC
369 -- can collect them if necessary.
370 require
371 is_cleanup_needed: is_cleanup_needed
372 has_open_operands: open_map /= Void
373 local
374 l_open_map: like open_map
375 i, nb, l_pos: INTEGER
376 l_internal: like internal_operands
377 do
378 l_open_map := open_map
379 from
380 i := 0
381 nb := l_open_map.count - 1
382 l_internal := internal_operands
383 until
384 i > nb
385 loop
386 l_pos := l_open_map.item (i)
387 -- We only need to clean up references so that GC
388 -- can collect them if necessary.
389 if l_internal.is_reference_item (l_pos) then
390 l_internal.put_reference (Void, l_pos)
391 end
392 i := i + 1
393 end
394 end
395
396 frozen compute_is_cleanup_needed is
397 -- Set `is_cleanup_needed' to True if some open arguments are references.
398 local
399 l_open_map: like open_map
400 i, nb, l_pos: INTEGER
401 l_internal: like internal_operands
402 do
403 is_cleanup_needed := False
404 l_open_map := open_map
405 if l_open_map /= Void then
406 from
407 i := 0
408 nb := l_open_map.count - 1
409 l_internal := internal_operands
410 until
411 i > nb or is_cleanup_needed
412 loop
413 l_pos := l_open_map.item (i)
414 -- We only need to clean up references so that GC
415 -- can collect them if necessary.
416 is_cleanup_needed := l_internal.is_reference_item (l_pos)
417 i := i + 1
418 end
419 end
420 end
421
422 open_operand_type (i: INTEGER): INTEGER is
423 -- Type of `i'th open operand.
424 require
425 positive: i >= 1
426 within_bounds: i <= open_count
427 local
428 l_internal: INTERNAL
429 do
430 if open_types = Void then
431 create open_types.make (1, open_map.count)
432 end
433 Result := open_types.item (i)
434 if Result = 0 then
435 create l_internal
436 Result := l_internal.generic_dynamic_type_of_type (
437 l_internal.generic_dynamic_type (Current, 2), i)
438 open_types.force (Result, i)
439 end
440 end
441
442 feature {NONE} -- Externals
443
444 rout_tuple_item_copy (a_target: POINTER; a_target_pos: INTEGER; a_source: POINTER; a_source_pos: INTEGER) is
445 -- Copy tuple element at position `a_source_pos' in `a_source' to position
446 -- `a_target_pos' in `a_target'.
447 external
448 "C macro use %"eif_rout_obj.h%""
449 end
450
451 eif_gen_typecode_str (obj: POINTER): STRING is
452 -- Code name for generic parameter `pos' in `obj'.
453 external
454 "C signature (EIF_REFERENCE): EIF_REFERENCE use %"eif_gen_conf.h%""
455 end
456
457 feature -- Obsolete
458
459 arguments: OPEN_ARGS is
460 obsolete
461 "use operands"
462 do
463 Result := operands
464 end
465
466 set_arguments (args: OPEN_ARGS) is
467 obsolete
468 "use set_operands"
469 do
470 set_operands (args)
471 end
472
473 valid_arguments (args: OPEN_ARGS): BOOLEAN is
474 obsolete
475 "use valid_operands"
476 do
477 Result := valid_operands (args)
478 end
479
480 indexing
481
482 library: "[
483 EiffelBase: Library of reusable components for Eiffel.
484 ]"
485
486 status: "[
487 Copyright 1986-2001 Interactive Software Engineering (ISE).
488 For ISE customers the original versions are an ISE product
489 covered by the ISE Eiffel license and support agreements.
490 ]"
491
492 license: "[
493 EiffelBase may now be used by anyone as FREE SOFTWARE to
494 develop any product, public-domain or commercial, without
495 payment to ISE, under the terms of the ISE Free Eiffel Library
496 License (IFELL) at http://eiffel.com/products/base/license.html.
497 ]"
498
499 source: "[
500 Interactive Software Engineering Inc.
501 ISE Building
502 360 Storke Road, Goleta, CA 93117 USA
503 Telephone 805-685-1006, Fax 805-685-6869
504 Electronic mail <info@eiffel.com>
505 Customer support http://support.eiffel.com
506 ]"
507
508 info: "[
509 For latest info see award-winning pages: http://eiffel.com
510 ]"
511
512 end -- class ROUTINE
513

Properties

Name Value
svn:eol-style native
svn:keywords Author Date Id Revision

  ViewVC Help
Powered by ViewVC 1.1.23