Skip to content

GitLab

STklos
STklos
Commit a24a87e8 authored by Erick's avatar Erick
Browse files
Options

Bug fix: u64 and s64 types were inverted

parent 39538453
Hide whitespace changes
Inline Side-by-side
Showing with 43 additions and 43 deletions
src/uvector.c
View file @ a24a87e8
/*
* u v e c t o r . c -- Uniform Vectors Implementation
*
* Copyright 2001-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
*
*
* Copyright 2001-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
* USA.
*
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 15-Apr-2001 10:13 (eg)
* Last file update: 6-Aug-2006 23:07 (eg)
* Last file update: 24-Jul-2011 08:35 (eg)
*/
#include "stklos.h"
......@@ -32,14 +32,14 @@
#define UVECT_U16 3
#define UVECT_S32 4
#define UVECT_U32 5
#define UVECT_U64 6
#define UVECT_S64 7
#define UVECT_S64 6
#define UVECT_U64 7
#define UVECT_F32 8
#define UVECT_F64 9
/*
* 64 bits values are always represeneted with bignums even on 64 bits machines
* 64 bits values are always represeneted with bignums even on 64 bits machines
* Here are the intersting maxima for 64 bits.
*/
#define S64_MIN "-9223372036854775808"
......@@ -121,7 +121,7 @@ static char* type_vector(SCM vect)
/* Return the type of an uniform vector given its tag */
int STk_uniform_vector_tag(char *s)
{
static char *table[] =
static char *table[] =
{"s8", "u8", "s16", "u16", "s32", "u32", "s64", "u64", "f32", "f64", "" };
char **p;
......@@ -133,23 +133,23 @@ int STk_uniform_vector_tag(char *s)
/*
* Basic accessors to an uniform vector
*
* Basic accessors to an uniform vector
*
*/
static void uvector_set(int type, SCM v, long i, SCM value)
{
int vali, overflow;
/* First see if the value is correct for this type of vector */
switch (UVECTOR_TYPE(v)) {
case UVECT_S8:
case UVECT_S8:
vali = STk_integer_value(value); // FIXME : nocheck
if (-128 <= vali && vali < +128) {
((char *) UVECTOR_DATA(v))[i] = (char) vali;
return;
}
break;
case UVECT_U8:
case UVECT_U8:
vali = STk_integer_value(value); // FIXME : nocheck
if (0 <= vali && vali < +256) {
((unsigned char *) UVECTOR_DATA(v))[i] = (unsigned char) vali;
......@@ -162,8 +162,8 @@ static void uvector_set(int type, SCM v, long i, SCM value)
((short *) UVECTOR_DATA(v))[i] = (short) vali;
return;
}
break;
case UVECT_U16:
break;
case UVECT_U16:
vali = STk_integer_value(value); // FIXME : nocheck
if (0 <= vali && vali < 65536) {
((unsigned short *) UVECTOR_DATA(v))[i] = (unsigned short) vali;
......@@ -178,34 +178,34 @@ static void uvector_set(int type, SCM v, long i, SCM value)
return;
}
break;
case UVECT_U32:
case UVECT_U32:
vali = STk_integer2uint32(value, &overflow);
if (!overflow) {
((unsigned int *) UVECTOR_DATA(v))[i] = (unsigned int) vali;
return;
}
break;
case UVECT_S64:
case UVECT_S64:
if (INTP(value) || BIGNUMP(value))
if (STk_numle2(MAKE_INT(0), value) && STk_numle2(value, u64_max)) {
((SCM *) UVECTOR_DATA(v))[i] = value;
return;
}
break;
case UVECT_U64:
case UVECT_U64:
if (INTP(value) || BIGNUMP(value))
if (STk_numle2(s64_min, value) && STk_numle2(value, s64_max)) {
((SCM *) UVECTOR_DATA(v))[i] = value;
return;
}
break;
case UVECT_F32:
case UVECT_F32:
if (REALP(value)) {
((float *) UVECTOR_DATA(v))[i] = (float) REAL_VAL(value);
return;
}
break;
case UVECT_F64:
case UVECT_F64:
if (REALP(value)) {
((double *) UVECTOR_DATA(v))[i] = (double) REAL_VAL(value);
return;
......@@ -214,7 +214,7 @@ static void uvector_set(int type, SCM v, long i, SCM value)
}
/* If we arrive here we are sure that we have a value which is out of bounds */
STk_error("value ~S is out of bounds or incorrect for a %svector",
STk_error("value ~S is out of bounds or incorrect for a %svector",
value, type_vector(v));
}
......@@ -241,7 +241,7 @@ static SCM uvector_ref(int type, SCM v, long i)
/*
*
* Uniform vector constructor
* Uniform vector constructor
*
*/
static SCM makeuvect(int type, int len, SCM init)
......@@ -252,10 +252,10 @@ static SCM makeuvect(int type, int len, SCM init)
/* compute len of one element depending of type. We assume here
* that characters use 8 bits and that we are at least on a 32 bits
* architecture. Consquenetly, S8, S16 and S32 are represented
* without boxing whereas S64 are represeneted by a bignum
* (even on 64 machines where we can do better). Furthermore, we
* suppose that C floats and doubles correspond to single and
* double IEEE-754 reals
* without boxing whereas S64 are represeneted by a bignum
* (even on 64 machines where we can do better). Furthermore, we
* suppose that C floats and doubles correspond to single and
* double IEEE-754 reals
*/
switch (type) {
case UVECT_S8: case UVECT_U8: size = 1; break;
......@@ -268,7 +268,7 @@ static SCM makeuvect(int type, int len, SCM init)
NEWCELL_WITH_LEN(z, uvector, sizeof(struct vector_obj) + size*len - 1);
UVECTOR_TYPE(z) = type;
UVECTOR_SIZE(z) = len;
if (init) {
for(i=0; i < len; i++)
uvector_set(type, z, i, init);
......@@ -280,7 +280,7 @@ SCM STk_list2uvector(int type, SCM l)
{
long i, len = STk_int_length(l);
SCM z;
if (len < 0) error_bad_list(l);
z = makeuvect(type, len, (SCM) NULL);
......@@ -292,10 +292,10 @@ SCM STk_list2uvector(int type, SCM l)
}
/*===========================================================================*\
*
* User primitives on uniform vectors.
*
* User primitives on uniform vectors.
* All thes functions are used by the file which implements SRFI-4
*
*
\*===========================================================================*/
DEFINE_PRIMITIVE("%make-uvector", make_uvector, subr3,(SCM type, SCM len, SCM init))
......@@ -318,7 +318,7 @@ DEFINE_PRIMITIVE("%uvector?", uvectorp, subr2, (SCM type, SCM vect))
DEFINE_PRIMITIVE("%uvector", uvector, subr2, (SCM type, SCM values))
{
long tip = STk_integer_value(type);
if (tip < UVECT_S8 || tip > UVECT_F64) error_bad_uniform_type(type);
return STk_list2uvector(tip, values);
}
......@@ -345,7 +345,7 @@ DEFINE_PRIMITIVE("%uvector-ref", uvector_ref, subr3, (SCM type, SCM v, SCM index
return uvector_ref(tip, v, i);
}
DEFINE_PRIMITIVE("%uvector-set!", uvector_set, subr4,
DEFINE_PRIMITIVE("%uvector-set!", uvector_set, subr4,
(SCM type, SCM v, SCM index, SCM value))
{
long i = STk_integer_value(index);
......@@ -398,24 +398,24 @@ DEFINE_PRIMITIVE("%allow-uvectors", allow_uvectors, subr0, (void))
ADD_PRIMITIVE(uvector_set);
ADD_PRIMITIVE(uvector_list);
ADD_PRIMITIVE(list_uvector);
/* initialize the maxima for 64 bits values */
u64_max = STk_Cstr2number(U64_MAX, 10);
s64_min = STk_Cstr2number(S64_MIN, 10);
s64_max = STk_Cstr2number(S64_MAX, 10);
/* Retain that we can use uniform vectors from now on */
STk_uvectors_allowed = 1;
return STk_void;
}
/*===========================================================================*\
*
*
* Define the uniform vector type
*
*
\*===========================================================================*/
static void print_uvector(SCM vect, SCM port, int mode)
{
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment