~ chicken-core (chicken-5) a82ee1718552e895e5d118afe5e8cc4712449cab
commit a82ee1718552e895e5d118afe5e8cc4712449cab
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jul 16 01:20:13 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri Jul 16 01:20:13 2010 +0200
use C_return internally
diff --git a/lolevel.scm b/lolevel.scm
index 6db68e2e..ae414886 100644
--- a/lolevel.scm
+++ b/lolevel.scm
@@ -229,7 +229,7 @@ EOF
(define (object->pointer x)
(and (##core#inline "C_blockp" x)
- ((foreign-lambda* nonnull-c-pointer ((scheme-object x)) "return((void *)x);") x) ) )
+ ((foreign-lambda* nonnull-c-pointer ((scheme-object x)) "C_return((void *)x);") x) ) )
(define (pointer->object ptr)
(##sys#check-pointer ptr 'pointer->object)
@@ -242,7 +242,7 @@ EOF
(define pointer+
(foreign-lambda* nonnull-c-pointer ([c-pointer ptr] [integer off])
- "return((unsigned char *)ptr + off);") )
+ "C_return((unsigned char *)ptr + off);") )
(define pointer-offset pointer+) ; DEPRECATED
diff --git a/manual/faq b/manual/faq
index d4a54820..5793c6a0 100644
--- a/manual/faq
+++ b/manual/faq
@@ -406,7 +406,8 @@ and compiler settings:
{{+}} {{*}} {{-}} {{/}} {{quotient}} {{eq?}} {{eqv?}} {{equal?}} {{apply}} {{c...r}} {{values}} {{call-with-values}}
{{list-ref}} {{null?}} {{length}} {{not}} {{char?}} {{string?}} {{symbol?}} {{vector?}} {{pair?}} {{procedure?}}
{{boolean?}} {{number?}} {{complex?}} {{rational?}} {{real?}} {{exact?}} {{inexact?}} {{list?}} {{eof-object?}}
-{{string-ref}} {{string-set!}} {{vector-ref}} {{vector-set!}} {{char=?}} {{char<?}} {{char>?}} {{char<=?}} {{char>=?}}
+{{string-ref}} {{string-set!}} {{vector-ref}} {{vector-set!}}
+{{char=?}} {{char<?}} {{char>?}} {{char<=?}} {{char>=?}}
{{char-numeric?}} {{char-alphabetic?}} {{char-whitespace?}} {{char-upper-case?}} {{for-each}}
{{char-lower-case?}} {{char-upcae}} {{char-downcase}} {{list-tail}} {{assv}} {{memv}} {{memq}} {{assoc}}
{{member}} {{set-car!}} {{set-cdr!}} {{abs}} {{exp}} {{sin}} {{cos}} {{tan}} {{log}} {{asin}} {{acos}} {{atan}} {{sqrt}}
diff --git a/posixunix.scm b/posixunix.scm
index 49213e6c..6b5ffc97 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -480,8 +480,8 @@ EOF
(define ##sys#file-nonblocking!
(foreign-lambda* bool ([int fd])
"int val = fcntl(fd, F_GETFL, 0);"
- "if(val == -1) return(0);"
- "return(fcntl(fd, F_SETFL, val | O_NONBLOCK) != -1);" ) )
+ "if(val == -1) C_return(0);"
+ "C_return(fcntl(fd, F_SETFL, val | O_NONBLOCK) != -1);" ) )
(define ##sys#file-select-one
(foreign-lambda* int ([int fd])
@@ -490,8 +490,8 @@ EOF
"FD_ZERO(&in);"
"FD_SET(fd, &in);"
"tm.tv_sec = tm.tv_usec = 0;"
- "if(select(fd + 1, &in, NULL, NULL, &tm) == -1) return(-1);"
- "else return(FD_ISSET(fd, &in) ? 1 : 0);" ) )
+ "if(select(fd + 1, &in, NULL, NULL, &tm) == -1) C_return(-1);"
+ "else C_return(FD_ISSET(fd, &in) ? 1 : 0);" ) )
;;; Lo-level I/O:
@@ -1082,7 +1082,7 @@ EOF
(define group-member
(foreign-lambda* c-string ([int i])
- "return(C_group->gr_mem[ i ]);") )
+ "C_return(C_group->gr_mem[ i ]);") )
(define (group-information group #!optional as-vector)
(let ([r (if (fixnum? group)
@@ -1103,14 +1103,14 @@ EOF
(define _get-groups
(foreign-lambda* int ([int n])
- "return(getgroups(n, C_groups));") )
+ "C_return(getgroups(n, C_groups));") )
(define _ensure-groups
(foreign-lambda* bool ([int n])
"if(C_groups != NULL) C_free(C_groups);"
"C_groups = (gid_t *)C_malloc(sizeof(gid_t) * n);"
- "if(C_groups == NULL) return(0);"
- "else return(1);") )
+ "if(C_groups == NULL) C_return(0);"
+ "else C_return(1);") )
(define (get-groups)
(let ([n (foreign-value "getgroups(0, C_groups)" int)])
@@ -1779,7 +1779,7 @@ EOF
"\n#else\n"
"char *z = (daylight ? tzname[1] : tzname[0]);"
"\n#endif\n"
- "return(z);") )
+ "C_return(z);") )
;;; Other things:
@@ -1847,8 +1847,8 @@ EOF
(define get-host-name
(let ([getit
(foreign-lambda* c-string ()
- "if(gethostname(C_hostbuf, 256) == -1) return(NULL);"
- "else return(C_hostbuf);") ] )
+ "if(gethostname(C_hostbuf, 256) == -1) C_return(NULL);"
+ "else C_return(C_hostbuf);") ] )
(lambda ()
(let ([host (getit)])
(unless host
diff --git a/posixwin.scm b/posixwin.scm
index 9f313952..9dee8ede 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -1534,7 +1534,7 @@ EOF
(define local-timezone-abbreviation
(foreign-lambda* c-string ()
"char *z = (_daylight ? _tzname[1] : _tzname[0]);\n"
- "return(z);") )
+ "C_return(z);") )
;;; Other things:
diff --git a/scheduler.scm b/scheduler.scm
index 4e868075..e4512a46 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -306,7 +306,7 @@ EOF
"timeout.tv_usec = (tm % 1000) * 1000;"
"C_fdset_input_2 = C_fdset_input;"
"C_fdset_output_2 = C_fdset_output;"
- "return(select(FD_SETSIZE, &C_fdset_input, &C_fdset_output, NULL, to ? &timeout : NULL));") )
+ "C_return(select(FD_SETSIZE, &C_fdset_input, &C_fdset_output, NULL, to ? &timeout : NULL));") )
(define ##sys#fdset-restore
(foreign-lambda* void ()
diff --git a/srfi-4.scm b/srfi-4.scm
index 818225ce..83120073 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -257,9 +257,9 @@ EOF
(let* ([ext-alloc
(foreign-lambda* scheme-object ([int bytes])
"C_word *buf = (C_word *)C_malloc(bytes + sizeof(C_header));"
- "if(buf == NULL) return(C_SCHEME_FALSE);"
+ "if(buf == NULL) C_return(C_SCHEME_FALSE);"
"C_block_header(buf) = C_make_header(C_BYTEVECTOR_TYPE, bytes);"
- "return(buf);") ]
+ "C_return(buf);") ]
[ext-free
(foreign-lambda* void ([scheme-object bv])
"C_free((void *)C_block_item(bv, 1));") ]
diff --git a/tcp.scm b/tcp.scm
index 4a7f56fc..324f6237 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -108,56 +108,57 @@ EOF
(define ##net#connect (foreign-lambda int "connect" int scheme-pointer int))
(define ##net#send
- (foreign-lambda* int ((int s) (scheme-pointer msg) (int offset) (int len) (int flags))
- "return(send(s, (char *)msg+offset, len, flags));"))
+ (foreign-lambda*
+ int ((int s) (scheme-pointer msg) (int offset) (int len) (int flags))
+ "C_return(send(s, (char *)msg+offset, len, flags));"))
(define ##net#make-nonblocking
(foreign-lambda* bool ((int fd))
"int val = fcntl(fd, F_GETFL, 0);"
- "if(val == -1) return(0);"
- "return(fcntl(fd, F_SETFL, val | O_NONBLOCK) != -1);") )
+ "if(val == -1) C_return(0);"
+ "C_return(fcntl(fd, F_SETFL, val | O_NONBLOCK) != -1);") )
(define ##net#getsockname
(foreign-lambda* c-string ((int s))
"struct sockaddr_in sa;"
"unsigned char *ptr;"
"int len = sizeof(struct sockaddr_in);"
- "if(getsockname(s, (struct sockaddr *)&sa, (socklen_t *)&len) != 0) return(NULL);"
+ "if(getsockname(s, (struct sockaddr *)&sa, (socklen_t *)&len) != 0) C_return(NULL);"
"ptr = (unsigned char *)&sa.sin_addr;"
"sprintf(addr_buffer, \"%d.%d.%d.%d\", ptr[ 0 ], ptr[ 1 ], ptr[ 2 ], ptr[ 3 ]);"
- "return(addr_buffer);") )
+ "C_return(addr_buffer);") )
(define ##net#getsockport
(foreign-lambda* int ((int s))
"struct sockaddr_in sa;"
"int len = sizeof(struct sockaddr_in);"
- "if(getsockname(s, (struct sockaddr *)&sa, (socklen_t *)(&len)) != 0) return(-1);"
- "else return(ntohs(sa.sin_port));") )
+ "if(getsockname(s, (struct sockaddr *)&sa, (socklen_t *)(&len)) != 0) C_return(-1);"
+ "else C_return(ntohs(sa.sin_port));") )
(define ##net#getpeerport
(foreign-lambda* int ((int s))
"struct sockaddr_in sa;"
"int len = sizeof(struct sockaddr_in);"
- "if(getpeername(s, (struct sockaddr *)&sa, (socklen_t *)(&len)) != 0) return(-1);"
- "else return(ntohs(sa.sin_port));") )
+ "if(getpeername(s, (struct sockaddr *)&sa, (socklen_t *)(&len)) != 0) C_return(-1);"
+ "else C_return(ntohs(sa.sin_port));") )
(define ##net#getpeername
(foreign-lambda* c-string ((int s))
"struct sockaddr_in sa;"
"unsigned char *ptr;"
"unsigned int len = sizeof(struct sockaddr_in);"
- "if(getpeername(s, (struct sockaddr *)&sa, ((unsigned int *)&len)) != 0) return(NULL);"
+ "if(getpeername(s, (struct sockaddr *)&sa, ((unsigned int *)&len)) != 0) C_return(NULL);"
"ptr = (unsigned char *)&sa.sin_addr;"
"sprintf(addr_buffer, \"%d.%d.%d.%d\", ptr[ 0 ], ptr[ 1 ], ptr[ 2 ], ptr[ 3 ]);"
- "return(addr_buffer);") )
+ "C_return(addr_buffer);") )
(define ##net#startup
(foreign-lambda* bool () #<<EOF
#ifdef _WIN32
- return(WSAStartup(MAKEWORD(1, 1), &wsa) == 0);
+ C_return(WSAStartup(MAKEWORD(1, 1), &wsa) == 0);
#else
signal(SIGPIPE, SIG_IGN);
- return(1);
+ C_return(1);
#endif
EOF
) )
@@ -168,8 +169,8 @@ EOF
(define ##net#getservbyname
(foreign-lambda* int ((c-string serv) (c-string proto))
"struct servent *se;
- if((se = getservbyname(serv, proto)) == NULL) return(0);
- else return(ntohs(se->s_port));") )
+ if((se = getservbyname(serv, proto)) == NULL) C_return(0);
+ else C_return(ntohs(se->s_port));") )
(define ##net#select
(foreign-lambda* int ((int fd))
@@ -181,7 +182,7 @@ EOF
tm.tv_sec = tm.tv_usec = 0;
rv = select(fd + 1, &in, NULL, NULL, &tm);
if(rv > 0) { rv = FD_ISSET(fd, &in) ? 1 : 0; }
- return(rv);") )
+ C_return(rv);") )
(define ##net#select-write
(foreign-lambda* int ((int fd))
@@ -193,18 +194,18 @@ EOF
tm.tv_sec = tm.tv_usec = 0;
rv = select(fd + 1, NULL, &out, NULL, &tm);
if(rv > 0) { rv = FD_ISSET(fd, &out) ? 1 : 0; }
- return(rv);") )
+ C_return(rv);") )
(define ##net#gethostaddr
(foreign-lambda* bool ((scheme-pointer saddr) (c-string host) (unsigned-short port))
"struct hostent *he = gethostbyname(host);"
"struct sockaddr_in *addr = (struct sockaddr_in *)saddr;"
- "if(he == NULL) return(0);"
+ "if(he == NULL) C_return(0);"
"memset(addr, 0, sizeof(struct sockaddr_in));"
"addr->sin_family = AF_INET;"
"addr->sin_port = htons((short)port);"
"addr->sin_addr = *((struct in_addr *)he->h_addr);"
- "return(1);") )
+ "C_return(1);") )
(define (yield)
(##sys#call-with-current-continuation
@@ -254,7 +255,7 @@ EOF
;; PLT makes this an optional arg to tcp-listen. Should we as well?
(when (eq? -1 ((foreign-lambda* int ((int socket))
"int yes = 1;
- return(setsockopt(socket, SOL_SOCKET, SO_REUSEADDR, (const char *)&yes, sizeof(int)));")
+ C_return(setsockopt(socket, SOL_SOCKET, SO_REUSEADDR, (const char *)&yes, sizeof(int)));")
s) )
(##sys#update-errno)
(##sys#signal-hook
@@ -551,8 +552,8 @@ EOF
"int err, optlen;"
"optlen = sizeof(err);"
"if (typecorrect_getsockopt(socket, SOL_SOCKET, SO_ERROR, &err, (socklen_t *)&optlen) == -1)"
- "return(-1);"
- "return(err);"))
+ "C_return(-1);"
+ "C_return(err);"))
(define general-strerror (foreign-lambda c-string "strerror" int))
Trap