From scsh-users-request@scsh.net Sat Aug 25 14:28:58 2007 Return-Path: X-Original-To: scsh@informatik.uni-tuebingen.de Delivered-To: scsh@informatik.uni-tuebingen.de Received: from localhost (localhost [127.0.0.1]) by mx1.informatik.uni-tuebingen.de (Postfix) with ESMTP id 164073493; Sat, 25 Aug 2007 14:28:56 +0200 (MEST) Received: from mx1.informatik.uni-tuebingen.de ([127.0.0.1]) by localhost (mx1.informatik.uni-tuebingen.de [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id vhsV6-zj2CgO; Sat, 25 Aug 2007 14:28:55 +0200 (MEST) Received: from www.scsh.net (bernard.Informatik.Uni-Tuebingen.De [134.2.12.122]) by mx1.informatik.uni-tuebingen.de (Postfix) with ESMTP id A1F6D3484; Sat, 25 Aug 2007 14:28:53 +0200 (MEST) Received: by www.scsh.net (Postfix, from userid 3123) id 25EFF5E9D; Sat, 25 Aug 2007 14:28:53 +0200 (MST) Old-Return-Path: X-Original-To: scsh-users@scsh.net Delivered-To: scsh-users@scsh.net Resent-To: scsh-users@scsh.net Resent-From: Michael Sperber Resent-Date: Sat, 25 Aug 2007 14:28:34 +0200 Resent-Message-ID: X-From-Line: nobody Tue Aug 21 18:05:13 2007 From: Michael Sperber To: Emilio Lopes Cc: scsh-users@scsh.net Subject: Re: Problem using sockets References: <0mk5v719x4.fsf@freenet.de> Date: Tue, 21 Aug 2007 18:05:12 +0200 In-Reply-To: <0mk5v719x4.fsf@freenet.de> (Emilio Lopes's message of "Thu\, 17 May 2007 22\:18\:15 +0200") Message-ID: User-Agent: Gnus/5.110006 (No Gnus v0.6) XEmacs/21.5-b28 (darwin) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Lines: 115 X-Virus-Scanned: ClamAV using ClamSMTP X-Mailing-List: archive/latest/393 X-Loop: scsh-users@scsh.net List-Post: List-Help: List-Subscribe: List-Unsubscribe: Precedence: list Resent-Sender: scsh-users-request@scsh.net List-Id: List-Archive: --=-=-= Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: quoted-printable Emilio Lopes writes: I know it's late ... Sorry. The gc-protection-mismatch problem is obvious enough. After that, I don't get any exceptions with your example. Could you try again with the patch? > I hope the transcript bellow is enough to describe the problem. > Basically I get an exception when trying to write to a socket. I'm > pretty sure this used to work, but it doesn't anymore... > > I also tried to enable some debugging, but it failed: > > > (socket-option *server-socket* level/socket socket/debug) > #f > > (set-socket-option *server-socket* level/socket socket/debug #t) > Error: 13 > "Permission denied" > #{Procedure 11768 (%setsockopt in scsh-level-0)} > 9 > 1 > 1 > 1 > > In case it matters: > > ~% uname -a > Linux jumeirah 2.6.18-4-k7 #1 SMP Mon Mar 26 17:57:15 UTC 2007 i686 = GNU/Linux > > Any hint? > > Welcome to scsh 0.6.7 (R6RS) > Type ,? for help. > > ,open threads > > (define (server-start socket socket-addr) > (format #t "Hello, ~a!\n" (host-info:name (host-info socket-addr= ))) > (let ((inport (socket:inport socket)) > (outport (socket:outport socket))) > (let loop () > (let ((input (read-line inport 'trim))) > (cond > ((eof-object? input) > (display "Goodbye.\n" outport) > (shutdown-socket socket shutdown/sends+receives)) > (else > (format outport "You said: \"~A\".\n" input) > (loop))))))) > > (spawn > (lambda () > (bind-listen-accept-loop protocol-family/internet server-start = 6666))) > > (define *server-socket* > (socket-connect protocol-family/internet socket-type/stream "loc= alhost" 6666)) > Hello, jumeirah! > > (connect-socket-successful? *server-socket*) > #t > > (send-message *server-socket* "hi!") > > Error: exception > gc-protection-mismatch > (call-external-value "send_substring") > 1> ,debug > '#{Exception-continuation (pc 3) (call-external-value in scheme-leve= l-0)} > > inspect: d > '#{Continuation (pc 62) (with-dynamic-env in fluids)} > > [0] '#{Procedure 1109 (unnamed in with-dynamic-env in fluids)} > [1] '((# . #f) (# # # # # ---) (# . #) (# # # # # ---) (# # # # #) = ---) > [2] #f > [3] #f > inspect: q > '#{Continuation (pc 62) (with-dynamic-env in fluids)} > 1>=20 > --=20 Cheers =3D8-} Mike Friede, V=F6lkerverst=E4ndigung und =FCberhaupt blabla --=-=-= Content-Disposition: inline Index: scsh/network1.c =================================================================== RCS file: /cvsroot/scsh/scsh/scsh/network1.c,v retrieving revision 1.33.2.2 diff -u -r1.33.2.2 network1.c --- scsh/network1.c 28 Jan 2007 15:13:52 -0000 1.33.2.2 +++ scsh/network1.c 21 Aug 2007 16:02:59 -0000 @@ -380,13 +380,14 @@ buf_part, end-start, flags, (struct sockaddr *)&name, sizeof(name)); - break; + S48_GC_UNPROTECT(); + + break; } default: s48_raise_argument_type_error (s48_extract_fixnum (scm_family)); /* error unknown address family */ } - S48_GC_UNPROTECT(); if (n >= 0) return s48_enter_fixnum (n); --=-=-=-- From scsh-users-request@scsh.net Sun Aug 26 15:26:39 2007 Return-Path: X-Original-To: scsh@informatik.uni-tuebingen.de Delivered-To: scsh@informatik.uni-tuebingen.de Received: from localhost (localhost [127.0.0.1]) by mx1.informatik.uni-tuebingen.de (Postfix) with ESMTP id 69C3F3482; Sun, 26 Aug 2007 15:26:38 +0200 (MEST) Received: from mx1.informatik.uni-tuebingen.de ([127.0.0.1]) by localhost (mx1.informatik.uni-tuebingen.de [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id foSc9um3SbjT; Sun, 26 Aug 2007 15:26:37 +0200 (MEST) Received: from www.scsh.net (bernard.Informatik.Uni-Tuebingen.De [134.2.12.122]) by mx1.informatik.uni-tuebingen.de (Postfix) with ESMTP id 490723456; Sun, 26 Aug 2007 15:26:37 +0200 (MEST) Received: by www.scsh.net (Postfix, from userid 3123) id D28055E9F; Sun, 26 Aug 2007 15:26:36 +0200 (MST) Old-Return-Path: X-Original-To: scsh-users@scsh.net Delivered-To: scsh-users@scsh.net X-Authenticated: #3737989 X-Provags-ID: V01U2FsdGVkX183MyU7nbk315UVH76p0MR6/BYeVEmd3aALlifa+Y sYvX/saN9IaDGx To: Michael Sperber Cc: scsh-users@scsh.net Subject: Re: Problem using sockets Organization: The Church of Emacs From: Emilio Lopes References: <0mk5v719x4.fsf@freenet.de> Date: Sun, 26 Aug 2007 15:22:19 +0200 In-Reply-To: (Michael Sperber's message of "Tue\, 21 Aug 2007 18\:05\:12 +0200") Message-ID: User-Agent: Emacs Gnus MIME-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8bit X-Y-GMX-Trusted: 0 Resent-Message-ID: <6y1iVC.A.S_S.M-X0GB@bernard> Resent-From: scsh-users@scsh.net X-Mailing-List: archive/latest/394 X-Loop: scsh-users@scsh.net List-Post: List-Help: List-Subscribe: List-Unsubscribe: Precedence: list Resent-Sender: scsh-users-request@scsh.net List-Id: List-Archive: Resent-Date: Sun, 26 Aug 2007 15:26:36 +0200 (MST) Michael Sperber writes: > I know it's late ... Sorry. No problem, I already imagined you'd be busy with other affairs... :-) > The gc-protection-mismatch problem is obvious enough. After that, I > don't get any exceptions with your example. Could you try again with > the patch? Yes, writing to the socket now works, thank you. But closing the socket still gives an error/warning/exception: Welcome to scsh 0.6.7 (R6RS) Type ,? for help. > ,open threads > (define (server-start socket socket-addr) (format #t "Hello, ~a!\n" (host-info:name (host-info socket-addr))) (let ((inport (socket:inport socket)) (outport (socket:outport socket))) (let loop () (let ((input (read-line inport 'trim))) (cond ((eof-object? input) (display "Goodbye.\n" outport) (shutdown-socket socket shutdown/sends+receives)) (else (format outport "You said: \"~A\".\n" input) (loop))))))) > (spawn (lambda () (bind-listen-accept-loop protocol-family/internet server-start 6666))) > (define *server-socket* (socket-connect protocol-family/internet socket-type/stream "localhost" 6666)) Hello, jumeirah! > (send-message *server-socket* "hi!\n") > (read-line (socket:inport *server-socket*)) "You said: \"hi!\"." > (close-socket *server-socket*) > Warning: error when flushing buffer; closing port #{Output-fdport #{Output-channel 8}} (exception 117 os-error 32 #{Byte-vector (length 255) 71 111 111 100 98 121 101 46 10 32 34 104 105 33 34 46 ...} 0 9 #{Output-channel 8} Broken pipe) > -- Emílio C. Lopes Munich, Germany From scsh-users-request@scsh.net Thu Aug 30 04:37:50 2007 Return-Path: X-Original-To: scsh@informatik.uni-tuebingen.de Delivered-To: scsh@informatik.uni-tuebingen.de Received: from localhost (localhost [127.0.0.1]) by mx1.informatik.uni-tuebingen.de (Postfix) with ESMTP id 1139D34A0; Thu, 30 Aug 2007 04:37:49 +0200 (MEST) Received: from mx1.informatik.uni-tuebingen.de ([127.0.0.1]) by localhost (mx1.informatik.uni-tuebingen.de [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 5GM4bfTDzV29; Thu, 30 Aug 2007 04:37:48 +0200 (MEST) Received: from www.scsh.net (bernard.Informatik.Uni-Tuebingen.De [134.2.12.122]) by mx1.informatik.uni-tuebingen.de (Postfix) with ESMTP id A7316346D; Thu, 30 Aug 2007 04:37:47 +0200 (MEST) Received: by www.scsh.net (Postfix, from userid 3123) id 3E05B5E9F; Thu, 30 Aug 2007 04:37:47 +0200 (MST) Old-Return-Path: X-Original-To: scsh-users@scsh.net Delivered-To: scsh-users@scsh.net X-Greylist: delayed 1917 seconds by postgrey-1.27 at mx4; Thu, 30 Aug 2007 04:37:28 MEST Message-ID: <46D625CC.5080702@199technologies.org> Date: Wed, 29 Aug 2007 22:05:00 -0400 From: Chris Turner User-Agent: Thunderbird 1.5.0.5 (X11/20061213) MIME-Version: 1.0 To: scsh-users@scsh.net Subject: srfi-40 patch for scsh-0.6.7 Content-Type: multipart/mixed; boundary="------------030100030602000009060206" Resent-Message-ID: Resent-From: scsh-users@scsh.net X-Mailing-List: archive/latest/395 X-Loop: scsh-users@scsh.net List-Post: List-Help: List-Subscribe: List-Unsubscribe: Precedence: list Resent-Sender: scsh-users-request@scsh.net List-Id: List-Archive: Resent-Date: Thu, 30 Aug 2007 04:37:47 +0200 (MST) This is a multi-part message in MIME format. --------------030100030602000009060206 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 7bit Hello all, Have been toying with scsh for some time, and am now looking to do some time-series modelling / analysis using scsh and it seems like a streams abstraction would be a good way to go about this.. After reviewing SICP and the various srfi documents, I was attempting to find a good library of streams for r5rs scheme that worked with scsh. Finding none & that the srfi-40 wasn't implemented for scsh, I decided to take a crack at hooking it into the build. Attached is my first crack at a patch against scsh-0.6.7 using the reference implementation I extracted from the srfi doc. In it's current state it seems to work for me using the examples / test cases given in the srfi document (can submit my simple tests upon request) FWIW It was tested on DragonFlyBSD v1.8 using the pkgsrc-patched version of scsh , although since it's pure scheme I doubt that makes much difference.. Please let me know if theres anything I need to do to fix it up to make it acceptable, I'd much prefer to get this in base than to maintain my own patchset. Thanks in advance & thanks for such a nice scheme system. - Chris --------------030100030602000009060206 Content-Type: text/x-patch; name="scsh-0.6.7-srfi40.patch" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="scsh-0.6.7-srfi40.patch" diff -urwN scsh-0.6.7.orig/scheme/more-interfaces.scm scsh-0.6.7/scheme/more-interfaces.scm --- scsh-0.6.7.orig/scheme/more-interfaces.scm 2004-01-27 04:49:14.000000000 -0500 +++ scsh-0.6.7/scheme/more-interfaces.scm 2007-08-29 21:48:17.000000000 -0400 @@ -649,6 +649,24 @@ option-processor args-fold)) +(define-interface srfi-40-interface + (export + make-stream + stream? + stream-error + stream-null + (stream-cons :syntax) + stream-null? + stream-pair? + stream-car + stream-cdr + (stream-delay :syntax) + stream + stream-unfoldn + stream-map + stream-for-each + stream-filter)) + (define-interface srfi-42-interface (export ((do-ec list-ec append-ec diff -urwN scsh-0.6.7.orig/scheme/more-packages.scm scsh-0.6.7/scheme/more-packages.scm --- scsh-0.6.7.orig/scheme/more-packages.scm 2004-10-06 07:38:16.000000000 -0400 +++ scsh-0.6.7/scheme/more-packages.scm 2007-08-29 21:37:07.000000000 -0400 @@ -952,6 +952,13 @@ srfi-11) (files (srfi srfi-37))) +(define-structure srfi-40 srfi-40-interface + (open scheme + srfi-1 + srfi-9 + srfi-23) + (files (srfi srfi-40))) + ; Eager Comprehensions (define-structure srfi-42 srfi-42-interface @@ -1055,7 +1062,7 @@ srfi-11 srfi-13 srfi-14 srfi-16 srfi-17 srfi-23 srfi-25 srfi-26 srfi-27 srfi-28 srfi-31 srfi-37 - srfi-42 + srfi-40 srfi-42 ) :structure) make-srfi-19 Binary files scsh-0.6.7.orig/scheme/sh.core and scsh-0.6.7/scheme/sh.core differ diff -urwN scsh-0.6.7.orig/scheme/srfi/srfi-40.scm scsh-0.6.7/scheme/srfi/srfi-40.scm --- scsh-0.6.7.orig/scheme/srfi/srfi-40.scm 1969-12-31 19:00:00.000000000 -0500 +++ scsh-0.6.7/scheme/srfi/srfi-40.scm 2007-08-29 21:20:06.000000000 -0400 @@ -0,0 +1,218 @@ +;;; $Id$ +;;; +;;; Copyright (C) 2003 by Philip L. Bewig of Saint Louis, Missouri, +;;; United States of America. All rights reserved. +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining +;;; a copy of this software and associated documentation files (the +;;; "Software"), to deal in the Software without restriction, including +;;; without limitation the rights to use, copy, modify, merge, publish, +;;; distribute, sublicense, and/or sell copies of the Software, and to +;;; permit persons to whom the Software is furnished to do so, subject to +;;; the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be +;;; included in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +;;; +;;; Srfi-40 : A Library of Streams +;;; Adapted for scsh by Chris Turner +;;; Requires SRFI's 1, 9, and 23, provided by scsh. +;;; +;;; Implementation +;;; +;;; A reference implementation of streams is shown below. It strongly +;;; prefers simplicity and clarity to efficiency, and though a reasonable +;;; attempt is made to be safe-for-space, no promises are made. The +;;; reference implementation relies on the mechanism for defining record +;;; types of SRFI-9, and the functions `any` and `every` from SRFI-1. +;;; The `stream-error` function aborts by calling `error` as defined +;;; in SRFI 23. +;;; +;;; PROMISES A LA SRFI-45 +;;; --------------------- +;;; +;;; A separate implementation is necessary to +;;; have promises that answer #t to stream? +;;; This requires lots of complicated type conversions. +;;; + +(define-record-type s:promise (make-s:promise kind content) s:promise? + (kind s:promise-kind set-s:promise-kind!) + (content s:promise-content set-s:promise-content!)) + +(define-record-type box (make-box x) box? + (x unbox set-box!)) + +(define-syntax srfi-40:lazy + (syntax-rules () + ((lazy exp) + (make-box (make-s:promise 'lazy (lambda () exp)))))) + +(define (srfi-40:eager x) + (make-stream (make-box (make-s:promise 'eager x)))) + +(define-syntax srfi-40:delay + (syntax-rules () + ((srfi-40:delay exp) (srfi-40:lazy (srfi-40:eager exp))))) + +(define (srfi-40:force promise) + (let ((content (unbox promise))) + (case (s:promise-kind content) + ((eager) (s:promise-content content)) + ((lazy) + (let* ((promise* (stream-promise ((s:promise-content content)))) + (content (unbox promise))) + (if (not (eqv? 'eager (s:promise-kind content))) + (begin + (set-s:promise-kind! content (s:promise-kind (unbox promise*))) + (set-s:promise-content! content (s:promise-content (unbox promise*))) + (set-box! promise* content))) + (srfi-40:force promise)))))) + + +;;; LIBRARY OF SYNTAX AND FUNCTIONS TO MANIPULATE STREAMS +;;; +;;; A stream is a new data type, disjoint from all other data types, that +;;; contains a promise that, when forced, is either nil (a single object +;;; distinguishable from all other objects) or consists of an object +;;; (the stream element) followed by a stream. Each stream element is +;;; evaluated exactly once, when it is first retrieved (not when it is +;;; created); once evaluated its value is saved to be returned by +;;; subsequent retrievals without being evaluated again. + +;; STREAM-TYPE -- type of streams +;; STREAM? object -- #t if object is a stream, #f otherwise +(define-record-type stream-type + (make-stream promise) + stream? + (promise stream-promise)) + +;;; UTILITY FUNCTIONS + +;; STREAM-ERROR message -- print message then abort execution +; replace this with a call to the native error handler +; if stream-error returns, so will the stream library function that called it +(define stream-error error) + +;;; STREAM SYNTAX AND FUNCTIONS + +;; STREAM-NULL -- the distinguished nil stream +(define stream-null (make-stream (srfi-40:delay '()))) + +;; STREAM-CONS object stream -- primitive constructor of streams +(define-syntax stream-cons + (syntax-rules () + ((stream-cons obj strm) + (make-stream + (srfi-40:delay + (if (not (stream? strm)) + (stream-error "attempt to stream-cons onto non-stream") + (cons obj strm))))))) + +;; STREAM-NULL? object -- #t if object is the null stream, #f otherwise +(define (stream-null? obj) + (and (stream? obj) (null? (srfi-40:force (stream-promise obj))))) + +;; STREAM-PAIR? object -- #t if object is a non-null stream, #f otherwise +(define (stream-pair? obj) + (and (stream? obj) (not (null? (srfi-40:force (stream-promise obj)))))) + +;; STREAM-CAR stream -- first element of stream +(define (stream-car strm) + (cond ((not (stream? strm)) (stream-error "attempt to take stream-car of non-stream")) + ((stream-null? strm) (stream-error "attempt to take stream-car of null stream")) + (else (car (srfi-40:force (stream-promise strm)))))) + +;; STREAM-CDR stream -- remaining elements of stream after first +(define (stream-cdr strm) + (cond ((not (stream? strm)) (stream-error "attempt to take stream-cdr of non-stream")) + ((stream-null? strm) (stream-error "attempt to take stream-cdr of null stream")) + (else (cdr (srfi-40:force (stream-promise strm)))))) + +;; STREAM-DELAY object -- the essential stream mechanism +(define-syntax stream-delay + (syntax-rules () + ((stream-delay expr) + (make-stream + (srfi-40:lazy expr))))) + +;; STREAM object ... -- new stream whose elements are object ... +(define (stream . objs) + (let loop ((objs objs)) + (stream-delay + (if (null? objs) + stream-null + (stream-cons (car objs) (loop (cdr objs))))))) + +;; STREAM-UNFOLDN generator seed n -- n+1 streams from (generator seed) +(define (stream-unfoldn gen seed n) + (define (unfold-result-stream gen seed) + (let loop ((seed seed)) + (stream-delay + (call-with-values + (lambda () (gen seed)) + (lambda (next . results) + (stream-cons results (loop next))))))) + (define (result-stream->output-stream result-stream i) + (stream-delay + (let ((result (list-ref (stream-car result-stream) i))) + (cond ((pair? result) + (stream-cons (car result) + (result-stream->output-stream + (stream-cdr result-stream) i))) + ((not result) + (result-stream->output-stream (stream-cdr result-stream) i)) + ((null? result) stream-null) + (else (stream-error "can't happen")))))) + (define (result-stream->output-streams result-stream n) + (let loop ((i 0) (outputs '())) + (if (= i n) + (apply values (reverse outputs)) + (loop (+ i 1) + (cons (result-stream->output-stream result-stream i) + outputs))))) + (result-stream->output-streams (unfold-result-stream gen seed) n)) + +;; STREAM-MAP func stream ... -- stream produced by applying func element-wise +(define (stream-map func . strms) + (cond ((not (procedure? func)) (stream-error "non-functional argument to stream-map")) + ((null? strms) (stream-error "no stream arguments to stream-map")) + ((not (every stream? strms)) (stream-error "non-stream argument to stream-map")) + (else (let loop ((strms strms)) + (stream-delay + (if (any stream-null? strms) + stream-null + (stream-cons (apply func (map stream-car strms)) + (loop (map stream-cdr strms))))))))) + +;; STREAM-FOR-EACH proc stream ... -- apply proc element-wise for side-effects +(define (stream-for-each proc . strms) + (cond ((not (procedure? proc)) (stream-error "non-functional argument to stream-for-each")) + ((null? strms) (stream-error "no stream arguments to stream-for-each")) + ((not (every stream? strms)) (stream-error "non-stream argument to stream-for-each")) + (else (let loop ((strms strms)) + (if (not (any stream-null? strms)) + (begin (apply proc (map stream-car strms)) + (loop (map stream-cdr strms)))))))) + +;; STREAM-FILTER pred? stream -- new stream including only items passing pred? +(define (stream-filter pred? strm) + (cond ((not (procedure? pred?)) (stream-error "non-functional argument to stream-filter")) + ((not (stream? strm)) (stream-error "attempt to apply stream-filter to non-stream")) + (else (stream-unfoldn + (lambda (s) + (values + (stream-cdr s) + (cond ((stream-null? s) '()) + ((pred? (stream-car s)) (list (stream-car s))) + (else #f)))) + strm + 1)))) --------------030100030602000009060206--