[gforth] / gforth / kernel / cond.fs  

gforth: gforth/kernel/cond.fs

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

version 1.12, Mon Feb 4 21:25:18 2002 UTC version 1.13, Tue Sep 24 17:57:29 2002 UTC
Line 110 
Line 110 
 : >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 
Line 122 
 \ 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 
Line 164 
 ' 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 
Line 172 
 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 
Line 251 
     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 
Line 277 
     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
   

Generate output suitable for use with a patch program
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help