Return to loops.fs CVS log

Up to [gforth] / gforth / compat

Environmental query "gforth" now returns the version-string
dictionary-end and unused moved into the kernel/basics.fs
Minor gforth.el bug fixes
Major rewrite of objects.fs (not yet done)
fixed -trailing bug (with test in test/other.fs)
optimization of fields with offset 0 in struct.fs and compat/struct.fs
other changes in compat/struct.fs (not yet done)
added ansreports to compat/*.fs
documentation changes
allot now checks for dict overflow
named [IS] (compilation semantics of IS).
minor changes

    1: \ +DO, -DO...-LOOP and friends
    2: 
    3: \ This file is in the public domain. NO WARRANTY.
    4: 
    5: \ Hmm, this would be a good application for ]] ... [[
    6: 
    7: \ The program uses the following words
    8: \ from CORE :
    9: \ : POSTPONE over min ; immediate 2dup IF swap THEN drop negate +LOOP
   10: \ ELSE 2drop < 1+ DO u<
   11: \ from CORE-EXT :
   12: \ ?DO u> 
   13: \ from BLOCK-EXT :
   14: \ \ 
   15: \ from FILE :
   16: \ ( 
   17: 
   18: : +DO ( compile-time: -- do-sys; run-time: n1 n2 -- )
   19:     POSTPONE over POSTPONE min POSTPONE ?do ; immediate
   20: 
   21: : umin ( u1 u2 -- u )
   22:     2dup u>
   23:     IF
   24: 	swap
   25:     THEN
   26:     drop ;
   27: 
   28: : U+DO ( compile-time: -- do-sys; run-time: u1 u2 -- )
   29:     POSTPONE over POSTPONE umin POSTPONE ?do ; immediate
   30: 
   31: \ -DO...-LOOP
   32: 
   33: \ You have to use the -LOOP implemented below with -DO or U-DO, you
   34: \ cannot use it with ?DO
   35: 
   36: \ The implementation is a little more complicated. Basically, we
   37: \ create an IF DO ... +LOOP THEN structure. The DO..+LOOP does not
   38: \ exhibit the anomaly of ?DO...+LOOP; the IF..THEN is needed to
   39: \ correct for DO's at-least-once semantics. The parameters are
   40: \ conditioned a bit such that the result is as expected.
   41: 
   42: \ I define a '-do-sys' (whose implementation is 'orig do-sys'). Like
   43: \ ANS Forth loop structures, this implementation of -DO..-LOOP
   44: \ cannot be mixed with any other structures.
   45: 
   46: \ unlike Gforth's -LOOP, this implementation cannot handle all
   47: \ unsigned increments, only positive integers
   48: : -LOOP ( compilation -do-sys -- ; run-time loop-sys1 +n -- | loop-sys2 )
   49:     POSTPONE negate POSTPONE +loop
   50:     POSTPONE else POSTPONE 2drop POSTPONE then ; immediate
   51: 
   52: : -DO ( compilation -- -do-sys ; run-time n1 n2 -- | loop-sys )
   53:     POSTPONE 2dup POSTPONE < POSTPONE if
   54:     POSTPONE swap POSTPONE 1+ POSTPONE swap POSTPONE do ; immediate
   55: 
   56: : U-DO ( compilation -- -do-sys ; run-time u1 u2 -- | loop-sys )
   57:     POSTPONE 2dup POSTPONE u< POSTPONE if
   58:     POSTPONE swap POSTPONE 1+ POSTPONE swap POSTPONE do ; immediate