Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Improved return value marshalling in CHICKEN callback wrapper |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: | ab22068543c55fa2fb3f13ea5836d025fde46485 |
| User & Date: | murphy 2015-08-06 15:17:38 |
Context
|
2015-08-07
| ||
| 16:01 | Flush the main loop after widget destruction before clearing the registry check-in: d42d57606e user: murphy tags: trunk | |
|
2015-08-06
| ||
| 15:17 | Improved return value marshalling in CHICKEN callback wrapper check-in: ab22068543 user: murphy tags: trunk | |
|
2015-08-05
| ||
| 16:05 | Exception handlers and dynamic exit traps for CHICKEN callback trampolines check-in: 59297e2f3f user: murphy tags: trunk | |
Changes
Changes to chicken/iup-base.scm.
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
...
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
|
(define frame-return/pointer! (foreign-lambda* void ([c-pointer frame] [c-pointer ret]) "va_return_ptr((va_alist)frame, void *, ret);")) (define frame-return/handle! (foreign-lambda* void ([c-pointer frame] [ihandle ret]) "va_return_ptr((va_alist)frame, Ihandle *, ret);")) (call-with-current-continuation (lambda (return) (let ([sig "i"] [ret 'continue]) (dynamic-wind void (lambda () (let* ([data (registry-ref (pointer->address cid))] [proc (cdr data)]) (set! sig (car data)) (case (string-ref sig 0) ................................................................................ [(#\f) (frame-arg/float! frame)] [(#\d) (frame-arg/double! frame)] [(#\s) (frame-arg/string! frame)] [(#\v) (frame-arg/pointer! frame)] [(#\h) (frame-arg/handle! frame)]))]) (handle-exceptions exn (print-error-message exn (current-error-port) "Error: in callback") (set! ret (apply proc args)))))) (lambda () (handle-exceptions exn (void) (case (string-ref sig 0) [(#\b) (frame-return/ubyte! frame ret)] [(#\i) (frame-return/status! frame ret)] [(#\f) (frame-return/float! frame ret)] [(#\d) (frame-return/double! frame ret)] [(#\v) (frame-return/pointer! frame ret)] [(#\h) (frame-return/handle! frame ret)])) (return (void)))))))) (define-values (callback-set! callback) (letrec ([signature/raw (foreign-lambda* c-string ([nonnull-ihandle handle] [iname/upcase name]) "C_return(iupClassCallbackGetFormat(handle->iclass, name));")] [set/pointer! |
|
|
<
<
<
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
|
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
...
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
|
(define frame-return/pointer! (foreign-lambda* void ([c-pointer frame] [c-pointer ret]) "va_return_ptr((va_alist)frame, void *, ret);")) (define frame-return/handle! (foreign-lambda* void ([c-pointer frame] [ihandle ret]) "va_return_ptr((va_alist)frame, Ihandle *, ret);")) (call-with-current-continuation (lambda (return) (let ([sig "i"] [ret? #f]) (dynamic-wind void (lambda () (let* ([data (registry-ref (pointer->address cid))] [proc (cdr data)]) (set! sig (car data)) (case (string-ref sig 0) ................................................................................ [(#\f) (frame-arg/float! frame)] [(#\d) (frame-arg/double! frame)] [(#\s) (frame-arg/string! frame)] [(#\v) (frame-arg/pointer! frame)] [(#\h) (frame-arg/handle! frame)]))]) (handle-exceptions exn (print-error-message exn (current-error-port) "Error: in callback") (let ([ret (apply proc args)]) (case (string-ref sig 0) [(#\b) (frame-return/ubyte! frame ret)] [(#\i) (frame-return/status! frame ret)] [(#\f) (frame-return/float! frame ret)] [(#\d) (frame-return/double! frame ret)] [(#\v) (frame-return/pointer! frame ret)] [(#\h) (frame-return/handle! frame ret)]) (set! ret? #t)))))) (lambda () (unless ret? (case (string-ref sig 0) [(#\b) (frame-return/ubyte! frame 0)] [(#\i) (frame-return/status! frame 'continue)] [(#\f) (frame-return/float! frame 0.0)] [(#\d) (frame-return/double! frame 0.0)] [(#\v #\h) (frame-return/pointer! frame #f)])) (return (void)))))))) (define-values (callback-set! callback) (letrec ([signature/raw (foreign-lambda* c-string ([nonnull-ihandle handle] [iname/upcase name]) "C_return(iupClassCallbackGetFormat(handle->iclass, name));")] [set/pointer! |