Implement (MSEC) using usleep() (#125)

[debian/pforth] / fth / misc2.fth

diff --git a/fth/misc2.fth b/fth/misc2.fth
index c943e8201657dc64fb4a8ff1877b25f8eb091a81..b1ae8eae96309eb67d84f01b256af6d38c4d12b9 100644 (file)
--- a/fth/misc2.fth
+++ b/fth/misc2.fth
@@ -4,14 +4,17 @@
 \ 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.
 \
 \ 00001 9/14/92 Added call, 'c w->s
 \ 00002 11/23/92 Moved redef of : to loadcom.fth
@@ -46,16 +49,39 @@ variable if-debug
 ;
 
 decimal
-create msec-delay 10000 ,  ( default for SUN )
-: (MSEC) ( #msecs -- )
+create MSEC-DELAY 100000 ,   \ calibrate this for your system
+: (MSEC.SPIN) ( #msecs -- , busy wait, not accurate )
+    0 max   \ avoid endless loop
     0
-    do  msec-delay @ 0
+    ?do  msec-delay @ 0
         do loop
     loop
 ;
 
+: (MSEC) ( millis -- )
+    dup (sleep) \ call system sleep in kernel
+    IF
+        ." (SLEEP) failed or not implemented! Using (MSEC.SPIN)" CR
+        (msec.spin)
+    ELSE
+        drop
+    THEN
+;
+
 defer msec
-' (msec) is msec
+
+\ (SLEEP) uses system sleep functions to actually sleep.
+\ Use (MSEC.SPIN) on embedded systems that do not support Win32 Sleep() posix usleep().
+1 (SLEEP) [IF]
+    ." (SLEEP) failed or not implemented! Use (MSEC.SPIN) for MSEC" CR
+    ' (msec.spin) is msec
+[ELSE]
+    ' (msec) is msec
+[THEN]
+
+: MS ( msec -- , sleep, ANS standard )
+    msec
+;
 
 : SHIFT ( val n -- val<<n )
     dup 0<
@@ -64,7 +90,6 @@ defer msec
     THEN
 ;
 
-
 variable rand-seed here rand-seed !
 : random ( -- random_number )
     rand-seed @
@@ -122,18 +147,18 @@ variable rand-seed here rand-seed !
 : B->S ( c -- c' , sign extend byte )
     dup $ 80 and
     IF
-        $ FFFFFF00 or
+        [ $ 0FF invert ] literal or
     ELSE
-        $ 000000FF and
+        $ 0FF and
     THEN
 ;
-: W->S ( 16bit-signed -- 32bit-signed )
+: W->S ( 16bit-signed -- cell-signed )
     dup $ 8000 and
-    if
-        $ FFFF0000 or
+    IF
+        [ $ 0FFFF invert ] literal or
     ELSE
-        $ 0000FFFF and
-    then
+        $ 0FFFF and
+    THEN
 ;
 
 : WITHIN { n1 n2 n3 -- flag }