/[cmucl]/src/code/unix-glibc2.lisp
ViewVC logotype

Diff of /src/code/unix-glibc2.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.43 by rtoy, Wed Nov 14 17:20:46 2007 UTC revision 1.43.4.6 by rtoy, Mon Mar 16 21:10:55 2009 UTC
# Line 185  Line 185 
185            unix-current-directory unix-isatty unix-ttyname unix-execve            unix-current-directory unix-isatty unix-ttyname unix-execve
186            unix-socket unix-connect unix-bind unix-listen unix-accept            unix-socket unix-connect unix-bind unix-listen unix-accept
187            unix-recv unix-send unix-getpeername unix-getsockname            unix-recv unix-send unix-getpeername unix-getsockname
188            unix-getsockopt unix-setsockopt            unix-getsockopt unix-setsockopt unix-openpty
189    
190            unix-recvfrom unix-sendto unix-shutdown            unix-recvfrom unix-sendto unix-shutdown
191    
# Line 1272  length LEN and type TYPE." Line 1272  length LEN and type TYPE."
1272    
1273  ;;; pty.h  ;;; pty.h
1274    
1275  #+(or)  (defun unix-openpty (name termp winp)
 (defun unix-openpty (amaster aslave name termp winp)  
1276    "Create pseudo tty master slave pair with NAME and set terminal    "Create pseudo tty master slave pair with NAME and set terminal
1277     attributes according to TERMP and WINP and return handles for both     attributes according to TERMP and WINP and return handles for both
1278     ends in AMASTER and ASLAVE."     ends in AMASTER and ASLAVE."
1279    (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios))    (with-alien ((amaster int)
1280                            (* (struct winsize)))                 (aslave int))
1281                 amaster aslave name termp winp))      (values
1282         (int-syscall ("openpty" (* int) (* int) c-string (* (struct termios))
1283                                 (* (struct winsize)))
1284                      (addr amaster) (addr aslave) name termp winp)
1285         amaster aslave)))
1286    
1287  #+(or)  #+(or)
1288  (defun unix-forkpty (amaster name termp winp)  (defun unix-forkpty (amaster name termp winp)
# Line 2192  length LEN and type TYPE." Line 2195  length LEN and type TYPE."
2195    (with-alien ((buf (array char 1024)))    (with-alien ((buf (array char 1024)))
2196      (syscall ("readlink" c-string (* char) int)      (syscall ("readlink" c-string (* char) int)
2197               (let ((string (make-string result)))               (let ((string (make-string result)))
2198                   #-unicode
2199                 (kernel:copy-from-system-area                 (kernel:copy-from-system-area
2200                  (alien-sap buf) 0                  (alien-sap buf) 0
2201                  string (* vm:vector-data-offset vm:word-bits)                  string (* vm:vector-data-offset vm:word-bits)
2202                  (* result vm:byte-bits))                  (* result vm:byte-bits))
2203                   #+unicode
2204                   (let ((sap (alien-sap buf)))
2205                     (dotimes (k result)
2206                       (setf (aref string k) (code-char (sap-ref-8 sap k)))))
2207                 string)                 string)
2208               path (cast buf (* char)) 1024)))               path (cast buf (* char)) 1024)))
2209    
# Line 2867  in at a time in poll.") Line 2875  in at a time in poll.")
2875        readoth           Read by others.        readoth           Read by others.
2876        writeoth          Write by others.        writeoth          Write by others.
2877        execoth           Execute (search directory) by others.        execoth           Execute (search directory) by others.
2878    
2879      Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)
2880      are equivalent for 'mode.  The octal-base is familar to Unix users.
2881    
2882    It returns T on successfully completion; NIL and an error number    It returns T on successfully completion; NIL and an error number
2883    otherwise."    otherwise."
# Line 2898  in at a time in poll.") Line 2909  in at a time in poll.")
2909    
2910  (defun unix-mkdir (name mode)  (defun unix-mkdir (name mode)
2911    "Unix-mkdir creates a new directory with the specified name and mode.    "Unix-mkdir creates a new directory with the specified name and mode.
2912     (Same as those for unix-fchmod.)  It returns T upon success, otherwise     (Same as those for unix-chmod.)  It returns T upon success, otherwise
2913     NIL and an error number."     NIL and an error number."
2914    (declare (type unix-pathname name)    (declare (type unix-pathname name)
2915             (type unix-file-mode mode))             (type unix-file-mode mode))
# Line 3621  in at a time in poll.") Line 3632  in at a time in poll.")
3632          (let ((n (length s)))          (let ((n (length s)))
3633            ;;            ;;
3634            ;; Blast the string into place            ;; Blast the string into place
3635              #-unicode
3636            (kernel:copy-to-system-area (the simple-string s)            (kernel:copy-to-system-area (the simple-string s)
3637                                        (* vm:vector-data-offset vm:word-bits)                                        (* vm:vector-data-offset vm:word-bits)
3638                                        string-sap 0                                        string-sap 0
3639                                        (* (1+ n) vm:byte-bits))                                        (* (1+ n) vm:byte-bits))
3640              #+unicode
3641              (progn
3642                ;; FIXME: Do we need to apply some kind of transformation
3643                ;; to convert Lisp unicode strings to C strings?  Utf-8?
3644                (dotimes (k n)
3645                  (setf (sap-ref-8 string-sap k)
3646                        (logand #xff (char-code (aref s k)))))
3647                (setf (sap-ref-8 string-sap n) 0))
3648            ;;            ;;
3649            ;; Blast the pointer to the string into place            ;; Blast the pointer to the string into place
3650            (setf (sap-ref-sap vec-sap i) string-sap)            (setf (sap-ref-sap vec-sap i) string-sap)

Legend:
Removed from v.1.43  
changed lines
  Added in v.1.43.4.6

  ViewVC Help
Powered by ViewVC 1.1.5