/[guile]/guile/guile-core/libguile/unif.c
ViewVC logotype

Diff of /guile/guile-core/libguile/unif.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.131 by mvo, Thu Mar 14 22:25:31 2002 UTC revision 1.132 by xxhanwen, Sat Jul 20 14:08:34 2002 UTC
# Line 678  SCM_DEFINE (scm_make_shared_array, "make Line 678  SCM_DEFINE (scm_make_shared_array, "make
678    scm_t_array_dim *s;    scm_t_array_dim *s;
679    
680    SCM_VALIDATE_REST_ARGUMENT (dims);    SCM_VALIDATE_REST_ARGUMENT (dims);
681    SCM_VALIDATE_ARRAY (1,oldra);    SCM_VALIDATE_ARRAY (1, oldra);
682    SCM_VALIDATE_PROC (2,mapfunc);    SCM_VALIDATE_PROC (2, mapfunc);
683    ra = scm_shap2ra (dims, FUNC_NAME);    ra = scm_shap2ra (dims, FUNC_NAME);
684    if (SCM_ARRAYP (oldra))    if (SCM_ARRAYP (oldra))
685      {      {
# Line 802  SCM_DEFINE (scm_transpose_array, "transp Line 802  SCM_DEFINE (scm_transpose_array, "transp
802              "@end lisp")              "@end lisp")
803  #define FUNC_NAME s_scm_transpose_array  #define FUNC_NAME s_scm_transpose_array
804  {  {
805    SCM res, vargs, *ve = &vargs;    SCM res, vargs;
806      SCM const *ve = &vargs;
807    scm_t_array_dim *s, *r;    scm_t_array_dim *s, *r;
808    int ndim, i, k;    int ndim, i, k;
809    
# Line 1104  SCM_DEFINE (scm_uniform_vector_ref, "uni Line 1105  SCM_DEFINE (scm_uniform_vector_ref, "uni
1105          }          }
1106        else        else
1107          {          {
1108            SCM_VALIDATE_INUM (2,args);            SCM_VALIDATE_INUM (2, args);
1109            pos = SCM_INUM (args);            pos = SCM_INUM (args);
1110          }          }
1111        length = SCM_INUM (scm_uniform_vector_length (v));        length = SCM_INUM (scm_uniform_vector_length (v));
# Line 1184  scm_cvref (SCM v, unsigned long pos, SCM Line 1185  scm_cvref (SCM v, unsigned long pos, SCM
1185      default:      default:
1186        SCM_WRONG_TYPE_ARG (SCM_ARG1, v);        SCM_WRONG_TYPE_ARG (SCM_ARG1, v);
1187      case scm_tc7_bvect:      case scm_tc7_bvect:
1188        if (SCM_BITVEC_REF(v,pos))        if (SCM_BITVEC_REF(v, pos))
1189          return SCM_BOOL_T;          return SCM_BOOL_T;
1190        else        else
1191          return SCM_BOOL_F;          return SCM_BOOL_F;
# Line 1278  SCM_DEFINE (scm_array_set_x, "array-set! Line 1279  SCM_DEFINE (scm_array_set_x, "array-set!
1279          }          }
1280        else        else
1281          {          {
1282            SCM_VALIDATE_INUM_COPY (3,args,pos);            SCM_VALIDATE_INUM_COPY (3, args, pos);
1283          }          }
1284        length = SCM_INUM (scm_uniform_vector_length (v));        length = SCM_INUM (scm_uniform_vector_length (v));
1285        SCM_ASRTGO (pos >= 0 && pos < length, outrng);        SCM_ASRTGO (pos >= 0 && pos < length, outrng);
# Line 1296  SCM_DEFINE (scm_array_set_x, "array-set! Line 1297  SCM_DEFINE (scm_array_set_x, "array-set!
1297        goto badarg1;        goto badarg1;
1298      case scm_tc7_bvect:      case scm_tc7_bvect:
1299        if (SCM_FALSEP (obj))        if (SCM_FALSEP (obj))
1300          SCM_BITVEC_CLR(v,pos);          SCM_BITVEC_CLR(v, pos);
1301        else if (SCM_EQ_P (obj, SCM_BOOL_T))        else if (SCM_EQ_P (obj, SCM_BOOL_T))
1302          SCM_BITVEC_SET(v,pos);          SCM_BITVEC_SET(v, pos);
1303        else        else
1304          badobj:SCM_WRONG_TYPE_ARG (2, obj);          badobj:SCM_WRONG_TYPE_ARG (2, obj);
1305        break;        break;
# Line 1350  SCM_DEFINE (scm_array_set_x, "array-set! Line 1351  SCM_DEFINE (scm_array_set_x, "array-set!
1351        break;        break;
1352      case scm_tc7_vector:      case scm_tc7_vector:
1353      case scm_tc7_wvect:      case scm_tc7_wvect:
1354        SCM_VELTS (v)[pos] = obj;        SCM_VECTOR_SET (v, pos, obj);
1355        break;        break;
1356      }      }
1357    return SCM_UNSPECIFIED;    return SCM_UNSPECIFIED;
# Line 1824  SCM_DEFINE (scm_bit_position, "bit-posit Line 1825  SCM_DEFINE (scm_bit_position, "bit-posit
1825    
1826    SCM_VALIDATE_BOOL (1, item);    SCM_VALIDATE_BOOL (1, item);
1827    SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME);    SCM_ASSERT (SCM_BITVECTOR_P (v), v, SCM_ARG2, FUNC_NAME);
1828    SCM_VALIDATE_INUM_COPY (3,k,pos);    SCM_VALIDATE_INUM_COPY (3, k, pos);
1829    SCM_ASSERT_RANGE (3, k, (pos <= SCM_BITVECTOR_LENGTH (v)) && (pos >= 0));    SCM_ASSERT_RANGE (3, k, (pos <= SCM_BITVECTOR_LENGTH (v)) && (pos >= 0));
1830    
1831    if (pos == SCM_BITVECTOR_LENGTH (v))    if (pos == SCM_BITVECTOR_LENGTH (v))
# Line 1902  SCM_DEFINE (scm_bit_set_star_x, "bit-set Line 1903  SCM_DEFINE (scm_bit_set_star_x, "bit-set
1903              k = SCM_UNPACK (SCM_VELTS (kv)[--i]);              k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
1904              if (k >= vlen)              if (k >= vlen)
1905                scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));                scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
1906              SCM_BITVEC_CLR(v,k);              SCM_BITVEC_CLR(v, k);
1907            }            }
1908        else if (SCM_EQ_P (obj, SCM_BOOL_T))        else if (SCM_EQ_P (obj, SCM_BOOL_T))
1909          for (i = SCM_UVECTOR_LENGTH (kv); i;)          for (i = SCM_UVECTOR_LENGTH (kv); i;)
# Line 1910  SCM_DEFINE (scm_bit_set_star_x, "bit-set Line 1911  SCM_DEFINE (scm_bit_set_star_x, "bit-set
1911              k = SCM_UNPACK (SCM_VELTS (kv)[--i]);              k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
1912              if (k >= vlen)              if (k >= vlen)
1913                scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));                scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
1914              SCM_BITVEC_SET(v,k);              SCM_BITVEC_SET(v, k);
1915            }            }
1916        else        else
1917          badarg3:SCM_WRONG_TYPE_ARG (3, obj);          badarg3:SCM_WRONG_TYPE_ARG (3, obj);
# Line 1960  SCM_DEFINE (scm_bit_count_star, "bit-cou Line 1961  SCM_DEFINE (scm_bit_count_star, "bit-cou
1961              k = SCM_UNPACK (SCM_VELTS (kv)[--i]);              k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
1962              if (k >= vlen)              if (k >= vlen)
1963                scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));                scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
1964              if (!SCM_BITVEC_REF(v,k))              if (!SCM_BITVEC_REF(v, k))
1965                count++;                count++;
1966            }            }
1967        else if (SCM_EQ_P (obj, SCM_BOOL_T))        else if (SCM_EQ_P (obj, SCM_BOOL_T))
# Line 1969  SCM_DEFINE (scm_bit_count_star, "bit-cou Line 1970  SCM_DEFINE (scm_bit_count_star, "bit-cou
1970              k = SCM_UNPACK (SCM_VELTS (kv)[--i]);              k = SCM_UNPACK (SCM_VELTS (kv)[--i]);
1971              if (k >= vlen)              if (k >= vlen)
1972                scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));                scm_out_of_range (FUNC_NAME, SCM_MAKINUM (k));
1973              if (SCM_BITVEC_REF (v,k))              if (SCM_BITVEC_REF (v, k))
1974                count++;                count++;
1975            }            }
1976        else        else
# Line 2050  scm_istr2bve (char *str, long len) Line 2051  scm_istr2bve (char *str, long len)
2051    
2052    
2053  static SCM  static SCM
2054  ra2l (SCM ra,unsigned long base,unsigned long k)  ra2l (SCM ra, unsigned long base, unsigned long k)
2055  {  {
2056    register SCM res = SCM_EOL;    register SCM res = SCM_EOL;
2057    register long inc = SCM_ARRAY_DIMS (ra)[k].inc;    register long inc = SCM_ARRAY_DIMS (ra)[k].inc;
# Line 2190  SCM_DEFINE (scm_list_to_uniform_array, " Line 2191  SCM_DEFINE (scm_list_to_uniform_array, "
2191    SCM ra;    SCM ra;
2192    unsigned long k;    unsigned long k;
2193    long n;    long n;
2194    SCM_VALIDATE_INUM_COPY (1,ndim,k);    SCM_VALIDATE_INUM_COPY (1, ndim, k);
2195    while (k--)    while (k--)
2196      {      {
2197        n = scm_ilength (row);        n = scm_ilength (row);
# Line 2261  l2ra (SCM lst, SCM ra, unsigned long bas Line 2262  l2ra (SCM lst, SCM ra, unsigned long bas
2262    
2263    
2264  static void  static void
2265  rapr1 (SCM ra,unsigned long j,unsigned long k,SCM port,scm_print_state *pstate)  rapr1 (SCM ra, unsigned long j, unsigned long k, SCM port, scm_print_state *pstate)
2266  {  {
2267    long inc = 1;    long inc = 1;
2268    long n = (SCM_TYP7 (ra) == scm_tc7_smob    long n = (SCM_TYP7 (ra) == scm_tc7_smob

Legend:
Removed from v.1.131  
changed lines
  Added in v.1.132

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26