Changeset 12639 in project for chicken


Ignore:
Timestamp:
11/28/08 14:17:04 (11 years ago)
Author:
felix winkelmann
Message:

merged trunk changes into branch

Location:
chicken/branches/lazy-gensyms
Files:
9 edited

Legend:

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

    r12629 r12639  
    382382        (dribble "Generating ~aprofile" (if acc "accumulated " "")) ) )
    383383
    384     (and-let* ((dbfile (file-exists? (make-pathname (repository-path) "db"))))
     384    ;;*** hardcoded "modules.db" is bad (also used in chicken-install.scm)
     385    (and-let* ((dbfile (file-exists? (make-pathname (repository-path) "modules.db"))))
    385386      (dribble "loading database ~a ..." dbfile)
    386387      (for-each
  • chicken/branches/lazy-gensyms/c-backend.scm

    r12612 r12639  
    305305                             (expr-args args i)
    306306                             (gen ");") ) ) )
     307                     ((and (eq? '##core#global (node-class fn))
     308                           (not unsafe)
     309                           (not no-procedure-checks)
     310                           (not (first params)))
     311                      (let* ((gparams (node-parameters fn))
     312                             (index (first gparams))
     313                             (safe (second gparams))
     314                             (block (third gparams))
     315                             (carg #f))
     316                        (gen #t "((C_proc" nf ")")
     317                        (cond (block
     318                               (set! carg (string-append "lf[" (number->string index) "]"))
     319                               (if safe
     320                                   (gen "C_retrieve_proc(" carg ")")
     321                                   (gen "C_retrieve2_symbol_proc(" carg ","
     322                                        (c-ify-string (symbol->string (fourth gparams))) #\)) ) )
     323                              (safe
     324                               (set! carg
     325                                 (string-append "*((C_word*)lf[" (number->string index) "]+1)"))
     326                               (gen "C_retrieve_proc(" carg ")"))
     327                              (else
     328                               (set! carg
     329                                 (string-append "*((C_word*)lf[" (number->string index) "]+1)"))
     330                               (gen "C_retrieve_symbol_proc(lf[" index "])") ))
     331                        (gen ")(" nf #\, carg #\,)
     332                        (expr-args args i)
     333                        (gen ");") ) )
    307334                     (else
    308335                      (gen #t #\t nc #\=)
  • chicken/branches/lazy-gensyms/chicken-install.scm

    r12609 r12639  
    312312                 (let* ((mod (cdr m))
    313313                        (mname (##sys#module-name mod)))
    314                    (print " " mname)
     314                   (print* " " mname)
    315315                   (let-values (((_ ve se) (##sys#module-exports mod)))
    316316                     (append
     
    320320              (lambda (e1 e2)
    321321                (string<? (symbol->string (car e1)) (symbol->string (car e2)))))))
     322        (newline)
    322323        (with-output-to-file (make-pathname (repository-path) +module-db+)
    323324          (lambda ()
  • chicken/branches/lazy-gensyms/chicken-syntax.scm

    r12559 r12639  
    2929  (unit chicken-syntax)
    3030  (disable-interrupts)
     31  (no-bound-checks)
     32  (no-procedure-checks)
    3133  (fixnum) )
    3234
  • chicken/branches/lazy-gensyms/chicken.h

    r11149 r12639  
    12631263C_fctexport C_word C_fcall C_retrieve2(C_word val, char *name) C_regparm;
    12641264C_fctexport void *C_fcall C_retrieve_proc(C_word closure) C_regparm;
     1265C_fctexport void *C_fcall C_retrieve_symbol_proc(C_word sym) C_regparm;
     1266C_fctexport void *C_fcall C_retrieve2_symbol_proc(C_word val, char *name) C_regparm;
    12651267C_fctexport C_word C_fcall C_permanentp(C_word x) C_regparm;
    12661268C_fctexport int C_in_stackp(C_word x) C_regparm;
  • chicken/branches/lazy-gensyms/expand.scm

    r12638 r12639  
    16021602         (and-let* ((a (##sys#get u '##core#db #f)))
    16031603           (let ((m (cadr a)))
    1604              (unless (memq m suggest)
     1604             (when (and (= (length a) 2) (not (memq m suggest)))
    16051605               (set! suggest (cons m suggest)))))))
    16061606     (module-undefined-list mod))
  • chicken/branches/lazy-gensyms/posixunix.scm

    r11989 r12639  
    16081608            [ready?
    16091609              (lambda ()
    1610                 (when (fx= -1 (##sys#file-select-one fd))
    1611                   (posix-error #:file-error loc "cannot select" fd nam) ) )]
     1610                (let ((res (##sys#file-select-one fd)))
     1611                  (if (fx= -1 res)
     1612                      (if (fx= _errno _ewouldblock)
     1613                          #f
     1614                          (posix-error #:file-error loc "cannot select" fd nam))
     1615                      (fx= 1 res))))]
    16121616            [peek
    16131617              (lambda ()
  • chicken/branches/lazy-gensyms/rules.make

    r12609 r12639  
    10591059ifeq ($(DESTDIR),)
    10601060        $(DESTDIR)$(IBINDIR)/$(CHICKEN_INSTALL_PROGRAM) -update-db
     1061else
     1062        @echo
     1063        @echo "Warning: can not run `chicken-install -u\' when DESTDIR is set"
     1064        @echo
    10611065endif
    10621066endif
     
    12561260        $(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
    12571261setup-api.import.c: $(SRCDIR)setup-api.scm
    1258         $(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
     1262        $(CHICKEN) $(SRCDIR)setup-api.import.scm $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
    12591263setup-download.import.c: $(SRCDIR)setup-download.scm
    1260         $(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
     1264        $(CHICKEN) $(SRCDIR)setup-download.import.scm $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
    12611265setup-utils.import.c: $(SRCDIR)setup-utils.scm
    1262         $(CHICKEN) $< $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
     1266        $(CHICKEN) $(SRCDIR)setup-utils.import.scm $(CHICKEN_IMPORT_LIBRARY_OPTIONS) -output-file $@
    12631267
    12641268chicken.c: $(SRCDIR)chicken.scm $(SRCDIR)chicken-ffi-syntax.scm $(SRCDIR)private-namespace.scm $(SRCDIR)tweaks.scm
  • chicken/branches/lazy-gensyms/runtime.c

    r12476 r12639  
    35603560C_regparm C_word C_fcall C_retrieve(C_word sym)
    35613561{
    3562   C_word val = C_u_i_car(sym);
     3562  C_word val = C_block_item(sym, 0);
    35633563
    35643564  if(val == C_SCHEME_UNBOUND)
     
    36193619{
    36203620  closure = resolve_procedure(closure, NULL);
     3621
     3622#ifndef C_NO_APPLY_HOOK
     3623  if(C_block_item(apply_hook_symbol, 0) != C_SCHEME_FALSE) {
     3624    C_mutate(&C_block_item(last_applied_procedure_symbol, 0), closure);
     3625    return (void *)C_block_item(C_block_item(apply_hook_symbol, 0), 0);
     3626  }
     3627#endif
     3628
     3629  return (void *)C_block_item(closure, 0);
     3630}
     3631
     3632
     3633C_regparm void *C_fcall C_retrieve_symbol_proc(C_word sym)
     3634{
     3635  C_word val = C_block_item(sym, 0);
     3636  C_word closure;
     3637
     3638  if(val == C_SCHEME_UNBOUND)
     3639    val = C_get_unbound_variable_value_hook(sym);
     3640
     3641  closure = resolve_procedure(val, NULL);
     3642
     3643#ifndef C_NO_APPLY_HOOK
     3644  if(C_block_item(apply_hook_symbol, 0) != C_SCHEME_FALSE) {
     3645    C_mutate(&C_block_item(last_applied_procedure_symbol, 0), closure);
     3646    return (void *)C_block_item(C_block_item(apply_hook_symbol, 0), 0);
     3647  }
     3648#endif
     3649
     3650  return (void *)C_block_item(closure, 0);
     3651}
     3652
     3653
     3654C_regparm void *C_fcall C_retrieve2_symbol_proc(C_word val, char *name)
     3655{
     3656  C_word closure;
     3657  C_word *p;
     3658  int len;
     3659
     3660  if(val == C_SCHEME_UNBOUND) {
     3661    len = C_strlen(name);
     3662    p = C_alloc(C_SIZEOF_STRING(len));  /* this is ok: we won't return from `C_retrieve2' (or the value isn't needed). */
     3663    val = get_unbound_variable_value(C_string2(&p, name));
     3664  }
     3665
     3666  closure = resolve_procedure(val, NULL);
    36213667
    36223668#ifndef C_NO_APPLY_HOOK
Note: See TracChangeset for help on using the changeset viewer.