Diff for /gforth/stuff.fs between versions 1.9 and 1.18

version 1.9, 1999/02/03 00:10:22 version 1.18, 2000/11/29 22:21:57
Line 1 Line 1
 \ miscelleneous words  \ miscelleneous words
   
 \ Copyright (C) 1996,1997,1998 Free Software Foundation, Inc.  \ Copyright (C) 1996,1997,1998,2000 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 16 Line 16
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   
   require glocals.fs
   
 ' require alias needs ( ... "name" -- ... ) \ gforth  ' require alias needs ( ... "name" -- ... ) \ gforth
 \G an alias for @code{require}; exists on other systems (e.g., Win32Forth).  \G An alias for @code{require}; exists on other systems (e.g., Win32Forth).
 \ needs is an F-PC name. we will probably switch to 'needs' in the future  \ needs is an F-PC name. we will probably switch to 'needs' in the future
   
 \ a little more compiler security  \ a little more compiler security
Line 36  AUser CSP Line 37  AUser CSP
   
 \ DMIN and DMAX  \ DMIN and DMAX
   
 : dmin ( d1 d2 -- d ) \ double  : dmin ( d1 d2 -- d ) \ double d-min
     2over 2over d> IF  2swap  THEN 2drop ;      2over 2over d> IF  2swap  THEN 2drop ;
   
 : dmax ( d1 d2 -- d ) \ double  
   : dmax ( d1 d2 -- d ) \ double d-max
     2over 2over d< IF  2swap  THEN 2drop ;      2over 2over d< IF  2swap  THEN 2drop ;
   
 \ shell commands  \ shell commands
   
 0 Value $? ( -- n ) \ gforth  0 Value $? ( -- n ) \ gforth dollar-question
 \G VALUE: The exit status returned by the most recently executed  \G @code{Value} -- the exit status returned by the most recently executed
 \G @code{system} command.  \G @code{system} command.
   
 : system ( addr u -- ) \ gforth  : system ( c-addr u -- ) \ gforth
 \G Pass the string specified by c-addr, u to the host operating system  \G Pass the string specified by @var{c-addr u} to the host operating system
 \G for execution in a sub-shell.  \G for execution in a sub-shell.
     (system) throw TO $? ;      (system) throw TO $? ;
   
Line 60  AUser CSP Line 62  AUser CSP
   
 \ stuff  \ stuff
   
 : ]L ( compilation: n -- ; run-time: -- n )  : ]L ( compilation: n -- ; run-time: -- n ) \ gforth
     \G equivalent to "] literal"      \G equivalent to @code{] literal}
     ] postpone literal ;      ] postpone literal ;
   
 : in-dictionary? ( x -- f )  : in-dictionary? ( x -- f )
Line 69  AUser CSP Line 71  AUser CSP
   
 : in-return-stack? ( addr -- f )  : in-return-stack? ( addr -- f )
     rp0 @ swap - [ forthstart 6 cells + ]L @ u< ;      rp0 @ swap - [ forthstart 6 cells + ]L @ u< ;
   
   \ const-does>
   
   : compile-literals ( w*u u -- ; run-time: -- w*u ) recursive
       \ compile u literals, starting with the bottommost one
       ?dup-if
           swap >r 1- compile-literals
           r> POSTPONE literal
       endif ;
   
   : compile-fliterals ( r*u u -- ; run-time: -- w*u ) recursive
       \ compile u fliterals, starting with the bottommost one
       ?dup-if
           { F: r } 1- compile-fliterals
           r POSTPONE fliteral
       endif ;
   
   : (const-does>) ( w*uw r*ur uw ur target "name" -- )
       \ define a colon definition "name" containing w*uw r*ur as
       \ literals and a call to target.
       { uw ur target }
       header docol: cfa, \ start colon def without stack junk
       ur compile-fliterals uw compile-literals
       target compile, POSTPONE exit reveal ;
   
   : const-does> ( run-time: w*uw r*ur uw ur "name" -- )
       \G Defines @var{name} and returns.@sp 0
       \G @var{name} execution: pushes @var{w*uw r*ur}, then performs the
       \G code following the @code{const-does>}.
       here >r 0 POSTPONE literal
       POSTPONE (const-does>)
       POSTPONE ;
       noname : POSTPONE rdrop
       lastxt r> cell+ ! \ patch the literal
   ; immediate

Removed from v.1.9  
changed lines
  Added in v.1.18


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