Annotation of gforth/kernel-ec/cbr.fs, revision 1.1

1.1     ! pazsan      1: \ Structural Conditionals, based on branches               12dec92py
        !             2: 
        !             3: \ Copyright (C) 1995,1996,1997,1999,2001,2003,2006,2007 Free Software Foundation, Inc.
        !             4: 
        !             5: \ This file is part of Gforth.
        !             6: 
        !             7: \ Gforth is free software; you can redistribute it and/or
        !             8: \ modify it under the terms of the GNU General Public License
        !             9: \ as published by the Free Software Foundation, either version 3
        !            10: \ of the License, or (at your option) any later version.
        !            11: 
        !            12: \ This program is distributed in the hope that it will be useful,
        !            13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            15: \ GNU General Public License for more details.
        !            16: 
        !            17: \ You should have received a copy of the GNU General Public License
        !            18: \ along with this program. If not, see http://www.gnu.org/licenses/.
        !            19: 
        !            20: : ?struc      ( flag -- )       abort" unstructured " ;
        !            21: : sys?        ( sys -- )        dup 0= ?struc ;
        !            22: : >mark       ( -- sys )        here  cell allot ;
        !            23: : >resolve    ( sys -- )        here swap
        !            24:     [ has? flash [IF] ] flash! [ [ELSE] ] ! [  [THEN] ] ;
        !            25: : <resolve    ( sys -- )        , ;
        !            26: 
        !            27: : BUT       sys? swap ;                      immediate restrict
        !            28: : YET       sys? dup ;                       immediate restrict
        !            29: 
        !            30: \ Structural Conditionals                              12dec92py
        !            31: 
        !            32: : AHEAD     postpone branch >mark ;           immediate restrict
        !            33: : IF        postpone ?branch >mark ;          immediate restrict
        !            34: : THEN      sys? ( dup @ ?struc ) >resolve ;  immediate restrict
        !            35: : ELSE      sys? postpone AHEAD swap postpone THEN ;
        !            36:                                              immediate restrict
        !            37: 
        !            38: ' THEN Alias ENDIF immediate restrict
        !            39: 
        !            40: : BEGIN     here ;                           immediate restrict
        !            41: : WHILE     sys? postpone IF swap ;           immediate restrict
        !            42: : AGAIN     sys? postpone branch  <resolve ;  immediate restrict
        !            43: : UNTIL     sys? postpone ?branch <resolve ;  immediate restrict
        !            44: : REPEAT    over 0= ?struc postpone AGAIN postpone THEN ;
        !            45:                                              immediate restrict
        !            46: 
        !            47: 0 CONSTANT case ( compilation  -- case-sys ; run-time  -- ) \ core-ext
        !            48:     immediate
        !            49: 
        !            50: : of ( compilation  -- of-sys ; run-time x1 x2 -- |x1 ) \ core-ext
        !            51:     \ !! the implementation does not match the stack effect
        !            52:     1+ >r
        !            53:     postpone over postpone = postpone if postpone drop
        !            54:     r> ; immediate
        !            55: 
        !            56: : endof ( compilation case-sys1 of-sys -- case-sys2 ; run-time  -- ) \ core-ext end-of
        !            57:     >r postpone else r> ; immediate
        !            58: 
        !            59: : endcase ( compilation case-sys -- ; run-time x -- ) \ core-ext end-case
        !            60:     postpone drop
        !            61:     0 ?do postpone then loop ; immediate

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