shirok

;;
;; Implementation of John Nash's enciphering-deciphering machine described in
;; http://www.nsa.gov/public_info/_files/nash_letters/nash_letters1.pdf
;;

(use gauche.sequence)
(use gauche.generator)
(use srfi-43)

;; The 'key' of this machine is a configuration of Permuter-Reverser (P/R)

shirok

(use srfi-60) ; for list->integer

(define read-bools
  ($ gconcatenate $ gmap (cut reverse-bits->generator <> 0 8)
     $ port->byte-generator $))
(define (string->bools s) (call-with-input-string s read-bools))

(define (write-bools src)
  ($ generator-for-each (^b (write-byte (list->integer b)) (flush))
     $ gslices src 8 #t 0))

shirok

;; -*- coding: utf-8 -*-

#!c-expr

;; I always use Scheme as a quick calculators, and a few such expressions
;; happened to be in my scratch buffer so I turned it to C-exprs.

(use srfi-42)

(define ^^ expt)

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)

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 (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 (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

--- 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

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

;; -*- 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))