Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
Simulation of CLU iterators. Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
22-Mar-04
Category
Algorithm
Language
Delphi All Versions
Views
586
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
Neumann, Jasper
Reference URL:
			(C) Jasper Neumann, June of 2003

Simulation of CLU iterators for Delphi and Kylix (16 and 32 bit)


*** Motivation

Delegation of extensive loop constructions as one procedure call.
One should not be forced to repeat them again and again.

Simulation of CLU iterators.


*** Application

Loop through containers (lists, trees, parameters, directories, registry, etc.).

"Frame routines", e.g. for locking purposes.


*** Semantic

Principely the iterator (iterator_proc) is called, which on its part calls the
loop body (iterator_body) on each yield.

The loop body and its scope are transferred as hidden parameters
(return_addr, ebp).
To let this work correctly some tricks are necessary resulting in some
restrictions, but they can be circumvented by the formalisms decsribed below.

The iterator communicates with the loop body via reference parameters.


*** Application of an iterator
1   
2   iterator_proc(...);
3   iterate;  while iterating do begin
4     iterator_body;
5     end;


*** Definition of an iterator
6   
7   procedure iterator_proc(...);
8   var
9     i_base: t_iterator_base;
10  procedure sub_iter;
11  begin
12    ...
13    yield(i_base);
14    ...
15    end;
16  begin
17    iterator_start(i_base);
18    sub_iter;
19    iterator_stop(i_base);
20    end;
21  

*** Aborting an iterator
22  
23  try
24    iterator_proc(...);
25    iterate;  while iterating do begin
26      ...
27      if necessary then
28        raise ...;  (* signal break via exception *)
29      ...
30      end;
31  except
32    ...  (* catch the break exception *)
33    end;
34  

It makes sense to circumvent the try..finally construction by setting a
boolean reference variable _break to true:
35  
36  iterator_proc(...,_break);
37  iterate;  while iterating do begin
38    ...
39    if necessary then
40      _break:=true
41    else begin
42      ...
43      end;
44    end;
45  
46  procedure iterator_proc(...; var _break:boolean);
47  var
48    i_base: t_iterator_base;
49  procedure sub_iter;
50  begin
51    _break:=false;
52    ...
53    yield(i_base);
54    if _break then
55      EXIT;
56    ...
57    end;
58  begin
59    iterator_start(i_base);
60    sub_iter;
61    iterator_stop(i_base);
62    end;
63  

*** Remarks

1. The iterator (iterator_proc) must be a procedure or method.

2. Calling convention of the iterator <> cdecl.

3. Iterators must be FAR (this is always the case in 32-bit-code).

4. It is forbidden to have parameters that must be copied by preamble of the
   iterator (string/set/object/record/array), they must therefore be transferred
   via reference (const) (ebx, esi, edi must be preserved by the iterator
   preamble).

5. Exceptions from the loop body must not be ignored by the iterator, because
   otherwise the register variables of the loop body (and the surrounding code)
   will possibly be destroyed.

6. An iterator loop may only be aborted with an exception but never with
   GOTO/EXIT/BREAK.

7. Constant referenz parameter which will be read after yield by the iterator
   (e.g. strings) should be copied first into local copies by sub_iter because
   they might become invalid after the yield (e.g. when calling with string
   expressions).

8. The iterator should obey strongly the formalism mentioned above, that means
   all actions should occur in sub_iter.

9. The compiler option $w+ (Stack frames on) should be set globally
   (the addressing in the loop body must not be esc relative).


- You may apply iterators recursively, i.e. you may nest iterator loops.
  sub_iter may call itself directly or indirectly.
  Iterators may use iterators; the yield may be executed in other procedures.


- The traditional way (e.g. C++ STL) uses an object with up to 6 methods
  (create, init, eof, value, step, free); in contrast to this with our solution
  you cannot run two iterators simultaneously (in one thread) to e.g. compare
  two lists but it is much easier to make the program correct.
  No space on the heap is necessary.

- Since Delphi does not support local procedures (iterator_body) as parameters
  at all or incompletely (no scope), this implementation could not be chosen.
  By the way: In qgrids.pas the method TSparsePointerArray.ForAll and in
  TVision's TCollection.ForEach and TCollection.FirstThat such iterators were
  already simulated, however there were severe limitations in application.


