shirok

;; -*- coding: utf-8 -*-
(use gauche.time)

(define last-mb   #`",(make-string 10000 #\\あ)ア")
(define middle-mb #`",(make-string 5000 #\\あ)ア,(make-string 5000 #\\あ)")
(define first-mb  #`"ア,(make-string 10000 #\\あ)")

(define last-sb   #`",(make-string 10000 #\\あ):")
(define middle-sb #`",(make-string 5000 #\\あ):,(make-string 5000 #\\あ)")
(define first-sb  #`":,(make-string 10000 #\\あ)")

shirok

diff --git a/src/vminsn.scm b/src/vminsn.scm
index f8e2dc9..8c7318d 100644
--- a/src/vminsn.scm
+++ b/src/vminsn.scm
@@ -757,6 +757,7 @@
 (define-insn GSET        0 obj #f
   (let* ((loc))
     (FETCH-OPERAND loc)
+    (SCM_FLONUM_ENSURE_MEM VAL0)
     (cond

shirok

(define-module util.toplevel-let
  (export toplevel-let))

(select-module util.toplevel-let)

(define-syntax toplevel-let
  (syntax-rules (define-toplevel define)
    [(_ "loop" () binds0 binds1 tops)
     (define-values tops (let binds0 (letrec binds1 (values . tops))))]
    [(_ "loop" ((define-toplevel (name . args) . body) . xs)

shirok

;; -*- mode:common-lisp -*-

(defun map-file (filename &rest flags)
  "Maps FILENAME, returns the opened stream, base aligned address and length."
  (let ((s (apply #'open filename :mapped t flags)))
    (values s (slot-value s 'excl::buffer) (file-length s))))

;; Read unaligned little-endian numbers
(defun read-u8  (base off)
  (sys:memref base off 0 :unsigned-byte))

shirok

diff --git a/ext/net/gauche-net.h b/ext/net/gauche-net.h
index 7377a36..07ee38a 100644
--- a/ext/net/gauche-net.h
+++ b/ext/net/gauche-net.h
@@ -196,6 +196,10 @@ extern ScmObj Scm_InetAddressToString(ScmObj addr, int proto);
 typedef struct ScmSocketRec {
     SCM_HEADER;
     Socket fd;                     /* INVALID_SOCKET if closed */
+#ifdef GAUCHE_WINDOWS
+    int crt_fd;                 /* integer fd allocated by open_osfhandle.

shirok

--- a/lib/gauche/cgen/literal.scm
+++ b/lib/gauche/cgen/literal.scm
@@ -528,7 +528,7 @@
     (cond
      [(fixnum? value)
       (make <cgen-scheme-integer> :value value :c-name #f)]
-     [(< (- (expt 2 31)) value (- (expt 2 32)))
+     [(< (- (%expt 2 31)) value (- (%expt 2 32)))
       (make <cgen-scheme-integer> :value value
             :c-name (cgen-allocate-static-datum))]

shirok

(define (rationalize3 x e)

  (define (refine xn yn an) ; returns reverse continued fraction
    (cond [(or (null? xn) (null? yn)) an]
          [(= (car xn) (car yn))
           (refine (cdr xn) (cdr yn) (cons (car xn) an))]
          [else (cons (+ 1 (min (car xn) (car yn))) an)]))

  (define (realize rcf) ; reverse continued fraction -> rational
    (fold (^[a r] (+ a (/ r))) (car rcf) (cdr rcf)))

shirok

(define (rationalize2 x e)

  (define (next an Qn-1 Qn-2)
    (/ (+ (* an (numerator Qn-1)) (numerator Qn-2))
       (+ (* an (denominator Qn-1)) (denominator Qn-2))))

  (if (< x 0)
    (- (rationalize2 (- x) e))
    (match (continued-fraction (exact x))
      [(a0) a0] ;integer

shirok

(define (continued-fraction r)
  (let loop ([p (numerator r)]
             [q (denominator r)])
    (receive (quot rem) (quotient&remainder p q)
      (if (zero? rem)
        (list quot)
        (lcons quot (loop q rem))))))

shirok

(define (rationalize1 x e)
  (define (refine lo hi)
    (let* ([M (/ (+ (numerator lo) (numerator hi))
                 (+ (denominator lo) (denominator hi)))]
           [delta (abs (- x M))])
      (cond
       [(<= delta e) M] ;; found
       [(< M x) (refine M hi)]
       [else    (refine lo M)])))
  (if (< (abs (- x (round x))) e)