From 439d92adbd68768d45390bbeeb4347400fbdcc1a Mon Sep 17 00:00:00 2001
From: Nick Briggs <nicholas.h.briggs@gmail.com>
Date: Wed, 6 Jan 2021 12:32:34 -0800
Subject: [PATCH] Add experimental SUBR to call nanosleep() for experiments in
 reducing CPU load

This adds a SUBR, sb_YIELD, value (octal) 0322 which takes a single number
0..999999999 which is the number of nanoseconds to pass to nanosleep().

The return value is T if the call to nanosleep() was executed or NIL
if it was not (argument out-of-range, or other error in getting the
number from the argument).

To use this experimental SUBR in a sysout you should:

   (SETQ \INITSUBRS (CONS '(YIELD #o322) \INITSUBRS))

then you can define functions that use that SUBR:

   (DEFINEQ (BACKGROUND-YIELD (SUBRCALL YIELD 833333)))
   (COMPILE 'BACKGROUND-YIELD)
   (SETQ BACKGROUNDFNS (CONS 'BACKGROUND-YIELD BACKGROUNDFNS))
---
 inc/subrs.h |  2 ++
 src/subr.c  | 15 +++++++++++++++
 2 files changed, 17 insertions(+)

diff --git a/inc/subrs.h b/inc/subrs.h
index 18bd61a..7817baa 100755
--- a/inc/subrs.h
+++ b/inc/subrs.h
@@ -191,4 +191,6 @@
 #define user_subr_DUMMY	012
 #define user_subr_SAMPLE_USER_SUBR	00
 
+/* Experimental yield */
+#define sb_YIELD                        0322
 #endif
diff --git a/src/subr.c b/src/subr.c
index ad73f27..90a9c80 100644
--- a/src/subr.c
+++ b/src/subr.c
@@ -29,6 +29,7 @@
 /***********************************************************/
 
 #include <stdio.h>
+#include <time.h>
 #include "lispemul.h"
 #include "address.h"
 #include "adr68k.h"
@@ -779,6 +780,20 @@ void OP_subrcall(int subr_no, int argnum) {
       break;
     }
 #endif /* LPSOLVE */
+  case sb_YIELD: {
+      struct timespec rqts = {0, 833333};
+      unsigned sleepnanos;
+      POP_SUBR_ARGS;
+      N_GETNUMBER(args[0], sleepnanos, ret_nil);
+      if (sleepnanos > 999999999) {
+          TopOfStack = NIL;
+          break;
+      }
+      rqts.tv_nsec = sleepnanos;
+      nanosleep(&rqts, NULL);
+      TopOfStack = ATOM_T;
+      break;
+  }
     default: {
       char errtext[200];
       sprintf(errtext, "OP_subrcall: Invalid alpha byte 0%o", ((*(PC + 1)) & 0xff));