home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / D / CLISP / CLISPSRC.TAR / clisp-1995-01-01 / src / unixaux.d < prev    next >
Encoding:
Text File  |  1994-12-12  |  14.0 KB  |  418 lines
  1. # Hilfsfunktionen fⁿr CLISP auf UNIX
  2. # Bruno Haible 12.12.1994
  3.  
  4. #include "lispbibl.c"
  5.  
  6. # Betriebssystem-Funktion read sichtbar machen:
  7.   #undef read
  8.  
  9. # ==============================================================================
  10.  
  11. #ifdef NEED_OWN_UALARM
  12. # Ein Ersatz fⁿr die ualarm-Funktion.
  13.   global unsigned int ualarm (unsigned int value, unsigned int interval);
  14.   global unsigned int ualarm(value,interval)
  15.     var reg1 unsigned int value;
  16.     var reg2 unsigned int interval;
  17.     { var struct itimerval itimer;
  18.       itimer.it_value.tv_sec = floor(value,1000000);
  19.       itimer.it_value.tv_usec = value % 1000000;
  20.       itimer.it_interval.tv_sec = floor(interval,1000000);
  21.       itimer.it_interval.tv_usec = interval % 1000000;
  22.       setitimer(ITIMER_REAL,&itimer,NULL);
  23.       return 0; # den Rⁿckgabewert ignorieren wir immer.
  24.     }
  25. #endif
  26.  
  27. # ==============================================================================
  28.  
  29. #ifdef NEED_OWN_SELECT
  30. # Ein Ersatz fⁿr die select-Funktion.
  31.   global int select (int width, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, struct timeval * timeout);
  32.   global int select(width,readfds,writefds,exceptfds,timeout)
  33.     var reg8 int width;
  34.     var reg4 fd_set* readfds;
  35.     var reg5 fd_set* writefds;
  36.     var reg6 fd_set* exceptfds;
  37.     var reg9 struct timeval * timeout;
  38.     { var struct pollfd pollfd_bag[FD_SETSIZE];
  39.       var reg1 struct pollfd * pollfd_ptr = &pollfd_bag[0];
  40.       var reg7 int pollfd_count = 0;
  41.       if (width<0) { errno = EINVAL; return -1; }
  42.       if (width>FD_SETSIZE) { width = FD_SETSIZE; }
  43.       { var reg3 int fd;
  44.         for (fd=0; fd<width; fd++)
  45.           { var reg2 short events = 0;
  46.             if (!(readfds==NULL) && FD_ISSET(fd,readfds)) { events |= POLLIN; }
  47.             if (!(writefds==NULL) && FD_ISSET(fd,writefds)) { events |= POLLOUT; }
  48.             if (!(exceptfds==NULL) && FD_ISSET(fd,exceptfds)) { events |= POLLPRI; }
  49.             if (events)
  50.               { pollfd_ptr->fd = fd;
  51.                 pollfd_ptr->events = events;
  52.                 pollfd_ptr->revents = 0;
  53.                 pollfd_ptr++; pollfd_count++;
  54.       }   }   }
  55.      {var reg10 int poll_timeout = timeout->tv_sec * 1000 + timeout->tv_usec / (1000000/1000);
  56.       var reg9 int result = poll(pollfd_count,&pollfd_bag[0],poll_timeout);
  57.       if (result>=0)
  58.         { pollfd_ptr = &pollfd_bag[0];
  59.           until (pollfd_count == 0)
  60.             { var reg3 int fd = pollfd_ptr->fd;
  61.               var reg2 short revents = pollfd_ptr->revents;
  62.               if (!(readfds==NULL) && (revents & POLLIN)) { FD_SET(fd,readfds); }
  63.               if (!(writefds==NULL) && (revents & POLLOUT)) { FD_SET(fd,writefds); }
  64.               if (!(exceptfds==NULL) && (revents & (POLLPRI|POLLERR|POLLHUP))) { FD_SET(fd,exceptfds); }
  65.               pollfd_ptr++; pollfd_count--;
  66.         }   }
  67.       return result;
  68.     }}
  69. #endif
  70.  
  71. # ==============================================================================
  72.  
  73. #ifdef NEED_OWN_GETTIMEOFDAY
  74. # Ein Ersatz fⁿr die gettimeofday-Funktion.
  75.   global int gettimeofday (struct timeval * tp, struct timezone * tzp);
  76.   global int gettimeofday(tp,tzp)
  77.     var reg1 struct timeval * tp;
  78.     var reg2 struct timezone * tzp;
  79.     { var struct timeb timebuf;
  80.       if (!((tp==NULL) && (tzp==NULL)))
  81.         { ftime(&timebuf);
  82.           if (!(tp==NULL))
  83.             { tp->tv_sec = timebuf.time;
  84.               tp->tv_usec = (long)(timebuf.millitm) * (1000000/1000);
  85.             }
  86.           if (!(tzp==NULL))
  87.             { tzp->tz_minuteswest = timebuf.timezone;
  88.               tzp->tz_dsttime = 0; # ??
  89.             }
  90.         }
  91.       return 0;
  92.     }
  93. #endif
  94.  
  95. # ==============================================================================
  96.  
  97. #ifdef NEED_OWN_RENAME
  98. # Ein Ersatz fⁿr die rename-Funktion.
  99.   global int rename (char* oldpath, char* newpath);
  100.   global int rename(oldpath,newpath)
  101.     var reg2 char* oldpath;
  102.     var reg3 char* newpath;
  103.     { var reg1 int result;
  104.       if ((result = access(oldpath,0)) < 0) # oldpath ⁿberhaupt da?
  105.         { return result; }
  106.       if ((result = access(newpath,0)) < 0) # newpath auch da?
  107.         { if (!(errno==ENOENT)) return result; }
  108.         else
  109.         { # ▄berprⁿfe, ob oldpath und newpath dasselbe sind.
  110.           # Dann darf nΣmlich nichts gel÷scht werden!
  111.           var struct stat oldstatbuf;
  112.           var struct stat newstatbuf;
  113.           if ((result = stat(oldpath,&oldstatbuf)) < 0) { return result; }
  114.           if ((result = stat(newpath,&newstatbuf)) < 0) { return result; }
  115.           if ((oldstatbuf.st_dev == newstatbuf.st_dev)
  116.               && (oldstatbuf.st_ino == newstatbuf.st_ino)
  117.              )
  118.             { return 0; }
  119.           if ((result = unlink(newpath)) < 0) # newpath l÷schen
  120.             { return result; }
  121.         }
  122.       if ((result = link(oldpath,newpath)) < 0) # newpath neu anlegen
  123.         { return result; }
  124.       if ((result = unlink(oldpath)) < 0) # oldpath kann nun gel÷scht werden
  125.         { return result; }
  126.       return 0;
  127.     }
  128. #endif
  129.  
  130. # ==============================================================================
  131.  
  132. #ifdef EINTR
  133.  
  134. #ifdef UNIX # EMUNIX und RISCOS brauchen das nicht
  135.  
  136. # Ein Wrapper um die open-Funktion.
  137.   global int nonintr_open (OPEN_CONST char* path, int flags, MODE_T mode);
  138.   global int nonintr_open(path,flags,mode)
  139.     var reg2 OPEN_CONST char* path;
  140.     var reg3 int flags;
  141.     var reg4 MODE_T mode;
  142.     { var reg1 int retval;
  143.       do { retval = open(path,flags,mode); } while ((retval < 0) && (errno == EINTR));
  144.       return retval;
  145.     }
  146.  
  147. # Ein Wrapper um die close-Funktion.
  148.   global int nonintr_close (int fd);
  149.   global int nonintr_close(fd)
  150.     var reg2 int fd;
  151.     { var reg1 int retval;
  152.       do { retval = close(fd); } while ((retval < 0) && (errno == EINTR));
  153.       return retval;
  154.     }
  155.  
  156. # Ein Wrapper um die ioctl-Funktion.
  157.   #undef ioctl
  158.   global int nonintr_ioctl (int fd, IOCTL_REQUEST_T request, CADDR_T arg);
  159.   global int nonintr_ioctl(fd,request,arg)
  160.     var reg2 int fd;
  161.     var reg3 IOCTL_REQUEST_T request;
  162.     var reg4 CADDR_T arg;
  163.     { var reg1 int retval;
  164.       do { retval = ioctl(fd,request,arg); } while ((retval != 0) && (errno == EINTR));
  165.       return retval;
  166.     }
  167.  
  168. #endif
  169.  
  170. #ifdef UNIX_TERM_TERMIOS
  171.  
  172. # Ein Wrapper um die tcsetattr-Funktion.
  173.   global int nonintr_tcsetattr (int fd, int optional_actions, struct termios * tp);
  174.   global int nonintr_tcsetattr(fd,optional_actions,tp)
  175.     var reg2 int fd;
  176.     var reg3 int optional_actions;
  177.     var reg4 struct termios * tp;
  178.     { var reg1 int retval;
  179.       do { retval = tcsetattr(fd,optional_actions,tp); }
  180.          while ((retval != 0) && (errno == EINTR));
  181.       return retval;
  182.     }
  183.  
  184. # Ein Wrapper um die tcdrain-Funktion.
  185.   global int nonintr_tcdrain (int fd);
  186.   global int nonintr_tcdrain(fd)
  187.     var reg2 int fd;
  188.     { var reg1 int retval;
  189.       do { retval = tcdrain(fd); } while ((retval != 0) && (errno == EINTR));
  190.       return retval;
  191.     }
  192.  
  193. # Ein Wrapper um die tcflush-Funktion.
  194.   global int nonintr_tcflush (int fd, int flag);
  195.   global int nonintr_tcflush(fd,flag)
  196.     var reg2 int fd;
  197.     var reg3 int flag;
  198.     { var reg1 int retval;
  199.       do { retval = tcflush(fd,flag); } while ((retval != 0) && (errno == EINTR));
  200.       return retval;
  201.     }
  202.  
  203. #endif
  204.  
  205. #ifdef NEED_OWN_SIGINTERRUPT
  206.  
  207. # Ein Ersatz fⁿr die siginterrupt-Funktion.
  208.   global int siginterrupt (int sig, int flag);
  209.   global int siginterrupt (sig,flag)
  210.     var reg1 int sig;
  211.     var reg2 int flag;
  212.     {
  213.      #if defined(HAVE_SIGACTION)
  214.       extern int sigaction (/* int sig, [const] struct sigaction * new, struct sigaction * old */);
  215.       var struct sigaction sa;
  216.       sigaction(sig,(struct sigaction *)NULL,&sa);
  217.       #ifdef SA_INTERRUPT
  218.       if (flag)
  219.         { if (sa.sa_flags & SA_INTERRUPT) return 0;
  220.           sa.sa_flags |= SA_INTERRUPT; # system calls will be interrupted
  221.         }
  222.         else
  223.         { if (!(sa.sa_flags & SA_INTERRUPT)) return 0;
  224.           sa.sa_flags &= ~ SA_INTERRUPT; # system calls will be restarted
  225.         }
  226.       #endif
  227.       #ifdef SA_RESTART
  228.       if (flag)
  229.         { if (!(sa.sa_flags & SA_RESTART)) return 0;
  230.           sa.sa_flags &= ~ SA_RESTART; # system calls will be interrupted
  231.         }
  232.         else
  233.         { if (sa.sa_flags & SA_RESTART) return 0;
  234.           sa.sa_flags |= SA_RESTART; # system calls will be restarted
  235.         }
  236.       #endif
  237.       sigaction(sig,&sa,(struct sigaction *)NULL);
  238.      #elif defined(HAVE_SIGVEC) && defined(SV_INTERRUPT)
  239.       extern int sigvec (/* int sig, [const] struct sigvec * new, struct sigvec * old */);
  240.       var struct sigvec sv;
  241.       sigvec(sig,(struct sigvec *)NULL,&sv);
  242.       if (flag)
  243.         { if (sv.sv_flags & SV_INTERRUPT) return 0;
  244.           sv.sv_flags |= SV_INTERRUPT; # system calls will be interrupted
  245.         }
  246.         else
  247.         { if (!(sv.sv_flags & SV_INTERRUPT)) return 0;
  248.           sv.sv_flags &= ~ SV_INTERRUPT; # system calls will be restarted
  249.         }
  250.       sigvec(sig,&sv,(struct sigvec *)NULL);
  251.      #endif
  252.       return 0; # den Rⁿckgabewert ignorieren wir immer.
  253.     }
  254.  
  255. #endif
  256.  
  257. #endif
  258.  
  259. # Ein Wrapper um die read-Funktion.
  260.   global RETRWTYPE full_read (int fd, char* buf, RW_SIZE_T nbyte);
  261.   global RETRWTYPE full_read (fd,buf,nbyte)
  262.     var reg5 int fd;
  263.     var reg4 char* buf;
  264.     var reg2 RW_SIZE_T nbyte;
  265.     { var reg1 RETRWTYPE retval;
  266.       var reg3 RW_SIZE_T done = 0;
  267.       until (nbyte==0)
  268.         { retval = read(fd,buf,nbyte);
  269.           if (retval == 0) break;
  270.           elif (retval < 0)
  271.             {
  272.               #ifdef EINTR
  273.               if (!(errno == EINTR))
  274.               #endif
  275.                 #if defined(GENERATIONAL_GC) && defined(SPVW_MIXED)
  276.                 if (!((errno == EFAULT) && handle_fault_range(PROT_READ_WRITE,(aint)buf,(aint)buf+nbyte)))
  277.                 #endif
  278.                   return retval;
  279.             }
  280.           else { buf += retval; done += (RW_SIZE_T)retval; nbyte -= (RW_SIZE_T)retval; }
  281.         }
  282.       return done;
  283.     }
  284.  
  285. # Ein Wrapper um die write-Funktion.
  286.   global RETRWTYPE full_write (int fd, WRITE_CONST char* buf, RW_SIZE_T nbyte);
  287.   global RETRWTYPE full_write (fd,buf,nbyte)
  288.     var reg5 int fd;
  289.     var reg4 WRITE_CONST char* buf;
  290.     var reg2 RW_SIZE_T nbyte;
  291.     { var reg1 RETRWTYPE retval;
  292.       var reg3 RW_SIZE_T done = 0;
  293.       until (nbyte==0)
  294.         { retval = write(fd,buf,nbyte);
  295.           if (retval == 0) break;
  296.           elif (retval < 0)
  297.             {
  298.               #ifdef EINTR
  299.               if (!(errno == EINTR))
  300.               #endif
  301.                 #if defined(GENERATIONAL_GC) && defined(SPVW_MIXED)
  302.                 if (!((errno == EFAULT) && handle_fault_range(PROT_READ,(aint)buf,(aint)buf+nbyte)))
  303.                 #endif
  304.                   return retval;
  305.             }
  306.           else { buf += retval; done += (RW_SIZE_T)retval; nbyte -= (RW_SIZE_T)retval; }
  307.         }
  308.       return done;
  309.     }
  310.  
  311. #ifdef PID_T
  312.  
  313. # Auf die Beendingung eines Child-Prozesses warten:
  314.   global int wait2 (PID_T child);
  315.   global int wait2(child)
  316.     var reg2 PID_T child;
  317.     { var int status = 0;
  318.       # vgl. WAIT(2V) und #include <sys/wait.h> :
  319.       #   WIFSTOPPED(status)  ==  ((status & 0xFF) == 0177)
  320.       #   WEXITSTATUS(status)  == ((status & 0xFF00) >> 8)
  321.       #ifdef HAVE_WAITPID
  322.       loop
  323.         { var reg1 int ergebnis = waitpid(child,&status,0);
  324.           if (!(ergebnis == child))
  325.             { if (ergebnis<0)
  326.                 { if (errno==EINTR) continue;
  327.                   #ifdef ECHILD
  328.                   if (errno==ECHILD) # Wenn der Child-Proze▀ nicht mehr da ist,
  329.                     { status = 0; break; } # ist er wohl korrekt beendet worden.
  330.                   #endif
  331.                 }
  332.               OS_error();
  333.             }
  334.           if (!((status & 0xFF) == 0177)) break; # Child-Proze▀ beendet?
  335.         }
  336.       #else
  337.       loop
  338.         { var reg1 int ergebnis = wait(&status);
  339.           if (ergebnis < 0)
  340.             { if (errno==EINTR) continue;
  341.               #ifdef ECHILD
  342.               if (errno==ECHILD) # Wenn der Child-Proze▀ nicht mehr da ist,
  343.                 { status = 0; break; } # ist er wohl korrekt beendet worden.
  344.               #endif
  345.               OS_error();
  346.             }
  347.           if ((ergebnis == child) && !((status & 0xFF) == 0177)) break; # Child-Proze▀ beendet?
  348.         }
  349.       #endif
  350.       return status;
  351.     }
  352.  
  353. #endif
  354.  
  355. # ==============================================================================
  356.  
  357. #if defined(UNIX_LINUX) && (defined(FAST_FLOAT) || defined(FAST_DOUBLE))
  358.  
  359. # Damit Division durch 0.0 ein NaN und kein SIGFPE liefert:
  360. # Entweder mit -lieee linken,
  361. # oder libc-linux/sysdeps/linux/{i386,m68k}/ieee.c kopieren:
  362.  
  363. #include <fpu_control.h>
  364.  
  365. global unsigned short __fpu_control = _FPU_IEEE;
  366.  
  367. #endif
  368.  
  369. # ==============================================================================
  370.  
  371. #if defined(HAVE_MMAP) && defined(UNIX_CONVEX)
  372.  
  373. # Ein Wrapper um die mmap-Funktion.
  374.   #undef mmap
  375.   global RETMMAPTYPE fixed_mmap (MMAP_ADDR_T addr, MMAP_SIZE_T len, int prot, int flags, int fd, off_t off);
  376.   global RETMMAPTYPE fixed_mmap(addr,len,prot,flags,fd,off)
  377.     var reg2 MMAP_ADDR_T addr;
  378.     var MMAP_SIZE_T len;
  379.     var reg3 int prot;
  380.     var reg5 int flags;
  381.     var reg6 int fd;
  382.     var reg4 off_t off;
  383.     { if (fd < 0)
  384.         # Brauche ein Handle auf ein regulΣres File.
  385.         { local var int regular_fd = -2;
  386.           #define regular_file  "/tmp/lispdummy.mmap"
  387.           if (regular_fd < -1)
  388.             { regular_fd = open(regular_file,O_CREAT|O_TRUNC|O_RDWR,my_open_mask);
  389.               if (regular_fd >= 0) { unlink(regular_file); }
  390.             }
  391.           if (regular_fd >= 0)
  392.             { return mmap(addr,&len,prot,flags,regular_fd,off); }
  393.         }
  394.       return mmap(addr,&len,prot,flags|MAP_FILE,fd,off);
  395.     }
  396.  
  397. # Ein Ersatz fⁿr die mprotect-Funktion.
  398.   global int mprotect(addr,len,prot)
  399.     var reg1 MMAP_ADDR_T addr;
  400.     var MMAP_SIZE_T len;
  401.     var reg2 int prot;
  402.     { return mremap(addr,&len,prot,MAP_PRIVATE); }
  403.  
  404. #endif
  405.  
  406. # ==============================================================================
  407.  
  408. #ifdef UNIX_CONVEX
  409.  
  410. # The purpose of this hack is to minimize crashes when memory is tight.
  411. global int __ap$sigblock (int sigmask) { return 0; }
  412. global int __ap$sigstack (struct sigstack *ss, struct sigstack *oss) { return 0; }
  413.  
  414. #endif
  415.  
  416. # ==============================================================================
  417.  
  418.