home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
s
/
s48.zip
/
EXTENSIO.C
< prev
next >
Wrap
C/C++ Source or Header
|
1992-06-17
|
4KB
|
194 lines
/*Copyright (c) 1992 by Richard Kelsey and Jonathan Rees. See file COPYING.*/
/* Implementation of the vm-extension opcode */
#include <stdio.h>
#include <sys/signal.h>
#include <sys/types.h>
#include <sys/times.h>
#include <sys/timeb.h>
#include <sys/time.h>
#include <fcntl.h> /* for O_RDWR */
#define TICKS_PER_SECOND 1000 /* should agree with ps_runtime() */
#define UNDEFINED ((4 << 2L) | 1L) /* cf. vm/prim.scm */
#define SCHFALSE 1L
#define SCHTRUE 5L
void when_alarm_interrupt(sig, code, scp)
int sig, code;
struct sigcontext *scp;
{
extern long Spending_interruptsS;
Spending_interruptsS |= 1;
return;
}
long my_ualarm( long delay, int ignore ) /* no alarm on Ultrix */
{
struct itimerval new, old;
new.it_value.tv_sec = delay / 1000000;
new.it_value.tv_usec = delay % 1000000;
if (0 == setitimer(ITIMER_REAL, &new, &old))
return old.it_value.tv_usec + 1000000 * old.it_value.tv_sec;
else {
perror("setitimer");
/* fprintf(stderr, "call to setitimer failed\n"); */
return -1;
}
}
long ps_real_time()
{
struct timeb tb;
static struct timeb tb_origin;
static int initp = 0;
if (!initp) {
ftime(&tb_origin);
initp = 1;
}
ftime(&tb);
return((long)((tb.time - tb_origin.time) * TICKS_PER_SECOND
+ (tb.millitm / (1000 / TICKS_PER_SECOND))));
}
long ticks_per_second()
{
return TICKS_PER_SECOND;
}
/* For char-ready? */
int listen(stream)
FILE *stream;
{
fd_set readfds;
struct timeval timeout;
if (feof(stream))
return EOF;
if (stream->_cnt)
return stream->_cnt;
FD_ZERO(&readfds);
FD_SET(fileno(stream), &readfds);
timerclear(&timeout);
return select(FD_SETSIZE, &readfds, NULL, NULL, &timeout);
}
/*
* (define-primitive-data-type stob/port port make-port
* (port-mode set-port-mode!)
* (port-index set-port-index!)
* (peeked-char set-peeked-char!)
* (port-id set-port-id!)) ; setter needed by the post-GC code
*/
long char_ready_p(long port)
{
long index_569X;
long c_568X;
extern FILE **Sopen_portsS;
if ((port & 3L) != 3L ||
(((*((long *) ((port - 3L) + -4L))) >> 2L) & 31L) != 5L ||
(*((long *) (port - 3L))) != 4L ||
((*((long *) ((port - 3L) + 4L))) < 0L))
return UNDEFINED;
index_569X = (*((long *) ((port - 3L) + 4L))) >> 2L; /* cf. case 132 */
c_568X = *((long *) ((port - 3L) + 8L));
if ((c_568X & 255L) == SCHFALSE) {
return listen(Sopen_portsS[index_569X]) ? SCHTRUE : SCHFALSE;
} else
return SCHTRUE; /* there's peeked character */
}
/* This kludge is for debugging the mobot scheme system. It takes a
port that's open for reading or writing (e.g. to /dev/null), closes
the associated stream, and replaces the stream with a new stream
open on /dev/ptyrf for reading or writing. In this way we get two
Scheme ports that share the same Unix file descriptor, allowing us
to do both input and output on the tty. */
clobber_port_with_pty(long port)
{
static char *pty_name = "/dev/ptyrf";
static int pty = -1;
FILE *stream, *new_stream;
int index, mode;
extern FILE **Sopen_portsS;
if ((port & 3L) != 3L ||
(((*((long *) ((port - 3L) + -4L))) >> 2L) & 31L) != 5L)
return UNDEFINED; /* not a port */
index = (*((long *) ((port - 3L) + 4L))) >> 2L;
if (index < 0)
return UNDEFINED; /* port not open */
stream = Sopen_portsS[index];
mode = (*((long *) (port - 3L))) >> 2;
if (pty < 0) {
pty = open(pty_name, O_RDWR);
if (pty < 0) {
perror(pty_name);
return UNDEFINED;
}
}
switch (mode) {
case 1: /* for input */
new_stream = fdopen(pty, "r");
break;
case 2:
new_stream = fdopen(pty, "w");
break;
default:
return UNDEFINED;
}
fclose(stream);
Sopen_portsS[index] = new_stream;
return port;
}
/******************************************/
long
extended_vm (long key, long value)
{
switch (key) {
case 1: /* number of ticks per second */
return TICKS_PER_SECOND << 2L;
case 2: /* real time in jiffies */
return ps_real_time() << 2;
case 3: /* arrange for periodic interrupt */
signal(SIGALRM, when_alarm_interrupt);
return my_ualarm((value >> 2) * (1000000 / TICKS_PER_SECOND), 0) << 2;
case 4: /* (char-ready? port) */
return char_ready_p(value);
case 7: /* read jumpers on 68000 board */
return 0;
case 100:
return clobber_port_with_pty(value);
default:
return UNDEFINED;
}
}