Skip to content
Snippets Groups Projects
unix.lisp 96 KiB
Newer Older
wlott's avatar
wlott committed
;;; -*- Package: UNIX -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix.lisp,v 1.63 1999/03/08 18:03:19 pw Exp $")
wlott's avatar
wlott committed
;;;
;;; **********************************************************************
;;;
;;; This file contains the UNIX low-level support.
;;;
(in-package "UNIX")
(use-package "ALIEN")
(use-package "C-CALL")
(use-package "SYSTEM")
(use-package "EXT")

(export '(
	  daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t
	  timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime
	  itimerval it-interval it-value tchars t-intrc t-quitc t-startc
wlott's avatar
wlott committed
	  t-stopc t-eofc t-brkc ltchars t-suspc t-dsuspc t-rprntc t-flushc
wlott's avatar
wlott committed
	  t-werasc t-lnextc sgttyb sg-ispeed sg-ospeed sg-erase sg-kill
	  sg-flags winsize ws-row ws-col ws-xpixel ws-ypixel
ram's avatar
ram committed
	  direct d-off d-ino d-reclen #-(or linux svr4) d-namlen d-name
wlott's avatar
wlott committed
	  stat st-dev st-mode st-nlink st-uid st-gid st-rdev st-size
	  st-atime st-mtime st-ctime st-blksize st-blocks
	  s-ifmt s-ifdir s-ifchr s-ifblk s-ifreg s-iflnk s-ifsock
	  s-isuid s-isgid s-isvtx s-iread s-iwrite s-iexec
	  ruseage ru-utime ru-stime ru-maxrss ru-ixrss ru-idrss
	  ru-isrss ru-minflt ru-majflt ru-nswap ru-inblock ru-oublock
	  ru-msgsnd ru-msgrcv ru-nsignals ru-nvcsw ru-nivcsw
ram's avatar
ram committed
	  rlimit rlim-cur rlim-max sc-onstack sc-mask sc-pc
wlott's avatar
wlott committed

	  unix-errno get-unix-error-msg

	  unix-pathname unix-file-mode unix-fd unix-pid unix-uid unix-gid
	  unix-setitimer unix-getitimer
	  unix-access r_ok w_ok x_ok f_ok unix-chdir unix-chmod setuidexec
wlott's avatar
wlott committed
	  setgidexec savetext readown writeown execown readgrp writegrp
	  execgrp readoth writeoth execoth unix-fchmod unix-chown unix-fchown
	  unix-getdtablesize unix-close unix-creat unix-dup unix-dup2
	  unix-fcntl f-dupfd f-getfd f-setfd f-getfl f-setfl f-getown f-setown
	  fndelay fappend fasync fcreat ftrunc fexcl unix-link unix-lseek
	  l_set l_incr l_xtnd unix-mkdir unix-open o_rdonly o_wronly o_rdwr
pw's avatar
pw committed
	  #+(or hpux svr4 freebsd linux) o_ndelay
	  #+(or hpux svr4 freebsd linux) o_noctty #+(or hpux svr4) o_nonblock
	  o_append o_creat o_trunc o_excl unix-pipe unix-read unix-readlink
	  unix-rename unix-rmdir unix-fast-select fd-setsize fd-set fd-clr
	  fd-isset fd-zero unix-select unix-sync unix-fsync unix-truncate
dtc's avatar
dtc committed
	  unix-ftruncate unix-symlink
	  #+(and sparc svr4) unix-times
	  unix-unlink unix-write unix-ioctl
	  tcsetpgrp tcgetpgrp tty-process-group
	  terminal-speeds tty-raw tty-crmod tty-echo tty-lcase
pw's avatar
pw committed
	  #-hpux tty-cbreak #-(or hpux linux) tty-tandem
	  #+(or hpux svr4 linux freebsd) termios
          #+(or hpux svr4 linux freebsd) c-lflag
	  #+(or hpux svr4 linux freebsd) c-iflag
          #+(or hpux svr4 linux freebsd) c-oflag
	  #+(or hpux svr4 linux freebsd) tty-icrnl
          #+(or hpux svr4 linux) tty-ocrnl
	  #+(or hpux svr4 freebsd) vdsusp #+(or hpux svr4 linux freebsd) veof
	  #+(or hpux svr4 linux freebsd) vintr
          #+(or hpux svr4 linux freebsd) vquit
          #+(or hpux svr4 linux freebsd) vstart
	  #+(or hpux svr4 linux freebsd) vstop
          #+(or hpux svr4 linux freebsd) vsusp
	  #+(or hpux svr4 linux freebsd) c-cflag
	  #+(or hpux svr4 linux freebsd) c-cc
	  #+(or bsd osf1) c-ispeed
	  #+(or bsd osf1) c-ospeed
pw's avatar
pw committed
          #+(or hpux svr4 linux freebsd) tty-icanon
	  #+(or hpux svr4 linux freebsd) vmin
          #+(or hpux svr4 linux freebsd) vtime
	  #+(or hpux svr4 linux freebsd) tty-ixon
          #+(or hpux svr4 freebsd linux) tcsanow
          #+(or hpux svr4 freebsd linux) tcsadrain
          #+(or hpux svr4 freebsd linux) tciflush
          #+(or hpux svr4 freebsd linux) tcoflush
          #+(or hpux svr4 freebsd linux) tcioflush
	  #+(or hpux svr4 freebsd linux) tcsaflush
          #+(or hpux svr4 linux freebsd) unix-tcgetattr
          #+(or hpux svr4 linux freebsd) unix-tcsetattr
          #+(or hpux svr4 freebsd) unix-cfgetospeed
          #+(or hpux svr4 freebsd) unix-cfsetospeed
          #+(or hpux svr4 freebsd) unix-cfgetispeed
          #+(or hpux svr4 freebsd) unix-cfsetispeed
          #+(or hpux svr4 linux freebsd) tty-ignbrk
          #+(or hpux svr4 linux freebsd) tty-brkint
          #+(or hpux svr4 linux freebsd) tty-ignpar
          #+(or hpux svr4 linux freebsd) tty-parmrk
          #+(or hpux svr4 linux freebsd) tty-inpck
          #+(or hpux svr4 linux freebsd) tty-istrip
          #+(or hpux svr4 linux freebsd) tty-inlcr
          #+(or hpux svr4 linux freebsd) tty-igncr
          #+(or hpux svr4 linux) tty-iuclc
          #+(or hpux svr4 linux freebsd) tty-ixany
          #+(or hpux svr4 linux freebsd) tty-ixoff
          #+hpux tty-ienqak
          #+(or hpux irix solaris linux freebsd) tty-imaxbel
          #+(or hpux svr4 linux freebsd) tty-opost
          #+(or hpux svr4 linux) tty-olcuc
          #+(or hpux svr4 linux freebsd) tty-onlcr
          #+(or hpux svr4 linux) tty-onocr
          #+(or hpux svr4 linux) tty-onlret
          #+(or hpux svr4 linux) tty-ofill
          #+(or hpux svr4 linux) tty-ofdel
          #+(or hpux svr4 linux freebsd) tty-isig
          #+(or hpux svr4 linux) tty-xcase
          #+(or hpux svr4 linux freebsd) tty-echoe
          #+(or hpux svr4 linux freebsd) tty-echok
          #+(or hpux svr4 linux freebsd) tty-echonl
          #+(or hpux svr4 linux freebsd) tty-noflsh
          #+(or hpux svr4 linux freebsd) tty-iexten
          #+(or hpux svr4 linux freebsd) tty-tostop
          #+(or hpux irix solaris linux freebsd) tty-echoctl
          #+(or hpux irix solaris linux freebsd) tty-echoprt
          #+(or hpux irix solaris linux freebsd) tty-echoke
          #+(or hpux irix solaris) tty-defecho
          #+(or hpux irix solaris freebsd) tty-flusho
          #+(or hpux irix solaris linux freebsd) tty-pendin
          #+(or hpux svr4 linux freebsd) tty-cstopb
          #+(or hpux svr4 linux freebsd) tty-cread
          #+(or hpux svr4 linux freebsd) tty-parenb
          #+(or hpux svr4 linux freebsd) tty-parodd
          #+(or hpux svr4 linux freebsd) tty-hupcl
          #+(or hpux svr4 linux freebsd) tty-clocal
          #+(or irix solaris) rcv1en
          #+(or irix solaris) xmt1en
          #+(or hpux irix solaris) tty-loblk
          #+(or hpux svr4 linux freebsd) vintr
          #+(or hpux svr4 linux freebsd) verase
          #+(or hpux svr4 linux freebsd) vkill
          #+(or hpux svr4 linux freebsd) veol
          #+(or hpux irix solaris linux freebsd) veol2
          #+(or hpux irix solaris) tty-cbaud
          #+(or hpux svr4 freebsd) tty-csize #+(or hpux svr4 freebsd) tty-cs5
          #+(or hpux svr4 freebsd) tty-cs6 #+(or hpux svr4 freebsd) tty-cs7
          #+(or hpux svr4 freebsd) tty-cs8
          #+(or hpux svr4 freebsd) unix-tcsendbreak
          #+(or hpux svr4 freebsd) unix-tcdrain
          #+(or hpux svr4 freebsd) unix-tcflush
          #+(or hpux svr4 freebsd) unix-tcflow
          
	  TIOCGETP TIOCSETP TIOCFLUSH TIOCSETC TIOCGETC TIOCSLTC
wlott's avatar
wlott committed
	  TIOCGLTC TIOCNOTTY TIOCSPGRP TIOCGPGRP TIOCGWINSZ TIOCSWINSZ
wlott's avatar
wlott committed
	  KBDCGET KBDCSET KBDCRESET KBDCRST KBDCSSTD KBDSGET KBDGCLICK
ram's avatar
ram committed
	  KBDSCLICK FIONREAD #+(or hpux freebsd) siocspgrp
	  unix-exit unix-stat unix-lstat unix-fstat
	  unix-getrusage unix-fast-getrusage rusage_self rusage_children
	  unix-gettimeofday
	  #-hpux unix-utimes #-(or svr4 hpux) unix-setreuid
	  #-(or svr4 hpux) unix-setregid
	  #+(or svr4 freebsd)unix-setpgid
wlott's avatar
wlott committed
	  unix-getgid unix-getegid unix-getpgrp unix-setpgrp unix-getuid
	  unix-getpagesize unix-gethostname unix-gethostid unix-fork
	  unix-current-directory unix-isatty unix-ttyname unix-execve
	  unix-socket unix-connect unix-bind unix-listen unix-accept
	  unix-recv unix-send unix-getpeername unix-getsockname))
