github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-01-28 20:41:30 +00:00
Code Issues Projects Releases Wiki Activity

add yield subr (#398)

Browse Source 
* 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))

* Update to use subrs.h newly generated from LLSUBRS

The subrs.h include file is generated by WRITECALLSUBRS based on the \INITSUBRS
list.  This update provides for the new YIELD subr in the generated file,
and makes some necessary updates to the C code implementations for some subr
names which have changed.
This commit is contained in:
Nick Briggs
2021-09-15 10:30:04 -07:00
committed by GitHub
parent a70b18d444
commit 6fedd97d21
2 changed files with 168 additions and 194 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
src/subr.c
View File

@@ -29,6 +29,7 @@
/***********************************************************/
#include <stdio.h>
#include <time.h>
#include "lispemul.h"
#include "address.h"
#include "adr68k.h"
@@ -62,6 +63,9 @@
#include "unixcommdefs.h"
#include "uutilsdefs.h"
#include "vmemsavedefs.h"
#ifdef MAIKO_ENABLE_FOREIGN_FUNCTION_INTERFACE
#include "foreigndefs.h"
#endif
extern LispPTR *PENDINGINTERRUPT68k;
@@ -682,7 +686,7 @@ void OP_subrcall(int subr_no, int argnum) {
/*****************************************/
/* foreign-function-call support subrs */
/*****************************************/
case sb_CALL_C_FN: {
case sb_CALL_C_FUNCTION: {
POP_SUBR_ARGS;
TopOfStack = call_c_fn(args); /* args[0]=fnaddr, args[1]=fn type */
break;
@@ -717,27 +721,27 @@ void OP_subrcall(int subr_no, int argnum) {
TopOfStack = Mdld_function_executable_p(args);
break;
}
case sb_DLD_LIST_UNDEFINED_SYM: {
case sb_DLD_LIST_UNDEFINED_SYMBOLS: {
POP_SUBR_ARGS;
TopOfStack = Mdld_list_undefined_sym();
break;
}
case sb_MALLOC: {
case sb_C_MALLOC: {
POP_SUBR_ARGS;
TopOfStack = c_malloc(args);
break;
}
case sb_FREE: {
case sb_C_FREE: {
POP_SUBR_ARGS;
TopOfStack = c_free(args);
break;
}
case sb_PUT_C_BASEBYTE: {
case sb_C_PUTBASEBYTE: {
POP_SUBR_ARGS;
TopOfStack = put_c_basebyte(args);
break;
}
case sb_GET_C_BASEBYTE: {
case sb_C_GETBASEBYTE: {
POP_SUBR_ARGS;
TopOfStack = get_c_basebyte(args);
break;
@@ -779,6 +783,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));