[BACK]Return to cond.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / kernel

Diff for /gforth/kernel/cond.fs between versions 1.12 and 1.13

version 1.12, 2002/02/04 21:25:18 version 1.13, 2002/09/24 17:57:29
Line 110  variable backedge-locals Line 110  variable backedge-locals
 : >mark ( -- orig )  : >mark ( -- orig )
  cs-push-orig 0 , ;   cs-push-orig 0 , ;
 : >resolve    ( addr -- )  : >resolve    ( addr -- )
     here over - swap !      here swap !
     basic-block-end ;      basic-block-end ;
 : <resolve    ( addr -- )        here - , ;  : <resolve    ( addr -- )        , ;
   
 : BUT  : BUT
     1 cs-roll ;                      immediate restrict      1 cs-roll ;                      immediate restrict
Line 122  variable backedge-locals Line 122  variable backedge-locals
 \ Structural Conditionals                              12dec92py  \ Structural Conditionals                              12dec92py
   
 : AHEAD ( compilation -- orig ; run-time -- ) \ tools-ext  : AHEAD ( compilation -- orig ; run-time -- ) \ tools-ext
     POSTPONE branch  >mark  POSTPONE unreachable ; immediate restrict      POSTPONE abranch  >mark  POSTPONE unreachable ; immediate restrict
   
 : IF ( compilation -- orig ; run-time f -- ) \ core  : IF ( compilation -- orig ; run-time f -- ) \ core
  POSTPONE ?branch >mark ; immediate restrict   POSTPONE a?branch >mark ; immediate restrict
   
 : ?DUP-IF ( compilation -- orig ; run-time n -- n| ) \ gforth   question-dupe-if  : ?DUP-IF ( compilation -- orig ; run-time n -- n| ) \ gforth   question-dupe-if
 \G This is the preferred alternative to the idiom "@code{?DUP IF}", since it can be  \G This is the preferred alternative to the idiom "@code{?DUP IF}", since it can be
 \G better handled by tools like stack checkers. Besides, it's faster.  \G better handled by tools like stack checkers. Besides, it's faster.
     POSTPONE ?dup-?branch >mark ;       immediate restrict      POSTPONE a?dup-?branch >mark ;       immediate restrict
   
 : ?DUP-0=-IF ( compilation -- orig ; run-time n -- n| ) \ gforth        question-dupe-zero-equals-if  : ?DUP-0=-IF ( compilation -- orig ; run-time n -- n| ) \ gforth        question-dupe-zero-equals-if
     POSTPONE ?dup-0=-?branch >mark ;       immediate restrict      POSTPONE a?dup-0=-?branch >mark ;       immediate restrict
   
 Defer then-like ( orig -- )  Defer then-like ( orig -- )
 : cs>addr ( orig/dest -- )  drop >resolve drop ;  : cs>addr ( orig/dest -- )  drop >resolve drop ;
Line 164  Defer again-like ( dest -- addr ) Line 164  Defer again-like ( dest -- addr )
 ' nip IS again-like  ' nip IS again-like
   
 : AGAIN ( compilation dest -- ; run-time -- ) \ core-ext  : AGAIN ( compilation dest -- ; run-time -- ) \ core-ext
     dest? again-like  POSTPONE branch  <resolve ; immediate restrict      dest? again-like  POSTPONE abranch  <resolve ; immediate restrict
   
 Defer until-like ( list addr xt1 xt2 -- )  Defer until-like ( list addr xt1 xt2 -- )
 :noname ( list addr xt1 xt2 -- )  :noname ( list addr xt1 xt2 -- )
