- Gambit-list - mailman.iro.umontreal.ca

Interfacing C++
by David St-Hilaire 21 Mai '07

21 Mai '07

Hi all, I'm still trying to interface the same c++ 3d engine with gambit and I am currently encountering some problems which seems out of my range of knowledge... I'm currently trying to define a type corresponding to a 2d position which I would like to interface with a simple scheme vector. Here is the code I wrote for it: (c-declare #<<c-declare-end typedef position2d<s32> position2d_s32; ___SCMOBJ SCMOBJ_to_POSITION2D_S32 (___SCMOBJ src, position2d_s32 *dst, int arg_num) { ___SCMOBJ ___err = ___FIX(___NO_ERR); ___SCMOBJ ___temp; if (!(___S32VECTORP(src) && (___S32VECTORLENGTH(src) == ___FIX(2)))) ___err = ___FIX(___UNKNOWN_ERR); else { dst->X = ___S32VECTORREF(src,___FIX(0)); dst->Y = ___S32VECTORREF(src,___FIX(1)); } return ___err; } ___SCMOBJ POSITION2D_S32_to_SCMOBJ (position2d_s32 src, ___SCMOBJ *dst, int arg_num) { ___SCMOBJ ___err = ___FIX(___NO_ERR); *dst = ___alloc_scmobj (___sS32VECTOR, 2<<3, ___STILL); if (___FIXNUMP(*dst)) ___err = ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num); else { ___S32VECTORSET(*dst,___FIX(0),src.X) ___S32VECTORSET(*dst,___FIX(1),src.Y) } return ___err; } #define ___BEGIN_CFUN_SCMOBJ_to_POSITION2D_S32(src,dst,i) \ if ((___err = SCMOBJ_to_POSITION2D_S32 (src, &dst, i)) == ___FIX(___NO_ERR)) { #define ___END_CFUN_SCMOBJ_to_POSITION2D_S32(src,dst,i) } #define ___BEGIN_CFUN_POSITION2D_S32_to_SCMOBJ(src,dst) \ if ((___err = POSITION2D_S32_to_SCMOBJ (src, &dst, ___RETURN_POS)) == ___FIX(___NO_ERR)) { #define ___END_CFUN_POSITION2D_S32_to_SCMOBJ(src,dst) \ ___EXT(___release_scmobj) (dst); } #define ___BEGIN_SFUN_POSITION2D_S32_to_SCMOBJ(src,dst,i) \ if ((___err = POSITION2D_S32_to_SCMOBJ (src, &dst, i)) == ___FIX(___NO_ERR)) { #define ___END_SFUN_POSITION2D_S32_to_SCMOBJ(src,dst,i) \ ___EXT(___release_scmobj) (dst); } #define ___BEGIN_SFUN_SCMOBJ_to_POSITION2D_S32(src,dst) \ { ___err = SCMOBJ_to_POSITION2D_S32 (src, &dst, ___RETURN_POS); #define ___END_SFUN_SCMOBJ_to_POSITION2D_S32(src,dst) } c-declare-end ) (c-define-type position2d_s32 "position2d_s32" "POSITION2D_S32_to_SCMOBJ" "SCMOBJ_to_POSITION2D_S32" #f) This code is a mere quasi-copy of one of Marc Feeley's code which originally was: (c-declare #<<c-declare-end ___SCMOBJ SCMOBJ_to_VECTOR3DF (___SCMOBJ src, vector3df *dst, int arg_num) { ___SCMOBJ ___err = ___FIX(___NO_ERR); ___SCMOBJ ___temp; if (!(___F64VECTORP(src) && (___F64VECTORLENGTH(src) == ___FIX(3)))) ___err = ___FIX(___UNKNOWN_ERR); else { dst->X = ___F64VECTORREF(src,___FIX(0)); dst->Y = ___F64VECTORREF(src,___FIX(1)); dst->Z = ___F64VECTORREF(src,___FIX(2)); } return ___err; } ___SCMOBJ VECTOR3DF_to_SCMOBJ (vector3df src, ___SCMOBJ *dst, int arg_num) { ___SCMOBJ ___err = ___FIX(___NO_ERR); *dst = ___alloc_scmobj (___sF64VECTOR, 3<<3, ___STILL); if (___FIXNUMP(*dst)) ___err = ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num); else { ___F64VECTORSET(*dst,___FIX(0),src.X) ___F64VECTORSET(*dst,___FIX(1),src.Y) ___F64VECTORSET(*dst,___FIX(2),src.Z) } return ___err; } #define ___BEGIN_CFUN_SCMOBJ_to_VECTOR3DF(src,dst,i) \ if ((___err = SCMOBJ_to_VECTOR3DF (src, &dst, i)) == ___FIX(___NO_ERR)) { #define ___END_CFUN_SCMOBJ_to_VECTOR3DF(src,dst,i) } #define ___BEGIN_CFUN_VECTOR3DF_to_SCMOBJ(src,dst) \ if ((___err = VECTOR3DF_to_SCMOBJ (src, &dst, ___RETURN_POS)) == ___FIX(___NO_ERR)) { #define ___END_CFUN_VECTOR3DF_to_SCMOBJ(src,dst) \ ___EXT(___release_scmobj) (dst); } #define ___BEGIN_SFUN_VECTOR3DF_to_SCMOBJ(src,dst,i) \ if ((___err = VECTOR3DF_to_SCMOBJ (src, &dst, i)) == ___FIX(___NO_ERR)) { #define ___END_SFUN_VECTOR3DF_to_SCMOBJ(src,dst,i) \ ___EXT(___release_scmobj) (dst); } #define ___BEGIN_SFUN_SCMOBJ_to_VECTOR3DF(src,dst) \ { ___err = SCMOBJ_to_VECTOR3DF (src, &dst, ___RETURN_POS); #define ___END_SFUN_SCMOBJ_to_VECTOR3DF(src,dst) } c-declare-end ) (c-define-type vector3df "vector3df" "VECTOR3DF_to_SCMOBJ" "SCMOBJ_to_VECTOR3DF" #f) Marc's code worked perfectly fine, but mine compiles from scm to c, but won't from .c to object file .o. The error message I get from g++ is the following: gsc -c irr-interface.scm g++ -rdynamic -I/opt/g4/current/include -I/home/dave/irrlicht-1.3/include -I/usr/X11R6/include -D___SINGLE_HOST -O3 -ffast-math -c irr-interface.c irr-interface.c: In function ‘int SCMOBJ_to_POSITION2D_S32(int, position2d_s32*, int)’: irr-interface.c:995: error: ‘___s32_temp’ was not declared in this scope irr-interface.c:995: error: ‘___hp’ was not declared in this scope irr-interface.c: In function ‘int POSITION2D_S32_to_SCMOBJ(position2d_s32, int*, int)’: irr-interface.c:1009: error: ‘___temp’ was not declared in this scope I don't understant why the almost exact same definitions works with F64VECTOR but not with S32VECTOR... Can anyone help me?? Thank you! David St-Hilaire

1 0

Loading syntax-case.scm disables lambda-lifting
by Bradley Lucier 21 Mai '07

21 Mai '07

Marc: I've been looking at a few benchmarks that use syntax-case.scm for macro expansion, and, well, for some reason the compiler doesn't do lambda-lifting after syntax-case.scm has been loaded. You're really hurting on some benchmarks. Brad Here's the code: (declare (standard-bindings)(block)) (define (update! table key value func) (let ((hash (vector-ref table 0)) (eql? (vector-ref table 1)) (size (vector-ref table 2)) (tabl (vector-ref table 3)) (count (vector-ref table 4))) (let ((slot (hash size key))) (let loop ((bucket (vector-ref tabl slot))) (cond ((null? bucket) (vector-set! table 4 (+ (vector-ref table 4) 1)) (vector-set! tabl slot (cons (cons key value) (vector-ref tabl slot)))) ((eql? (caar bucket) key) (set-cdr! (car bucket) (func key (cdar bucket) value))) (else (loop (cdr bucket)))))))) Here's without syntax-case.scm: (define update! (lambda (table key value func) (let ((count (if (and ('#<procedure #4 ##vector?> table) ('#<procedure #5 ##fx<> 4 ('#<procedure #6 ##vector-length> table))) ('#<procedure #7 ##vector-ref> table 4) (vector-ref table 4))) (tabl (if (and ('#<procedure #4 ##vector?> table) ('#<procedure #5 ##fx<> 3 ('#<procedure #6 ##vector-length> table))) ('#<procedure #7 ##vector-ref> table 3) (vector-ref table 3))) (size (if (and ('#<procedure #4 ##vector?> table) ('#<procedure #5 ##fx<> 2 ('#<procedure #6 ##vector-length> table))) ('#<procedure #7 ##vector-ref> table 2) (vector-ref table 2))) (eql? (if (and ('#<procedure #4 ##vector?> table) ('#<procedure #5 ##fx<> 1 ('#<procedure #6 ##vector-length> table))) ('#<procedure #7 ##vector-ref> table 1) (vector-ref table 1))) (hash (if (and ('#<procedure #4 ##vector?> table) ('#<procedure #5 ##fx<> 0 ('#<procedure #6 ##vector-length> table))) ('#<procedure #7 ##vector-ref> table 0) (vector-ref table 0)))) (let ((slot (hash size key))) (letrec ((loop (lambda (table key value func tabl eql? slot bucket) (if ('#<procedure #9 ##null?> bucket) (let ((begin-temp.0 (let ((temp.18 (let ((temp.13 (if (and ('#<procedure #4 ##vector?> table) ('#<procedure #5 ##fx<> 4 ('#<procedure #6 ##vector-length> table))) ( '#<procedure #7 ##vector-ref> table 4) ( vector-ref table 4)))) (if ('#<procedure #11 ##fixnum?> temp.13) (let ((temp. 15 ('#<procedure #12 ##fx+?> temp.13 1))) (if temp. 15 temp.15 (+ temp.13 1))) (+ temp.13 1))))) (if (and (and ('#<procedure #4 ##vector?> table) ('#<procedure #14 ##subtyped-mutable?> table)) ('#<procedure #5 ##fx<> 4 ('#<procedure #6 ##vector-length> table))) ('#<procedure #15 ##vector- set!> table 4 temp.18) (vector-set! table 4 temp. 18))))) (let ((temp.23 ('#<procedure #18 ##cons> ('#<procedure #18 ##cons> key value) (if (and ('#<procedure #4 ##vector?> tabl) (and ('#<procedure #11 ##fixnum?> slot) (and ('#<procedure #16 ##fx<=> 0 slot) ('#<procedure #5 ##fx<> slot ('#<procedure #6 ##vector-length> tabl))))) ('#<procedure #7 ##vector-ref> tabl slot) (vector-ref tabl slot))))) (if (and (and ('#<procedure #4 ##vector?> tabl) ('#<procedure #14 ##subtyped-mutable?> tabl)) (and ('#<procedure #11 ##fixnum?> slot) (and ('#<procedure #16 ##fx<=> 0 slot) ('#<procedure #5 ##fx<> slot ('#<procedure #6 ##vector-length> tabl))))) ('#<procedure #15 ##vector-set! > tabl slot temp.23) (vector-set! tabl slot temp.23)))) (if (eql? (let ((temp.25 (if ('#<procedure #20 ##pair?> bucket) ('#<procedure #21 ##car> bucket) #f))) (if ('#<procedure #20 ##pair?> temp.25) ('#<procedure #21 ##car> temp.25) (caar bucket))) key) (let ((temp.30 (func key (let ((temp.28 (if ('#<procedure #20 ##pair?> bucket) ('#<procedure #21 ##car> bucket) #f))) (if ('#<procedure #20 ##pair?> temp.28) ('#<procedure #23 ##cdr> temp.28) (cdar bucket))) value)) (temp.29 (if ('#<procedure #20 ##pair?> bucket) ('#<procedure #21 ##car> bucket) (car bucket)))) (if (and ('#<procedure #20 ##pair? > temp.29) ('#<procedure #26 ##pair- mutable?> temp.29)) ('#<procedure #27 ##set-cdr!> temp.29 temp.30) (set-cdr! temp.29 temp.30))) (loop table key value func tabl eql? slot (if ('#<procedure #20 ##pair? > bucket) ('#<procedure #23 ##cdr> bucket) (cdr bucket)))))))) (loop table key value func tabl eql? slot (if (and ('#<procedure #4 ##vector?> tabl) (and ('#<procedure #11 ##fixnum?> slot) (and ('#<procedure #16 ##fx<=> 0 slot) ('#<procedure #5 ##fx<> slot ('#<procedure #6 ##vector-length> tabl))))) ('#<procedure #7 ##vector-ref> tabl slot) (vector-ref tabl slot)))))))) Here's after loading syntax-case.scm: > (compile-file "update-test.scm" '(expansion)) Expansion: (define update! (lambda (%%table0 %%key1 %%value2 %%func3) (let ((%%count8 (if (and ('#<procedure #4 ##vector?> %%table0) ('#<procedure #5 ##fx<> 4 ('#<procedure #6 ##vector-length> %%table0))) ('#<procedure #7 ##vector-ref> %%table0 4) (vector-ref %%table0 4))) (%%tabl7 (if (and ('#<procedure #4 ##vector?> %%table0) ('#<procedure #5 ##fx<> 3 ('#<procedure #6 ##vector-length> %%table0))) ('#<procedure #7 ##vector-ref> %%table0 3) (vector-ref %%table0 3))) (%%size6 (if (and ('#<procedure #4 ##vector?> %%table0) ('#<procedure #5 ##fx<> 2 ('#<procedure #6 ##vector-length> %%table0))) ('#<procedure #7 ##vector-ref> %%table0 2) (vector-ref %%table0 2))) (%%eql?5 (if (and ('#<procedure #4 ##vector?> %%table0) ('#<procedure #5 ##fx<> 1 ('#<procedure #6 ##vector-length> %%table0))) ('#<procedure #7 ##vector-ref> %%table0 1) (vector-ref %%table0 1))) (%%hash4 (if (and ('#<procedure #4 ##vector?> %%table0) ('#<procedure #5 ##fx<> 0 ('#<procedure #6 ##vector-length> %%table0))) ('#<procedure #7 ##vector-ref> %%table0 0) (vector-ref %%table0 0)))) (let ((%%slot9 (%%hash4 %%size6 %%key1))) ((letrec ((%%loop10 (lambda (%%bucket11) (if ('#<procedure #9 ##null?> %%bucket11) (let ((begin-temp.0 (let ((temp.20 (let ((temp.15 (if (and ('#<procedure #4 ##vector?> %%table0) ('#<procedure #5 ##fx<> 4 ('#<procedure #6 ##vector-length> %%table0))) ('#<procedure #7 ##vector-ref> %%table0 4) (vector-ref %%table0 4)))) (if ('#<procedure #11 ##fixnum?> temp.15) (let ((temp.17 ('#<procedure #12 ##fx+?> temp.15 1))) (if temp.17 temp.17 (+ temp.15 1))) (+ temp.15 1))))) (if (and (and ('#<procedure #4 ##vector?> %%table0) ('#<procedure #14 ##subtyped-mutable?> %%table0)) ('#<procedure #5 ##fx<> 4 ('#<procedure #6 ##vector-length> %%table0))) ('#<procedure #15 ##vector-set! > %%table0 4 temp.20) (vector-set! %%table0 4 temp. 20))))) (let ((temp.25 ('#<procedure #18 ##cons> ('#<procedure #18 ##cons> %%key1 %%value2) (if (and ('#<procedure #4 ##vector?> %%tabl7) (and ('#<procedure #11 ##fixnum?> %%slot9) (and ('#<procedure #16 ##fx<=> 0 %%slot9) ('#<procedure #5 ##fx<> %%slot9 ('#<procedure #6 ##vector-length> %%tabl7))))) ('#<procedure #7 ##vector-ref> %%tabl7 %%slot9) (vector-ref %%tabl7 %% slot9))))) (if (and (and ('#<procedure #4 ##vector? > %%tabl7) ('#<procedure #14 ##subtyped-mutable?> %%tabl7)) (and ('#<procedure #11 ##fixnum?> %%slot9) (and ('#<procedure #16 ##fx<=> 0 %%slot9) ('#<procedure #5 ##fx<> %%slot9 ('#<procedure #6 ##vector-length> %%tabl7))))) ('#<procedure #15 ##vector-set!> %% tabl7 %%slot9 temp.25) (vector-set! %%tabl7 %%slot9 temp. 25)))) (if (%%eql?5 (let ((temp.27 (if ('#<procedure #20 ##pair?> %%bucket11) ('#<procedure #21 ##car> %%bucket11) #f))) (if ('#<procedure #20 ##pair? > temp.27) ('#<procedure #21 ##car> temp.27) (caar %%bucket11))) %%key1) (let ((temp.32 (%%func3 %%key1 (let ((temp.30 (if ('#<procedure #20 ##pair?> %%bucket11) ('#<procedure #21 ##car> %%bucket11) #f))) (if ('#<procedure #20 ##pair?> temp.30) ('#<procedure #23 ##cdr> temp.30) (cdar %% bucket11))) %%value2)) (temp.31 (if ('#<procedure #20 ##pair?> %%bucket11) ('#<procedure #21 ##car> %%bucket11) (car %%bucket11)))) (if (and ('#<procedure #20 ##pair?> temp.31) ('#<procedure #26 ##pair- mutable?> temp.31)) ('#<procedure #27 ##set-cdr!> temp.31 temp.32) (set-cdr! temp.31 temp.32))) (%%loop10 (if ('#<procedure #20 ##pair?> %% bucket11) ('#<procedure #23 ##cdr> %%bucket11) (cdr %%bucket11)))))))) %%loop10) (if (and ('#<procedure #4 ##vector?> %%tabl7) (and ('#<procedure #11 ##fixnum?> %%slot9) (and ('#<procedure #16 ##fx<=> 0 %%slot9) ('#<procedure #5 ##fx<> %%slot9 ('#<procedure #6 ##vector-length> %%tabl7))))) ('#<procedure #7 ##vector-ref> %%tabl7 %%slot9) (vector-ref %%tabl7 %%slot9)))))))

1 0

Re: [gambit-list] Where is macro-character-port-rlo defined?
by Guillaume Cartier 20 Mai '07

20 Mai '07

Christian Jaeger wrote: > Guillaume Cartier wrote: > >> An unfortunate note is that GIT doesn't run natively on Windows and is >> very slow under Cygwin. >> >> If Marc decides to implement a source control for Gambit I would propose >> using Darcs which has nice support for every major platform and also has >> a very formal theory of patches. >> >> > > Well, the reasons I would prefer working with GIT is that it works for > me, that I've already invested some time into it, that it's very simple > conceptually (the git database is just a mostly-purely functional object > storage with the hashed object contents as keys, which all types share > (the file contents (blobs), directory listings, commit objects), has > very compact storage (pack files), and no space or time complexity > problems. I didn't know it wouldn't work well on Windows. > > I do not have much experience with Darcs. If GIT is no option, it would > be my second choice to seriously try (because using a decentralized > approach is important, and it's written in Haskell, which is important > to keep getting into anyway). I don't know what this formal patching > theory is, btw, what is it telling and how does it affect the user > interface or internal workings? Is that theory the reason behind the > (still unsolved?) algorithmic complexity problems Darcs has? > > Note that there is also ongoing work on several fronts on GIT for > Windows. So possibly what's slow now won't remain so for long.(*) > > (I also have some temptation writing a GIT library directly in Gambit, > without requiring the git tools; that could also possibly solve the > speed issues on Windows. But I'd probably only write the lowlevel parts, > stuff like merging tools and network access would likely have to be done > by someone else.) > > Christian. > > (*some possibly interesting links > http://git.or.cz/gitwiki/WindowsInstall > http://git.or.cz/gitwiki/EclipsePluginWishlist > http://git.or.cz/gitwiki/SoC2007Ideas > ) > > > Christian, if you write a GIT lowlevel interface in Gambit and it solves the speed issues on Windows, I would most certainly write GUI tools on top of it! And the good news is that with the port of JazzScheme to X11 and Macintosh under way, they could be made available to the community. Guillaume

1 0

Re: [gambit-list] Where is macro-character-port-rlo defined?
by Guillaume Cartier 20 Mai '07

20 Mai '07

Christian Jaeger wrote: > ... > > I would suggest using GIT as code versioning repository one has not > already been decided upon, I'm using it for about a year now and I > really like it (I've even started writing a Gambit library for accessing > the git tools, what's there already is a parser of git-log output and > I'm just in the midst of developing a better git-bisect algorithm with it). > > > ... > An unfortunate note is that GIT doesn't run natively on Windows and is very slow under Cygwin. If Marc decides to implement a source control for Gambit I would propose using Darcs which has nice support for every major platform and also has a very formal theory of patches. Guillaume

