Changeset 14237 in project


Ignore:
Timestamp:
04/13/09 12:38:22 (11 years ago)
Author:
felix winkelmann
Message:

applied readline-speedup patch by Jim Ursetto; chicken-install -prefix should work better

Location:
chicken/trunk
Files:
1 added
6 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/chicken.h

    r13819 r14237  
    829829# define C_fputc                    fputc
    830830# define C_putchar                  putchar
     831# if (defined getc_unlocked || _POSIX_C_SOURCE >= 199506L)
     832#  define C_getc                    getc_unlocked
     833# else
     834#  define C_getc                    getc
     835# endif
    831836# define C_fgetc                    fgetc
    832837# define C_fgets                    fgets
  • chicken/trunk/library.scm

    r14143 r14237  
    7878  C_FILEPTR fp = C_port_file(port);
    7979
    80   if ((c = getc(fp)) == EOF)
     80  if ((c = C_getc(fp)) == EOF)
    8181    return C_SCHEME_END_OF_FILE;
    8282
    83   ungetc(c, fp);
     83  C_ungetc(c, fp);
    8484
    8585  for (i = 0; i < n; i++) {
    86     c = getc(fp);
     86    c = C_getc(fp);
    8787    switch (c) {
    88     case '\r':  if ((c = getc(fp)) != '\n') ungetc(c, fp);
     88    case '\r':  if ((c = C_getc(fp)) != '\n') C_ungetc(c, fp);
    8989    case EOF:   clearerr(fp);
    9090    case '\n':  return C_fix(i);
     
    177177(define-constant char-name-table-size 37)
    178178(define-constant output-string-initial-size 256)
     179(define-constant read-line-buffer-initial-size 1024)
    179180(define-constant default-parameter-vector-size 16)
    180181(define-constant maximal-string-length #x00ffffff)
     
    17161717    port) )
    17171718
     1719;;; Stream ports:
     1720; Input port slots:
     1721;   12: Static buffer for read-line, allocated on-demand
     1722
    17181723(define ##sys#stream-port-class
    17191724  (vector (lambda (p)                   ; read-char
     
    17461751                        act ] ) ) ) )
    17471752          (lambda (p limit)             ; read-line
    1748             (let* ((buffer-len (if limit limit 256))
    1749                    (buffer (make-string buffer-len)))
    1750               (let loop ([len buffer-len]
    1751                          [buffer buffer]
     1753            (if limit (##sys#check-exact limit 'read-line))
     1754            (let ((sblen read-line-buffer-initial-size))
     1755              (unless (##sys#slot p 12)
     1756                (##sys#setslot p 12 (##sys#make-string sblen)))
     1757              (let loop ([len sblen]
     1758                         [limit (or limit maximal-string-length)]   ; guaranteed fixnum?
     1759                         [buffer (##sys#slot p 12)]
    17521760                         [result ""]
    17531761                         [f #f])
    1754                 (let ([n (##core#inline "fast_read_line_from_file" buffer p len)])
     1762                (let ([n (##core#inline "fast_read_line_from_file" buffer p
     1763                                        (fxmin limit len))])
    17551764                  (cond [(eof-object? n) (if f result #!eof)]
    1756                         [(and limit (not n))
    1757                          (##sys#string-append result (##sys#substring buffer 0 limit))]
    17581765                        [(not n)
    1759                          (loop (fx* len 2) (##sys#make-string (fx* len 2))
    1760                                (##sys#string-append
    1761                                 result
    1762                                 (##sys#substring buffer 0 len))
    1763                                #t) ]
     1766                         (if (fx< limit len)
     1767                             (##sys#string-append result (##sys#substring buffer 0 limit))
     1768                             (loop (fx* len 2)
     1769                                   (fx- limit len)
     1770                                   (##sys#make-string (fx* len 2))
     1771                                   (##sys#string-append result buffer)
     1772                                   #t)) ]
    17641773                        [f (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
    17651774                           (##sys#string-append result (##sys#substring buffer 0 n))]
    17661775                        [else
    17671776                         (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
    1768                          (##sys#substring buffer 0 n)] ) ) ) ) ) ) )
     1777                         (##sys#substring buffer 0 n)] ) ) ) ) )         
     1778 ) )
    17691779
    17701780(define ##sys#open-file-port (##core#primitive "C_open_file_port"))
  • chicken/trunk/runtime.c

    r13948 r14237  
    40344034C_regparm C_word C_fcall C_read_char(C_word port)
    40354035{
    4036   int c = C_fgetc(C_port_file(port));
     4036  int c = C_getc(C_port_file(port));
    40374037
    40384038  return c == EOF ? C_SCHEME_END_OF_FILE : C_make_character(c);
     
    40434043{
    40444044  C_FILEPTR fp = C_port_file(port);
    4045   int c = C_fgetc(fp);
     4045  int c = C_getc(fp);
    40464046
    40474047  C_ungetc(c, fp);
  • chicken/trunk/scripts/make-egg-index.scm

    r14235 r14237  
    8888    (misc "Miscellaneous")
    8989    (hell "Concurrency and parallelism")
    90     (uncategorized "Not categerized")
     90    (uncategorized "Not categorized")
    9191    (obsolete "Unsupported or redundant") ) )
    9292
  • chicken/trunk/setup-api.scm

    r14236 r14237  
    449449
    450450(define (copy-file from to #!optional (err #t) (prefix (installation-prefix)))
     451  ;;XXX the prefix handling is completely bogus
    451452  (let ((from (if (pair? from) (car from) from))
    452453        (to (let ((to-path (if (pair? from) (make-pathname to (cadr from)) to)))
     
    517518                               (run (,*ranlib-command* ,(shellpath to)) ) ))
    518519                           (make-dest-pathname rpath f)))
    519                        files) ) )
     520                       files) )
     521           (pre (installation-prefix))
     522           (docpath (if pre
     523                        (ensure-directory (make-pathname pre "share/chicken/doc"))
     524                        *doc-path*)))
    520525      (and-let* ((docs (assq 'documentation info)))
    521         (print "\n* Installing documentation files in " *doc-path* ":")
     526        (print "\n* Installing documentation files in " docpath ":")
    522527        (for-each
    523528         (lambda (f)
    524            (copy-file f (make-pathname *doc-path* f) #f) )
     529           (copy-file f (make-pathname docpath f) #f) )
    525530         (cdr docs))
    526531        (newline))
    527532      (and-let* ((exs (assq 'examples info)))
    528         (print "\n* Installing example files in " *doc-path* ":")
     533        (print "\n* Installing example files in " docpath ":")
    529534        (for-each
    530535         (lambda (f)
    531            (let ((destf (make-pathname *doc-path* f)))
     536           (let ((destf (make-pathname docpath f)))
    532537             (copy-file f destf #f)
    533538             (unless *windows-shell*
     
    544549  (when (setup-install-flag)
    545550    (let* ((files (check-filelist (if (list? files) files (list files))))
    546            (ppath ((lambda (pre) (if pre (make-pathname pre (program-path)) (program-path)))
     551           (ppath ((lambda (pre)
     552                     (if pre
     553                         (ensure-directory (make-pathname pre "bin"))
     554                         (program-path)))
    547555                   (installation-prefix)))
    548556           (files (if *windows*
     
    566574  (when (setup-install-flag)
    567575    (let* ((files (check-filelist (if (list? files) files (list files))))
    568            (ppath ((lambda (pre) (if pre (make-pathname pre (program-path)) (program-path)))
     576           (ppath ((lambda (pre)
     577                     (if pre
     578                         (ensure-directory (make-pathname pre "bin"))
     579                         (program-path)))
    569580                   (installation-prefix)))
    570581           (pfiles (map (lambda (f)
     
    585596(define (repo-path #!optional ddir?)
    586597  (let ((p (if (and ddir? (installation-prefix))
    587                (make-pathname (installation-prefix) (repository-path))
     598               (make-pathname
     599                (installation-prefix)
     600                (sprintf "lib/chicken/~a" (##sys#fudge 42)))
    588601               (repository-path))) )
    589602    (ensure-directory p)
     
    596609          (error "cannot create directory: a file with the same name already exists") )
    597610        (begin
    598           (create-directory dir)
     611          (create-directory/parents dir)
    599612          (unless *windows-shell*
    600                   (run (,*chmod-command* a+x ,(shellpath dir))))))))
     613                  (run (,*chmod-command* a+x ,(shellpath dir)))))))
     614  path)
    601615
    602616(define (try-compile code #!key c++ (cc (if c++ *cxx* *cc*)) (cflags "") (ldflags "")
  • chicken/trunk/site/index.html

    r14200 r14237  
    179179</pre>
    180180(username: <tt>anonymous</tt>, password: &lt;none&gt;)
     181<p>
     182Also checkout our <a href="http://www.chicken-scheme.org/"/>Bug Tracking System</p>.
     183</p>
    181184</p>
    182185
Note: See TracChangeset for help on using the changeset viewer.