Changeset 15813 in project for chicken/trunk/posixunix.scm


Ignore:
Timestamp:
09/09/09 07:04:31 (11 years ago)
Author:
Kon Lovett
Message:

posixwin use of 'fx= 0' instead of 'zero?'
posixunix use of 'fx= 0' instead of 'zero?', fix for 'create-directory' when absolute pathname & easier to read
files common code for "is this a pds char?", added 'decompose-directory', rmvd redundent compile-time proc cache
files added 'decompose-directory'
data-structures 'random-seed' not here

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/posixunix.scm

    r15758 r15813  
    3232  (usual-integrations)
    3333  (hide ##sys#stat group-member _get-groups _ensure-groups posix-error
    34               ##sys#terminal-check
    35               check-time-vector)
     34        ##sys#terminal-check
     35        check-time-vector)
    3636  (not inline ##sys#interrupt-hook ##sys#user-interrupt-hook)
    3737  (foreign-declare #<<EOF
     
    490490     pathname-file process-fork file-close duplicate-fileno process-execute get-environment-variable
    491491     make-string make-input-port make-output-port ##sys#thread-block-for-i/o create-pipe
    492      process-wait pathname-strip-directory ##sys#expand-home-path directory
     492     process-wait pathname-strip-directory pathname-directory ##sys#expand-home-path directory
    493493     decompose-pathname ##sys#cons-flonum ##sys#decode-seconds ##sys#null-pointer ##sys#pointer->address
    494494     ##sys#substring ##sys#context-switch close-input-pipe close-output-pipe change-directory
     
    860860;;; Directory stuff:
    861861
     862#| ;has a problem w/ absolute-pathname (inf loop) & uses string-null?
    862863(define-inline (create-directory-helper name)
    863     (unless (zero? (##core#inline "C_mkdir" (##sys#make-c-string name)))
     864    (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name)))
    864865            (posix-error #:file-error 'create-directory
    865866                         "cannot create directory" name)))
     
    888889
    889890(define create-directory
    890   (let ((string=? string=?))
     891  (let ((string-length string-length))
    891892    (lambda (name #!optional parents?)
    892893      (##sys#check-string name 'create-directory)
    893       (if (not (string=? "" name))
     894      (if (fx< 0 (string-length name))
    894895          (let ((b (create-directory-check name)))
    895896            (if (not b)
     
    901902                ))
    902903          ))))
     904|#
     905
     906(define-inline (*directory? loc name)
     907  (and (fx= 0 (##core#inline "C_stat" (##sys#make-c-string name)))
     908       (foreign-value "C_isdir" bool) ) )
     909
     910(define-inline (*create-directory loc name)
     911  (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name)))
     912    (posix-error #:file-error loc "cannot create directory" name)) )
     913
     914(define create-directory
     915  (let ((decompose-pathname decompose-pathname)
     916        (pathname-directory pathname-directory) )
     917    (lambda (name #!optional parents?)
     918      (##sys#check-string name 'create-directory)
     919      (let ((name (##sys#expand-home-path name)))
     920        (unless (or (fx= 0 (##sys#size name)) (*directory? 'create-directory name))
     921          (if parents?
     922              (let loop ((dir (let-values (((dir file ext) (decompose-pathname name)))
     923                                (if file (make-pathname dir file ext) dir))))
     924                (when (and dir (not (*directory? 'create-directory dir)))
     925                  (loop (pathname-directory dir))
     926                  (*create-directory 'create-directory dir)) )
     927              (*create-directory 'create-directory name) ) ) ) ) ) )
    903928
    904929(define change-directory
    905930  (lambda (name)
    906931    (##sys#check-string name 'change-directory)
    907     (unless (zero? (##core#inline "C_chdir" (##sys#make-c-string (##sys#expand-home-path name))))
     932    (unless (fx= 0 (##core#inline "C_chdir" (##sys#make-c-string (##sys#expand-home-path name))))
    908933      (posix-error #:file-error 'change-directory "cannot change current directory" name) ) ) )
    909934
     
    911936  (lambda (name)
    912937    (##sys#check-string name 'delete-directory)
    913     (unless (zero? (##core#inline "C_rmdir" (##sys#make-c-string (##sys#expand-home-path name))))
     938    (unless (fx= 0 (##core#inline "C_rmdir" (##sys#make-c-string (##sys#expand-home-path name))))
    914939      (posix-error #:file-error 'delete-directory "cannot delete directory" name) ) ) )
    915940
     
    945970(define (directory? fname)
    946971  (##sys#check-string fname 'directory?)
    947   (let ((info (##sys#file-info (##sys#expand-home-path fname))))
    948     (and info (fx= 1 (##sys#slot info 4))) ) )
     972  (*directory? 'directory? (##sys#expand-home-path fname)) )
    949973
    950974(define current-directory
     
    23642388        [string-match string-match]
    23652389        [make-pathname make-pathname]
     2390        [pathname-file pathname-file]
    23662391        [directory? directory?] )
    23672392    (lambda (dir pred . action-id-limit)
Note: See TracChangeset for help on using the changeset viewer.