Line 172  Defer until-like ( list addr xt1 xt2 -- Line 172  Defer until-like ( list addr xt1 xt2 --
 IS until-like  IS until-like
   
 : UNTIL ( compilation dest -- ; run-time f -- ) \ core  : UNTIL ( compilation dest -- ; run-time f -- ) \ core
     dest? ['] ?branch ['] ?branch-lp+!# until-like ; immediate restrict      dest? ['] a?branch ['] a?branch-lp+!# until-like ; immediate restrict
   
 : WHILE ( compilation dest -- orig dest ; run-time f -- ) \ core  : WHILE ( compilation dest -- orig dest ; run-time f -- ) \ core
     POSTPONE if      POSTPONE if
Line 251  Avariable leave-sp  leave-stack 3 cells Line 251  Avariable leave-sp  leave-stack 3 cells
     POSTPONE begin drop do-dest ;      POSTPONE begin drop do-dest ;
   
 : ?DO ( compilation -- do-sys ; run-time w1 w2 -- | loop-sys )  \ core-ext      question-do  : ?DO ( compilation -- do-sys ; run-time w1 w2 -- | loop-sys )  \ core-ext      question-do
     POSTPONE (?do) ?do-like ; immediate restrict      POSTPONE a(?do) ?do-like ; immediate restrict
   
 : +DO ( compilation -- do-sys ; run-time n1 n2 -- | loop-sys )  \ gforth        plus-do  : +DO ( compilation -- do-sys ; run-time n1 n2 -- | loop-sys )  \ gforth        plus-do
     POSTPONE (+do) ?do-like ; immediate restrict      POSTPONE a(+do) ?do-like ; immediate restrict
   
 : U+DO ( compilation -- do-sys ; run-time u1 u2 -- | loop-sys ) \ gforth        u-plus-do  : U+DO ( compilation -- do-sys ; run-time u1 u2 -- | loop-sys ) \ gforth        u-plus-do
     POSTPONE (u+do) ?do-like ; immediate restrict      POSTPONE a(u+do) ?do-like ; immediate restrict
   
 : -DO ( compilation -- do-sys ; run-time n1 n2 -- | loop-sys )  \ gforth        minus-do  : -DO ( compilation -- do-sys ; run-time n1 n2 -- | loop-sys )  \ gforth        minus-do
     POSTPONE (-do) ?do-like ; immediate restrict      POSTPONE a(-do) ?do-like ; immediate restrict
   
 : U-DO ( compilation -- do-sys ; run-time u1 u2 -- | loop-sys ) \ gforth        u-minus-do  : U-DO ( compilation -- do-sys ; run-time u1 u2 -- | loop-sys ) \ gforth        u-minus-do
     POSTPONE (u-do) ?do-like ; immediate restrict      POSTPONE a(u-do) ?do-like ; immediate restrict
   
 : FOR ( compilation -- do-sys ; run-time u -- loop-sys )        \ gforth  : FOR ( compilation -- do-sys ; run-time u -- loop-sys )        \ gforth
     POSTPONE (for)      POSTPONE (for)
Line 277  Avariable leave-sp  leave-stack 3 cells Line 277  Avariable leave-sp  leave-stack 3 cells
     until-like  POSTPONE done  POSTPONE unloop ;      until-like  POSTPONE done  POSTPONE unloop ;
   
 : LOOP ( compilation do-sys -- ; run-time loop-sys1 -- | loop-sys2 )    \ core  : LOOP ( compilation do-sys -- ; run-time loop-sys1 -- | loop-sys2 )    \ core
  ['] (loop) ['] (loop)-lp+!# loop-like ; immediate restrict   ['] a(loop) ['] a(loop)-lp+!# loop-like ; immediate restrict
   
 : +LOOP ( compilation do-sys -- ; run-time loop-sys1 n -- | loop-sys2 ) \ core  plus-loop  : +LOOP ( compilation do-sys -- ; run-time loop-sys1 n -- | loop-sys2 ) \ core  plus-loop
  ['] (+loop) ['] (+loop)-lp+!# loop-like ; immediate restrict   ['] a(+loop) ['] a(+loop)-lp+!# loop-like ; immediate restrict
   
 \ !! should the compiler warn about +DO..-LOOP?  \ !! should the compiler warn about +DO..-LOOP?
 : -LOOP ( compilation do-sys -- ; run-time loop-sys1 u -- | loop-sys2 ) \ gforth        minus-loop  : -LOOP ( compilation do-sys -- ; run-time loop-sys1 u -- | loop-sys2 ) \ gforth        minus-loop
  ['] (-loop) ['] (-loop)-lp+!# loop-like ; immediate restrict   ['] a(-loop) ['] a(-loop)-lp+!# loop-like ; immediate restrict
   
 \ A symmetric version of "+LOOP". I.e., "-high -low ?DO -inc S+LOOP"  \ A symmetric version of "+LOOP". I.e., "-high -low ?DO -inc S+LOOP"
 \ will iterate as often as "high low ?DO inc S+LOOP". For positive  \ will iterate as often as "high low ?DO inc S+LOOP". For positive
 \ increments it behaves like "+LOOP". Use S+LOOP instead of +LOOP for  \ increments it behaves like "+LOOP". Use S+LOOP instead of +LOOP for
 \ negative increments.  \ negative increments.
 : S+LOOP ( compilation do-sys -- ; run-time loop-sys1 n -- | loop-sys2 )        \ gforth        s-plus-loop  : S+LOOP ( compilation do-sys -- ; run-time loop-sys1 n -- | loop-sys2 )        \ gforth        s-plus-loop
  ['] (s+loop) ['] (s+loop)-lp+!# loop-like ; immediate restrict   ['] a(s+loop) ['] a(s+loop)-lp+!# loop-like ; immediate restrict
   
 : NEXT ( compilation do-sys -- ; run-time loop-sys1 -- | loop-sys2 ) \ gforth  : NEXT ( compilation do-sys -- ; run-time loop-sys1 -- | loop-sys2 ) \ gforth
  ['] (next) ['] (next)-lp+!# loop-like ; immediate restrict   ['] a(next) ['] a(next)-lp+!# loop-like ; immediate restrict
   
 \ Structural Conditionals                              12dec92py  \ Structural Conditionals                              12dec92py
   
Removed from v.1.12  
changed lines
  Added in v.1.13

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>