Changeset 13138 in project
- Timestamp:
- 01/31/09 10:19:20 (12 years ago)
- Location:
- chicken/trunk
- Files:
-
- 16 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/trunk/benchmarks/scheme.scm
r1016 r13138 87 87 (scheme-error "Identifier expected" x)) 88 88 (if (memq x scheme-syntactic-keywords) 89 (scheme-error "Variable name can 89 (scheme-error "Variable name cannot be a syntactic keyword" x))) 90 90 91 91 (define (shape form n) -
chicken/trunk/c-backend.scm
r12937 r13138 1426 1426 str) ) ) 1427 1427 ((##sys#immediate? lit) 1428 (bomb "invalid literal - can 1428 (bomb "invalid literal - cannot encode" lit)) 1429 1429 ((##core#inline "C_byteblockp" lit) 1430 1430 (##sys#string-append ; relies on the fact that ##sys#string-append doesn't check -
chicken/trunk/chicken.texi
r12937 r13138 914 914 @item -no-usual-integrations 915 915 916 Specifies that standard procedures and certain internal procedures may be redefined, and can 916 Specifies that standard procedures and certain internal procedures may be redefined, and cannot be inlined. This is equivalent to declaring @code{(not usual-integrations)}. 917 917 @item -version 918 918 … … 1229 1229 @code{csi @{FILENAME|OPTION}@} 1230 1230 1231 where @code{FILENAME} specifies a file with Scheme source-code. If the extension of the source file is @code{.scm}, it may be omitted. The runtime options described in @uref{http://galinha.ucpel.tche.br/Using%20the%20compiler#Compiler%20command%20line%20format, Compiler command line format} are also available for the interpreter. If the environment variable @code{CSI_OPTIONS} is set to a list of options, then these options are additionally passed to every direct or indirect invocation of @code{csi}. Please note that runtime options (like @code{-:...}) can 1231 where @code{FILENAME} specifies a file with Scheme source-code. If the extension of the source file is @code{.scm}, it may be omitted. The runtime options described in @uref{http://galinha.ucpel.tche.br/Using%20the%20compiler#Compiler%20command%20line%20format, Compiler command line format} are also available for the interpreter. If the environment variable @code{CSI_OPTIONS} is set to a list of options, then these options are additionally passed to every direct or indirect invocation of @code{csi}. Please note that runtime options (like @code{-:...}) cannot be passed using this method. The options recognized by the interpreter are: 1232 1232 1233 1233 @table @b … … 3017 3017 [declaration specifier] (not interrupts-enabled) 3018 3018 @end verbatim 3019 Disable timer-interrupts checks in the compiled program. Threads can 3019 Disable timer-interrupts checks in the compiled program. Threads cannot be preempted in main- or library-units that contain this declaration. 3020 3020 3021 3021 @node Declarations - disable-warning, Declarations - import, Declarations - disable-interrupts, Declarations … … 4168 4168 [procedure] (cpu-time) 4169 4169 @end verbatim 4170 Returns the used CPU time of the current process in milliseconds as two values: the time spent in user code, and the time spent in system code. On platforms where user and system time can 4170 Returns the used CPU time of the current process in milliseconds as two values: the time spent in user code, and the time spent in system code. On platforms where user and system time cannot be differentiated, system time will be always be 0. 4171 4171 4172 4172 @node Unit library - Execution time - current-milliseconds, Unit library - Execution time - current-seconds, Unit library - Execution time - cpu-time, Unit library - Execution time … … 13565 13565 % csc -static-extensions my-program.scm -uses my-ext 13566 13566 @end verbatim 13567 The compiler will try to do the right thing, but can 13567 The compiler will try to do the right thing, but cannot handle all extensions, since the ability to statically link eggs is relatively new. Eggs that support static linking are designated as being able to do so. If you require a statically linkable version of an egg that has not been converted yet, contact the extension author or the CHICKEN mailing list. 13568 13568 13569 13569 Previous: @ref{Interface to external functions and variables, Interface to external functions and variables} … … 13771 13771 13772 13772 13773 @code{case} expands into a cascaded @code{if} expression, where the first item in each arm is treated as a quoted list. So the @code{case} macro can 13773 @code{case} expands into a cascaded @code{if} expression, where the first item in each arm is treated as a quoted list. So the @code{case} macro cannot infer whether a symbol is to be treated as a constant-name (defined via @code{define-constant}) or a literal symbol. 13774 13774 13775 13775 @node FAQ - General - How can I enable case sensitive reading/writing in user code?, FAQ - General - How can I change match-error-control during compilation?, FAQ - General - Why are constants defined by define-constant not honoured in case constructs?, FAQ - General … … 14063 14063 14064 14064 14065 Even when the @code{match} unit is not used, the macros from that package are visible in the compiler. The reason for this is that macros can 14065 Even when the @code{match} unit is not used, the macros from that package are visible in the compiler. The reason for this is that macros cannot be accessed from library units (only when explicitly evaluated in running code). To speed up macro-expansion time, the compiler and the interpreter both already provide the compiled @code{match-...} macro definitions. Macros shadowed lexically are no problem, but global definitions of variables named identically to (global) macros are useless - the macro definition shadows the global variable. 14066 14066 14067 14067 This problem can be solved using a different name or undefining the macro, like this: -
chicken/trunk/compiler.scm
r12956 r13138 213 213 ; call-sites -> ((<lambda-id> <node>) ...) Known call-nodes of a named procedure 214 214 ; home -> <lambda-id> Procedure which introduces this variable 215 ; unknown -> <boolean> If true: variable can 215 ; unknown -> <boolean> If true: variable cannot have a known value 216 216 ; assigned -> <boolean> If true: variable is assigned somewhere 217 217 ; assigned-locally -> <boolean> If true: variable has been assigned inside user lambda … … 2589 2589 "coerced inexact literal number `~S' to fixnum ~S" c (inexact->exact c)) 2590 2590 (immediate-literal (inexact->exact c)) ) 2591 (else (quit "can 2591 (else (quit "cannot coerce inexact literal `~S' to fixnum" c)) ) ) 2592 2592 (else (make-node '##core#literal (list (literal c)) '())) ) ) 2593 2593 ((immediate? c) (immediate-literal c)) -
chicken/trunk/csi.scm
r12937 r13138 435 435 (else 436 436 (let ((old (##sys#slot s 0))) 437 (cond ((not (procedure? old)) (##sys#error "can 437 (cond ((not (procedure? old)) (##sys#error "cannot trace non-procedure" s)) 438 438 (else 439 439 (set! traced-procedures (cons (cons s old) traced-procedures)) … … 473 473 (set! traced-procedures (del a traced-procedures eq?)) ) 474 474 (let ((old (##sys#slot s 0))) 475 (cond ((not (procedure? old)) (##sys#error "can 475 (cond ((not (procedure? old)) (##sys#error "cannot set breakpoint on non-procedure" s)) 476 476 (else 477 477 (set! broken-procedures (cons (cons s old) broken-procedures)) … … 744 744 [out ##sys#standard-output] ) 745 745 (define (bestlen n) (if len (min len n) n)) 746 (cond [(##sys#immediate? x) (##sys#error 'dump "can 746 (cond [(##sys#immediate? x) (##sys#error 'dump "cannot dump immediate object" x)] 747 747 [(##sys#bytevector? x) (hexdump x (bestlen (##sys#size x)) ##sys#byte out)] 748 748 [(string? x) (hexdump x (bestlen (##sys#size x)) ##sys#byte out)] … … 752 752 (let ([bv (##sys#slot x 1)]) 753 753 (hexdump bv (bestlen (##sys#size bv)) ##sys#byte out) ) ] 754 [else (##sys#error 'dump "can 754 [else (##sys#error 'dump "cannot dump object" x)] ) ) ) ) 755 755 756 756 (define hexdump -
chicken/trunk/eval.scm
r12937 r13138 739 739 ##core#foreign-primitive 740 740 ##core#foreign-lambda* ##core#define-foreign-type) 741 (##sys#syntax-error-hook "can 741 (##sys#syntax-error-hook "cannot evaluate compiler-special-form" x) ] 742 742 743 743 [(##core#app) … … 746 746 [else 747 747 (cond [(eq? head 'location) 748 (##sys#syntax-error-hook "can 748 (##sys#syntax-error-hook "cannot evaluate compiler-special-form" x) ] 749 749 750 750 [else (compile-call x e tf cntr se)] ) ] ) ) ) ) ] … … 925 925 [evproc (or evaluator eval)] ) 926 926 (cond [(and (string? input) (not fname)) 927 (##sys#signal-hook #:file-error 'load "can 927 (##sys#signal-hook #:file-error 'load "cannot open file" input) ] 928 928 [(and (load-verbose) fname) 929 929 (display "; loading ") … … 1132 1132 (set! ##sys#loaded-extensions (cons p ##sys#loaded-extensions)) 1133 1133 #t) 1134 ((optional err? #t) (##sys#error loc "can 1134 ((optional err? #t) (##sys#error loc "cannot load extension" id)) 1135 1135 (else #f) ) ) ) ) ) ) ) ) 1136 1136 -
chicken/trunk/expand.scm
r12952 r13138 754 754 (else 755 755 (syntax-error 756 loc "can 756 loc "cannot import from undefined module" 757 757 mname))))) 758 758 (let ((vexp (module-vexports mod)) … … 1466 1466 a 1467 1467 (##sys#error 1468 'import "can 1468 'import "cannot find implementation of re-exported syntax" 1469 1469 name)))) 1470 1470 (let* ((sexps -
chicken/trunk/library.scm
r13127 r13138 1332 1332 (##sys#signal-hook 1333 1333 #:bounds-error 'vector-copy! 1334 "can 1334 "cannot copy vector - count exceeds length" from to n) ) ] 1335 1335 [else] ) 1336 1336 (do ([i 0 (fx+ i 1)]) … … 1866 1866 [(#:append) 1867 1867 (if inp 1868 (##sys#error loc "can 1868 (##sys#error loc "cannot use append mode with input file") 1869 1869 (set! fmode "a") ) ] 1870 1870 [else (##sys#error loc "invalid file option" o)] ) ) ) … … 1872 1872 (unless (##sys#open-file-port port name (##sys#string-append fmode bmode)) 1873 1873 (##sys#update-errno) 1874 (##sys#signal-hook #:file-error loc (##sys#string-append "can 1874 (##sys#signal-hook #:file-error loc (##sys#string-append "cannot open file - " strerror) name) ) 1875 1875 port) ) ) 1876 1876 #:open (not inp) modes) ) … … 1970 1970 (if (##sys#slot port 1) 1971 1971 (##sys#values (##sys#slot port 4) (##sys#slot port 5)) 1972 (##sys#error 'port-position "can 1972 (##sys#error 'port-position "cannot compute position of port" port) ) ) 1973 1973 1974 1974 (define (delete-file filename) … … 1981 1981 (##sys#signal-hook 1982 1982 #:file-error 'delete-file 1983 (##sys#string-append "can 1983 (##sys#string-append "cannot delete file - " strerror) filename) ) ) 1984 1984 #:delete) ) 1985 1985 … … 1997 1997 (##sys#signal-hook 1998 1998 #:file-error 'rename-file 1999 (##sys#string-append "can 1999 (##sys#string-append "cannot rename file - " strerror) old new) ) ) ) ) 2000 2000 #:rename new) ) 2001 2001 … … 2299 2299 (cond [val 2300 2300 (when (and (##sys#inexact? val) rat-flag) 2301 (##sys#read-warning port "can 2301 (##sys#read-warning port "cannot represent exact fraction - coerced to flonum" tok) ) 2302 2302 val] 2303 2303 [radix (##sys#read-error port "illegal number syntax" tok)] … … 3754 3754 ((8) (apply ##sys#signal-hook #:bounds-error loc "out of range" args)) 3755 3755 ((9) (apply ##sys#signal-hook #:type-error loc "call of non-procedure" args)) 3756 ((10) (apply ##sys#signal-hook #:arity-error loc "continuation can 3756 ((10) (apply ##sys#signal-hook #:arity-error loc "continuation cannot receive multiple values" args)) 3757 3757 ((11) (apply ##sys#signal-hook #:type-error loc "bad argument type - not a non-cyclic list" args)) 3758 3758 ((12) (apply ##sys#signal-hook #:limit-error loc "recursion too deep" args)) 3759 ((13) (apply ##sys#signal-hook #:type-error loc "inexact number can 3759 ((13) (apply ##sys#signal-hook #:type-error loc "inexact number cannot be represented as an exact number" args)) 3760 3760 ((14) (apply ##sys#signal-hook #:type-error loc "bad argument type - not a proper list" args)) 3761 3761 ((15) (apply ##sys#signal-hook #:type-error loc "bad argument type - not a fixnum" args)) … … 4369 4369 (define (##sys#make-locative obj index weak? loc) 4370 4370 (cond [(##sys#immediate? obj) 4371 (##sys#signal-hook #:type-error loc "locative can 4371 (##sys#signal-hook #:type-error loc "locative cannot refer to immediate object" obj) ] 4372 4372 [(or (vector? obj) (pair? obj)) 4373 4373 (##sys#check-range index 0 (##sys#size obj) loc) … … 4423 4423 (##sys#signal-hook 4424 4424 #:type-error loc 4425 "bad argument type - locative can 4425 "bad argument type - locative cannot refer to objects of this type" 4426 4426 obj) ] ) ) 4427 4427 -
chicken/trunk/lolevel.scm
r10788 r13138 293 293 (define (number-of-bytes x) 294 294 (cond [(not (##core#inline "C_blockp" x)) 295 (##sys#signal-hook #:type-error 'number-of-bytes "can 295 (##sys#signal-hook #:type-error 'number-of-bytes "cannot compute number of bytes of immediate object" x) ] 296 296 [(##core#inline "C_byteblockp" x) (##sys#size x)] 297 297 [else (##core#inline "C_w2b" (##sys#size x))] ) ) … … 414 414 (make-property-condition 415 415 'exn 'location 'object-evict-to-location 416 'message "can 416 'message "cannot evict object - limit exceeded" 417 417 'arguments (list x limit)) 418 418 (make-property-condition 'evict 'limit limit) ) ) ) ) … … 455 455 (lambda (x #!optional (full #f)) 456 456 (define (err x) 457 (##sys#signal-hook #:type-error 'object-unevict "can 457 (##sys#signal-hook #:type-error 'object-unevict "cannot copy object" x) ) 458 458 (let ([tab (##sys#make-vector evict-table-size '())]) 459 459 (let copy ([x x]) -
chicken/trunk/runtime.c
r13135 r13138 548 548 549 549 if(!CHICKEN_initialize(h, s, n, toplevel)) 550 panic(C_text("can 550 panic(C_text("cannot initialize - out of memory")); 551 551 552 552 CHICKEN_run(NULL); … … 567 567 568 568 if(C_main_argv == NULL) 569 panic(C_text("can 569 panic(C_text("cannot allocate argument-list buffer")); 570 570 571 571 C_main_argc = 0; … … 583 583 584 584 if(aptr == NULL) 585 panic(C_text("can 585 panic(C_text("cannot allocate argument buffer")); 586 586 587 587 C_strcpy(aptr, bptr0); … … 713 713 memset(signal_mapping_table, 0, sizeof(int) * NSIG); 714 714 initialize_symbol_table(); 715 C_dlerror = "can 715 C_dlerror = "cannot load compiled code dynamically - this is a statically linked executable"; 716 716 error_location = C_SCHEME_FALSE; 717 717 C_pre_gc_hook = NULL; … … 735 735 736 736 if(pt == NULL) 737 panic(C_text("out of memory - can 737 panic(C_text("out of memory - cannot create initial ptable")); 738 738 739 739 C_pte(termination_continuation); … … 812 812 813 813 if(r == NULL) 814 panic(C_text("out of memory - can 814 panic(C_text("out of memory - cannot allocate GC root")); 815 815 816 816 r->value = C_SCHEME_UNDEFINED; … … 1070 1070 tospace_limit - tospace_start, 1071 1071 size, &ptr2a)) == NULL) 1072 panic(C_text("out of memory - can 1072 panic(C_text("out of memory - cannot allocate heap")); 1073 1073 1074 1074 heapspace1 = ptr1, heapspace1_size = size; … … 1467 1467 1468 1468 case C_CONTINUATION_CANT_RECEIVE_VALUES_ERROR: 1469 msg = C_text("continuation can 1469 msg = C_text("continuation cannot receive multiple values"); 1470 1470 c = 1; 1471 1471 break; … … 1482 1482 1483 1483 case C_CANT_REPRESENT_INEXACT_ERROR: 1484 msg = C_text("inexact number can 1484 msg = C_text("inexact number cannot be represented as an exact number"); 1485 1485 c = 1; 1486 1486 break; … … 2258 2258 2259 2259 if(dptr == NULL) 2260 panic(C_text("out of memory - can 2260 panic(C_text("out of memory - cannot allocate static string")); 2261 2261 2262 2262 strblock = (C_word)dptr; … … 2274 2274 2275 2275 if(dptr == NULL) 2276 panic(C_text("out of memory - can 2276 panic(C_text("out of memory - cannot allocate static lambda info")); 2277 2277 2278 2278 strblock = (C_word)dptr; … … 2296 2296 C_SCHEME_BLOCK *pbv = C_malloc(len + sizeof(C_header)); 2297 2297 2298 if(pbv == NULL) panic(C_text("out of memory - can 2298 if(pbv == NULL) panic(C_text("out of memory - cannot allocate permanent blob")); 2299 2299 2300 2300 pbv->header = C_BYTEVECTOR_TYPE | len; … … 2625 2625 2626 2626 if(mutation_stack_bottom == NULL) 2627 panic(C_text("out of memory - can 2627 panic(C_text("out of memory - cannot re-allocate mutation stack")); 2628 2628 2629 2629 mutation_stack_limit = mutation_stack_bottom + mssize + MUTATION_STACK_GROWTH; … … 3164 3164 3165 3165 if ((new_heapspace = heap_alloc (size, &new_tospace_start)) == NULL) 3166 panic(C_text("out of memory - can 3166 panic(C_text("out of memory - cannot allocate heap segment")); 3167 3167 new_heapspace_size = size; 3168 3168 … … 3257 3257 3258 3258 if ((heapspace2 = heap_alloc (size, &tospace_start)) == NULL) 3259 panic(C_text("out ot memory - can 3259 panic(C_text("out ot memory - cannot allocate heap segment")); 3260 3260 heapspace2_size = size; 3261 3261 … … 3728 3728 3729 3729 if((result = (char *)C_malloc(STRING_BUFFER_SIZE)) == NULL) 3730 horror(C_text("out of memory - can 3730 horror(C_text("out of memory - cannot allocate trace-dump buffer")); 3731 3731 3732 3732 *result = '\0'; … … 3748 3748 if(C_strlen(result) > STRING_BUFFER_SIZE - 32) { 3749 3749 if((result = C_realloc(result, C_strlen(result) * 2)) == NULL) 3750 horror(C_text("out of memory - can 3750 horror(C_text("out of memory - cannot reallocate trace-dump buffer")); 3751 3751 } 3752 3752 … … 3770 3770 3771 3771 if(trace_buffer == NULL) 3772 panic(C_text("out of memory - can 3772 panic(C_text("out of memory - cannot allocate trace-buffer")); 3773 3773 } 3774 3774 … … 7362 7362 while((C_uword)(C_fromspace_limit - C_fromspace_top) < (bytes + stack_size)) { 7363 7363 if(C_heap_size_is_fixed) 7364 panic(C_text("out of memory - can 7364 panic(C_text("out of memory - cannot allocate vector (heap resizing disabled)")); 7365 7365 7366 7366 C_save(init); … … 8427 8427 if(finalizer_free_list == NULL) { 8428 8428 if((flist = (FINALIZER_NODE *)C_malloc(sizeof(FINALIZER_NODE))) == NULL) 8429 panic(C_text("out of memory - can 8429 panic(C_text("out of memory - cannot allocate finalizer node")); 8430 8430 8431 8431 ++allocated_finalizer_count; … … 8584 8584 8585 8585 if(tmp == NULL) 8586 panic(C_text("out of memory - can 8586 panic(C_text("out of memory - cannot allocate toplevel name string")); 8587 8587 8588 8588 C_strcpy(tmp, C_text("_")); … … 8747 8747 if(i == 0) { 8748 8748 if((forwarding_table = (C_word *)realloc(forwarding_table, (forwarding_table_size + 1) * 4 * sizeof(C_word))) == NULL) 8749 panic(C_text("out of memory - can 8749 panic(C_text("out of memory - cannot re-allocate forwarding table")); 8750 8750 8751 8751 i = forwarding_table_size; … … 8832 8832 8833 8833 if(locative_table == NULL) 8834 panic(C_text("out of memory - can 8834 panic(C_text("out of memory - cannot resize locative table")); 8835 8835 8836 8836 locative_table_size *= 2; … … 8982 8982 8983 8983 if(collectibles == NULL) 8984 panic(C_text("out of memory - can 8984 panic(C_text("out of memory - cannot allocate GC protection vector")); 8985 8985 8986 8986 collectibles_top = collectibles + k; … … 9246 9246 9247 9247 if((bits & C_SPECIALBLOCK_BIT) != 0) 9248 panic(C_text("literals with special bit can 9248 panic(C_text("literals with special bit cannot be decoded")); 9249 9249 9250 9250 size = decode_size(str); -
chicken/trunk/setup-api.scm
r12956 r13138 143 143 (define (windows-sudo-install-setup) 144 144 (set! *sudo* #f) 145 (print "Warning: can 145 (print "Warning: cannot install as superuser with Windows") ) 146 146 147 147 (define (unix-sudo-install-setup) … … 590 590 (if (file-exists? dir) 591 591 (unless (directory? dir) 592 (error "can 592 (error "cannot create directory: a file with the same name already exists") ) 593 593 (begin 594 594 (create-directory dir) … … 698 698 (cond ((not (file-exists? dir)) 699 699 (if strict 700 (error 'remove-directory "can 700 (error 'remove-directory "cannot remove - directory not found" dir) 701 701 #f)) 702 702 (*sudo* -
chicken/trunk/setup-download.scm
r12938 r13138 250 250 ((http) 251 251 (locate-egg/http name location version destination tests)) 252 (else (error "can 252 (else (error "cannot retrieve extension unsupported transport" transport)))) ) 253 253 254 254 (define (list-extensions transport location #!key quiet username password) … … 259 259 ((svn) 260 260 (list-eggs/svn location username password)) 261 (else (error "can 261 (else (error "cannot list extensions - unsupported transport" transport)))) ) 262 262 263 263 ) -
chicken/trunk/srfi-18.scm
r12937 r13138 209 209 (##sys#check-structure thread 'thread 'thread-start!) ) 210 210 (unless (eq? 'created (##sys#slot thread 3)) 211 (##sys#error 'thread-start! "thread can 211 (##sys#error 'thread-start! "thread cannot be started a second time" thread) ) 212 212 (##sys#setslot thread 3 'ready) 213 213 (##sys#add-to-ready-queue thread) -
chicken/trunk/srfi-4.scm
r12937 r13138 258 258 (let ([bv (ext-alloc len)]) 259 259 (or bv 260 (##sys#error loc "not enough memory - can 260 (##sys#error loc "not enough memory - cannot allocate external number vector" len)) ) 261 261 (let ([bv (##sys#allocate-vector len #t #f #t)]) ; this could be made better... 262 262 (##core#inline "C_string_to_bytevector" bv) -
chicken/trunk/support.scm
r12948 r13138 288 288 (lambda (str) 289 289 (handle-exceptions ex 290 (quit "can 290 (quit "cannot parse expression: ~s [~a]~%" 291 291 str 292 292 (if (exn? ex) … … 1045 1045 (define (estimate-foreign-result-location-size type) 1046 1046 (define (err t) 1047 (quit "can 1047 (quit "cannot compute size of location for foreign type `~S'" t) ) 1048 1048 (follow-without-loop 1049 1049 type -
chicken/trunk/tcp.scm
r12937 r13138 174 174 175 175 (unless (##net#startup) 176 (##sys#signal-hook #:network-error "can 176 (##sys#signal-hook #:network-error "cannot initialize Winsock") ) 177 177 178 178 (define ##net#getservbyname … … 240 240 (##sys#update-errno) 241 241 (##sys#signal-hook 242 #:network-error 'tcp-connect (##sys#string-append "can 242 #:network-error 'tcp-connect (##sys#string-append "cannot compute port from service - " strerror) 243 243 s) ) 244 244 p) ) … … 263 263 (when (eq? _invalid_socket s) 264 264 (##sys#update-errno) 265 (##sys#error "can 265 (##sys#error "cannot create socket") ) 266 266 ;; PLT makes this an optional arg to tcp-listen. Should we as well? 267 267 (when (eq? -1 ((foreign-lambda* int ((int socket)) … … 279 279 (when (eq? -1 b) 280 280 (##sys#update-errno) 281 (##sys#signal-hook #:network-error 'tcp-listen (##sys#string-append "can 281 (##sys#signal-hook #:network-error 'tcp-listen (##sys#string-append "cannot bind to socket - " strerror) s port) ) 282 282 (values s addr) ) ) ) ) 283 283 … … 291 291 (when (eq? -1 l) 292 292 (##sys#update-errno) 293 (##sys#signal-hook #:network-error 'tcp-listen (##sys#string-append "can 293 (##sys#signal-hook #:network-error 'tcp-listen (##sys#string-append "cannot listen on socket - " strerror) s port) ) 294 294 (##sys#make-structure 'tcp-listener s) ) ) ) ) 295 295 … … 303 303 (when (fx= -1 (##net#close s)) 304 304 (##sys#update-errno) 305 (##sys#signal-hook #:network-error 'tcp-close (##sys#string-append "can 305 (##sys#signal-hook #:network-error 'tcp-close (##sys#string-append "cannot close TCP socket - " strerror) tcpl) ) ) ) 306 306 307 307 (define-constant +input-buffer-size+ 1024) … … 332 332 (unless (##net#make-nonblocking fd) 333 333 (##sys#update-errno) 334 (##sys#signal-hook #:network-error (##sys#string-append "can 334 (##sys#signal-hook #:network-error (##sys#string-append "cannot create TCP ports - " strerror)) ) 335 335 (let* ((buf (make-string +input-buffer-size+)) 336 336 (data (vector fd #f #f)) … … 364 364 (##sys#signal-hook 365 365 #:network-error 366 (##sys#string-append "can 366 (##sys#string-append "cannot read from socket - " strerror) 367 367 fd) ) ) ) 368 368 (else … … 386 386 (##sys#signal-hook 387 387 #:network-error 388 (##sys#string-append "can 388 (##sys#string-append "cannot check socket for input - " strerror) 389 389 fd) ) 390 390 (eq? f 1) ) ) ) … … 397 397 (##sys#signal-hook 398 398 #:network-error 399 (##sys#string-append "can 399 (##sys#string-append "cannot close socket input port - " strerror) 400 400 fd) ) ) ) 401 401 #f … … 461 461 (##sys#signal-hook 462 462 #:network-error 463 (##sys#string-append "can 463 (##sys#string-append "cannot write to socket - " strerror) 464 464 fd) ) ) ) 465 465 ((fx< n len) … … 486 486 (##sys#update-errno) 487 487 (##sys#signal-hook 488 #:network-error (##sys#string-append "can 488 #:network-error (##sys#string-append "cannot close socket output port - " strerror) fd) ) ) ) 489 489 (and outbuf 490 490 (lambda () … … 533 533 (##sys#update-errno) 534 534 (##sys#signal-hook 535 #:network-error 'tcp-accept-ready? (##sys#string-append "can 535 #:network-error 'tcp-accept-ready? (##sys#string-append "cannot check socket for input - " strerror) 536 536 tcpl) ) 537 537 (eq? 1 f) ) ) … … 561 561 (##sys#update-errno) 562 562 (##sys#signal-hook 563 #:network-error 'tcp-connect (##sys#string-append "can 563 #:network-error 'tcp-connect (##sys#string-append "cannot connect to socket - " strerror) 564 564 host port) ) 565 565 (when (eq? -1 s) 566 566 (##sys#update-errno) 567 (##sys#signal-hook #:network-error 'tcp-connect (##sys#string-append "can 567 (##sys#signal-hook #:network-error 'tcp-connect (##sys#string-append "cannot create socket - " strerror) host port) ) 568 568 (unless (##net#gethostaddr addr host port) 569 (##sys#signal-hook #:network-error 'tcp-connect "can 569 (##sys#signal-hook #:network-error 'tcp-connect "cannot find host address" host) ) 570 570 (unless (##net#make-nonblocking s) 571 571 (##sys#update-errno) … … 594 594 (##sys#signal-hook #:network-error 'tcp-connect (##sys#string-append "getsockopt() failed - " strerror))) 595 595 ((> err 0) 596 (##sys#signal-hook #:network-error 'tcp-connect (##sys#string-append "can 596 (##sys#signal-hook #:network-error 'tcp-connect (##sys#string-append "cannot create socket - " (general-strerror err)))))) 597 597 (##net#io-ports s) ) ) ) 598 598 … … 608 608 (values 609 609 (or (##net#getsockname fd) 610 (##sys#signal-hook #:network-error 'tcp-addresses (##sys#string-append "can 610 (##sys#signal-hook #:network-error 'tcp-addresses (##sys#string-append "cannot compute local address - " strerror) p) ) 611 611 (or (##net#getpeername fd) 612 (##sys#signal-hook #:network-error 'tcp-addresses (##sys#string-append "can 612 (##sys#signal-hook #:network-error 'tcp-addresses (##sys#string-append "cannot compute remote address - " strerror) p) ) ) ) ) 613 613 614 614 (define (tcp-port-numbers p) … … 617 617 (values 618 618 (or (##net#getsockport fd) 619 (##sys#signal-hook #:network-error 'tcp-port-numbers (##sys#string-append "can 619 (##sys#signal-hook #:network-error 'tcp-port-numbers (##sys#string-append "cannot compute local port - " strerror) p) ) 620 620 (or (##net#getpeerport fd) 621 (##sys#signal-hook #:network-error 'tcp-port-numbers (##sys#string-append "can 621 (##sys#signal-hook #:network-error 'tcp-port-numbers (##sys#string-append "cannot compute remote port - " strerror) p) ) ) ) ) 622 622 623 623 (define (tcp-listener-port tcpl) … … 627 627 (when (eq? -1 port) 628 628 (##sys#signal-hook 629 #:network-error 'tcp-listener-port (##sys#string-append "can 629 #:network-error 'tcp-listener-port (##sys#string-append "cannot obtain listener port - " strerror) 630 630 tcpl fd) ) 631 631 port) )
Note: See TracChangeset
for help on using the changeset viewer.