Skip to content

Get rid of the result pipe #4

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
DerGuteMoritz wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Get rid of the result pipe #4

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
1af574c
Get rid of the result pipe
DerGuteMoritz Mar 1, 2015
e8a5ba2
Merge remote-tracking branch 'origin/master' into remove-result-pipe
DerGuteMoritz Mar 1, 2015
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 3 additions & 7 deletions cncb-compile-time.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,16 +38,14 @@
(define (generate-entry-point r name dispvar t/a sync rtype)
(let ((cvar (gensym "cvar"))
(mutex (gensym "mutex"))
(infd (gensym "infd"))
(outfd (gensym "outfd"))
(data (gensym "data"))
(ptr (gensym "ptr"))
(result (symbol->string (gensym "result")))
(result-arg (gensym "arg"))
(%begin (r 'begin))
(%define-foreign-variable (r 'define-foreign-variable))
(%dispatcher-argument-output-fileno (r 'dispatcher-argument-output-fileno))
(%dispatcher-result-input-fileno (r 'dispatcher-result-input-fileno))
(%dispatcher-output-fileno (r 'dispatcher-output-fileno))
(%foreign-declare (r 'foreign-declare))
(rtype (strip-syntax rtype))
(t/a (strip-syntax t/a)))
Expand Down Expand Up @@ -94,7 +92,7 @@
`(,%begin
(,%foreign-declare
"#include <pthread.h>\n"
,(conc "static int " infd "," outfd ";\n")
,(conc "static int " outfd ";\n")
,(conc (if sync (foreign-type-declaration rtype "") "void")
" " name "("
(string-intersperse
Expand Down Expand Up @@ -126,10 +124,8 @@
(conc "return " result ";\n")
"")
"}\n")
(,%define-foreign-variable ,infd int)
(,%define-foreign-variable ,outfd int)
(set! ,outfd (,%dispatcher-argument-output-fileno ,dispvar))
(set! ,infd (,%dispatcher-result-input-fileno ,dispvar)))))
(set! ,outfd (,%dispatcher-output-fileno ,dispvar)))))


(define (unstash-and-execute r t/a ptr body sync rtype)
Expand Down
6 changes: 2 additions & 4 deletions cncb-module.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,10 +2,8 @@
dispatcher?
dispatcher-id
dispatcher-thread
dispatcher-argument-input-fileno
dispatcher-argument-output-fileno
dispatcher-result-input-fileno
dispatcher-result-output-fileno
dispatcher-input-fileno
dispatcher-output-fileno
dispatch
dispatcher-add!
dispatcher-terminate!
Expand Down
23 changes: 7 additions & 16 deletions cncb.scm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,10 +19,8 @@
(id : symbol)
(thread : thread)
(callbacks : (list-of (pair fixnum ((struct dispatcher) pointer -> * boolean))))
(argument-input-fileno : fixnum)
(argument-output-fileno : fixnum)
(result-input-fileno : fixnum)
(result-output-fileno : fixnum) )
(input-fileno : fixnum)
(output-fileno : fixnum))


(define word-size (foreign-value "sizeof(void *)" int))
Expand All @@ -31,14 +29,10 @@
(define (nonblocking-pipe-input-port fd id)
(##sys#custom-input-port 'nonblocking-pipe-input-port (->string id) fd #t))

(define (nonblocking-pipe-output-port fd id)
(##sys#custom-output-port 'nonblocking-pipe-output-port (->string id) fd #t))

(define (dispatch-loop box)
(let* ((disp (car box))
(id (dispatcher-id disp))
(in (nonblocking-pipe-input-port (dispatcher-argument-input-fileno disp) id))
(out (nonblocking-pipe-output-port (dispatcher-result-output-fileno disp) id)))
(in (nonblocking-pipe-input-port (dispatcher-input-fileno disp) id)))
(let loop ()
(let* ((str (read-string word-size in))
(input (extract_argument_ptr str)))
Expand All @@ -52,14 +46,11 @@
(loop)))
(else ; NULL-ptr aborts dispatcher
(close-input-port in)
(close-output-port out)
(file-close (dispatcher-argument-output-fileno disp))
(file-close (dispatcher-result-input-fileno disp))))))))
(file-close (dispatcher-output-fileno disp))))))))

(define (create-dispatcher id thread)
(let-values (((in1 out1) (create-pipe))
((in2 out2) (create-pipe)))
(let ((disp (make-dispatcher id thread '() in1 out1 in2 out2)))
(let-values (((in out) (create-pipe)))
(let ((disp (make-dispatcher id thread '() in out)))
(hash-table-set! dispatcher-table id disp)
disp)))

Expand All @@ -82,7 +73,7 @@

(define (dispatcher-terminate! disp)
(send_termination_message
(dispatcher-argument-output-fileno disp)))
(dispatcher-output-fileno disp)))


(define-syntax define-concurrent-native-callback
Expand Down