Changeset 11766 in project for chicken


Ignore:
Timestamp:
08/26/08 07:17:11 (12 years ago)
Author:
elf
Message:

LOTS of fixes.
compiler fixes: nested statements like
(print (((if #t (lambda () add1))) 0))
now work. imitation compiler hash tables are used properly. bootstrap target
works now, although the bootstrap is WAY out of date. all of the -debug flags
now work and dont make the compilation crash. :)

Location:
chicken/branches/hygienic
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/hygienic/batch-driver.scm

    r11646 r11766  
    498498                    [proc (user-pass-2)] )
    499499               (when (debugging 'M "; requirements:")
    500                  (pretty-print (##sys#hash-table->alist file-requirements)))
     500                 (pretty-print (apply append (vector->list file-requirements))))
    501501               (when proc
    502502                 (when verbose (printf "Secondary user pass...~%"))
  • chicken/branches/hygienic/compiler.scm

    r11741 r11766  
    11681168                                 
    11691169                                 [else (handle-call)] ) ) ) ) ] ) ) ) )
     1170; end of clause
    11701171
    11711172          ((not (proper-list? x))
     
    11771178           (mapwalk x se) )
    11781179
    1179           ((and (pair? (car x)) (eq? 'lambda (or (lookup (caar x) se) (caar x))))
     1180          ((and (pair? (car x)) (symbol? (caar x)) (eq? 'lambda (or (lookup (caar x) se) (caar x))))
    11801181           (let ([lexp (car x)]
    11811182                 [args (cdr x)] )
  • chicken/branches/hygienic/eval.scm

    r11680 r11766  
    155155      (if (eq? s cache-s)
    156156          (##core#inline "C_fixnum_modulo" cache-h n)
    157           (let ([h (##core#inline "C_hash_string" (##sys#slot s 1))])
    158             (set! cache-s s)
    159             (set! cache-h h)
    160             (##core#inline "C_fixnum_modulo" h n) ) ) ) ) )
     157          (begin
     158              (set! cache-s s)
     159              (set! cache-h (##core#inline "C_hash_string" (##sys#slot s 1)))
     160              (##core#inline "C_fixnum_modulo" cache-h n))))))
    161161
    162162(define (##sys#hash-table-ref ht key)
    163   (let ((k (##sys#hash-symbol key (##core#inline "C_block_size" ht))))
    164     (let loop ((bucket (##sys#slot ht k)))
    165       (and (not (null? bucket))
    166            (let ((b (##sys#slot bucket 0)))
    167              (if (eq? key (##sys#slot b 0))
    168                  (##sys#slot b 1)
    169                  (loop (##sys#slot bucket 1)) ) ) ) ) ) )
     163  (let loop ((bucket (##sys#slot ht (##sys#hash-symbol key (##core#inline "C_block_size" ht)))))
     164      (if (eq? '() bucket)
     165          #f
     166          (if (eq? key (##sys#slot (##sys#slot bucket 0) 0))
     167              (##sys#slot (##sys#slot bucket 0) 1)
     168              (loop (##sys#slot bucket 1))))))
    170169
    171170(define (##sys#hash-table-set! ht key val)
    172171  (let* ((k (##sys#hash-symbol key (##core#inline "C_block_size" ht)))
    173          (bucket0 (##sys#slot ht k)) )
    174     (let loop ((bucket bucket0))
    175       (if (eq? bucket '())
    176           (##sys#setslot ht k (cons (cons key val) bucket0))
    177           (let ((b (##sys#slot bucket 0)))
    178             (if (eq? key (##sys#slot b 0))
    179                 (##sys#setslot b 1 val)
    180                 (loop (##sys#slot bucket 1)) ) ) ) ) ) )
     172         (ib (##sys#slot ht k)))
     173      (let loop ((bucket ib))
     174          (if (eq? '() bucket)
     175              (##sys#setslot ht k (cons (cons key val) ib))
     176              (if (eq? key (##sys#slot (##sys#slot bucket 0) 0))
     177                  (##sys#setslot (##sys#slot bucket 0) 1 val)
     178                  (loop (##sys#slot bucket 1)))))))
    181179
    182180(define (##sys#hash-table-update! ht key updtfunc valufunc)
  • chicken/branches/hygienic/rules.make

    r11750 r11766  
    14411441.PHONY: bootstrap bootstrap.tar.gz
    14421442
    1443 bootstrap: bootstrap.tar.gz
     1443bootstrap:
    14441444        gzip -d -c $(SRCDIR)/bootstrap.tar.gz | tar xvf -
    14451445        touch *.c
  • chicken/branches/hygienic/runtime.c

    r11646 r11766  
    38253825  int len = C_header_size(str);
    38263826  C_byte *ptr = C_data_pointer(str);
    3827 
    3828   while(len--) key = (key << 4) + *(ptr++);
     3827// *(ptr++) means you run off the edge. 
     3828  while(len--) key = (key << 4) + (*ptr++);
    38293829
    38303830  return C_fix(key & C_MOST_POSITIVE_FIXNUM);
     
    38383838  C_byte *ptr = C_data_pointer(str);
    38393839
    3840   while(len--) key = (key << 4) + C_tolower(*(ptr++));
     3840  while(len--) key = (key << 4) + C_tolower(*ptr++);
    38413841
    38423842  return C_fix(key & C_MOST_POSITIVE_FIXNUM);
Note: See TracChangeset for help on using the changeset viewer.