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 >
C/C++ Source or Header  |  1992-06-17  |  4KB  |  194 lines
  1. /*Copyright (c) 1992 by Richard Kelsey and Jonathan Rees.  See file COPYING.*/
  2.  
  3.  
  4. /* Implementation of the vm-extension opcode */
  5.  
  6. #include <stdio.h>
  7. #include <sys/signal.h>
  8. #include <sys/types.h>
  9. #include <sys/times.h>
  10. #include <sys/timeb.h>
  11. #include <sys/time.h>
  12. #include <fcntl.h>        /* for O_RDWR */
  13.  
  14. #define TICKS_PER_SECOND 1000    /* should agree with ps_runtime() */
  15. #define UNDEFINED ((4 << 2L) | 1L) /* cf. vm/prim.scm */
  16. #define SCHFALSE 1L
  17. #define SCHTRUE 5L
  18.  
  19. void when_alarm_interrupt(sig, code, scp)
  20.      int sig, code; 
  21.      struct sigcontext *scp;
  22. {
  23.   extern long Spending_interruptsS;
  24.   Spending_interruptsS |= 1;
  25.   return;
  26. }
  27.  
  28. long my_ualarm( long delay, int ignore ) /* no alarm on Ultrix */
  29. {
  30.   struct itimerval new, old;
  31.   new.it_value.tv_sec = delay / 1000000;
  32.   new.it_value.tv_usec = delay % 1000000;
  33.   if (0 == setitimer(ITIMER_REAL, &new, &old))
  34.     return old.it_value.tv_usec + 1000000 * old.it_value.tv_sec;
  35.   else {
  36.     perror("setitimer");
  37.     /* fprintf(stderr, "call to setitimer failed\n"); */
  38.     return -1;
  39.   }
  40. }
  41.  
  42. long ps_real_time()
  43. {
  44.   struct timeb tb;
  45.   static struct timeb tb_origin;
  46.   static int initp = 0;
  47.  
  48.   if (!initp) {
  49.     ftime(&tb_origin);
  50.     initp = 1;
  51.   }
  52.  
  53.   ftime(&tb);
  54.   return((long)((tb.time - tb_origin.time) * TICKS_PER_SECOND
  55.         + (tb.millitm / (1000 / TICKS_PER_SECOND))));
  56. }
  57.  
  58. long ticks_per_second()
  59. {
  60.   return TICKS_PER_SECOND;
  61. }
  62.  
  63.  
  64. /* For char-ready? */
  65.  
  66. int listen(stream)
  67.      FILE *stream;
  68. {
  69.   fd_set readfds;
  70.   struct timeval timeout;
  71.  
  72.   if (feof(stream))
  73.     return EOF;
  74.  
  75.   if (stream->_cnt)
  76.     return stream->_cnt;
  77.  
  78.   FD_ZERO(&readfds);
  79.   FD_SET(fileno(stream), &readfds);
  80.   timerclear(&timeout);
  81.  
  82.   return select(FD_SETSIZE, &readfds, NULL, NULL, &timeout);
  83. }
  84.  
  85. /*
  86.  * (define-primitive-data-type stob/port port make-port
  87.  *   (port-mode set-port-mode!)
  88.  *   (port-index set-port-index!)
  89.  *   (peeked-char set-peeked-char!)
  90.  *   (port-id set-port-id!))  ; setter needed by the post-GC code
  91.  */
  92.  
  93. long char_ready_p(long port)
  94. {
  95.   long index_569X;
  96.   long c_568X;
  97.   extern FILE **Sopen_portsS;
  98.  
  99.   if ((port & 3L) != 3L ||
  100.       (((*((long *) ((port - 3L) + -4L))) >> 2L) & 31L) != 5L ||
  101.       (*((long *) (port - 3L))) != 4L ||
  102.       ((*((long *) ((port - 3L) + 4L))) < 0L))
  103.     return UNDEFINED;
  104.  
  105.   index_569X = (*((long *) ((port - 3L) + 4L))) >> 2L; /* cf. case 132 */
  106.   c_568X = *((long *) ((port - 3L) + 8L));
  107.   if ((c_568X & 255L) == SCHFALSE) {
  108.     return listen(Sopen_portsS[index_569X]) ? SCHTRUE : SCHFALSE;
  109.   } else
  110.     return SCHTRUE;            /* there's peeked character */
  111. }
  112.  
  113.  
  114. /* This kludge is for debugging the mobot scheme system.  It takes a
  115.    port that's open for reading or writing (e.g. to /dev/null), closes
  116.    the associated stream, and replaces the stream with a new stream
  117.    open on /dev/ptyrf for reading or writing.  In this way we get two
  118.    Scheme ports that share the same Unix file descriptor, allowing us
  119.    to do both input and output on the tty. */
  120.  
  121. clobber_port_with_pty(long port)
  122. {
  123.   static char *pty_name = "/dev/ptyrf";
  124.  
  125.   static int pty = -1;
  126.   FILE *stream, *new_stream;
  127.   int index, mode;
  128.   extern FILE **Sopen_portsS;
  129.  
  130.   if ((port & 3L) != 3L ||
  131.       (((*((long *) ((port - 3L) + -4L))) >> 2L) & 31L) != 5L)
  132.     return UNDEFINED;        /* not a port */
  133.  
  134.   index = (*((long *) ((port - 3L) + 4L))) >> 2L;
  135.   if (index < 0)
  136.     return UNDEFINED;        /* port not open */
  137.  
  138.   stream = Sopen_portsS[index];
  139.   mode = (*((long *) (port - 3L))) >> 2;
  140.  
  141.   if (pty < 0) {
  142.     pty = open(pty_name, O_RDWR);
  143.     if (pty < 0) {
  144.       perror(pty_name);
  145.       return UNDEFINED;
  146.     }
  147.   }
  148.  
  149.   switch (mode) {
  150.   case 1:            /* for input */
  151.     new_stream = fdopen(pty, "r");
  152.     break;
  153.   case 2:
  154.     new_stream = fdopen(pty, "w");
  155.     break;
  156.   default:
  157.     return UNDEFINED;
  158.   }
  159.   fclose(stream);
  160.   Sopen_portsS[index] = new_stream;
  161.   return port;
  162. }
  163.  
  164. /******************************************/
  165.  
  166. long
  167. extended_vm (long key, long value)
  168. {
  169.   switch (key) {
  170.   
  171.   case 1:            /* number of ticks per second */
  172.     return TICKS_PER_SECOND << 2L;
  173.  
  174.   case 2:            /* real time in jiffies */
  175.     return ps_real_time() << 2;
  176.  
  177.   case 3:            /* arrange for periodic interrupt */
  178.     signal(SIGALRM, when_alarm_interrupt);
  179.     return my_ualarm((value >> 2) * (1000000 / TICKS_PER_SECOND), 0) << 2;
  180.  
  181.   case 4:            /* (char-ready? port) */
  182.     return char_ready_p(value);
  183.  
  184.   case 7:            /* read jumpers on 68000 board */
  185.     return 0;
  186.  
  187.   case 100:
  188.     return clobber_port_with_pty(value);
  189.  
  190.   default:
  191.     return UNDEFINED;
  192.   }
  193. }
  194.