Changeset 7985 in project


Ignore:
Timestamp:
01/29/08 21:05:40 (12 years ago)
Author:
Kon Lovett
Message:

Made custom input port read-line not call out from ##sys#scan-buffer-line. Made C_ tm get/set since used many times.

Location:
chicken/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/extras.scm

    r7929 r7985  
    622622             (lambda (p)                ; char-ready?
    623623               (ready?) )
    624              read-string                ; read-string
     624             read-string                ; read-string!
    625625             read-line) )               ; read-line
    626626           (data (vector #f))
     
    631631(define make-output-port
    632632  (let ([string string])
    633     (lambda (write close . flush)
    634       (let* ((flush (and (pair? flush) (car flush)))
    635              (class
     633    (lambda (write close #!optional flush)
     634      (let* ((class
    636635              (vector
    637636               #f                       ; read-char
     
    647646                 (when flush (flush)) )
    648647               #f                       ; char-ready?
    649                #f                       ; read-string
     648               #f                       ; read-string!
    650649               #f) )                    ; read-line
    651650             (data (vector #f))
  • chicken/trunk/library.scm

    r7945 r7985  
    100100  }
    101101  return C_SCHEME_FALSE;
     102}
     103
     104static C_word
     105fast_read_string_from_file (C_word dest, C_word port, C_word len, C_word pos)
     106{
     107  int n = C_unfix (len);
     108  char * buf = (char *) (C_data_pointer (dest) + C_unfix (pos));
     109  C_FILEPTR fp = C_port_file (port);
     110
     111  size_t m = fread (buf, sizeof (char), n, fp);
     112
     113  if (m < n) {
     114    if (feof (fp)) {
     115      clearerr (fp);
     116      if (0 == m)
     117        return C_SCHEME_END_OF_FILE;
     118    } else if (ferror (fp)) {
     119      if (0 == m) {
     120        return C_SCHEME_FALSE;
     121      } else {
     122        clearerr (fp);
     123      }
     124    }
     125  }
     126
     127  return C_fix (m);
    102128}
    103129EOF
     
    16541680; 8:  closed (bool)
    16551681; 9:  data
    1656 ; 10-15: reserved
     1682; 10-15: reserved, port class specific
    16571683;
    16581684; Port-class:
     
    16951721            (##core#inline "C_char_ready_p" p) )
    16961722          #f                            ; read-string!
     1723          #; ;UNUSED
     1724          (lambda (p n dest start)      ; read-string!
     1725            (let loop ([rem (or n (fx- (##sys#size dest) start))] [act 0] [start start])
     1726              (let ([len (##core#inline "fast_read_string_from_file" dest p rem start)])
     1727                (cond [(eof-object? len)
     1728                        (if (eq? 0 act) #!eof act)]
     1729                      [(not len)
     1730                        act]
     1731                      [(fx< len rem)
     1732                        (loop (fx- rem len) (fx+ act len) (fx+ start len))]
     1733                      [else
     1734                        act ] ) ) ) )
    16971735          (lambda (p limit)             ; read-line
    16981736            (let* ((buffer-len (if limit limit 256))
     
    20092047  (##sys#read-char/port port) )
    20102048
    2011 (define (##sys#read-char/port port)
    2012   (##sys#check-port* port 'read-char)
    2013   (##sys#check-port-mode port #t 'read-char)
    2014   (##sys#read-char-0 port) )
    2015 
    20162049(define (##sys#read-char-0 p)
    20172050  (let ([c (if (##sys#slot p 6)
     
    20272060    c) )
    20282061
    2029 (define (peek-char #!optional (port ##sys#standard-input))
    2030   (##sys#check-port* port 'peek-char)
    2031   (##sys#check-port-mode port #t 'peek-char)
    2032   (##sys#peek-char-0 port) )
     2062(define (##sys#read-char/port port)
     2063  (##sys#check-port* port 'read-char)
     2064  (##sys#check-port-mode port #t 'read-char)
     2065  (##sys#read-char-0 port) )
    20332066
    20342067(define (##sys#peek-char-0 p)
     
    20392072          (##sys#setislot p 6 #t) )
    20402073        c) ) )
     2074
     2075(define (peek-char #!optional (port ##sys#standard-input))
     2076  (##sys#check-port* port 'peek-char)
     2077  (##sys#check-port-mode port #t 'peek-char)
     2078  (##sys#peek-char-0 port) )
    20412079
    20422080(define (read #!optional (port ##sys#standard-input))
     
    30593097                  dest) ) ) ) ) ) ) ) )
    30603098
     3099; Invokes the eol handler when EOL or EOS is reached.
    30613100(define (##sys#scan-buffer-line buf limit pos k)
    30623101  (let loop ((pos2 pos))
     
    30703109                 (k pos2 (fx+ pos2 2)) )
    30713110                (else (loop (fx+ pos2 1))) ) ) ) ) )
     3111
     3112; Scans a string, 'buf', from a start index, 'pos', to an end index,
     3113; 'lim'. During the scan the current position of the 'port' is updated to
     3114; reflect the rows & columns encountered.
     3115#; ;UNUSED (at the moment)
     3116(define (##sys#update-port-position/scan port buf pos lim)
     3117  (let loop ([pos pos])
     3118    (let ([bumper
     3119           (lambda (cur ptr)
     3120             (cond [(eq? cur ptr)       ; at EOB
     3121                     (##sys#setislot port 5 (fx+ (##sys#slot port 5) (fx- cur pos)))
     3122                     #f ]
     3123                   [else                ; at EOL
     3124                     (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1))
     3125                     (##sys#setislot port 5 0)
     3126                     ptr ] ) ) ] )
     3127      (when pos
     3128        (loop (##sys#scan-buffer-line buf lim pos bumper)) ) ) ) )
    30723129
    30733130(define open-input-string
  • chicken/trunk/posixunix.scm

    r7984 r7985  
    379379        (C_set_block_item(v, 9, C_fix(C_tm.tm_gmtoff)))
    380380
     381#if 0
    381382#if !defined(C_GNU_ENV) || defined(__CYGWIN__) || defined(__uClinux__)
    382383# define C_tm_set(v) (C_tm_set_08(v), &C_tm)
     
    385386# define C_tm_set(v) (C_tm_set_08(v), C_tm_set_9(v), &C_tm)
    386387# define C_tm_get(v) (C_tm_get_08(v), C_tm_get_9(v), v)
     388#endif
     389#else
     390#if !defined(C_GNU_ENV) || defined(__CYGWIN__) || defined(__uClinux__)
     391static struct tm *
     392C_tm_set (C_word v)
     393{
     394  C_tm_set_08 (v);
     395  return &C_tm;
     396}
     397static C_word
     398C_tm_get (C_word v)
     399{
     400  C_tm_get_08 (v);
     401  C_tm_set_9 (v);
     402  return v;
     403}
     404#else
     405static struct tm *
     406C_tm_set (C_word v)
     407{
     408  C_tm_set_08 (v);
     409  return &C_tm;
     410}
     411static C_word
     412C_tm_get (C_word v)
     413{
     414  C_tm_get_08 (v);
     415  C_tm_get_9 (v);
     416  return v;
     417}
     418#endif
    387419#endif
    388420
     
    830862                         [char1 (string-ref file 0)]
    831863                         [char2 (and (fx> flen 1) (string-ref file 1))] )
    832                     (if (and (eq? char1 #\.)
     864                    (if (and (eq? #\. char1)
    833865                             (or (not char2)
    834                                  (and (eq? char2 #\.) (eq? flen 2))
     866                                 (and (eq? #\. char2) (eq? 2 flen))
    835867                                 (not show-dotfiles?) ) )
    836868                        (loop)
     
    14551487  (let ([make-input-port make-input-port]
    14561488        [set-port-name! set-port-name!] )
    1457     (lambda (loc nam fd
    1458                #!optional
    1459                (nonblocking? #f) (bufi 1) (on-close noop) (more? #f))
     1489    (lambda (loc nam fd #!optional (nonblocking? #f) (bufi 1) (on-close noop) (more? #f))
    14601490      (when nonblocking? (##sys#file-nonblocking! fd) )
    14611491      (let ([bufsiz (if (fixnum? bufi) bufi (##sys#size bufi))]
     
    15051535              [this-port
    15061536                (make-input-port
    1507                   (lambda ()                    ; Read-Char
     1537                  (lambda ()                    ; read-char
    15081538                    (fetch)
    15091539                    (let ([ch (peek)])
     
    15121542                      (set! bufpos (fx+ bufpos 1))
    15131543                      ch ) )
    1514                   (lambda () ; Ready?
     1544                  (lambda ()                    ; char-ready?
    15151545                    (or (fx< bufpos buflen)
    15161546                        (ready?)) )
    1517                   (lambda ()                    ; Close
     1547                  (lambda ()                    ; close
    15181548                    ; Do nothing when closed already
    15191549                    (unless (##sys#slot this-port 8)
     
    15211551                        (posix-error #:file-error loc "cannot close" fd nam) )
    15221552                      (on-close) ) )
    1523                   (lambda ()                    ; Peek
     1553                  (lambda ()                    ; peek-char
    15241554                    (fetch)
    15251555                    (peek) )
    1526                   (lambda (port n dest start)   ; Read-String!
    1527                     (let loop ([n n] [m 0] [start start])
    1528                       (cond [(eq? n 0) m]
     1556                  (lambda (port n dest start)   ; read-string!
     1557                    (let loop ([n (or n (fx- (##sys#size dest) start))] [m 0] [start start])
     1558                      (cond [(eq? 0 n) m]
    15291559                            [(fx< bufpos buflen)
    15301560                              (let* ([rest (fx- buflen bufpos)]
     
    15351565                            [else
    15361566                              (fetch)
    1537                               (if (eq? buflen 0)
     1567                              (if (eq? 0 buflen)
    15381568                                  m
    15391569                                  (loop n m start) ) ] ) ) )
    1540                   (lambda (port limit)          ; Read-Line
     1570                  (lambda (port limit)          ; read-line
    15411571                    (let loop ([str #f])
    1542                       (cond [(fx< bufpos buflen)
    1543                               (##sys#scan-buffer-line
    1544                                 buf buflen bufpos
    1545                                 (lambda (cur ptr)
    1546                                   (let ([dest (##sys#make-string (fx- cur bufpos))])
    1547                                     (##core#inline "C_substring_copy" buf dest bufpos cur 0)
    1548                                     (set! bufpos ptr)
    1549                                     (cond [(eq? cur ptr) ; no line-terminator encountered
    1550                                             (fetch)
    1551                                             (if (fx>= bufpos buflen)
    1552                                                 (or str "")
    1553                                                 (loop (if str (##sys#string-append str dest) dest)) ) ]
    1554                                           [else
    1555                                             (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1))
    1556                                             (if str (##sys#string-append str dest) dest) ] ) ) ) ) ]
    1557                             [else
    1558                               (fetch)
    1559                               (if (fx< bufpos buflen)
    1560                                  (loop str)
    1561                                  #!eof) ] ) ) ) )] )
     1572                      (let ([bumper
     1573                             (lambda (cur ptr)
     1574                               (let* ([cnt (fx- cur bufpos)]
     1575                                      [dest
     1576                                       (if (eq? 0 cnt)
     1577                                           (or str "")
     1578                                           (let ([dest (##sys#make-string cnt)])
     1579                                             (##core#inline "C_substring_copy"
     1580                                              buf dest bufpos cur 0)
     1581                                             (##sys#setislot port 5
     1582                                              (fx+ (##sys#slot port 5) cnt))
     1583                                             (if str
     1584                                                 (##sys#string-append str dest)
     1585                                                 dest ) ) ) ] )
     1586                                 (set! bufpos ptr)
     1587                                 (cond [(eq? cur ptr)   ; no EOL encountered
     1588                                         (fetch)
     1589                                         (values dest (fx< bufpos buflen)) ]
     1590                                        [else           ; at EOL
     1591                                          (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1))
     1592                                          (##sys#setislot port 5 0)
     1593                                          (values dest #f) ] ) ) ) ] )
     1594                        (cond [(fx< bufpos buflen)
     1595                                (let-values ([(dest cont?)
     1596                                              (##sys#scan-buffer-line buf buflen bufpos bumper)])
     1597                                  (if cont?
     1598                                      (loop dest)
     1599                                      dest ) ) ]
     1600                              [else
     1601                                (fetch)
     1602                                (if (fx< bufpos buflen)
     1603                                    (loop str)
     1604                                    #!eof) ] ) ) ) ) ) ] )
    15621605            (set-port-name! this-port nam)
    15631606            this-port ) ) ) ) ) )
     
    15661609  (let ([make-output-port make-output-port]
    15671610        [set-port-name! set-port-name!] )
    1568     (lambda (loc nam fd
    1569                #!optional
    1570                (nonblocking? #f) (bufi 0) (on-close noop))
     1611    (lambda (loc nam fd #!optional (nonblocking? #f) (bufi 0) (on-close noop))
    15711612      (when nonblocking? (##sys#file-nonblocking! fd) )
    15721613      (letrec (
     
    16081649            [this-port
    16091650              (make-output-port
    1610                 (lambda (str)           ; Write-String
     1651                (lambda (str)           ; write-string
    16111652                  (store str) )
    1612                 (lambda ()              ; Close
     1653                (lambda ()              ; close
    16131654                  ; Do nothing when closed already
    16141655                  (unless (##sys#slot this-port 8)
     
    16161657                      (posix-error #:file-error loc "cannot close" fd nam) )
    16171658                    (on-close) ) )
    1618                 (lambda ()              ; Flush
     1659                (lambda ()              ; flush
    16191660                  (store #f) ) )] )
    16201661          (set-port-name! this-port nam)
     
    18751916  (##sys#check-port port 'terminal-port?)
    18761917  (let ([fp (##sys#peek-unsigned-integer port 0)])
    1877     (and (not (eq? fp 0)) (##core#inline "C_tty_portp" port) ) ) )
     1918    (and (not (eq? 0 fp)) (##core#inline "C_tty_portp" port) ) ) )
    18781919
    18791920(define (##sys#terminal-check caller port)
     
    20402081      (let ([args (if (pair? args) (car args) #f)]
    20412082            [pid (process-fork)] )
    2042         (cond [(not (eq? pid 0)) pid]
     2083        (cond [(not (eq? 0 pid)) pid]
    20432084              [args (process-execute f args)]
    20442085              [else
Note: See TracChangeset for help on using the changeset viewer.