anchor.diff:     #+allegro (excl.osi:fork)
      #+ccl (#.(read-from-string "#_fork"))
      #+ecl (ffi:c-inline () () :int
  -		       "(int) fork()" :one-liner t)
  +                       "(int) fork()" :one-liner t)
      (error "should support fork")))
   
   #-allegro
  
positive.code:   #+sbcl (sb-posix:close fd)
    #+ccl (#.(read-from-string "#_close") fd)
    #+ecl (ffi:c-inline (fd) (:int) :int
  		      "close(#0)" :one-liner t))
  
  #+allegro
  (ff:def-foreign-call (pclose "close") (d)) 
  
  (defun exit ()
    #+sbcl 
    #.(if (and (find-package :sb-posix) 
  	     (find-symbol (symbol-name :exit) :sb-posix))
  	(read-from-string "(sb-posix:exit 0)")
  	(read-from-string "(sb-unix:unix-exit)"))
    #+allegro (excl:exit 0 :quiet t)
    #+ccl (#.(read-from-string "#_exit") 0)
    #+ecl (ext:exit))
  
negative.code:   #+allegro (not (excl.osi:waitpid pid :wnohang (not (zerop option))))
    #+ccl (zerop (#.(read-from-string "#_waitpid") pid 0 option))
    #+ecl (ffi:c-inline (pid option) (:int :int) :int
                        "waitpid(#0,NULL,#1)" :one-liner t))
  
  (defun setsid ()
    #+sbcl (not (minusp (sb-posix:setsid)))
    #+allegro (excl.osi:setsid)
    #+ccl (not (minusp (#.(read-from-string "#_setsid"))))
    #+ecl (not (minusp (ffi:c-inline () () :int
                                     "setsid()" :one-liner t))))
  
  (defun umask (mask)
    #+sbcl (sb-posix:umask mask)
    #+allegro (excl.osi:umask mask)
    #+ccl (#.(read-from-string "#_umask") mask)
    #+ecl (ffi:c-inline (mask) (:int) :int
                        "umask(#0)" :one-liner t))
  
  (defun setuid (uid)
    #+sbcl(sb-posix:setuid uid)
    #+allegro (excl.osi:setuid uid)
    #+ccl (#.(read-from-string "#_setuid") uid)
    #+ecl (ffi:c-inline (uid) (:int) :int
                        "setuid(#0)" :one-liner t))
  
  (defun getpid ()
    #+sbcl (sb-posix:getpid)
    #+allegro (excl.osi:getpid)
    #+ccl (ccl::getpid)
    #+ecl (ffi:c-inline () () :int
                        "getpid()" :one-liner t))
  
  (defun getppid ()
    #+sbcl (sb-posix:getppid)
    #+allegro (excl.osi:getppid)
    #+ccl (#.(read-from-string "#_getppid"))
    #+ecl (ffi:c-inline () () :int
                        "getppid()" :one-liner t))
  
  (defun getuid ()
    #+sbcl (sb-posix:getuid)
    #+allegro (excl.osi:getuid)
    #+ccl (#.(read-from-string "#_getuid"))
    #+ecl (ffi:c-inline () () :int
                        "getuid()" :one-liner t))
  
  (defun getgrnam (name)
    #+sbcl (sb-posix:getgrnam name)
    #+allegro (excl.osi:getgrnam name)
    #+ccl (ccl::with-cstrs ((cstr name)) (#.(read-from-string "#_getgrnam") cstr))
    #+ecl (let ((ret (ffi:c-inline (name) (:cstring) :pointer-void
                                   "getgrnam(#0)" :one-liner t)))
            (unless (zerop (si:foreign-data-address ret))
              ret)))
  
  (defun setgid (gid)
    #+sbcl (sb-posix:setgid gid)
    #+allegro (excl.osi:setgid gid)
    #+ccl (#.(read-from-string "#_setgid") gid)
    #+ecl (ffi:c-inline (gid) (:int) :int
                        "setgid(#0)" :one-liner t))
  
  (defun getgrgid (gid)
    #+sbcl (sb-posix:getgrgid gid)
    #+allegro (excl.osi:getgrgid gid)
    #+ccl (#.(read-from-string "#_getgrgid") gid)
    #+ecl (ffi:c-inline (gid) (:int) :pointer-void
                        "getgrgid(#0)" :one-liner t))
  
  (defun group-gid (grp)
    #+sbcl (sb-posix:group-gid grp)
    #+allegro (excl.osi:grent-gid grp)
    #+ccl (unless (ccl:%null-ptr-p grp) (ccl:pref grp :group.gr_gid))
    #+ecl (ffi:c-inline (grp) (:pointer-void) :int
                        "((struct group*)(#0))->gr_gid" :one-liner t))
  
  (defun getpwnam (name)
    #+sbcl (sb-posix:getpwnam name)
    #+allegro (excl.osi:getpwnam name)
    #+ccl (ccl::with-cstrs ((cstr name)) (#.(read-from-string "#_getpwnam") cstr))
    #+ecl (let ((ret (ffi:c-inline (name) (:cstring) :pointer-void
                                   "getpwnam(#0)" :one-liner t)))
            (unless (zerop (si:foreign-data-address ret))
              ret)))
  
  (defun getpwuid (id)
    #+sbcl (sb-posix:getpwuid id)
    #+allegro (excl.osi:getpwuid id)
    #+ccl (#.(read-from-string "#_getpwuid") id)
    #+ecl (let ((ret (ffi:c-inline (id) (:int) :pointer-void
                                   "getpwuid(#0)" :one-liner t)))
            (unless (zerop (si:foreign-data-address ret))
              ret)))
  
  (defun passwd-username (pswd)
    #+sbcl (sb-posix:passwd-name pswd)
    #+allegro (excl.osi:pwent-name pswd)
    #+ccl (ccl:%get-cstring (ccl:pref pswd :passwd.pw_name))
    #+ecl (when pswd
            (ffi:c-inline (pswd) (:pointer-void) :cstring
                          "((struct passwd*)(#0))->pw_name" :one-liner t)))
  
  (defun passwd-uid (pswd)
    #+sbcl(sb-posix:passwd-uid pswd)
    #+allegro (excl.osi:pwent-uid pswd)
    #+ccl (unless (ccl:%null-ptr-p pswd) (ccl:pref pswd :passwd.pw_uid))
    #+ecl (when pswd
            (ffi:c-inline (pswd) (:pointer-void) :int
                          "((struct passwd*)(#0))->pw_uid" :one-liner t)))
  
  (defun passwd-dir (pswd)
    #+sbcl (sb-posix:passwd-dir pswd)
    #+allegro (excl.osi:pwent-dir pswd)
    #+ccl (ccl:%get-cstring(ccl:pref pswd :passwd.pw_dir))
    #+ecl (when pswd
            (ffi:c-inline (pswd) (:pointer-void) :cstring
                          "((struct passwd*)(#0))->pw_dir" :one-liner t)))
  
  (defun detouch-terminal (&key input output error)
    (declare (ignorable input output error))
    #-allegro
    (progn
      (chdir "/")
      (unless (eql t (setsid))
        (exit))
      #+sbcl
      (progn
        (setf sb-sys:*stdin* (make-concatenated-stream))
        (when (sb-sys:fd-stream-p sb-sys:*tty*)
          (close sb-sys:*tty* :abort t)
          (setf sb-sys:*tty* (make-two-way-stream sb-sys:*stdin* sb-sys:*stdout*))))
      #+ccl
      (setf ccl::*stdin* (make-concatenated-stream)
            ccl::*stdout* (make-broadcast-stream)
            ccl::*terminal-input* ccl::*stdin*
            ccl::*terminal-output* ccl::*stdout*
            ccl::*terminal-io* (make-two-way-stream
                                ccl::*terminal-input* ccl::*terminal-output*))
      (dup2 (popen "/dev/null" *o-rdonly*) 0)
      (dup2 (popen "/dev/null" (logior *o-wronly* *o-append*)) 1)
      (dup2 (popen "/dev/null" *o-rdonly*) 2))
    #+allegro
    (excl.osi:detach-from-terminal :output-stream nil :error-output-stream nil))
  
  (defun daemonize (&key input output error (umask +default-mask+) pidfile
                      exit-parent (exit-hook t) (disable-debugger t)
                      user group
                      sigabrt sighup sigint sigterm)
    (declare (ignorable exit-hook disable-debugger sigabrt sighup sigint sigterm))
    (when pidfile
      (ignore-errors (delete-file pidfile)))
    (let ((uid (typecase user
                 (string
                  (or (passwd-uid (getpwnam user))
                      (error "Unknown username: ~S" user)))
                 (unsigned-byte
                  (or (passwd-uid user)
                      (error "Unknown userid: ~S" user)))))
          (gid (typecase group
                 (string
                  (group-gid
                   (or (getgrnam group)
                       (error "Unknown groupname: ~S" group))))
                 (unsigned-byte
                  (if (getgrgid group)
                      group
                      (error "Unknown groupid: ~S" group)))))
          (pid (fork)))
      (cond ((zerop pid)
             ;; Child
             (umask umask)
             (detouch-terminal :input input :output output :error error)
             (when gid
               (setgid gid))
             (when uid
               (setuid uid))
             (let* ((out (make-two-way-stream
                          (make-concatenated-stream)
                          (make-broadcast-stream))))
               (setf *standard-output* out
                     *error-output* out
                     *trace-output* out
                     *standard-input* out
                     *debug-io* out
                     *query-io* out
                     *terminal-io* out)))
            (t
             ;; Parent
             (when exit-parent
               (exit))
             (pclose 0)
             (pclose 1)
             (pclose 2)
             (return-from daemonize pid))))
    (when pidfile
      (with-open-file (f pidfile :direction :output
                         :if-exists :supersede)
        (format f "~A~%" (getpid))))
    nil)
  