2 1

Much faster character IO
by Bradley Lucier 20 Mai '07

20 Mai '07

Marc: If you're in the mood for adding specializations to the compiler, please consider the approach to read-char and write-char in <https://webmail.iro.umontreal.ca/pipermail/gambit-list/2007-February/ 001135.html> <https://webmail.iro.umontreal.ca/pipermail/gambit-list/2007-February/ 001130.html> and especially <https://webmail.iro.umontreal.ca/pipermail/gambit-list/2007-February/ 001140.html> I think character-based IO will probably end up being just about as fast as in C with this approach. Brad

1 0

Thread scheduling
by Christian Jaeger 20 Mai '07

20 Mai '07

Hello The priorities in the threading system seem to behave somewhat strange (in beta21). 1. the default priority of the primordial thread is -1e10; is this on purpose and reasonable? 2. a thread with higher priority doesn't let other threads run at all, and this even if it calls yield. In the examples below, the lower-priority threads are only really started after higher priority ones have finished. Is this a feature or a bug? Christian. > (prio 20000000 0 2 2e100) baseprio cur before: #<thread #1 primordial> -1e10 baseprio cur after: #<thread #1 primordial> 0. baseprio before: #<thread #2> 0. baseprio before: #<thread #3> 0. baseprio after: #<thread #2> 2. baseprio after: #<thread #3> 2e100 started: #<thread #2> finished: #<thread #2> started: #<thread #3> finished: #<thread #3> > (prio 20000000 3 2 2e100) baseprio cur before: #<thread #1 primordial> 0. baseprio cur after: #<thread #1 primordial> 3. baseprio before: #<thread #4> 3. baseprio before: #<thread #5> 3. baseprio after: #<thread #4> 2. baseprio after: #<thread #5> 2e100 started: #<thread #5> finished: #<thread #5> started: #<thread #4> finished: #<thread #4> ;; library function (supposed to format values like |error| does): (define warn (lambda l (if (pair? l) (let ((p (current-error-port))) (display (car l) p) (let loop ((l (cdr l))) (if (pair? l) (begin (write-char #\space p) (write (car l) p) (loop (cdr l))) (newline p)))) (error "warn called without arguments")))) ;; / library (define (prio n cur p1 p2) (warn "baseprio cur before:" (current-thread) (thread-base-priority (current-thread))) (thread-base-priority-set! (current-thread) cur) (warn "baseprio cur after:" (current-thread) (thread-base-priority (current-thread))) (let ((proc (lambda () (warn "started: " (current-thread)) (let lp ((i n)) (if (positive? i) (begin (if (zero? (modulo i 1000)) (begin ;;(warn "thread-yield of:" (current-thread)) (thread-yield!))) (lp (- i 1))))) (warn "finished: " (current-thread))))) (let ((th1 (make-thread proc)) (th2 (make-thread proc))) (warn "baseprio before:" th1 (thread-base-priority th1)) (warn "baseprio before:" th2 (thread-base-priority th2)) (thread-base-priority-set! th1 p1) (thread-base-priority-set! th2 p2) (warn "baseprio after:" th1 (thread-base-priority th1)) (warn "baseprio after:" th2 (thread-base-priority th2)) (thread-start! th1) (thread-start! th2) (thread-sleep! 3);;(to make sure the thread-join!'s don't have an influence) (values (thread-join! th1) (thread-join! th2)))))

