Commit 62141f9f authored by jjgarcia's avatar jjgarcia

Replace int -> cl_fixnum, cl_index, to avoid problems with 64-bit archit.

Make sure that structure/instance slots may be indexed with a simple integer.
parent a6dbc270
......@@ -15,7 +15,7 @@
cl_index cl_num_symbols_in_core = 0;
@(defun si::mangle-name (symbol &optional as_symbol)
int l;
cl_index l;
char c, *source, *dest;
cl_object output;
cl_object package;
......
......@@ -474,6 +474,9 @@ cl_object
cl_alloc_instance(cl_index slots)
{
cl_object i = cl_alloc_object(t_instance);
if (slots >= ECL_SLOTS_LIMIT)
FEerror("Limit on instance size exceeded: ~S slots requested.",
1, MAKE_FIXNUM(slots));
/* INV: slots > 0 */
i->instance.slots = (cl_object*)cl_alloc(sizeof(cl_object) * slots);
i->instance.length = slots;
......
......@@ -35,7 +35,7 @@ setf_namep(cl_object fun_spec)
endp(CDR(cdr)) && CAR(fun_spec) == @'setf') {
cl_object sym, fn_name = CAR(cdr);
cl_object fn_str = fn_name->symbol.name;
int l = fn_str->string.fillp + 7;
cl_index l = fn_str->string.fillp + 7;
cl_object string = cl_alloc_simple_string(l);
char *str = string->string.self;
strncpy(str, "(SETF ", 6);
......
......@@ -130,7 +130,7 @@ big_alloc(int size)
}
cl_object
bignum1(int val)
bignum1(cl_fixnum val)
{
volatile cl_object z = cl_alloc_object(t_bignum);
mpz_init_set_si(z->big.big_num, val);
......
......@@ -21,38 +21,6 @@ cl_object class_class, class_object, class_built_in;
/******************************* ------- ******************************/
static cl_object
make_our_hash_table(cl_object test, int size)
{
enum httest htt;
int i;
cl_object rehash_size, rehash_threshold, h;
rehash_size = make_shortfloat(1.5);
rehash_threshold = make_shortfloat(0.7);
if (test == @'eq')
htt = htt_eq;
else if (test == @'eql')
htt = htt_eql;
else if (test == @'equal')
htt = htt_equal;
h = cl_alloc_object(t_hashtable);
h->hash.data = NULL; /* for GC sake */
h->hash.test = (short)htt;
h->hash.size = size;
h->hash.rehash_size = rehash_size;
h->hash.threshold = rehash_threshold;
h->hash.entries = 0;
h->hash.data = (struct hashtable_entry *)cl_alloc_align(size * sizeof(struct hashtable_entry), sizeof(int));
for(i = 0; i < size; i++) {
h->hash.data[i].key = OBJNULL;
h->hash.data[i].value = OBJNULL;
}
return(h);
}
@(defun find-class (name &optional (errorp Ct) env)
cl_object class;
@
......@@ -67,7 +35,10 @@ make_our_hash_table(cl_object test, int size)
void
init_clos(void)
{
SYM_VAL(@'si::*class-name-hash-table*') = make_our_hash_table(@'eq', 1024);
SYM_VAL(@'si::*class-name-hash-table*') =
cl__make_hash_table(@'eq', MAKE_FIXNUM(1024), /* size */
make_shortfloat(1.5), /* rehash-size */
make_shortfloat(0.7)); /* rehash-threshold */
/* booting Class CLASS */
......
......@@ -25,8 +25,8 @@ si_specialp(cl_object sym)
Ct : Cnil))
}
int
ifloor(int x, int y)
cl_fixnum
ifloor(cl_fixnum x, cl_fixnum y)
{
if (y == 0)
FEerror("Zero divizor", 0);
......@@ -42,8 +42,8 @@ ifloor(int x, int y)
return((-x)/(-y));
}
int
imod(int x, int y)
cl_fixnum
imod(cl_fixnum x, cl_fixnum y)
{
return(x - ifloor(x, y)*y);
}
......
......@@ -75,7 +75,7 @@ si_gfun_method_ht_set(cl_object x, cl_object y)
cl_object
si_gfun_spec_how_ref(cl_object x, cl_object y)
{
int i;
cl_fixnum i;
if (type_of(x) != t_gfun)
FEwrong_type_argument(@'dispatch-function', x);
......
......@@ -14,23 +14,6 @@
See file '../Copyright' for full details.
*/
/* ******** WARNING ********
Do not insert any data definitions before data_start!
Since this is the first file linked, the address of the following
variable should correspond to the start of initialized data space.
On some systems this is a constant that is independent of the text
size for shared executables. On others, it is a function of the
text size. In short, this seems to be the most portable way to
discover the start of initialized data space dynamically at runtime,
for either shared or unshared executables, on either swapping or
virtual systems. It only requires that the linker allocate objects
in the order encountered, a reasonable model for most Unix systems.
Fred Fish, UniSoft Systems Inc. */
/* On SGI one could use extern _fdata[] instead */
int data_start = (int)&data_start;
/******************************** IMPORTS *****************************/
#include <stdlib.h>
......
......@@ -43,7 +43,7 @@ fixnum_times(cl_fixnum i, cl_fixnum j)
}
static cl_object
big_times_fix(cl_object b, int i)
big_times_fix(cl_object b, cl_fixnum i)
{
cl_object z;
......@@ -202,19 +202,19 @@ number_times(cl_object x, cl_object y)
cl_object
number_plus(cl_object x, cl_object y)
{
int i, j;
cl_fixnum i, j;
cl_object z, z1;
switch (type_of(x)) {
case t_fixnum:
switch (type_of(y)) {
case t_fixnum: {
int k = fix(x) + fix(y);
cl_fixnum k = fix(x) + fix(y);
if (k >= MOST_NEGATIVE_FIXNUM && k <= MOST_POSITIVE_FIXNUM)
return(MAKE_FIXNUM(k));
else
return(bignum1(k));
}
}
case t_bignum:
if ((i = fix(x)) == 0)
return(y);
......@@ -357,7 +357,7 @@ number_plus(cl_object x, cl_object y)
cl_object
number_minus(cl_object x, cl_object y)
{
int i, j, k;
cl_fixnum i, j, k;
cl_object z, z1;
switch (type_of(x)) {
......@@ -523,7 +523,7 @@ number_negate(cl_object x)
switch (type_of(x)) {
case t_fixnum: {
int k = fix(x);
cl_fixnum k = fix(x);
/* -MOST_NEGATIVE_FIXNUM > MOST_POSITIVE_FIXNUM */
if (k == MOST_NEGATIVE_FIXNUM)
return(bignum1(- MOST_NEGATIVE_FIXNUM));
......
......@@ -735,7 +735,7 @@ cl_decode_float(cl_object x)
cl_object
cl_scale_float(cl_object x, cl_object y)
{
int k;
cl_fixnum k;
if (FIXNUMP(y))
k = fix(y);
......
......@@ -140,7 +140,7 @@ number_equalp(cl_object x, cl_object y)
int
number_compare(cl_object x, cl_object y)
{
int ix, iy;
cl_fixnum ix, iy;
double dx, dy;
switch (type_of(x)) {
......
......@@ -313,7 +313,7 @@ ecl_ash(cl_object x, cl_fixnum w)
}
static int
int_bit_length(int i)
int_bit_length(cl_fixnum i)
{
register int count, j;
......@@ -424,14 +424,11 @@ cl_boole(cl_object o, cl_object x, cl_object y)
cl_object
cl_logbitp(cl_object p, cl_object x)
{
bool i;
int n;
bool i;
assert_type_integer(x);
if (FIXNUMP(p)) {
cl_fixnum n = fixnnint(p);
if (n < 0)
FEtype_error_index(p);
if (FIXNUMP(x))
i = ((fix(x) >> n) & 1);
else
......@@ -493,7 +490,8 @@ cl_logcount(cl_object x)
cl_object
cl_integer_length(cl_object x)
{
int count, i;
int count;
cl_fixnum i;
switch (type_of(x)) {
case t_fixnum:
......@@ -501,6 +499,7 @@ cl_integer_length(cl_object x)
count = int_bit_length((i < 0) ? ~i : i);
break;
case t_bignum: {
/* FIXME! We should not be using internals of GMP here */
int last = abs(x->big.big_size) - 1;
i = x->big.big_limbs[last];
count = last * (sizeof(mp_limb_t) * 8) + int_bit_length(i);
......
......@@ -30,7 +30,7 @@ rando(cl_object x, cl_object rs)
d = (double)(rs->random.value>>1) / (4294967296.0/2.0);
d = number_to_double(x) * d;
if (tx == t_fixnum) {
z = MAKE_FIXNUM((int)d);
z = MAKE_FIXNUM((cl_fixnum)d);
return(z);
} else if (tx == t_bignum) {
z = double_to_integer(d);
......
......@@ -41,9 +41,7 @@ cl_object imag_unit, minus_imag_unit, imag_two;
cl_fixnum
fixnum_expt(cl_fixnum x, cl_fixnum y)
{
int z;
z = 1;
cl_fixnum z = 1;
while (y > 0)
if (y%2 == 0) {
x *= x;
......
......@@ -87,7 +87,7 @@ static cl_fixnum CIRCLEcounter = -2;
static cl_object no_stream;
static void flush_queue (bool force);
static void write_decimal1 (int i);
static void write_decimal1 (cl_fixnum i);
static void travel_push_object (cl_object x);
static cl_fixnum search_print_circle(cl_object x);
static bool do_print_circle(cl_fixnum mark);
......@@ -267,7 +267,7 @@ write_str(char *s)
}
static void
write_decimal(int i)
write_decimal(cl_fixnum i)
{
if (i == 0) {
write_ch('0');
......@@ -277,7 +277,7 @@ write_decimal(int i)
}
static void
write_decimal1(int i)
write_decimal1(cl_fixnum i)
{
if (i == 0)
return;
......@@ -464,8 +464,6 @@ call_print_object(cl_object x, int level)
call_structure_print_function(cl_object x, int level)
#endif
{
int i;
bool e = PRINTescape;
bool r = PRINTradix;
int b = PRINTbase;
......@@ -548,13 +546,15 @@ call_structure_print_function(cl_object x, int level)
static void
write_fixnum(cl_fixnum i)
{
short digits[16];
/* The maximum number of digits is achieved for base 2 and it
is always < FIXNUM_BITS, since we use at least one bit for
tagging */
short digits[FIXNUM_BITS];
int j;
for (j = 0; j < 16 && i != 0; i /= PRINTbase)
digits[j++] = digit_weight(i%PRINTbase, PRINTbase);
if (j == 16) write_fixnum(i);
for (j = 0; j < FIXNUM_BITS && i != 0; i /= PRINTbase)
digits[j++] = digit_weight(i%PRINTbase, PRINTbase);
while (j-- > 0)
write_ch(digits[j]);
write_ch(digits[j]);
}
static void
......@@ -800,7 +800,7 @@ _write_object(cl_object x, int level)
return;
case t_array: {
int subscripts[ARANKLIM];
cl_index subscripts[ARANKLIM];
cl_index n, m, k, i;
if (!PRINTarray) {
......@@ -1554,8 +1554,9 @@ cl_write_byte(cl_object integer, cl_object binary_output_stream)
cl_object
si_write_bytes(cl_object stream, cl_object string, cl_object start, cl_object end)
{
cl_index is, ie; FILE *fp;
int written, sofarwritten, towrite;
FILE *fp;
cl_index is, ie;
cl_fixnum written, sofarwritten, towrite;
assert_type_stream(stream);
if (stream->stream.mode == smm_closed)
......
......@@ -553,7 +553,8 @@ static cl_object
dispatch_reader_fun(cl_object in, cl_object dc)
{
cl_object x, y;
int i, d, c;
cl_fixnum i;
int d, c;
cl_object rtbl = ecl_current_readtable();
if (rtbl->readtable.table[char_code(dc)].dispatch_table == NULL)
......@@ -1528,13 +1529,14 @@ CANNOT_PARSE:
cl_object
si_read_bytes(cl_object stream, cl_object string, cl_object start, cl_object end)
{
int is, ie, c; FILE *fp;
cl_fixnum is, ie, c;
FILE *fp;
assert_type_stream(stream);
if (stream->stream.mode == smm_closed)
FEclosed_stream(stream);
/* FIXME! this may fail! */
/* FIXME! this may fail! We have to check the signs of is, ie, etc.*/
is = fix(start);
ie = fix(end);
fp = stream->stream.file;
......@@ -1853,7 +1855,7 @@ read_VV(cl_object block, void *entry)
{
typedef void (*entry_point_ptr)(cl_object);
volatile cl_object x;
int i, len;
cl_index i, len;
cl_object in;
entry_point_ptr entry_point = (entry_point_ptr)entry;
cl_object *VV;
......
......@@ -28,7 +28,7 @@
I know the following name is not good.
*/
cl_object
cl_alloc_simple_vector(int l, cl_elttype aet)
cl_alloc_simple_vector(cl_index l, cl_elttype aet)
{
cl_object x;
......@@ -43,7 +43,7 @@ cl_alloc_simple_vector(int l, cl_elttype aet)
}
cl_object
cl_alloc_simple_bitvector(int l)
cl_alloc_simple_bitvector(cl_index l)
{
cl_object x;
......@@ -110,7 +110,7 @@ si_elt_set(cl_object seq, cl_object index, cl_object val)
cl_object
elt_set(cl_object seq, cl_fixnum index, cl_object val)
{
int i;
cl_fixnum i;
cl_object l;
cl_object endp_temp;
......@@ -306,7 +306,7 @@ cl_object
cl_reverse(cl_object seq)
{
cl_object x, y;
int i, j, k;
cl_fixnum i, j, k;
cl_object endp_temp;
switch (type_of(seq)) {
......@@ -382,7 +382,7 @@ cl_object
cl_nreverse(cl_object seq)
{
cl_object x, y, z;
int i, j, k;
cl_fixnum i, j, k;
cl_object endp_temp;
switch (type_of(seq)) {
......
......@@ -642,6 +642,7 @@ nstring_case(int narg, int (*casefun)(int, bool *), cl_va_list ARGS)
cl_object v, strings[narg];
char *vself;
@
/* FIXME! We should use cl_va_start() instead of this ugly trick */
for (i = 0, l = 0; i < narg; i++) {
strings[i] = cl_string(cl_va_arg(args));
l += strings[i]->string.fillp;
......
......@@ -82,6 +82,9 @@ structure_to_list(cl_object x)
SLOTS(x) = NULL; /* for GC sake */
SLENGTH(x) = --narg;
SLOTS(x) = (cl_object *)cl_alloc_align(sizeof(cl_object)*narg, sizeof(cl_object));
if (narg >= ECL_SLOTS_LIMIT)
FEerror("Limit on structure size exceeded: ~S slots requested.",
1, MAKE_FIXNUM(narg));
for (i = 0; i < narg; i++)
SLOT(x, i) = cl_va_arg(args);
@(return x)
......
......@@ -45,7 +45,7 @@ runtime(void)
static cl_object Jan1st1970UT;
cl_object
UTC_time_to_universal_time(int i)
UTC_time_to_universal_time(cl_fixnum i)
{
return number_plus(bignum1(i), Jan1st1970UT);
}
......
......@@ -501,7 +501,7 @@ actual_directory(cl_object namestring, cl_object mask, bool all)
if ((all || t == FILE_REGULAR) &&
string_match(dir.d_name, mask->string.self))
{
int e = strlen(dir.d_name);
cl_index e = strlen(dir.d_name);
cl_object file = parse_namestring(dir.d_name, 0, e, &e);
file = merge_pathnames(dir_path, file,Cnil);
*directory = CONS(file, Cnil);
......@@ -580,7 +580,7 @@ cl_object
si_mkdir(cl_object directory, cl_object mode)
{
cl_object filename;
int modeint;
cl_index modeint;
/* INV: coerce_to_filename() checks types */
filename = coerce_to_filename(directory);
......
......@@ -102,7 +102,7 @@
;; *destination* must be RETURN-FIXNUM
(if (or bds-lcl (plusp bds-bind))
(let ((lcl (next-lcl)))
(wt-nl "{int ") (wt-lcl lcl) (wt "= ")
(wt-nl "{cl_fixnum ") (wt-lcl lcl) (wt "= ")
(wt-fixnum-loc loc) (wt ";")
(unwind-bds bds-lcl bds-bind stack-pop)
(wt-nl "return(") (wt-lcl lcl) (wt ");}"))
......
......@@ -160,7 +160,7 @@
(FIXNUM-VALUE
(wt (second loc)))
((INLINE-SHORT-FLOAT INLINE-LONG-FLOAT)
(wt "((int)(")
(wt "((cl_fixnum)(")
(wt-inline-loc (third loc) (fourth loc))
(wt "))"))
(t (wt "fix(" loc ")")))
......
......@@ -561,7 +561,7 @@
(defun rep-type (type)
(case type
(FIXNUM "int ")
(FIXNUM "cl_fixnum ")
(CHARACTER "unsigned char ")
(SHORT-FLOAT "float ")
(LONG-FLOAT "double ")
......
......@@ -60,10 +60,12 @@ typedef unsigned @[email protected] cl_hashkey;
#define ATOTLIM 16*1024*1024 /* array total limit */
/*
* Function limits
* Function limits.
*
* In general, any of these limits must fit in a "signed int".
*/
/* Maximum number of function arguments */
#define CALL_ARGUMENTS_LIMIT @[email protected]
#define CALL_ARGUMENTS_LIMIT 65536
/* Maximum number of required arguments */
#define LAMBDA_PARAMETERS_LIMIT 64
......@@ -75,6 +77,13 @@ typedef unsigned @[email protected] cl_hashkey;
#define ecl_setjmp @[email protected]
#define ecl_longjmp @[email protected]
/*
* Structure/Instance limits. The index to a slot must fit in the
* "int" type. We also require ECL_SLOTS_LIMIT <= CALL_ARGUMENTS_LIMIT
* because constructors typically require as many arguments as slots,
* or more.
*/
#define ECL_SLOTS_LIMIT 32768
/* -CUT-: Everything below this mark will not be installed */
/* -------------------------------------------------------------------- *
......
......@@ -140,7 +140,7 @@ extern cl_object big_register2_get(void);
extern cl_object big_register_copy(cl_object x);
extern cl_object big_register_normalize(cl_object x);
extern void big_register_free(cl_object x);
extern cl_object bignum1(int val);
extern cl_object bignum1(cl_fixnum val);
extern cl_object bignum2(mp_limb_t hi, mp_limb_t lo);
extern cl_object big_set_fixnum(cl_object x, cl_object fix);
extern cl_object big_copy(cl_object x);
......@@ -1068,8 +1068,8 @@ extern cl_object cl_reverse(cl_object x);
extern cl_object cl_nreverse(cl_object x);
extern cl_object cl_subseq _ARGS((int narg, cl_object sequence, cl_object start, ...));
extern cl_object cl_alloc_simple_vector(int l, cl_elttype aet);
extern cl_object cl_alloc_simple_bitvector(int l);
extern cl_object cl_alloc_simple_vector(cl_index l, cl_elttype aet);
extern cl_object cl_alloc_simple_bitvector(cl_index l);
extern cl_object elt(cl_object seq, cl_fixnum index);
extern cl_object elt_set(cl_object seq, cl_fixnum index, cl_object val);
extern cl_fixnum length(cl_object x);
......@@ -1260,7 +1260,7 @@ extern cl_object cl_get_internal_real_time();
extern cl_object si_get_local_time_zone();
extern cl_object si_daylight_saving_time_p _ARGS((int narg, ...));
extern cl_object UTC_time_to_universal_time(int i);
extern cl_object UTC_time_to_universal_time(cl_fixnum i);
extern void init_unixtime(void);
......
......@@ -293,8 +293,8 @@ struct stream {
FILE *file; /* file pointer */
cl_object object0; /* some object */
cl_object object1; /* some object */
int int0; /* some int */
int int1; /* some int */
cl_fixnum int0; /* some int */
cl_fixnum int1; /* some int */
#if !defined(GBC_BOEHM)
char *buffer; /* file buffer */
#endif
......
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