Hi Ian, Ian Piumarta <[EMAIL PROTECTED]> writes:
> I suggest you allocate them statically. Do the malloc() of the > struct _send from within the send syntax, and treat the address as a > constant in the expansion. Unlike the C version, you can pre-fill > selector and argument count immediately after allocation (they are > constants while expanding the send) to eliminate the two > corresponding writes at each send site. That's an interesting design. I've implemented this. It wasn't too big of a change, so I've attached the new functions in boot.k and object.k that made this work (given my libid-as-Jolt-primitive patch is installed... if you don't want that, then you'll replace (long@ _libid 34) with (dlsym "_libid_bindv")). > If this won't work for you for any reason let me know and I'll look > at implementing alloca() for all three currently supported > architectures. This does raise the question: what kind of concurrency model do you have in mind for Jolt/Coke? I've been trying to do things that work in the presence of threads, but static allocations bound to the send site definitely conflict with preemptive threading. -- Michael FIG <[EMAIL PROTECTED]> //\ http://michael.fig.org/ \// == boot.k ============================================================ ;; message send syntax ;; ((oop *)_libid->import("_send"))[-1] (define _send_vtable (long@ ((long@ _libid 24) "_send") (- 0 1))) ;; A bindv shortcut, just for bootstrap. ;; When using, don't forget to count our receiver as an argument. (define _bindv (lambda (_s receiver selector nArgs) (set-long@ _s 0 selector) (set-long@ _s 1 nArgs) (set-long@ _s 2 receiver) ((long@ _libid 34) _s))) (define Array (import "Array")) (syntax send ; (send selector receiver args...) (lambda (form compiler) (let ((_send_struct (malloc (* 6 sizeof-long))) (_s (+ _send_struct sizeof-long)) (__s (+ (<< _s 1) 1))) ;; _s (set-long@ _send_struct _send_vtable) (let ((call ((_bindv _s form 'copyWithFirst: 2) _s form form 0)) ;; [form copyWithFirst: 0] (size ((_bindv _s form 'size 1) _s form form)) ;; [form size] (params ((_bindv _s Array 'new: 2) _s Array Array '4)) ;; [Array new: '4] (sel ((_bindv _s form 'at: 2) _s form form '1)) ;; selector (rcv ((_bindv _s form 'at: 2) _s form form '2)) ;; receiver (setsel '0) (sym 0)) ;; Check if the selector was a quoted symbol. (let ((sel-size ((_bindv _s sel 'size 1) _s sel sel))) ;; 5 == tagged integer 2 (if (== sel-size (+ (<< 2 1) 1)) (if (== ((_bindv _s sel 'first 1) _s sel sel) 'quote) (set sym ((_bindv _s sel 'second 1) _s sel sel))))) (if (== sym 0) (let () ;; Create the expression that sets the selector at runtime. (set setsel ((_bindv _s Expression 'new: 2) _s Expression Expression '3)) ((_bindv _s setsel 'at:put: 3) _s setsel setsel '0 'set-long@) ((_bindv _s setsel 'at:put: 3) _s setsel setsel '1 __s) ((_bindv _s setsel 'at:put: 3) _s setsel setsel '2 sel))) ((_bindv _s call 'at:put: 3) _s call call '0 '__f) ;; [call at: '0 put: '__f] ((_bindv _s call 'at:put: 3) _s call call '1 __s) ;; [call at: '1 put: _s] ((_bindv _s call 'at:put: 3) _s call call '2 '__r) ;; [call at: '2 put: '__r] ((_bindv _s call 'at:put: 3) _s call call '3 '__r) ;; [call at: '3 put: '__r] ((_bindv _s params 'at:put: 3) _s params params '0 rcv) ;; [params at: '0 put: rcv] ((_bindv _s params 'at:put: 3) _s params params '1 __s) ;; [params at: '1 put: _s] ((_bindv _s params 'at:put: 3) _s params params '2 setsel) ;; [params at: '2 put: setsel] ((_bindv _s params 'at:put: 3) _s params params '3 call) ;; [params at: '3 put: call] (let ((tpl '(let ((__r : 0)) (set-long@ : 1 2 __r) : 2 ;; maybe set the selector at runtime ;; _libid->bind(_s) (let ((__f ((long@ _libid 34) : 1))) : 3)))) (let ((send ((_bindv _s tpl 'withParameters: 2) _s tpl tpl params))) ;; Reuse the allocated send struct for this call site. ;; _nArgs is definitely known at compile-time. (set-long@ _s 1 (- (>> size 1) 2)) ;; _nArgs (if (!= sym 0) (set-long@ _s 0 sym)) send)))))) == object.k ========================================================= ;; message send syntax (replaces the bogus version defined in boot.k which cannot cope with ':) (syntax send ; (send selector receiver args...) (lambda (node compiler) (or [[node size] >= '3] [compiler errorSyntax: node]) (let ((selector [node second]) (receiver [node third]) (nArgs [[node size] - '2]) (_send_struct (malloc (* 6 sizeof-long))) (_s (+ _send_struct sizeof-long)) (__s [SmallInteger value_: _s])) ;; Reuse a single allocated send struct for this call site. (set (long@ _send_struct 0) _send_vtable) (set (long@ _s 1) (>> nArgs 1)) (let ((selector-setter '0)) (if (and [[selector size] = '2] [[selector first] = 'quote]) ;; An optimisation: move the setting of the selector to ;; compile-time if it is a constant. (set (long@ _s 0) [selector second]) ;; A non-constant: set the selector at runtime. (set selector-setter `(set (long@ ,__s 0) ,selector))) `(let ((__r ,receiver)) ,selector-setter (set (long@ ,__s 2) __r) (let ((__f ((long@ _libid 34) ,__s))) (__f ,__s __r __r ,@[node copyFrom: '3]))))))) _______________________________________________ fonc mailing list [email protected] http://vpri.org/mailman/listinfo/fonc
