X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=fth%2Fsystem.fth;h=08f3ef4f8474f17497ea7454bf8888e08564f31e;hb=ff136ea5caf229ce3135cc6245051f40a9b443f3;hp=c33f40bac6cfd733a7ebd9cc3672651e3a9dbb58;hpb=3b3c2dec4044db0e00b4353a7978e601f7e0f8c0;p=debian%2Fpforth

diff --git a/fth/system.fth b/fth/system.fth
index c33f40b..08f3ef4 100644
--- a/fth/system.fth
+++ b/fth/system.fth
@@ -26,16 +26,19 @@
 \ Based on HMSL Forth
 \
 \ Author: Phil Burk
-\ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
+\ 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@ ;
@@ -318,6 +321,10 @@
         dup cell+ @ swap @
 ;
 
+: 2CONSTANT ( n1 n2 <name> -c- ) ( -x- n1 n2 )
+        CREATE , , ( n1 n2 -- )
+        DOES> 2@   ( -- n1 n2 )
+;
 
 : ABS ( n -- |n| )
         dup 0<
@@ -360,6 +367,18 @@
         2* swap
 ;
 
+: D= ( xd1 xd2 -- flag )
+	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
@@ -717,9 +736,11 @@ ustack 0stackp
 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 )
@@ -756,7 +777,13 @@ variable TRACE-INCLUDE
         rdrop
 ;
 
-: $INCLUDE ( $filename -- ) count included ;
+defer MAP.FILENAME ( $filename1 -- $filename2 , modify name )
+' noop is map.filename
+
+: $INCLUDE ( $filename -- )
+    map.filename
+    count included
+;
 
 create INCLUDE-SAVE-NAME 128 allot
 : INCLUDE ( <fname> -- )
@@ -822,4 +849,6 @@ decimal
 FREEZE    \ prevent forgetting below this point
 
 .( Dictionary compiled, save in "pforth.dic".) cr
+\ 300000 headers-size !
+\ 700000 code-size !
 c" pforth.dic" save-forth