Changeset 7929 in project


Ignore:
Timestamp:
01/25/08 18:21:01 (12 years ago)
Author:
Kon Lovett
Message:

Added closure bad argument checking support. Added proc test to 'make-hash-table'.

Location:
chicken/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/chicken.h

    r7777 r7929  
    489489#define C_RUNTIME_SAFE_DLOAD_UNSAFE_ERROR             34
    490490#define C_BAD_ARGUMENT_TYPE_NO_FLONUM_ERROR           35
     491#define C_BAD_ARGUMENT_TYPE_NO_CLOSURE_ERROR          36
    491492
    492493
     
    10571058#endif
    10581059
     1060#define C_i_check_closure(x)            C_i_check_closure_2(x, C_SCHEME_FALSE)
    10591061#define C_i_check_exact(x)              C_i_check_exact_2(x, C_SCHEME_FALSE)
    10601062#define C_i_check_number(x)             C_i_check_number_2(x, C_SCHEME_FALSE)
     
    14551457C_fctexport C_word C_fcall C_i_length(C_word lst) C_regparm;
    14561458C_fctexport C_word C_fcall C_i_inexact_to_exact(C_word n) C_regparm;
     1459C_fctexport C_word C_fcall C_i_check_closure_2(C_word x, C_word loc) C_regparm;
    14571460C_fctexport C_word C_fcall C_i_check_exact_2(C_word x, C_word loc) C_regparm;
    14581461C_fctexport C_word C_fcall C_i_check_number_2(C_word x, C_word loc) C_regparm;
  • chicken/trunk/extras.scm

    r7776 r7929  
    6666     read open-input-string ##sys#peek-char-0 ##sys#read-char-0 ##sys#write-char call-with-input-file
    6767     read-line reverse make-string ##sys#string-append random
    68      ##sys#gcd ##sys#lcm ##sys#fudge ##sys#check-list ##sys#user-read-hook) ) ] )
     68     ##sys#gcd ##sys#lcm ##sys#fudge ##sys#check-list ##sys#user-read-hook
     69     ##sys#check-closure) ) ] )
    6970
    7071(private
     
    7879 [unsafe
    7980  (eval-when (compile)
     81    (define-macro (##sys#check-closure . _) '(##core#undefined))
    8082    (define-macro (##sys#check-structure . _) '(##core#undefined))
    8183    (define-macro (##sys#check-range . _) '(##core#undefined))
     
    15401542                                    [hashf ##sys#hash]
    15411543                                    [len hashtab-default-size])
     1544        (##sys#check-closure test 'make-hash-table)
     1545        (##sys#check-closure hashf 'make-hash-table)
    15421546        (##sys#check-exact len 'make-hash-table)
    15431547        (##sys#make-structure 'hash-table (make-vector len '()) 0 test hashf) ) ) ) )
  • chicken/trunk/library.scm

    r7899 r7929  
    319319    (##sys#signal-hook #:type-error loc "bad argument type - not a pointer-like object" ptr) ) )
    320320
     321(define (##sys#check-closure x . y)
     322  (if (pair? y)
     323      (##core#inline "C_i_check_closure_2" x (car y))
     324      (##core#inline "C_i_check_closure" x) ) )
     325
    321326(cond-expand
    322327 [unsafe
    323328  (eval-when (compile)
     329    (define-macro (##sys#check-closure . _) '(##core#undefined))
    324330    (define-macro (##sys#check-structure . _) '(##core#undefined))
    325331    (define-macro (##sys#check-range . _) '(##core#undefined))
     
    37033709                     "code to load dynamically was linked with unsafe runtime libraries, but executing runtime was not"
    37043710                     args) )
    3705         ((35) (apply ##sys#signal-hook #:runtime-error loc "bad argument type - not a floating-point number" args))
     3711        ((35) (apply ##sys#signal-hook #:type-error loc "bad argument type - not a floating-point number" args))
     3712        ((36) (apply ##sys#signal-hook #:type-error loc "bad argument type - not a procedure" args))
    37063713        (else (apply ##sys#signal-hook #:runtime-error loc "unknown internal error" args)) ) ) ) )
    37073714
  • chicken/trunk/runtime.c

    r7844 r7929  
    16311631    break;
    16321632
     1633  case C_BAD_ARGUMENT_TYPE_NO_CLOSURE_ERROR:
     1634    msg = C_text("bad argument type - procedure expected");
     1635    c = 1;
     1636    break;
     1637
    16331638  default: panic(C_text("illegal internal error code"));
    16341639  }
     
    20552060  unsigned int key = 0;
    20562061
     2062# if 0
     2063  /* Zbigniew's suggested change for extended significance & ^2 table sizes. */
     2064  while(len--) key += (key << 5) + *(str++);
     2065# else
    20572066  while(len--) key = (key << 4) + *(str++);
     2067# endif
    20582068
    20592069  return (int)(key % m);
     
    56915701
    56925702/* Inline routines for extended bindings: */
     5703
     5704C_regparm C_word C_fcall C_i_check_closure_2(C_word x, C_word loc)
     5705{
     5706  if(C_immediatep(x) || (C_header_bits(x) != C_CLOSURE_TYPE)) {
     5707    error_location = loc;
     5708    barf(C_BAD_ARGUMENT_TYPE_NO_CLOSURE_ERROR, NULL, x);
     5709  }
     5710
     5711  return C_SCHEME_UNDEFINED;
     5712}
     5713
    56935714
    56945715C_regparm C_word C_fcall C_i_check_exact_2(C_word x, C_word loc)
Note: See TracChangeset for help on using the changeset viewer.