*** Example (result: '1 2 3 4 7 8 9 10 ')
64  
65  (*$w+*)
66  uses
67    iterator;
68  
69  type
70    tn_set=byte;
71    tsn_set=set of tn_set;
72  
73  procedure for_in(var i:byte; const s:tsn_set);  FAR;  (* => 3., 4. *)
74  var
75    i_base: t_iterator_base;
76  procedure sub_iter;
77  var
78    j: tn_set;
79    ss: tsn_set;
80  begin
81    ss:=s;  (* Local copy, => 7. *)
82    for j:=0 to 255 do begin
83      if j in ss then begin
84        i:=j;
85        YIELD(i_base);
86      end;
87    end;
88  end;
89  begin  (* for_in *)
90    iterator_start(i_base);
91    sub_iter;
92    iterator_stop(i_base);
93  end;
94  
95  var
96    q: tn_set;
97  begin
98    for_in(q, [1..3, 7..10]);
99    ITERATE;  while ITERATING do begin
100     write(q,' ');
101   end;
102 end.


*** References
http://www.home.unix-ag.org/tjabo/ruby/uguide/uguide08.html
http://webster.cs.ucr.edu/Page_asm/ArtofAssembly/CH12/CH12-6.html
c't 1994/10, page 244

*** License
Hereby I grant these programming sniplets to the public domain.
Of course I cannot take any responsibility for it.
If need be, send me hints, questions, or remarks.

Please send me a nice postcard if you could make any use of it.
Thanks a lot!

_-jane-_@web.de

Jasper Neumann
Schoenauer Friede 78
D-52072 Aachen
Germany

