1
0
mirror of https://github.com/Interlisp/maiko.git synced 2026-03-02 09:46:27 +00:00

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))
This commit is contained in:
Nick Briggs
2021-01-06 12:32:34 -08:00
parent c6a74b2516
commit 439d92adbd
2 changed files with 17 additions and 0 deletions

View File

@@ -191,4 +191,6 @@
#define user_subr_DUMMY 012
#define user_subr_SAMPLE_USER_SUBR 00
/* Experimental yield */
#define sb_YIELD 0322
#endif

View File

@@ -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));