relicense to 0BSD

[pforth] / fth / system.fth

diff --git a/fth/system.fth b/fth/system.fth
index c1b7f66..2bd959d 100644 (file)
--- a/fth/system.fth
+++ b/fth/system.fth
@@ -28,14 +28,17 @@
 \ Author: Phil Burk
 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
 \
 \ Author: Phil Burk
 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
 \

-\ The pForth software code is dedicated to the public domain,
-\ and any third party may reproduce, distribute and modify
-\ the pForth software code or any derivative works thereof
-\ without any compensation or license.  The pForth software
-\ code is provided on an "as is" basis without any warranty
-\ of any kind, including, without limitation, the implied
-\ warranties of merchantability and fitness for a particular
-\ purpose and their equivalents under the laws of any jurisdiction.
+\ Permission to use, copy, modify, and/or distribute this
+\ software for any purpose with or without fee is hereby granted.
+\
+\ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+\ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+\ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
+\ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+\ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
+\ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
+\ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+\ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

 \ *********************************************************************
 
 : COUNT  dup 1+ swap c@ ;
 \ *********************************************************************
 
 : COUNT  dup 1+ swap c@ ;


@@ -364,6 +367,14 @@
        rot = -rot = and
 ;
 
        rot = -rot = and
 ;
 

+: D< ( d1 d2 -- flag )
+    d- nip 0<
+;
+
+: D> ( d1 d2 -- flag )
+    2swap d<
+;
+

 \ define some useful constants ------------------------------
 1 0= constant FALSE
 0 0= constant TRUE
 \ define some useful constants ------------------------------
 1 0= constant FALSE
 0 0= constant TRUE


@@ -721,9 +732,11 @@ ustack 0stackp
 variable TRACE-INCLUDE
 
 : INCLUDE.MARK.START  ( c-addr u -- , mark start of include for FILE?)
 variable TRACE-INCLUDE
 
 : INCLUDE.MARK.START  ( c-addr u -- , mark start of include for FILE?)

-    " ::::"  pad $MOVE
-    pad $APPEND
-    pad ['] noop (:)
+    dup 5 + allocate throw >r
+    " ::::" r@ $move
+    r@ $append
+    r@ ['] noop (:)
+    r> free throw

 ;
 
 : INCLUDE.MARK.END  ( -- , mark end of include )
 ;
 
 : INCLUDE.MARK.END  ( -- , mark end of include )


@@ -826,4 +839,6 @@ decimal
 FREEZE    \ prevent forgetting below this point
 
 .( Dictionary compiled, save in "pforth.dic".) cr
 FREEZE    \ prevent forgetting below this point
 
 .( Dictionary compiled, save in "pforth.dic".) cr

+\ 300000 headers-size !
+\ 700000 code-size !

 c" pforth.dic" save-forth
 c" pforth.dic" save-forth