From 1a24cc9da63c032efb8c2b0a15986e04e10ecfa1 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Tue, 3 Aug 2010 22:35:33 +0000 Subject: [PATCH] Use intmax and uintmax to support 64-bit off_t, time_t, &c. Eliminate BIGNUM_NO_ULONG. Twenty years ago it may have made sense; now too much of the system relies on having unsigned longs for it to matter. New routines convert between integers and intmax/uintmax. The old ones for long/unsigned long are still there, because they are likely to be much faster on 32-bit systems. Only a few uses of long have been replaced by intmax -- the ones where it was obvious we were converting between time_t, off_t, ino_t, &c., and long. Others may still be there. Before: (file-length "fnord") ;Value: 1235 After: (file-length "fnord") ;Value: 4294968531 (`fnord' was created by seeking to byte 2^32 + 1234 or something and writing a single byte there.) --- src/microcode/artutl.c | 51 +++++++++-- src/microcode/bignmint.h | 4 +- src/microcode/bignum.c | 177 ++++++++++++++++++++----------------- src/microcode/bignum.h | 13 +-- src/microcode/configure.ac | 51 ++++------- src/microcode/confshared.h | 16 ++++ src/microcode/extern.h | 6 ++ src/microcode/object.h | 6 ++ src/microcode/prims.h | 2 + src/microcode/prosenv.c | 6 +- src/microcode/prosfile.c | 10 ++- src/microcode/pruxenv.c | 2 +- src/microcode/pruxfs.c | 28 +++--- src/microcode/utils.c | 20 +++++ 14 files changed, 235 insertions(+), 157 deletions(-) diff --git a/src/microcode/artutl.c b/src/microcode/artutl.c index 831c8d18f..a709c0db0 100644 --- a/src/microcode/artutl.c +++ b/src/microcode/artutl.c @@ -58,6 +58,18 @@ integer_to_long (SCHEME_OBJECT n) return ((FIXNUM_P (n)) ? (FIXNUM_TO_LONG (n)) : (bignum_to_long (n))); } +bool +integer_to_intmax_p (SCHEME_OBJECT n) +{ + return ((FIXNUM_P (n)) || (BIGNUM_TO_INTMAX_P (n))); +} + +intmax_t +integer_to_intmax (SCHEME_OBJECT n) +{ + return ((FIXNUM_P (n)) ? (FIXNUM_TO_LONG (n)) : (bignum_to_intmax (n))); +} + SCHEME_OBJECT long_to_integer (long number) { @@ -67,6 +79,15 @@ long_to_integer (long number) : (long_to_bignum (number))); } +SCHEME_OBJECT +intmax_to_integer (intmax_t number) +{ + return + (((LONG_MIN <= number) && (number <= LONG_MAX)) + ? (long_to_integer (number)) + : (intmax_to_bignum (number))); +} + bool integer_to_ulong_p (SCHEME_OBJECT n) { @@ -81,6 +102,21 @@ integer_to_ulong (SCHEME_OBJECT n) : (bignum_to_ulong (n))); } +bool +integer_to_uintmax_p (SCHEME_OBJECT n) +{ + return + ((FIXNUM_P (n)) ? (!FIXNUM_NEGATIVE_P (n)) : (BIGNUM_TO_UINTMAX_P (n))); +} + +uintmax_t +integer_to_uintmax (SCHEME_OBJECT n) +{ + return ((FIXNUM_P (n)) + ? ((uintmax_t) (FIXNUM_TO_LONG (n))) + : (bignum_to_uintmax (n))); +} + SCHEME_OBJECT ulong_to_integer (unsigned long number) { @@ -94,6 +130,14 @@ ulong_to_integer (unsigned long number) return (ulong_to_bignum (number)); } +SCHEME_OBJECT +uintmax_to_integer (uintmax_t number) +{ + return ((number <= ULONG_MAX) + ? (ulong_to_integer (number)) + : (uintmax_to_bignum (number))); +} + bool integer_to_double_p (SCHEME_OBJECT n) { @@ -477,11 +521,8 @@ static unsigned long unsigned_long_length_in_bits (unsigned long n) { unsigned long result = 0; - while (n > 0) - { - result += 1; - n >>= 1; - } + while (n > 0xff) { result += 8; n >>= 8; } + while (n > 0) { result += 1; n >>= 1; } return (result); } diff --git a/src/microcode/bignmint.h b/src/microcode/bignmint.h index 66a1efdd8..f3d62c186 100644 --- a/src/microcode/bignmint.h +++ b/src/microcode/bignmint.h @@ -132,8 +132,8 @@ extern void abort (); #define BIGNUM_BITS_TO_DIGITS(n) \ (((n) + (BIGNUM_DIGIT_LENGTH - 1)) / BIGNUM_DIGIT_LENGTH) -#define BIGNUM_DIGITS_FOR_LONG \ - (BIGNUM_BITS_TO_DIGITS ((sizeof (long)) * CHAR_BIT)) +#define BIGNUM_DIGITS_FOR_TYPE(TYPE) \ + (BIGNUM_BITS_TO_DIGITS ((sizeof (TYPE)) * CHAR_BIT)) #ifndef BIGNUM_DISABLE_ASSERTION_CHECKS diff --git a/src/microcode/bignum.c b/src/microcode/bignum.c index efebdddc3..c06735539 100644 --- a/src/microcode/bignum.c +++ b/src/microcode/bignum.c @@ -425,97 +425,108 @@ bignum_remainder (bignum_type numerator, bignum_type denominator) } } -bignum_type -long_to_bignum (long n) +static bignum_type +bignum_from_digits (bignum_digit_type *start_digits, + bignum_digit_type *end_digits, + bool negative_p) { - int negative_p; - bignum_digit_type result_digits [BIGNUM_DIGITS_FOR_LONG]; - bignum_digit_type * end_digits = result_digits; - /* Special cases win when these small constants are cached. */ - if (n == 0) return (BIGNUM_ZERO ()); - if (n == 1) return (BIGNUM_ONE (0)); - if (n == -1) return (BIGNUM_ONE (1)); - { - unsigned long accumulator = ((negative_p = (n < 0)) ? (-n) : n); - do - { - (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); - accumulator >>= BIGNUM_DIGIT_LENGTH; - } - while (accumulator != 0); - } - { - bignum_type result = - (bignum_allocate ((end_digits - result_digits), negative_p)); - bignum_digit_type * scan_digits = result_digits; - bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); - while (scan_digits < end_digits) - (*scan_result++) = (*scan_digits++); - return (result); - } + bignum_type result = + (bignum_allocate ((end_digits - start_digits), negative_p)); + bignum_digit_type *scan_digits = start_digits; + bignum_digit_type *scan_result = (BIGNUM_START_PTR (result)); + while (scan_digits < end_digits) + (*scan_result++) = (*scan_digits++); + return (result); } -long -bignum_to_long (bignum_type bignum) -{ - if (BIGNUM_ZERO_P (bignum)) - return (0); - { - unsigned long accumulator = 0; - bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); - bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); - while (start < scan) - accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); - return - ((BIGNUM_NEGATIVE_P (bignum)) - ? (- ((long) accumulator)) - : ((long) accumulator)); - } +#define DEFINE_INT_TO_BIGNUM(NAME, TYPE, UTYPE) \ +bignum_type \ +NAME (TYPE n) \ +{ \ + /* Special cases win when these small constants are cached. */ \ + if (n == 0) return (BIGNUM_ZERO ()); \ + if (n == 1) return (BIGNUM_ONE (0)); \ + if (n == -1) return (BIGNUM_ONE (1)); \ + { \ + int negative_p; \ + bignum_digit_type result_digits [BIGNUM_DIGITS_FOR_TYPE (TYPE)]; \ + bignum_digit_type * end_digits = result_digits; \ + UTYPE accumulator = ((negative_p = (n < 0)) ? (-n) : n); \ + do { \ + (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \ + accumulator >>= BIGNUM_DIGIT_LENGTH; \ + } while (accumulator != 0); \ + return \ + (bignum_from_digits (result_digits, end_digits, negative_p)); \ + } \ } -bignum_type -ulong_to_bignum (unsigned long n) -{ - bignum_digit_type result_digits [BIGNUM_DIGITS_FOR_LONG]; - bignum_digit_type * end_digits = result_digits; - /* Special cases win when these small constants are cached. */ - if (n == 0) return (BIGNUM_ZERO ()); - if (n == 1) return (BIGNUM_ONE (0)); - { - unsigned long accumulator = n; - do - { - (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); - accumulator >>= BIGNUM_DIGIT_LENGTH; - } - while (accumulator != 0); - } - { - bignum_type result = - (bignum_allocate ((end_digits - result_digits), 0)); - bignum_digit_type * scan_digits = result_digits; - bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); - while (scan_digits < end_digits) - (*scan_result++) = (*scan_digits++); - return (result); - } +DEFINE_INT_TO_BIGNUM (long_to_bignum, long, unsigned long) +DEFINE_INT_TO_BIGNUM (intmax_to_bignum, intmax_t, uintmax_t) + +#define DEFINE_BIGNUM_TO_INT(NAME, TYPE, UTYPE) \ +TYPE \ +NAME (bignum_type bignum) \ +{ \ + if (BIGNUM_ZERO_P (bignum)) \ + return (0); \ + { \ + UTYPE accumulator = 0; \ + bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \ + bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \ + while (start < scan) \ + accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \ + return \ + ((BIGNUM_NEGATIVE_P (bignum)) \ + ? (- ((TYPE) accumulator)) \ + : ((TYPE) accumulator)); \ + } \ } -unsigned long -bignum_to_ulong (bignum_type bignum) -{ - if (BIGNUM_ZERO_P (bignum)) - return (0); - BIGNUM_ASSERT (BIGNUM_POSITIVE_P (bignum)); - { - unsigned long accumulator = 0; - bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); - bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); - while (start < scan) - accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); - return (accumulator); - } +DEFINE_BIGNUM_TO_INT (bignum_to_long, long, unsigned long) +DEFINE_BIGNUM_TO_INT (bignum_to_intmax, intmax_t, uintmax_t) + +#define DEFINE_UINT_TO_BIGNUM(NAME, TYPE) \ +bignum_type \ +NAME (TYPE n) \ +{ \ + /* Special cases win when these small constants are cached. */ \ + if (n == 0) return (BIGNUM_ZERO ()); \ + if (n == 1) return (BIGNUM_ONE (0)); \ + { \ + bignum_digit_type result_digits [BIGNUM_DIGITS_FOR_TYPE (TYPE)]; \ + bignum_digit_type * end_digits = result_digits; \ + TYPE accumulator = n; \ + do { \ + (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \ + accumulator >>= BIGNUM_DIGIT_LENGTH; \ + } while (accumulator != 0); \ + return (bignum_from_digits (result_digits, end_digits, false)); \ + } \ +} + +DEFINE_UINT_TO_BIGNUM (ulong_to_bignum, unsigned long) +DEFINE_UINT_TO_BIGNUM (uintmax_to_bignum, uintmax_t) + +#define DEFINE_BIGNUM_TO_UINT(NAME, TYPE) \ +TYPE \ +NAME (bignum_type bignum) \ +{ \ + if (BIGNUM_ZERO_P (bignum)) \ + return (0); \ + BIGNUM_ASSERT (BIGNUM_POSITIVE_P (bignum)); \ + { \ + TYPE accumulator = 0; \ + bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \ + bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \ + while (start < scan) \ + accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \ + return (accumulator); \ + } \ } + +DEFINE_BIGNUM_TO_UINT (bignum_to_ulong, unsigned long) +DEFINE_BIGNUM_TO_UINT (bignum_to_uintmax, uintmax_t) #define DTB_WRITE_DIGIT(n_bits) do \ { \ diff --git a/src/microcode/bignum.h b/src/microcode/bignum.h index 0280935bd..0779b5c7f 100644 --- a/src/microcode/bignum.h +++ b/src/microcode/bignum.h @@ -27,13 +27,6 @@ USA. #ifndef SCM_BIGNUM_H_INCLUDED #define SCM_BIGNUM_H_INCLUDED 1 - -/* The `unsigned long' type is used for the conversion procedures - `bignum_to_long' and `long_to_bignum'. Older implementations of C - don't support this type; if you have such an implementation you can - disable these procedures using the following flag (alternatively - you could write alternate versions that don't require this type). */ -/* #define BIGNUM_NO_ULONG */ #ifdef MIT_SCHEME @@ -70,12 +63,14 @@ extern int bignum_divide bignum_type * remainder); extern bignum_type bignum_quotient (bignum_type, bignum_type); extern bignum_type bignum_remainder (bignum_type, bignum_type); -#ifndef BIGNUM_NO_ULONG extern bignum_type long_to_bignum (long); extern bignum_type ulong_to_bignum (unsigned long); extern long bignum_to_long (bignum_type); extern unsigned long bignum_to_ulong (bignum_type); -#endif /* not BIGNUM_NO_ULONG */ +extern bignum_type intmax_to_bignum (intmax_t); +extern bignum_type uintmax_to_bignum (uintmax_t); +extern intmax_t bignum_to_intmax (bignum_type); +extern uintmax_t bignum_to_uintmax (bignum_type); extern bignum_type double_to_bignum (double); extern double bignum_to_double (bignum_type); extern int bignum_fits_in_word_p diff --git a/src/microcode/configure.ac b/src/microcode/configure.ac index 829df0d3b..a3e22029e 100644 --- a/src/microcode/configure.ac +++ b/src/microcode/configure.ac @@ -471,42 +471,16 @@ AC_TYPE_SIGNAL AC_TYPE_SIZE_T AC_TYPE_UID_T -dnl These macros are too new; we'll handle this by hand for now. - -dnl AC_TYPE_INT8_T -dnl AC_TYPE_INT16_T -dnl AC_TYPE_INT32_T -dnl AC_TYPE_INTPTR_T -dnl AC_TYPE_UINT8_T -dnl AC_TYPE_UINT16_T -dnl AC_TYPE_UINT32_T -dnl AC_TYPE_UINTPTR_T - -define([SCM_STDINT_MSG], [Define replacement if no .])dnl - -AC_CHECK_TYPE([int8_t],, - [AC_DEFINE_UNQUOTED([int8_t], [signed char], SCM_STDINT_MSG)]) - -AC_CHECK_TYPE([int16_t],, - [AC_DEFINE_UNQUOTED([int16_t], [short], SCM_STDINT_MSG)]) - -AC_CHECK_TYPE([int32_t],, - [AC_DEFINE_UNQUOTED([int32_t], [int], SCM_STDINT_MSG)]) - -AC_CHECK_TYPE([uint8_t],, - [AC_DEFINE_UNQUOTED([uint8_t], [unsigned char], SCM_STDINT_MSG)]) - -AC_CHECK_TYPE([uint16_t],, - [AC_DEFINE_UNQUOTED([uint16_t], [unsigned short], SCM_STDINT_MSG)]) - -AC_CHECK_TYPE([uint32_t],, - [AC_DEFINE_UNQUOTED([uint32_t], [unsigned int], SCM_STDINT_MSG)]) - -AC_CHECK_TYPE([intptr_t],, - [AC_DEFINE_UNQUOTED([intptr_t], [long], SCM_STDINT_MSG)]) - -AC_CHECK_TYPE([uintptr_t],, - [AC_DEFINE_UNQUOTED([uintptr_t], [unsigned long], SCM_STDINT_MSG)]) +AC_TYPE_INT8_T +AC_TYPE_INT16_T +AC_TYPE_INT32_T +AC_TYPE_INTPTR_T +AC_TYPE_INTMAX_T +AC_TYPE_UINT8_T +AC_TYPE_UINT16_T +AC_TYPE_UINT32_T +AC_TYPE_UINTPTR_T +AC_TYPE_UINTMAX_T AC_CHECK_SIZEOF([char]) AC_CHECK_SIZEOF([short]) @@ -519,6 +493,8 @@ AC_CHECK_SIZEOF([unsigned long]) AC_CHECK_SIZEOF([void *]) AC_CHECK_SIZEOF([intptr_t]) AC_CHECK_SIZEOF([uintptr_t]) +AC_CHECK_SIZEOF([intmax_t]) +AC_CHECK_SIZEOF([uintmax_t]) if test ${ac_cv_sizeof_char} -ne 1; then AC_MSG_ERROR([SIZEOF_CHAR is not 1]) @@ -563,6 +539,9 @@ AC_CHECK_TYPE([speed_t], [Define to `short' if doesn't define.])], [SCM_INC_TERMIO]) +AC_CHECK_SIZEOF([time_t]) +AC_CHECK_SIZEOF([off_t]) + AC_STRUCT_TM AC_STRUCT_TIMEZONE diff --git a/src/microcode/confshared.h b/src/microcode/confshared.h index 45a29dc97..4d9484507 100644 --- a/src/microcode/confshared.h +++ b/src/microcode/confshared.h @@ -125,6 +125,22 @@ USA. # include "error: pointers must fit in 'unsigned long'" #endif +#ifndef OFF_T_MAX +# if SIZEOF_OFF_T < SIZEOF_INTMAX_T +# define OFF_T_MAX (~ ((~ ((intmax_t) 0)) << (CHAR_BIT * SIZEOF_OFF_T))) +# else +# define OFF_T_MAX INTMAX_MAX +# endif +#endif + +#ifndef TIME_T_MAX +# if SIZEOF_TIME_T == SIZEOF_INTMAX_T +# define TIME_T_MAX INTMAX_MAX +# else +# define TIME_T_MAX (~ ((~ ((intmax_t) 0)) << (CHAR_BIT * SIZEOF_TIME_T))) +# endif +#endif + #if ((defined (__GNUC__)) && (__GNUC__ >= 3)) # define ATTRIBUTE(x) __attribute__ (x) # define NORETURN __attribute__ ((__noreturn__)) diff --git a/src/microcode/extern.h b/src/microcode/extern.h index 1cf012b4e..3fef79c09 100644 --- a/src/microcode/extern.h +++ b/src/microcode/extern.h @@ -198,10 +198,16 @@ extern long fixnum_to_long (SCHEME_OBJECT); extern SCHEME_OBJECT double_to_fixnum (double); extern bool integer_to_long_p (SCHEME_OBJECT); extern long integer_to_long (SCHEME_OBJECT); +extern bool integer_to_intmax_p (SCHEME_OBJECT); +extern intmax_t integer_to_intmax (SCHEME_OBJECT); extern SCHEME_OBJECT long_to_integer (long); +extern SCHEME_OBJECT intmax_to_integer (intmax_t); extern bool integer_to_ulong_p (SCHEME_OBJECT); extern unsigned long integer_to_ulong (SCHEME_OBJECT); +extern bool integer_to_uintmax_p (SCHEME_OBJECT); +extern uintmax_t integer_to_uintmax (SCHEME_OBJECT); extern SCHEME_OBJECT ulong_to_integer (unsigned long); +extern SCHEME_OBJECT uintmax_to_integer (uintmax_t); extern bool integer_to_double_p (SCHEME_OBJECT); extern double integer_to_double (SCHEME_OBJECT); extern SCHEME_OBJECT double_to_integer (double); diff --git a/src/microcode/object.h b/src/microcode/object.h index 916843e7e..5a0f42e2f 100644 --- a/src/microcode/object.h +++ b/src/microcode/object.h @@ -386,6 +386,12 @@ extern SCHEME_OBJECT * memory_base; #define BIGNUM_TO_ULONG_P(bignum) \ (bignum_fits_in_word_p ((bignum), ((sizeof (unsigned long)) * CHAR_BIT), 0)) +#define BIGNUM_TO_INTMAX_P(bignum) \ + (bignum_fits_in_word_p ((bignum), ((sizeof (intmax_t)) * CHAR_BIT), 1)) + +#define BIGNUM_TO_UINTMAX_P(bignum) \ + (bignum_fits_in_word_p ((bignum), ((sizeof (uintmax_t)) * CHAR_BIT), 0)) + #define BIGNUM_TO_DOUBLE_P(bignum) \ (bignum_fits_in_word_p ((bignum), (DBL_MAX_EXP + 1), 1)) diff --git a/src/microcode/prims.h b/src/microcode/prims.h index 1d2cdca06..f3a1018dd 100644 --- a/src/microcode/prims.h +++ b/src/microcode/prims.h @@ -82,8 +82,10 @@ extern void error_bad_range_arg (int) NORETURN; extern void error_external_return (void) NORETURN; extern void error_with_argument (SCHEME_OBJECT) NORETURN; extern long arg_integer (int); +extern intmax_t arg_integer_to_intmax (int); extern long arg_nonnegative_integer (int); extern long arg_index_integer (int, long); +extern intmax_t arg_index_integer_to_intmax (int, intmax_t); extern long arg_integer_in_range (int, long, long); extern unsigned long arg_ulong_integer (int); extern unsigned long arg_ulong_index_integer (int, unsigned long); diff --git a/src/microcode/prosenv.c b/src/microcode/prosenv.c index ab2069818..335d79646 100644 --- a/src/microcode/prosenv.c +++ b/src/microcode/prosenv.c @@ -33,7 +33,7 @@ USA. DEFINE_PRIMITIVE ("ENCODED-TIME", Prim_encoded_time, 0, 0, "Return the current time as an integer.") { - PRIMITIVE_RETURN (ulong_to_integer ((unsigned long) (OS_encoded_time ()))); + PRIMITIVE_RETURN (intmax_to_integer (OS_encoded_time ())); } #define DECODE_TIME_BODY(proc) \ @@ -45,7 +45,7 @@ DEFINE_PRIMITIVE ("ENCODED-TIME", Prim_encoded_time, 0, 0, struct time_structure ts; \ if (! (len >= 10)) \ error_bad_range_arg (1); \ - proc (((time_t) (arg_ulong_integer (2))), &ts); \ + proc (((time_t) (arg_index_integer_to_intmax (2, TIME_T_MAX))), &ts); \ VECTOR_SET (vec, 1, (ulong_to_integer (ts . second))); \ VECTOR_SET (vec, 2, (ulong_to_integer (ts . minute))); \ VECTOR_SET (vec, 3, (ulong_to_integer (ts . hour))); \ @@ -108,7 +108,7 @@ DEFINE_PRIMITIVE ("ENCODE-TIME", Prim_encode_time, 1, 1, && (integer_to_ulong_p (VECTOR_REF (vec, 9)))) ? (integer_to_ulong (VECTOR_REF (vec, 9))) : INT_MAX); - PRIMITIVE_RETURN (ulong_to_integer ((unsigned long) (OS_encode_time (&ts)))); + PRIMITIVE_RETURN (intmax_to_integer (OS_encode_time (&ts))); } DEFINE_PRIMITIVE ("SYSTEM-CLOCK", Prim_system_clock, 0, 0, diff --git a/src/microcode/prosfile.c b/src/microcode/prosfile.c index 1d2dafe62..bbfe225fb 100644 --- a/src/microcode/prosfile.c +++ b/src/microcode/prosfile.c @@ -129,7 +129,7 @@ DEFINE_PRIMITIVE ("FILE-LENGTH-NEW", Prim_file_length_new, 1, 1, "Return the length of CHANNEL in characters.") { PRIMITIVE_HEADER (1); - PRIMITIVE_RETURN (long_to_integer (OS_file_length (arg_channel (1)))); + PRIMITIVE_RETURN (intmax_to_integer (OS_file_length (arg_channel (1)))); } DEFINE_PRIMITIVE ("FILE-POSITION", Prim_file_position, 1, 1, @@ -137,7 +137,7 @@ DEFINE_PRIMITIVE ("FILE-POSITION", Prim_file_position, 1, 1, This is a non-negative number strictly less than the file's length.") { PRIMITIVE_HEADER (1); - PRIMITIVE_RETURN (long_to_integer (OS_file_position (arg_channel (1)))); + PRIMITIVE_RETURN (intmax_to_integer (OS_file_position (arg_channel (1)))); } DEFINE_PRIMITIVE ("FILE-SET-POSITION", Prim_file_set_position, 2, 2, @@ -145,7 +145,8 @@ DEFINE_PRIMITIVE ("FILE-SET-POSITION", Prim_file_set_position, 2, 2, POSITION must be a non-negative number strictly less than the file's length.") { PRIMITIVE_HEADER (1); - OS_file_set_position ((arg_channel (1)), (arg_nonnegative_integer (2))); + OS_file_set_position + ((arg_channel (1)), (arg_index_integer_to_intmax (2, OFF_T_MAX))); PRIMITIVE_RETURN (UNSPECIFIC); } @@ -154,6 +155,7 @@ DEFINE_PRIMITIVE ("FILE-TRUNCATE", Prim_file_truncate, 2, 2, LENGTH must be a non-negative number.") { PRIMITIVE_HEADER (1); - OS_file_truncate ((arg_channel (1)), (arg_nonnegative_integer (2))); + OS_file_truncate + ((arg_channel (1)), (arg_index_integer_to_intmax (2, OFF_T_MAX))); PRIMITIVE_RETURN (UNSPECIFIC); } diff --git a/src/microcode/pruxenv.c b/src/microcode/pruxenv.c index 944b04cba..242f40b41 100644 --- a/src/microcode/pruxenv.c +++ b/src/microcode/pruxenv.c @@ -44,7 +44,7 @@ DEFINE_PRIMITIVE ("FILE-TIME->STRING", Prim_file_time_to_string, 1, 1, PRIMITIVE_HEADER (1); CHECK_ARG (1, INTEGER_P); { - time_t clock = (arg_integer (1)); + time_t clock = (arg_index_integer_to_intmax (1, TIME_T_MAX)); char * time_string = (UX_ctime (&clock)); (time_string[24]) = '\0'; PRIMITIVE_RETURN (char_pointer_to_string (time_string)); diff --git a/src/microcode/pruxfs.c b/src/microcode/pruxfs.c index 6acb70d71..04c80d25e 100644 --- a/src/microcode/pruxfs.c +++ b/src/microcode/pruxfs.c @@ -66,7 +66,7 @@ DEFINE_PRIMITIVE ("FILE-MOD-TIME", Prim_file_mod_time, 1, 1, 0) PRIMITIVE_HEADER (1); PRIMITIVE_RETURN ((UX_read_file_status ((STRING_ARG (1)), (&s))) - ? (long_to_integer (s . st_mtime)) + ? (intmax_to_integer (s . st_mtime)) : SHARP_F); } @@ -76,7 +76,7 @@ DEFINE_PRIMITIVE ("FILE-MOD-TIME-INDIRECT", Prim_file_mod_time_indirect, 1, 1, 0 PRIMITIVE_HEADER (1); PRIMITIVE_RETURN ((UX_read_file_status_indirect ((STRING_ARG (1)), (&s))) - ? (long_to_integer (s . st_mtime)) + ? (intmax_to_integer (s . st_mtime)) : SHARP_F); } @@ -86,7 +86,7 @@ DEFINE_PRIMITIVE ("FILE-ACCESS-TIME", Prim_file_acc_time, 1, 1, 0) PRIMITIVE_HEADER (1); PRIMITIVE_RETURN ((UX_read_file_status ((STRING_ARG (1)), (&s))) - ? (long_to_integer (s . st_atime)) + ? (intmax_to_integer (s . st_atime)) : SHARP_F); } @@ -96,7 +96,7 @@ DEFINE_PRIMITIVE ("FILE-ACCESS-TIME-INDIRECT", Prim_file_acc_time_indirect, 1, 1 PRIMITIVE_HEADER (1); PRIMITIVE_RETURN ((UX_read_file_status_indirect ((STRING_ARG (1)), (&s))) - ? (long_to_integer (s . st_atime)) + ? (intmax_to_integer (s . st_atime)) : SHARP_F); } @@ -107,8 +107,8 @@ The file must exist and you must be the owner (or superuser).") { struct utimbuf times; PRIMITIVE_HEADER (3); - times.actime = (arg_nonnegative_integer (2)); - times.modtime = (arg_nonnegative_integer (3)); + times.actime = (arg_index_integer_to_intmax (2, TIME_T_MAX)); + times.modtime = (arg_index_integer_to_intmax (3, TIME_T_MAX)); STD_VOID_SYSTEM_CALL (syscall_utime, (UX_utime ((STRING_ARG (1)), (×)))); PRIMITIVE_RETURN (UNSPECIFIC); @@ -173,16 +173,16 @@ file_attributes_internal (struct stat * s) VECTOR_SET (result, 0, SHARP_F); break; } - VECTOR_SET (result, 1, (long_to_integer (s -> st_nlink))); - VECTOR_SET (result, 2, (long_to_integer (s -> st_uid))); - VECTOR_SET (result, 3, (long_to_integer (s -> st_gid))); - VECTOR_SET (result, 4, (long_to_integer (s -> st_atime))); - VECTOR_SET (result, 5, (long_to_integer (s -> st_mtime))); - VECTOR_SET (result, 6, (long_to_integer (s -> st_ctime))); - VECTOR_SET (result, 7, (long_to_integer (s -> st_size))); + VECTOR_SET (result, 1, (intmax_to_integer (s -> st_nlink))); + VECTOR_SET (result, 2, (intmax_to_integer (s -> st_uid))); + VECTOR_SET (result, 3, (intmax_to_integer (s -> st_gid))); + VECTOR_SET (result, 4, (intmax_to_integer (s -> st_atime))); + VECTOR_SET (result, 5, (intmax_to_integer (s -> st_mtime))); + VECTOR_SET (result, 6, (intmax_to_integer (s -> st_ctime))); + VECTOR_SET (result, 7, (intmax_to_integer (s -> st_size))); file_mode_string (s, (STRING_POINTER (modes))); VECTOR_SET (result, 8, modes); - VECTOR_SET (result, 9, (long_to_integer (s -> st_ino))); + VECTOR_SET (result, 9, (intmax_to_integer (s -> st_ino))); return (result); } diff --git a/src/microcode/utils.c b/src/microcode/utils.c index 9ccea2c19..7c8a64d8a 100644 --- a/src/microcode/utils.c +++ b/src/microcode/utils.c @@ -380,6 +380,17 @@ arg_integer (int arg_number) return (integer_to_long (object)); } +intmax_t +arg_integer_to_intmax (int arg_number) +{ + SCHEME_OBJECT object = (ARG_REF (arg_number)); + if (! (INTEGER_P (object))) + error_wrong_type_arg (arg_number); + if (! (integer_to_intmax_p (object))) + error_bad_range_arg (arg_number); + return (integer_to_intmax (object)); +} + long arg_nonnegative_integer (int arg_number) { @@ -398,6 +409,15 @@ arg_index_integer (int arg_number, long upper_limit) return (result); } +intmax_t +arg_index_integer_to_intmax (int arg_number, intmax_t upper_limit) +{ + intmax_t result = (arg_integer_to_intmax (arg_number)); + if ((result < 0) || (result >= upper_limit)) + error_bad_range_arg (arg_number); + return (result); +} + long arg_integer_in_range (int arg_number, long lower_limit, long upper_limit) { -- 2.25.1