| \ EXTEND.FS CORE-EXT Word not fully tested! 12may93jaw |
\ EXTEND.FS CORE-EXT Word not fully tested! 12may93jaw |
| |
|
| \ Copyright (C) 1995,1998,2000,2003,2005,2007,2009 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1998,2000,2003,2005,2007,2009,2010,2011 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| |
|
| \ just as described in dpANS5 |
\ just as described in dpANS5 |
| |
|
| 0 CONSTANT case ( compilation -- case-sys ; run-time -- ) \ core-ext |
[ifundef] cs-drop |
| immediate |
: CS-DROP ( dest -- ) \ gforth |
| |
dest? 2drop ; |
| |
[then] |
| |
|
| |
: case ( compilation -- case-sys ; run-time -- ) \ core-ext |
| |
postpone begin 0 ; immediate |
| |
|
| |
: ?of ( compilation -- of-sys ; run-time f -- ) \ gforth |
| |
>r POSTPONE if r> ; immediate |
| |
|
| : of ( compilation -- of-sys ; run-time x1 x2 -- |x1 ) \ core-ext |
: of ( compilation -- of-sys ; run-time x1 x2 -- |x1 ) \ core-ext |
| \ !! the implementation does not match the stack effect |
\ !! the implementation does not match the stack effect |
| 1+ >r |
postpone over postpone = postpone ?of postpone drop ; immediate |
| postpone over postpone = postpone if postpone drop |
|
| r> ; immediate |
|
| |
|
| : endof ( compilation case-sys1 of-sys -- case-sys2 ; run-time -- ) \ core-ext end-of |
: endof ( compilation case-sys1 of-sys -- case-sys2 ; run-time -- ) \ core-ext end-of |
| >r postpone else r> ; immediate |
>r postpone else 1 cs-roll r> 1+ ; immediate |
| |
|
| |
: contof ( compilation case-sys1 of-sys -- case-sys2 ; run-time -- ) |
| |
\ like @code{endof}, but loops back to the @code{case} |
| |
>r 1 cs-pick postpone again postpone then r> ; immediate |
| |
|
| |
: n-thens ( orig1 ... origu u -- ) |
| |
0 ?do postpone then loop ; |
| |
|
| : endcase ( compilation case-sys -- ; run-time x -- ) \ core-ext end-case |
: endcase ( compilation case-sys -- ; run-time x -- ) \ core-ext end-case |
| postpone drop |
>r cs-drop postpone drop r> n-thens ; immediate |
| 0 ?do postpone then loop ; immediate |
|
| |
: nextcase ( compilation case-sys -- ; run-time x -- ) \ gforth-undocumented |
| |
\ like ENDCASE, but start again from the beginning if this is |
| |
\ reached by fallthrough |
| |
>r postpone drop postpone again r> n-thens ; immediate |
| |
|
| |
|
| \ C" 17may93jaw |
\ C" 17may93jaw |
| |
|
| \G editing capabilites are available. The length of the string is |
\G editing capabilites are available. The length of the string is |
| \G stored in @code{span}; it does not include the <return> |
\G stored in @code{span}; it does not include the <return> |
| \G character. OBSOLESCENT: superceeded by @code{accept}. |
\G character. OBSOLESCENT: superceeded by @code{accept}. |
| |
everyline |
| 0 rot over |
0 rot over |
| BEGIN ( maxlen span c-addr pos1 ) |
BEGIN ( maxlen span c-addr pos1 ) |
| key decode ( maxlen span c-addr pos2 flag ) |
xkey decode ( maxlen span c-addr pos2 flag ) |
| >r 2over = r> or |
>r 2over = r> or |
| UNTIL |
UNTIL |
| 2 pick swap /string type |
2 pick swap /string type |