1 0

Compiler expansion for sqrt
by Bradley Lucier 20 Mai '07

20 Mai '07

Marc: The compiler can expand (sqrt x) as (define (sqrt x) (cond ((##fixnum? x) (if (and (##fixnum.<= 0 x) (or (##not (##fixnum? 4294967296)) ; 32-bit fixnums (##fixnum.<= x 4503599627370496))) (##flonum->fixnum (##flonum.sqrt (##flonum.<-fixnum x))) (##sqrt x))) ((and (##flonum? x) (##flonum.<= 0. x)) (##flonum.sqrt x)) (else (##sqrt x)))) It's very worthwhile for some programs (and some micro-benchmarks ;-). Brad

2 2

display of lists
by Marijn Schouten (hkBst) 15 Mai '07

15 Mai '07

-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 Hi, why does gambit eliminate all spacing and parens when displaying lists, such as in: (display ((lambda (lambda) `(,lambda ',lambda)) '(lambda (lambda) `(,lambda ,'lambda))))(newline) with output: lambdalambdaquasiquoteunquotelambdaunquotequotelambdaquotelambdalambdaquasiquoteunquotelambdaunquotequotelambda ? Marijn -----BEGIN PGP SIGNATURE----- Version: GnuPG v2.0.4 (GNU/Linux) Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org iD8DBQFGSfIKp/VmCx0OL2wRAnKzAJ0dEwDl+eOdaVbcHZNSn/cXMW7uAQCdEPxy qOQ8bE+EypALeJECh7qwElg= =Z1c3 -----END PGP SIGNATURE-----

2 1

Re: [gambit-list] Bug
by Bradley Lucier 15 Mai '07

15 Mai '07

This is copied to the Gambit mail list (as was the original message). On May 10, 2007, at 8:32 PM, Marc Feeley wrote: > And what makes you think it is OK to > > (define (##vector-copy v) > (let* ((n (vector-length v)) > (result (make-vector n))) > (do ((i (- n 1) (- i 1))) > ((< i 0) result) > (vector-set! result i (vector-ref v i))))) > > "##vector-copy" is supposed to accept any vector-like object as > argument, including structures such as readtables. Just chuck that > definition. So how am I supposed to know that ##vector-copy has been defined somewhere in the gambit runtime? In the main gambc-4.0b22 directory I see > euler-7% grep -r vector-copy `find . -name '*.scm'` > ./gsc/_gvm.scm: (left-to-schedule (stretchable-vector-copy > (bbs-basic-blocks bbs)))) > ./gsc/_utils.scm:(define (stretchable-vector-copy sv) > ./gsc/_utils.scm:(define (stretchable-vector-copy sv) > ./lib/_eval#.scm: '(##vector (##vector-copy ##step-handlers) > ./lib/_io.scm: (let ((copy (##vector-copy rt))) > ./lib/_io.scm: (##vector-copy obj)) > ./lib/gambit#.scm:f32vector-copy > ./lib/gambit#.scm:f64vector-copy > ./lib/gambit#.scm:s16vector-copy > ./lib/gambit#.scm:s32vector-copy > ./lib/gambit#.scm:s64vector-copy > ./lib/gambit#.scm:s8vector-copy > ./lib/gambit#.scm:u16vector-copy > ./lib/gambit#.scm:u32vector-copy > ./lib/gambit#.scm:u64vector-copy > ./lib/gambit#.scm:u8vector-copy > ./lib/gambit#.scm:vector-copy I presume that there's some macro somewhere that expands to a definition of ##vector-copy. Perhaps the compiler should remark if (standard-bindings) or (extended-bindings) are declared and a standard or gambit-specific function is (re-)defined in a user file. Brad

3 6

open-tcp-server MacOSX
by François Magnan 14 Mai '07

14 Mai '07

Hi, I found a strange behavior with open-tcp-server on MacOSX of GambitC4b20 and GambitC4b22. I was able to isolate the problem up to this point... Eval the following code (define (rpc-server-start) (let ((rpc-command-queue (open-tcp-server 5000))) (thread-start! (make-thread (lambda () (let loop () (let ((incoming-connection (read rpc-command-queue))) (debug "Got connection\n") (serve-rpc-command incoming-connection) ) (loop))))) rpc-command-queue)) (define (serve-rpc-command incoming-connection) (let* ((command (read-line incoming-connection))) (display (string-append command "\n") incoming-connection) (display "ok!\n\n" incoming-connection) (force-output incoming-connection) (close-port incoming-connection))) (define (main) (rpc-server-start) (loop-indefinitely) ) (define (loop-indefinitely) (thread-sleep! 1) (loop-indefinitely)) (main) Then in a Terminal type telnet 127.0.0.1 5000 type something and then return. You should see: Trying 127.0.0.1... Connected to localhost. Escape character is '^]'. sdj sdj ok! Now comment out the call to "loop-indefinitely" in the (main) function. If you try the telnet again it will not work... This is not the case in the MingW (WinXP) versions. It seems I cannot start a tcp-server in a thread and still get the read-eval-print loop. Anybody can help? Thank you, Francois Magnan

3 3