Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-11 23:17:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding explicit type-casts when using sexp_cpointer_value,

Browse source 
not all compilers will allow implicit conversions from void*.
also removing Linux-specific stime and utime from siginfo_t.
This commit is contained in:
Alex Shinn 2009-12-26 09:01:45 +09:00
parent 8596e1812a
commit e82b500b61
3 changed files with 17 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lib/chibi/process.stub
View file

@ -4,7 +4,7 @@
(c-system-include "signal.h") (c-system-include "signal.h")
(c-system-include "unistd.h") (c-system-include "unistd.h")
(define-c-struct siginfo (define-c-type siginfo_t
predicate: signal-info? predicate: signal-info?
(int si_signo signal-number) (int si_signo signal-number)
(int si_errno signal-error-number) (int si_errno signal-error-number)
@ -12,8 +12,9 @@
(pid_t si_pid signal-pid) (pid_t si_pid signal-pid)
(uid_t si_uid signal-uid) (uid_t si_uid signal-uid)
(int si_status signal-status) (int si_status signal-status)
(clock_t si_utime signal-user-time) ;;(clock_t si_utime signal-user-time)
(clock_t si_stime signal-system-time)) ;;(clock_t si_stime signal-system-time)
)
(define-c-type sigset_t (define-c-type sigset_t
predicate: signal-set?) predicate: signal-set?)

2
lib/chibi/signal.c
View file

@ -15,7 +15,7 @@ static void sexp_call_sigaction (int signum, siginfo_t *info, void *uctx) {
sexp_gc_preserve1(sigctx, args); sexp_gc_preserve1(sigctx, args);
args = sexp_cons(sigctx, SEXP_FALSE, SEXP_NULL); args = sexp_cons(sigctx, SEXP_FALSE, SEXP_NULL);
sexp_car(args) sexp_car(args)
= sexp_make_cpointer(sigctx, sexp_siginfo_type_id, info, SEXP_FALSE, 0); = sexp_make_cpointer(sigctx, sexp_siginfo_t_type_id, info, SEXP_FALSE, 0);
args = sexp_cons(sigctx, SEXP_FALSE, args); args = sexp_cons(sigctx, SEXP_FALSE, args);
sexp_car(args) = sexp_make_fixnum(signum); sexp_car(args) = sexp_make_fixnum(signum);
sexp_apply(sigctx, handler, args); sexp_apply(sigctx, handler, args);

18
tools/genstubs.scm
View file

@ -502,7 +502,8 @@
(let ((ctype (assq base *types*))) (let ((ctype (assq base *types*)))
(cond (cond
(ctype (ctype
(cat (if (type-null? type) (cat "(" (type-c-name type) ")"
(if (type-null? type)
"sexp_cpointer_maybe_null_value" "sexp_cpointer_maybe_null_value"
"sexp_cpointer_value") "sexp_cpointer_value")
"(" val ")")) "(" val ")"))
@ -532,13 +533,16 @@
((string env-string non-null-string) "char*") ((string env-string non-null-string) "char*")
(else (symbol->string base)))) (else (symbol->string base))))
(define (type-struct-type type)
(let ((type-spec (assq (if (vector? type) (type-base type) type) *types*)))
(cond ((and type-spec (memq 'type: type-spec)) => cadr)
(else #f))))
(define (type-c-name type) (define (type-c-name type)
(let* ((type (parse-type type)) (let* ((type (parse-type type))
(base (type-base type)) (base (type-base type))
(type-spec (assq base *types*)) (type-spec (assq base *types*))
(struct-type (struct-type (type-struct-type type)))
(cond ((and type-spec (memq 'type: type-spec)) => cadr)
(else #f))))
(string-append (string-append
(if (type-const? type) "const " "") (if (type-const? type) "const " "")
(if struct-type (string-append (symbol->string struct-type) " ") "") (if struct-type (string-append (symbol->string struct-type) " ") "")
@ -988,7 +992,8 @@
(lambda () (lambda ()
(c->scheme-converter (c->scheme-converter
(car field) (car field)
(string-append "((struct " (mangle name) "*)" (string-append "((" (x->string (or (type-struct-type name) ""))
" " (mangle name) "*)"
"sexp_cpointer_value(x))" "sexp_cpointer_value(x))"
(if (type-struct? (car field)) "." "->") (if (type-struct? (car field)) "." "->")
(x->string (cadr field))) (x->string (cadr field)))
@ -1008,7 +1013,8 @@
" " " "
(lambda () (c->scheme-converter (lambda () (c->scheme-converter
(car field) (car field)
(string-append "((struct " (mangle name) "*)" (string-append "((" (x->string (or (type-struct-type name) ""))
" " (mangle name) "*)"
"sexp_cpointer_value(x))" "sexp_cpointer_value(x))"
(if (type-struct? (car field)) "." "->") (if (type-struct? (car field)) "." "->")
(x->string (cadr field))))) (x->string (cadr field)))))