wlott's avatar
wlott committed

(pushnew :unix *features*)


;;;; Common machine independent structures.

ram's avatar
ram committed
#+bsd
(def-alien-type quad-t (array unsigned-long 2))

wlott's avatar
wlott committed
;;; From sys/types.h

ram's avatar
ram committed
(def-alien-type daddr-t #-(or linux alpha) long #+(or linux alpha) int)
wlott's avatar
wlott committed
(def-alien-type caddr-t (* char))
hallgren's avatar
hallgren committed
(def-alien-type ino-t #-alpha unsigned-long #+alpha unsigned-int)
wlott's avatar
wlott committed
(def-alien-type swblk-t long)
ram's avatar
ram committed
(def-alien-type size-t #-(or linux alpha) long #+linux unsigned-int 
  #+alpha unsigned-long)
(def-alien-type time-t #-(or linux alpha) unsigned-long #+linux long
  #+alpha unsigned-int)

(def-alien-type dev-t #-(or alpha svr4 bsd linux) short #+linux unsigned-short
	 #+alpha int #+(and (not linux) (or bsd svr4)) unsigned-long)
#-FreeBSD
hallgren's avatar
hallgren committed
(def-alien-type off-t #-alpha long #+alpha unsigned-long)
ram's avatar
ram committed
#+FreeBSD
(def-alien-type off-t quad-t)
#-FreeBSD
(def-alien-type uid-t #-(or alpha svr4) unsigned-short #+alpha unsigned-int
  #+svr4 long)
ram's avatar
ram committed
#+FreeBSD
(def-alien-type uid-t unsigned-long)
#-FreeBSD
(def-alien-type gid-t #-(or alpha svr4) unsigned-short #+alpha unsigned-int
  #+svr4 long)
ram's avatar
ram committed
#+FreeBSD
ram's avatar
ram committed
(def-alien-type gid-t unsigned-long)
(def-alien-type mode-t #-(or alpha svr4) unsigned-short
ram's avatar
ram committed
  #+alpha unsigned-int #+svr4 unsigned-long)
(def-alien-type nlink-t #-svr4 unsigned-short #+svr4 unsigned-long)
wlott's avatar
wlott committed

ram's avatar
ram committed
(defconstant FD-SETSIZE #-(or hpux alpha linux) 256 #+hpux 2048 #+alpha 4096 #+linux 1024)
wlott's avatar
wlott committed

ram's avatar
ram committed
;; not checked for linux...
wlott's avatar
wlott committed
(def-alien-type nil
  (struct fd-set
hallgren's avatar
hallgren committed
    (fds-bits (array #-alpha unsigned-long #+alpha int #.(/ fd-setsize 32)))))
wlott's avatar
wlott committed

ram's avatar
ram committed
;; not checked for linux...
wlott's avatar
wlott committed
(defmacro fd-set (offset fd-set)
  (let ((word (gensym))
	(bit (gensym)))
wlott's avatar
wlott committed
    `(multiple-value-bind (,word ,bit) (floor ,offset 32)
       (setf (deref (slot ,fd-set 'fds-bits) ,word)
	     (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))
		     (deref (slot ,fd-set 'fds-bits) ,word))))))
wlott's avatar
wlott committed

ram's avatar
ram committed
;; not checked for linux...
wlott's avatar
wlott committed
(defmacro fd-clr (offset fd-set)
  (let ((word (gensym))
	(bit (gensym)))
wlott's avatar
wlott committed
    `(multiple-value-bind (,word ,bit) (floor ,offset 32)
       (setf (deref (slot ,fd-set 'fds-bits) ,word)
	     (logand (deref (slot ,fd-set 'fds-bits) ,word)
		     (32bit-logical-not
		      (truly-the (unsigned-byte 32) (ash 1 ,bit))))))))
wlott's avatar
wlott committed

ram's avatar
ram committed
;; not checked for linux...
wlott's avatar
wlott committed
(defmacro fd-isset (offset fd-set)
  (let ((word (gensym))
	(bit (gensym)))
    `(multiple-value-bind (,word ,bit) (floor ,offset 32)
       (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))

ram's avatar
ram committed
;; not checked for linux...
wlott's avatar
wlott committed
(defmacro fd-zero (fd-set)
  `(progn
     ,@(loop for index upfrom 0 below (/ fd-setsize 32)
	 collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))
wlott's avatar
wlott committed

;;; From sys/time.h

(def-alien-type nil
  (struct timeval
ram's avatar
ram committed
    (tv-sec #-linux time-t #+linux int)		; seconds
    (tv-usec #-linux time-t #+linux int)))		; and microseconds
wlott's avatar
wlott committed

(def-alien-type nil
  (struct timezone
    (tz-minuteswest int)		; minutes west of Greenwich
    (tz-dsttime				; type of dst correction
ram's avatar
ram committed
     #-linux (enum nil :none :usa :aust :wet :met :eet :can)
     #+linux int)))
wlott's avatar
wlott committed

(def-alien-type nil
  (struct itimerval
    (it-interval (struct timeval))	; timer interval
    (it-value (struct timeval))))	; current value

ram's avatar
ram committed
#+(or linux svr4)
ram's avatar
ram committed
; High-res time.  Actually posix definition under svr4 name.
(def-alien-type nil
  (struct timestruc-t
    (tv-sec time-t)
    (tv-nsec long)))

ram's avatar
ram committed
#+(or linux FreeBSD)
(def-alien-type nil
  (struct timespec-t
    (ts-sec long)
    (ts-nsec long)))
wlott's avatar
wlott committed

ram's avatar
ram committed
;;; From ioctl.h
wlott's avatar
wlott committed
(def-alien-type nil
  (struct tchars
    (t-intrc char)			; interrupt
    (t-quitc char)			; quit
ram's avatar
ram committed
    #+linux (t-eofc char)
wlott's avatar
wlott committed
    (t-startc char)			; start output
    (t-stopc char)			; stop output
ram's avatar
ram committed
    #-linux (t-eofc char)			; end-of-file
wlott's avatar
wlott committed
    (t-brkc char)))			; input delimiter (like nl)

ram's avatar
ram committed
;; not found (semi) linux
wlott's avatar
wlott committed
(def-alien-type nil
  (struct ltchars
ram's avatar
ram committed
    #+linux (t-werasc char)			; word erase 	  
wlott's avatar
wlott committed
    (t-suspc char)			; stop process signal
    (t-dsuspc char)			; delayed stop process signal
    (t-rprntc char)			; reprint line
    (t-flushc char)			; flush output (toggles)
ram's avatar
ram committed
    #-linux (t-werasc char)			; word erase
wlott's avatar
wlott committed
    (t-lnextc char)))			; literal next character

ram's avatar
ram committed

wlott's avatar
wlott committed
(def-alien-type nil
  (struct sgttyb
ram's avatar
ram committed
    #+linux (sg-flags #+mach short #-mach int) ; mode flags 	  
wlott's avatar
wlott committed
    (sg-ispeed char)			; input speed.
    (sg-ospeed char)			; output speed
    (sg-erase char)			; erase character
ram's avatar
ram committed
    #-linux (sg-kill char)			; kill character
    #-linux (sg-flags #+mach short #-mach int) ; mode flags
    #+linux (sg-kill char)
    #+linux (t (struct termios))
    #+linux (check int)))
wlott's avatar
wlott committed

(def-alien-type nil
  (struct winsize
    (ws-row unsigned-short)		; rows, in characters
    (ws-col unsigned-short)		; columns, in characters
    (ws-xpixel unsigned-short)		; horizontal size, pixels
    (ws-ypixel unsigned-short)))	; veritical size, pixels

pw's avatar
pw committed
;;; From sys/termios.h
;;; NOTE: There is both a  termio (SYSV) and termios (POSIX)
;;; structure with similar but incompatible definitions. It may be that
;;; the non-BSD variant of termios below is really a termio but I (pw)
;;; can't verify. The BSD variant uses the Posix termios def. Some systems
;;; (Ultrix and OSF1) seem to support both if used independently.
;;; The 17f version of this seems a bit confused wrt the conditionals.
;;; Please check these defs for your system.

pw's avatar
pw committed
;;; TSM: from what I can tell looking at the 17f definition, my guess is that it
;;; was originally a termio for sunos (nonsolaris) (because it had the c-line
;;; member for sunos only), and then was mutated into the termios definition for
;;; later systems. The definition here is definitely not an IRIX termio because
;;; it doesn't have c-line. In any case, the functions tcgetattr, etc.,
;;; definitely take a termios, and termios seems to be the more standard
;;; standard now, so my suggestion is to just go with termios and forget about
;;; termio. Note the SVID says NCCS not NCC for the constant here, so I've
;;; changed it (which means you need to bootstrap it to avoid a reader error).

;;; On top of all that, SGI decided to change the termios structure on irix
;;; 6.[34] (but NOT 6.2), left the old routines named the same in the library,
;;; but introduced static functions in termios.h to redirect new calls to the
;;; new library--which means it's important not to #include termios.h before
;;; undefineds.h when building lisp.

(defconstant +NCCS+
pw's avatar
pw committed
  #+(or linux solaris) 19
pw's avatar
pw committed
  #+(or bsd osf1) 20
  #+(and sunos (not svr4)) 17
  "Size of control character vector.")

(def-alien-type nil
pw's avatar
pw committed
  (struct termios
    (c-iflag unsigned-int)
    (c-oflag unsigned-int)
    (c-cflag unsigned-int)
    (c-lflag unsigned-int)
    #+(or linux hpux (and sunos (not svr4)))
    (c-reserved #-(or linux (and sunos (not svr4))) unsigned-int
		#+(or linux (and sunos (not svr4))) unsigned-char)
    (c-cc (array unsigned-char #.+NCCS+))
pw's avatar
pw committed
    #+(or bsd osf1) (c-ispeed unsigned-int)
    #+(or bsd osf1) (c-ospeed unsigned-int)))
wlott's avatar
wlott committed
;;; From sys/dir.h
ram's avatar
ram committed
#-bsd
wlott's avatar
wlott committed
(def-alien-type nil
  (struct direct
    #+(and sunos (not svr4)) (d-off long) ; offset of next disk directory entry
ram's avatar
ram committed
    (d-ino ino-t); inode number of entry
ram's avatar
ram committed
    #+(or linux svr4) (d-off long)
wlott's avatar
wlott committed
    (d-reclen unsigned-short)		; length of this record
ram's avatar
ram committed
    #-(or linux svr4)
    (d-namlen unsigned-short)		; length of string in d-name
wlott's avatar
wlott committed
    (d-name (array char 256))))		; name must be no longer than this

ram's avatar
ram committed
#+bsd
(def-alien-type nil
  (struct direct
    (d-fileno unsigned-long)
    (d-reclen unsigned-short)
    (d-type unsigned-char)
    (d-namlen unsigned-char)		; length of string in d-name
    (d-name (array char 256))))		; name must be no longer than this

wlott's avatar
wlott committed
;;; From sys/stat.h
ram's avatar
ram committed
;; oh boy, in linux-> 2 stat(s)!!
wlott's avatar
wlott committed

#-(or svr4 freebsd linux)		; eg hpux and alpha
wlott's avatar
wlott committed
(def-alien-type nil
  (struct stat
    (st-dev dev-t)
    (st-ino ino-t)
    (st-mode mode-t)
    (st-nlink nlink-t)
wlott's avatar
wlott committed
    (st-uid uid-t)
    (st-gid gid-t)
    (st-rdev dev-t)
    (st-size off-t)
    (st-atime time-t)
    (st-spare1 int)
    (st-mtime time-t)
    (st-spare2 int)
    (st-ctime time-t)
    (st-spare3 int)
hallgren's avatar
hallgren committed
    (st-blksize #-alpha long #+alpha unsigned-int)
    (st-blocks #-alpha long #+alpha int)
wlott's avatar
wlott committed
    (st-spare4 (array long 2))))

ram's avatar
ram committed
#+FreeBSD
hallgren's avatar
Loading
Loading full blame...