****************************** CODE MAIN UNIT **********************
103 
104 (*$ifdef ver80 *)
105   (*$define _16 *)  (* 16 bit Delphi *)
106 (*$else *)
107   (*$define _32 *)  (* 32 bit Delphi *)
108   (*$w+*)  (* Generate stack frame (necessary for iterators) *)
109 (*$endif *)
110 
111 (* (C) Jasper Neumann *)
112 (* Simulation of iterators as in the programming language CLU *)
113 
114 unit iterator;
115 
116 interface
117 
118 (*$ifdef _16 *)
119 type
120   t_iterator_base=record
121     _bp: word;
122     _call: pointer;
123     end;
124 (*$else *)
125 type
126   t_iterator_base=record
127     _ebx: longint;
128     _esi: longint;
129     _edi: longint;
130     _ebp: longint;
131     _call: pointer;
132     end;
133 (*$endif *)
134 
135 procedure iterate;
136 (*$ifdef _16 *)
137 inline(
138    $b0/$00  (* mov    al,false *)
139   /$eb/$03  (* jmp    short goon *)
140   );
141 (*$endif *)
142 
143 function iterating:boolean;
144 (*$ifdef _16 *)
145 inline(
146    $cb      (*       retf *)
147   /$b0/$01  (* loop: mov    al,true *)
148   );        (* goon: *)
149 (*$endif *)
150 procedure iterator_start(var base:t_iterator_base);
151 
152 (*$ifdef _16 *)
153 inline(
154    $5F              (* pop di *)
155   /$07              (* pop es *)
156   /$8b/$5E/$00      (* mov bx,[bp] // org bp *)
157   /$26/$89/$1D      (* mov es:[di+t_iterator_base._bp],bx *)
158   /$8b/$5E/$02      (* mov bx,[bp+02] // ret-adr ofs *)
159   /$83/$C3/$05      (* add bx,5 // Einspringpunkt *)
160   /$26/$89/$5D/$02  (* mov word ptr es:[di+t_iterator_base._call],bx *)
161   /$8b/$5E/$04      (* mov bx,[bp+04] // ret-adr seg *)
162   /$26/$89/$5D/$04  (* mov word ptr es:[di+t_iterator_base._call+2],bx *)
163   );
164 (*$endif *)
165 
166 procedure iterator_stop(const base:t_iterator_base);
167 (*$ifdef _16 *)
168 inline(
169   (* kill argument *)
170    $5B  (* pop bx *)
171   /$07  (* pop es *)
172    );
173 (*$endif *)
174 
175 procedure YIELD(const base:t_iterator_base);
176 (*$ifdef _16 *)
177 inline(
178    $5B              (* pop    bx *)
179   /$07              (* pop    es *)
180   /$55              (* push   bp *)
181   /$26/$8b/$2f      (* mov    bp,es:[bx+t_iterator_base._bp] *)
182   /$26/$ff/$5f/$02  (* call   far es:[bx+t_iterator_base._call] *)
183   /$5D              (* pop    bp *)
184   );
185 (*$endif *)
186 
187 implementation
188 
189 (*$ifdef _32 *)
190 
191 const
192   mask_near_jmp=$fffc0000;  (* mask for maximum near jmp *)
193 
194 procedure raise_tch(p:pointer);
195 begin
196   asm int 3 end;
197   (* This must not happen! *)
198   (* Raise an exception here if you want to: Illegal code at p *)
199   end;


200 
201 procedure iterate;
202 { assembler; }
203 asm
204   pop   eax                     (* Fetch return address *)
205   mov   dl,[eax]
206   mov   ecx,[eax+1]
207   cmp   dl,$eb                  (* Jmp short? *)
208   je    @@short
209   cmp   dl,$e9                  (* Jmp near? *)
210   je    @@near
211   cmp   dl,$e8                  (* Call iterating? *)
212   je    @@call
213   cmp   dl,$cc                  (* Breakpoint? *)
214   je    @@break
215   call  RAISE_TCH               (* No? This MUST NOT happen! *)
216 
217 @@sleuth_err:
218   call  RAISE_TCH
219 
220 @@break:                        (* A breakpoint detected... *)
221   int   3                       (* ...let us step through. *)
222   mov   edx,ecx
223   add   edx,eax
224   cmp   edx,offset iterating-5
225   je    @@call1                 (* Probably call *)
226   mov   edx,ecx
227   and   edx,mask_near_jmp
228   jz    @@near                  (* Probably near *)
229   jmp   @@short                 (* No? Ought to be short *)
230 
231 @@call:
232   mov   edx,ecx
233   add   edx,eax
234   cmp   edx,offset iterating-5
235   je    @@call1
236   call  RAISE_TCH               (* No JMP? This MUST NOT happen! *)
237 @@call1:
238   add   eax,5                   (* Skip the JMP near *)
239   jmp   @@go_on
240 
241 @@near:
242   lea   eax,[eax+ecx+5+5]       (* Skip the JMP near and the call of iterate *)
243   jmp   @@go_on
244 
245 @@short:
246   movsx ecx,cl
247   lea   eax,[eax+ecx+2+5]       (* Skip the JMP short and the call of iterate *)
248 @@go_on:
249 
250   (* Sleuth fixup :*)
251   cmp   byte ptr [eax-5],$9c    (* Sleuth? *)
252   jne   @@normal
253   cmp   word ptr [eax-5+1],$be60
254   jne   @@sleuth_err
255   cmp   word ptr [eax-5+7],$15ff
256   jne   @@sleuth_err
257   cmp   word ptr [eax-5+13],$9D61
258   jne   @@sleuth_err
259   add   eax,15
260 @@normal:
261 
262   push  eax
263   mov   al,false                (* Yield false to while *)
264   end;
265 
266 function iterating:boolean;
267 { assembler; }
268 asm
269   pop   eax             (* Pop the return address and return to YIELD *)
270   end;
271 
272 procedure iterator_start(var base:t_iterator_base);
273 (* eax: @base *)
274 asm
275   mov   edx,[ebp]               (* Fetch saved ebp of iterator *)
276   mov   [eax].t_iterator_base._ebx,ebx
277   mov   [eax].t_iterator_base._esi,esi
278   mov   [eax].t_iterator_base._edi,edi
279   mov   [eax].t_iterator_base._ebp,edx
280   mov   edx,[ebp+4]  (* Fetch return address of iterator *)
281                      (* Stack frames are needed for the iterator ($w+ !) *)
282   (* Sleuth fixup :*)
283   cmp   byte ptr [edx],$9c      (* Sleuth? *)
284   jne   @@normal
285   cmp   word ptr [edx+1],$be60
286   jne   @@sleuth_err
287   cmp   word ptr [edx+7],$15ff
288   jne   @@sleuth_err
289   cmp   word ptr [edx+13],$9D61
290   jne   @@sleuth_err
291   add   edx,15
292 
293 @@normal:
294   add   edx,5                   (* Skip the call of iterate *)
295   mov   cl,[edx]
296   cmp   cl,$eb                  (* Jmp short? *)
297   je    @@short
298   cmp   cl,$e9                  (* Jmp dword? *)
299   je    @@near
300   cmp   cl,$e8                  (* Call iterating? *)
301   je    @@call
302   cmp   cl,$cc                  (* Breakpoint? *)
303   je    @@break
304   mov   eax,edx
305   call  RAISE_TCH               (* No? This MUST NOT happen! *)
306 
307 @@sleuth_err:
308   mov   eax,edx
309   call  RAISE_TCH
310 
311 @@break:                        (* A breakpoint detected... *)
312   int   3                       (* ...let us step through. *)
313   mov   ecx,[edx+1]
314   add   ecx,edx
315   cmp   ecx,offset iterating-5
316   je    @@go_on                 (* Probably call *)
317   mov   ecx,[edx+1]
318   and   ecx,mask_near_jmp
319   jz    @@near                  (* Probably near *)
320   jmp   @@short                 (* No? Ought to be short *)
321 
322 @@call:
323   mov   ecx,[edx+1]
324   add   ecx,edx
325   cmp   ecx,offset iterating-5
326   je    @@go_on
327   mov   eax,edx
328   call  RAISE_TCH               (* No JMP? This MUST NOT happen! *)
329 
330 @@near:
331   add   edx,3                   (* Skip the JMP near (+2) *)
332 @@short:
333   add   edx,2                   (* Skip the JMP short *)
334 @@go_on:
335   mov   [eax].t_iterator_base._call,edx
336   end;
337 
338 procedure iterator_stop(const base:t_iterator_base);
339 (* eax: @base *)
340 asm
341   mov   ebx,[eax].t_iterator_base._ebx
342   mov   esi,[eax].t_iterator_base._esi
343   mov   edi,[eax].t_iterator_base._edi
344 {   mov   ebp,[eax].t_iterator_base._ebp }
345   end;
346 
347 procedure YIELD(const base:t_iterator_base);
348 (* eax: @base *)
349 asm
350   push  ebx
351   push  esi
352   push  edi
353   push  ebp
354   mov   ebx,[eax].t_iterator_base._ebx
355   mov   esi,[eax].t_iterator_base._esi
356   mov   edi,[eax].t_iterator_base._edi
357   mov   ebp,[eax].t_iterator_base._ebp
358   push  eax
359   call  [eax].t_iterator_base._call
360   pop   eax
361   mov   [eax].t_iterator_base._edi,edi
362   mov   [eax].t_iterator_base._esi,esi
363   mov   [eax].t_iterator_base._ebx,ebx
364   pop   ebp
365   pop   edi
366   pop   esi
367   pop   ebx
368   end;
369 
370 (*$endif *)
371 
372 end.


************************* Sample Program ******************************
373 
374 (*$ifdef ver80 *)
375   (*$define _16 *)  (* 16 bit Delphi *)
376 (*$else *)
377   (*$define _32 *)  (* 32 bit Delphi *)
378   (*$w+*)     (* Generate stack frame (necessary for iterators) *)
379 (*$endif *)
380 
381 (* (C) Jasper Neumann *)
382 
383 program itertest;
384 (* Example: Meet all members of a set (resulting in 1 2 3 7 8 9 10 ) *)
385 
386 uses
387   iterator;
388 
389 type
390   tn_set=byte;
391   tsn_set=set of tn_set;
392 
393 procedure for_in(var i:tn_set; const s:tsn_set);  FAR;
394 var
395   i_base: t_iterator_base;  (* No other variables here *)
396 
397 procedure sub_iter;
398 (* All the iterator stuff is managed here *)
399 var
400   j: tn_set;
401   ss: tsn_set;
402 begin
403   (* Be sure that all const ref parameters get their local copy *)
404   (* if they are used after YIELD! *)
405   ss:=s;
406   for j:=low(tn_set) to high(tn_set) do begin
407     if j in ss then begin
408       i:=j;
409       YIELD(i_base);
410     end;
411   end;
412 end;
413 
414 begin
415   (* Every iterator should look like this; no further action here! *)
416   iterator_start(i_base);
417   sub_iter;
418   iterator_stop(i_base);
419 end;
420 
421 var
422   q: tn_set;
423 begin
424   for_in(q, [1..5, 7..10]);
425   ITERATE;  while ITERATING do begin
426     SYSTEM.write(q,' ');
427   end;
428 end.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC