X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/e14f25331be47e565ff6ae8cd7fb372fd329aff1..1f99f95d6a7eecc05cae8fb357f9b7bf564c2725:/fth/misc2.fth

diff --git a/fth/misc2.fth b/fth/misc2.fth
index 09f585f..f5f9f34 100644
--- a/fth/misc2.fth
+++ b/fth/misc2.fth
@@ -2,16 +2,19 @@
 \ Utilities for PForth extracted from HMSL
 \
 \ 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.
 \
 \ 00001 9/14/92 Added call, 'c w->s
 \ 00002 11/23/92 Moved redef of : to loadcom.fth
@@ -41,6 +44,10 @@ anew task-misc2.fth
 
 variable if-debug
 
+: ? ( address -- , fatch from address and print value )
+    @ .
+;
+
 decimal
 create msec-delay 10000 ,  ( default for SUN )
 : (MSEC) ( #msecs -- )
@@ -233,3 +240,40 @@ VARIABLE SPAN
     addr3 cnt3 flag
 ;
 
+private{
+
+: env= ( c-addr u c-addr1 u1 x -- x true true | c-addr u false )
+    { x } 2over compare 0= if 2drop x true true else false then
+;
+
+: 2env= ( c-addr u c-addr1 u1 x y -- x y true true | c-addr u false )
+    { x y } 2over compare 0= if 2drop x y true true else false then
+;
+
+0 invert constant max-u
+0 invert 1 rshift constant max-n
+
+}private
+
+: ENVIRONMENT? ( c-addr u -- false | i*x true )
+    s" /COUNTED-STRING"      255 env= if exit then
+    s" /HOLD"                128 env= if exit then \ same as PAD
+    s" /PAD"                 128 env= if exit then
+    s" ADDRESS-UNITS-BITS"     8 env= if exit then
+    s" FLOORED"            false env= if exit then
+    s" MAX-CHAR"             255 env= if exit then
+    s" MAX-D"       max-n max-u 2env= if exit then
+    s" MAX-N"              max-n env= if exit then
+    s" MAX-U"              max-u env= if exit then
+    s" MAX-UD"      max-u max-u 2env= if exit then
+    s" RETURN-STACK-CELLS"   512 env= if exit then \ DEFAULT_RETURN_DEPTH
+    s" STACK-CELLS"          512 env= if exit then \ DEFAULT_USER_DEPTH
+    \ FIXME: maybe define those:
+    \ s" FLOATING-STACK"
+    \ s" MAX-FLOAT"
+    \ s" #LOCALS"
+    \ s" WORDLISTS"
+    2drop false
+;
+
+privatize