Implement (MSEC) using usleep() (#125)
authorPhil Burk <philburk@mobileer.com>
Sun, 27 Nov 2022 22:01:46 +0000 (14:01 -0800)
committerGitHub <noreply@github.com>
Sun, 27 Nov 2022 22:01:46 +0000 (14:01 -0800)
Use Sleep() on Windows.
Need platform specific code for embedded systems.

Check to see is (SLEEP) is implemented.
If not then use old busy loop code.

Fixes #112

csrc/pf_guts.h
csrc/pf_inner.c
csrc/pf_io.h
csrc/pf_io_none.c
csrc/pfcompil.c
csrc/posix/pf_io_posix.c
csrc/win32/pf_io_win32.c
fth/loadp4th.fth
fth/misc2.fth
platforms/unix/Makefile

index 5b10ac83fe0b5d0a8baab10a5e7d671ad6e3b8dd..6092bf34994f94032a667bcc8e33aee62a976865 100644 (file)
@@ -285,9 +285,10 @@ enum cforth_primitive_ids
     ID_CELLS,
     /* DELETE-FILE */
     ID_FILE_DELETE,
-    ID_FILE_FLUSH,             /* FLUSH-FILE */
-    ID_FILE_RENAME,            /* (RENAME-FILE) */
-    ID_FILE_RESIZE,            /* RESIZE-FILE */
+    ID_FILE_FLUSH,     /* FLUSH-FILE */
+    ID_FILE_RENAME,    /* (RENAME-FILE) */
+    ID_FILE_RESIZE,    /* RESIZE-FILE */
+    ID_SLEEP_P,        /* (SLEEP) V2.0.0 */
 /* If you add a word here, take away one reserved word below. */
 #ifdef PF_SUPPORT_FP
 /* Only reserve space if we are adding FP so that we can detect
@@ -302,7 +303,6 @@ enum cforth_primitive_ids
     ID_RESERVED07,
     ID_RESERVED08,
     ID_RESERVED09,
-    ID_RESERVED10,
     ID_FP_D_TO_F,
     ID_FP_FSTORE,
     ID_FP_FTIMES,
index b23974d6747968a83b56ac1cff1d20e6903435b1..b7c8ae156af3dd213c4af109b86dc4020e580cde 100644 (file)
@@ -1635,6 +1635,10 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
             endcase;
 #endif
 
+        case ID_SLEEP_P:
+            TOS = sdSleepMillis(TOS);
+            endcase;
+
         case ID_SP_FETCH:    /* ( -- sp , address of top of stack, sorta ) */
             PUSH_TOS;
             TOS = (cell_t)STKPTR;
index 56cc9057afab0790adfbd30828c001afd6c0d41f..4db8faf1a39b10fd378db739918a73c10c8a244b 100644 (file)
@@ -37,6 +37,7 @@ int  sdTerminalIn( void );
 int  sdQueryTerminal( void );
 void sdTerminalInit( void );
 void sdTerminalTerm( void );
+cell_t sdSleepMillis( cell_t msec );
 #ifdef __cplusplus
 }
 #endif
index 52f92b00075d30510b20dd6c872237ebc0c66d06..2aa0f7356a6548e2a208ead9006d8093e9d3b5f1 100644 (file)
@@ -49,4 +49,10 @@ void sdTerminalInit( void )
 void sdTerminalTerm( void )
 {
 }
+
+void sdSleepMillis(cell_t /* msec */)
+{
+    // TODO Call some platform specific sleep function here.
+    return PF_ERR_NOT_SUPPORTED;
+}
 #endif
index 00c1540dd4f19b4af8eae05e36c0bbe5c8f4713d..3b54284da03f7564b862bea6dfb912cd7a54e13f 100644 (file)
@@ -344,6 +344,7 @@ PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize )
     CreateDicEntryC( ID_SAVE_FORTH_P, "(SAVE-FORTH)",  0 );
     CreateDicEntryC( ID_SCAN, "SCAN",  0 );
     CreateDicEntryC( ID_SKIP, "SKIP",  0 );
+    CreateDicEntryC( ID_SLEEP_P, "(SLEEP)", 0 );
     CreateDicEntryC( ID_SOURCE, "SOURCE",  0 );
     CreateDicEntryC( ID_SOURCE_SET, "SET-SOURCE",  0 );
     CreateDicEntryC( ID_SOURCE_ID, "SOURCE-ID",  0 );
index 156e8608617c976afca67180820f59735bacec71..c66ebea4f31bf1e7a54d288fdae5f5173bf74b43 100644 (file)
@@ -146,3 +146,23 @@ void sdTerminalTerm(void)
         tcsetattr(STDIN_FILENO, TCSANOW, &save_termios);
     }
 }
+
+cell_t sdSleepMillis(cell_t msec)
+{
+    const cell_t kMaxMicros = 500000; /* to be safe, usleep() limit is 1000000 */
+    cell_t micros;
+    cell_t napTime;
+    if (msec < 0) return 0;
+    micros = msec * 1000;
+    while (micros > 0)
+    {
+        napTime = (micros > kMaxMicros) ? kMaxMicros : micros;
+        if (usleep(napTime))
+        {
+            perror("sdSleepMillis: usleep failed");
+            return -1;
+        }
+        micros -= napTime;
+    }
+    return 0;
+}
index ea2150819fcb252221220242bbeb8a545954f8cc..89b6fd9ae1fad9cb8886f8896f9510ac6fb0e224 100644 (file)
@@ -24,6 +24,7 @@
 #include "../pf_all.h"
 
 #include <conio.h>
+#include <synchapi.h>   /* for Sleep() */
 
 /* Use console mode I/O so that KEY and ?TERMINAL will work. */
 #if defined(WIN32) || defined(__NT__)
@@ -72,4 +73,12 @@ void sdTerminalInit( void )
 void sdTerminalTerm( void )
 {
 }
+
+cell_t sdSleepMillis(cell_t msec)
+{
+    if (msec < 0) return 0;
+    Sleep((DWORD)msec);
+    return 0;
+}
+
 #endif
index e794c60f7133259b6e5eda1723a659ca3ce6db92..8afa2d99a66c698c0b25b7da0bda5145e207ef97 100644 (file)
@@ -25,8 +25,8 @@ include? privatize   private.fth
 include? (local) ansilocs.fth
 include? {       locals.fth
 include? fm/mod  math.fth
-include? task-misc2.fth misc2.fth
 include? [if]    condcomp.fth
+include? task-misc2.fth misc2.fth
 include? save-input save-input.fth
 include? read-line  file.fth
 include? require    require.fth
index f5f9f345574fc2e118b0dd46d59718b2818328c9..b1ae8eae96309eb67d84f01b256af6d38c4d12b9 100644 (file)
@@ -49,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<
@@ -67,7 +90,6 @@ defer msec
     THEN
 ;
 
-
 variable rand-seed here rand-seed !
 : random ( -- random_number )
     rand-seed @
index f178ea64c29d9066cbd2f3654f177f2ec0ca301d..fab1f8250be130227f02ab681c1f65ce3389451d 100644 (file)
@@ -28,7 +28,6 @@ FULL_WARNINGS =  \
         -fsigned-char \
         -fno-builtin \
         -fno-unroll-loops \
-        -fno-keep-inline-functions \
         -pedantic \
         -Wcast-qual \
         -Wall \