Changeset 13414 in project


Ignore:
Timestamp:
02/26/09 11:20:06 (11 years ago)
Author:
felix winkelmann
Message:

merged with trunk rev. 13389

Location:
chicken/branches/prerelease
Files:
16 edited
4 copied

Legend:

Unmodified
Added
Removed
  • chicken/branches/prerelease

  • chicken/branches/prerelease/Makefile.mingw

    r13240 r13414  
    5656LINKER_LINK_SHARED_LIBRARY_OPTIONS = -shared
    5757LIBRARIES = -lm -lws2_32
     58LINKER_OPTIONS = -Wl,--enable-auto-import
    5859LIBCHICKEN_SO_LINKER_OPTIONS = -Wl,--out-implib,libchicken.dll.a
    5960LIBUCHICKEN_SO_LINKER_OPTIONS = -Wl,--out-implib,libuchicken.dll.a
  • chicken/branches/prerelease/Makefile.mingw-msys

    r13240 r13414  
    5050C_COMPILER_SHARED_OPTIONS = -DPIC
    5151C_COMPILER_GUI_RUNTIME_OPTIONS = -DC_WINDOWS_GUI
     52LINKER_OPTIONS = -Wl,--enable-auto-import
    5253LINKER_LINK_SHARED_LIBRARY_OPTIONS = -shared
    5354LIBRARIES = -lm -lws2_32
  • chicken/branches/prerelease/TODO

    r13240 r13414  
    1 TODO for trunk                                                          -*- Outline -*-
     1TODO for chicken                                                        -*- Outline -*-
     2================
    23
    34
     
    3738*** library/runtime: cyclic list checks for assq/assv/assoc/memq/memv/member
    3839    and C_i_list_tail
    39 
    40 ** henrietta
    41 *** installed version on kitten-tech seems not to work?
     40*** finalizers on lexically ref'd data not working in interpreter
     41    reported by Jim Ursetto
     42    reverted original patch, see patches/finalizer-closures.diff
     43*** Use record-descriptors instead of symbols as 1st slot in structure objects?
    4244
    4345
    4446* tasks
     47
     48** Convert this file to org mode
    4549
    4650** branches
     
    5155**** test "numbers" egg
    5256**** is s48-modules still working?
    53 **** port xlib egg
    5457*** at some stage remove debug-output in expand.scm
    5558
  • chicken/branches/prerelease/chicken.h

    r13240 r13414  
    11241124#define C_i_structurep(x, s)            C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_STRUCTURE_TYPE && C_block_item(x, 0) == (s))
    11251125
    1126 #define C_u_i_char_alphabeticp(x)       C_mk_bool(C_isalpha(C_character_code(x) & 0xff))
    1127 #define C_u_i_char_numericp(x)          C_mk_bool(C_isdigit(C_character_code(x) & 0xff))
    1128 #define C_u_i_char_whitespacep(x)       C_mk_bool(C_isspace(C_character_code(x) & 0xff))
    1129 #define C_u_i_char_upper_casep(x)       C_mk_bool(C_isupper(C_character_code(x) & 0xff))
    1130 #define C_u_i_char_lower_casep(x)       C_mk_bool(C_islower(C_character_code(x) & 0xff))
    1131 
    1132 #define C_u_i_char_upcase(x)            C_make_character(C_toupper(C_character_code(x) & 0xff))
    1133 #define C_u_i_char_downcase(x)          C_make_character(C_tolower(C_character_code(x) & 0xff))
     1126#define C_u_i_char_alphabeticp(x)       C_mk_bool(C_character_code(x) < 0x100 && C_isalpha(C_character_code(x)))
     1127#define C_u_i_char_numericp(x)          C_mk_bool(C_character_code(x) < 0x100 && C_isdigit(C_character_code(x)))
     1128#define C_u_i_char_whitespacep(x)       C_mk_bool(C_character_code(x) < 0x100 && C_isspace(C_character_code(x)))
     1129#define C_u_i_char_upper_casep(x)       C_mk_bool(C_character_code(x) < 0x100 && C_isupper(C_character_code(x)))
     1130#define C_u_i_char_lower_casep(x)       C_mk_bool(C_character_code(x) < 0x100 && C_islower(C_character_code(x)))
     1131
     1132#define C_u_i_char_upcase(x)            (C_character_code(x) < 0x100 ? C_make_character(C_toupper(C_character_code(x))) : (x))
     1133#define C_u_i_char_downcase(x)          (C_character_code(x) < 0x100 ? C_make_character(C_tolower(C_character_code(x))) : (x))
    11341134
    11351135#define C_i_list_ref(lst, i)            C_i_car(C_i_list_tail(lst, i))
  • chicken/branches/prerelease/expand.scm

    r13240 r13414  
    8585             (ua (or (lookup var se) var)))
    8686        (##sys#put! alias '##core#macro-alias ua)
    87         (dd "aliasing " alias " to "
     87        (##sys#put! alias '##core#real-name var)
     88        (dd "aliasing " alias " (real: " var ") to "
    8889            (if (pair? ua)
    8990                '<macro>
     
    103104                         (lookup x se)
    104105                         (get x '##core#macro-alias) ) ) )
    105              (cond ((and alias (not (assq x se)))
     106             (cond ((get x '##core#real-name))
     107                   ((and alias (not (assq x se)))
    106108                    (##sys#alias-global-hook x #f))
    107109                   ((not x2) x)
  • chicken/branches/prerelease/library.scm

    r13240 r13414  
    30703070         (let ([position (##sys#slot p 10)]
    30713071               [output (##sys#slot p 12)] )
    3072            (do ((i 0 (fx+ i 1)))
    3073                ((fx>= i len) (##sys#setislot p 10 position))
    3074              (##core#inline "C_setsubchar" output position (##core#inline "C_subchar" str i))
    3075              (set! position (fx+ position 1)) ) ) ) )
     3072           (##core#inline "C_substring_copy" str output 0 len position)
     3073           (##sys#setislot p 10 (fx+ position len)) ) ) )
    30763074     (lambda (p)                        ; close
    30773075       (##sys#setislot p 10 (##sys#slot p 11)) )
  • chicken/branches/prerelease/posixunix.scm

    r13240 r13414  
    196196#define C_sleep             sleep
    197197
    198 #define C_putenv(s)         C_fix(putenv((char *)C_data_pointer(s)))
    199198#define C_stat(fn)          C_fix(stat((char *)C_data_pointer(fn), &C_statbuf))
    200199#define C_lstat(fn)         C_fix(lstat((char *)C_data_pointer(fn), &C_statbuf))
     
    214213
    215214#ifdef C_GNU_ENV
     215# define C_unsetenv(s)      (unsetenv((char *)C_data_pointer(s)), C_SCHEME_TRUE)
    216216# define C_setenv(x, y)     C_fix(setenv((char *)C_data_pointer(x), (char *)C_data_pointer(y), 1))
    217217#else
     218# define C_unsetenv(s)      C_fix(putenv((char *)C_data_pointer(s)))
    218219static C_word C_fcall C_setenv(C_word x, C_word y) {
    219220  char *sx = C_data_pointer(x),
     
    18731874(define (unsetenv var)
    18741875  (##sys#check-string var 'unsetenv)
    1875   (##core#inline "C_putenv" (##sys#make-c-string var))
     1876  (##core#inline "C_unsetenv" (##sys#make-c-string var))
    18761877  (##core#undefined) )
    18771878
  • chicken/branches/prerelease/runtime.c

    r13240 r13414  
    27362736    }
    27372737
    2738     /* mark finalizer procedures: */
    2739     for(flist = finalizer_list; flist != NULL; flist = flist->next)
    2740       mark(&flist->finalizer);
    2741 
    27422738    mark_system_globals();
    27432739  }
     
    28042800        for(flist = finalizer_list; flist != NULL; flist = flist->next) {
    28052801          mark(&flist->item);
     2802          mark(&flist->finalizer);
    28062803          ++fcount;
    28072804        }
     
    28252822
    28262823          mark(&flist->item);
     2824          mark(&flist->finalizer);
    28272825        }
    28282826
     
    28372835
    28382836      if(pending_finalizer_count > 0 && gc_report_flag)
    2839         C_printf(C_text("[GC] finalizers pending: %d (%d live)\n"),
     2837        C_printf(C_text("[GC] finalizers pending for rescan:\t %d (%d live)\n"),
    28402838                 pending_finalizer_count, live_finalizer_count);
    28412839
     
    28462844         (and release finalizer node): */
    28472845      if(pending_finalizer_count > 0) {
    2848         if(gc_report_flag) C_printf(C_text("[GC] finalizers queued: %d\n"), pending_finalizer_count);
     2846        if(gc_report_flag) C_printf(C_text("[GC] queueing %d finalizers\n"), pending_finalizer_count);
    28492847
    28502848        last = C_block_item(pending_finalizers_symbol, 0);
  • chicken/branches/prerelease/scripts/setversion

    r13240 r13414  
    2828                       (unless (eof-object? ln)
    2929                         (write-line (string-substitute rx subst ln #t))
    30                          (loop) ) ) ) ) ) ) ) ) )
     30                         (loop) ) ) ) )
     31                 binary:) )
     32             binary:)))
    3133        (else
    3234         (let ((tmp (create-temporary-file)))
     
    4749                (huh (car (cddddr v))))
    4850           (set! buildversion (conc maj "." min "." (add1 (string->number pl)) huh)) ) ) )
    49   (with-output-to-file "buildversion" (cut display buildversion))
     51  (with-output-to-file "buildversion" (cut display buildversion) binary:)
    5052  (with-output-to-file "version.scm"
    5153    (lambda ()
    5254      (write `(define-constant +build-version+ ,buildversion))
    53       (newline) ) )
     55      (newline) )
     56    binary:)
    5457  (system* "cat version.scm")
    5558  (let ([vstr (sprintf "version ~A" buildversion)])
    5659    (for-each (cut patch <> (rx "version [0-9][-.0-9a-zA-Z]+") vstr) files) )
    57   (with-output-to-file "DONE" (cut print "- version is " buildversion))
    5860  0)
    5961
  • chicken/branches/prerelease/setup-download.scm

    r13240 r13414  
    4747
    4848  (define (d fstr . args)
    49     (apply     
    50      fprintf (if *quiet* (current-error-port) (current-output-port))
    51      fstr args))
     49    (let ((port (if *quiet* (current-error-port) (current-output-port))))
     50      (apply fprintf port fstr args)
     51      (flush-output port)))
    5252     
    5353  (define temporary-directory (make-parameter #f))
  • chicken/branches/prerelease/support.scm

    r13240 r13414  
    114114(set! ##sys#syntax-error-hook
    115115  (lambda (msg . args)
    116     (let ([out (current-error-port)])
    117       (fprintf out "Syntax error: ~a~%~%" msg)
     116    (let ((out (current-error-port))
     117          (loc (and (symbol? msg)
     118                    (begin
     119                      (set! msg (car args))
     120                      (set! args (cdr args))
     121                      msg))))
     122      (if loc
     123          (fprintf out "Syntax error (~a): ~a~%~%" loc msg)
     124          (fprintf out "Syntax error: ~a~%~%" msg) )
    118125      (for-each (cut fprintf out "\t~s~%" <>) args)
    119126      (print-call-chain out 0 ##sys#current-thread "\n\tExpansion history:\n")
  • chicken/branches/prerelease/tcp.scm

    r13240 r13414  
    415415                              (loop n m start) ) ) ) ) )
    416416               (lambda (p limit)        ; read-line
    417                  (let loop ((str #f))
     417                 (let loop ((str #f)
     418                            (limit (or limit (##sys#fudge 21))))
    418419                   (cond ((fx< bufindex buflen)
    419420                          (##sys#scan-buffer-line
    420421                           buf
    421                            buflen
     422                           (fxmin buflen limit)
    422423                           bufindex
    423424                           (lambda (pos2 next)
    424                              (let ((dest (##sys#make-string (fx- pos2 bufindex))))
     425                             (let* ((len (fx- pos2 bufindex))
     426                                    (dest (##sys#make-string len)))
    425427                               (##core#inline "C_substring_copy" buf dest bufindex pos2 0)
    426428                               (set! bufindex next)
    427                                (cond ((eq? pos2 next) ; no line-terminator encountered
     429                               (cond ((eq? pos2 limit) ; no line-terminator, hit limit
     430                                      (if str (##sys#string-append str dest) dest))
     431                                     ((eq? pos2 next)  ; no line-terminator, hit buflen
    428432                                      (read-input)
    429433                                      (if (fx>= bufindex buflen)
    430434                                          (or str "")
    431                                           (loop (if str (##sys#string-append str dest) dest)) ) )
     435                                          (loop (if str (##sys#string-append str dest) dest)
     436                                                (fx- limit len)) ) )
    432437                                     (else
    433438                                      (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
     
    436441                          (read-input)
    437442                          (if (fx< bufindex buflen)
    438                               (loop str)
     443                              (loop str limit)
    439444                              #!eof) ) ) ) ) ) )
    440445             (output
  • chicken/branches/prerelease/tests/runtests.sh

    r13240 r13414  
    66export DYLD_LIBRARY_PATH=${TEST_DIR}/..
    77export LD_LIBRARY_PATH=${TEST_DIR}/..
    8 compile="../csc -compiler ../chicken -v -I.. -L.. -include-path .. -o a.out"
    9 compile_s="../csc -s -compiler ../chicken -v -I.. -L.. -include-path .."
     8
     9CHICKEN=../chicken
     10
     11if test "$MSYSTEM" == "MINGW32"; then
     12    CHICKEN="..\\chicken"
     13fi
     14
     15compile="../csc -compiler $CHICKEN -v -I.. -L.. -include-path .. -o a.out"
     16compile_s="../csc -s -compiler $CHICKEN -v -I.. -L.. -include-path .."
    1017interpret="../csi -n -include-path .."
    1118
     
    101108$interpret -e '(set! ##sys#procedure->string (constantly "#<procedure>"))' \
    102109  -i -s r4rstest.scm >r4rstest.log
    103 diff -u r4rstest.out r4rstest.log
     110
     111if test "$MSYSTEM" == "MINGW32"; then
     112    # the windows runtime library prints flonums differently
     113    tail r4rstest.log
     114else
     115    diff -bu r4rstest.out r4rstest.log || true
     116fi
    104117
    105118echo "======================================== finalizer tests ..."
     
    126139        *)
    127140            echo $x
    128             ../csc $x -compiler ../chicken -C -I.. -L.. -O2 -d0
     141            ../csc $x -compiler $CHICKEN -C -I.. -L.. -O2 -d0
    129142            ./`basename $x .scm`;;
    130143    esac
  • chicken/branches/prerelease/tests/syntax-tests.scm

    r13240 r13414  
    270270        (set! i (add1 i))))
    271271(newline)
     272
     273
     274;;;; exported macro would override original name (fixed in rev. 13351)
     275
     276(module xfoo (xbaz xbar)
     277  (import scheme)
     278  (define-syntax xbar
     279    (syntax-rules ()
     280      ((_ 1) (xbaz))
     281      ((_) 'xbar)))
     282  (define-syntax xbaz
     283    (syntax-rules ()
     284      ((_ 1) (xbar))
     285      ((_) 'xbazz))))
     286
     287(import xfoo)
     288(assert (eq? 'xbar (xbaz 1)))
     289(assert (eq? 'xbazz (xbar 1)))
     290(assert (eq? 'xbar (xbar)))
  • chicken/branches/prerelease/tests/test-finalizers.scm

    r13240 r13414  
    2323(gc #t)
    2424(assert (not x-f))
     25
     26#|
     27
     28This ought to work, see patches/finalizer.closures.diff for
     29a fix that unfortunately disables finalizers in the interpreter
     30(probably due to the different closure representation).
     31
    2532(assert (not y-f))
    2633(set! x #f)
     
    3239(assert y-f)
    3340(assert x-f)
     41|#
     42
     43(define foo-f #f)
     44
     45(let ((foo (vector 1 2 3)))
     46  (set-finalizer! foo (lambda _ (set! foo-f #t)))
     47  #t)
     48
     49(gc #t)
     50(assert foo-f)
Note: See TracChangeset for help on using the changeset viewer.