/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bignum.c,v 9.35 1991/03/06 00:32:43 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bignum.c,v 9.36 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1989-91 Massachusetts Institute of Technology
#ifndef MIT_SCHEME
static bignum_type
-bignum_malloc (length)
- bignum_length_type length;
+DEFUN (bignum_malloc, (length), bignum_length_type length)
{
extern char * malloc ();
char * result = (malloc ((length + 1) * (sizeof (bignum_digit_type))));
}
static bignum_type
-bignum_realloc (bignum, length)
- bignum_type bignum;
- bignum_length_type length;
+DEFUN (bignum_realloc, (bignum, length),
+ bignum_type bignum AND bignum_length_type length)
{
extern char * realloc ();
char * result =
#endif /* not MIT_SCHEME */
/* Forward references */
-static int bignum_equal_p_unsigned ();
-static enum bignum_comparison bignum_compare_unsigned ();
-static bignum_type bignum_add_unsigned ();
-static bignum_type bignum_subtract_unsigned ();
-static bignum_type bignum_multiply_unsigned ();
-static bignum_type bignum_multiply_unsigned_small_factor ();
-static void bignum_destructive_scale_up ();
-static void bignum_destructive_add ();
-static void bignum_divide_unsigned_large_denominator ();
-static int bignum_compute_normalization_shift ();
-static void bignum_destructive_normalization ();
-static void bignum_destructive_unnormalization ();
-static void bignum_divide_unsigned_normalized ();
-static bignum_digit_type bignum_divide_subtract ();
-static void bignum_divide_unsigned_medium_denominator ();
-static bignum_digit_type bignum_digit_divide ();
-static bignum_digit_type bignum_digit_divide_subtract ();
-static void bignum_divide_unsigned_small_denominator ();
-static bignum_digit_type bignum_destructive_scale_down ();
-static bignum_type bignum_remainder_unsigned_small_denominator ();
-static bignum_type bignum_digit_to_bignum ();
-static bignum_type bignum_allocate ();
-static bignum_type bignum_allocate_zeroed ();
-static bignum_type bignum_shorten_length ();
-static bignum_type bignum_trim ();
-static bignum_type bignum_copy ();
-static bignum_type bignum_new_sign ();
-static bignum_type bignum_maybe_new_sign ();
-static void bignum_destructive_copy ();
-static void bignum_destructive_zero ();
+static int EXFUN (bignum_equal_p_unsigned,
+ (bignum_type, bignum_type));
+static enum bignum_comparison EXFUN (bignum_compare_unsigned,
+ (bignum_type, bignum_type));
+static bignum_type EXFUN (bignum_add_unsigned,
+ (bignum_type, bignum_type, int));
+static bignum_type EXFUN (bignum_subtract_unsigned,
+ (bignum_type, bignum_type));
+static bignum_type EXFUN (bignum_multiply_unsigned,
+ (bignum_type, bignum_type, int));
+static bignum_type EXFUN (bignum_multiply_unsigned_small_factor,
+ (bignum_type, bignum_digit_type, int));
+static void EXFUN (bignum_destructive_scale_up,
+ (bignum_type, bignum_digit_type));
+static void EXFUN (bignum_destructive_add,
+ (bignum_type, bignum_digit_type));
+static void EXFUN (bignum_divide_unsigned_large_denominator,
+ (bignum_type, bignum_type, bignum_type *, bignum_type *,
+ int, int));
+static void EXFUN (bignum_destructive_normalization,
+ (bignum_type, bignum_type, int));
+static void EXFUN (bignum_destructive_unnormalization,
+ (bignum_type, int));
+static void EXFUN (bignum_divide_unsigned_normalized,
+ (bignum_type, bignum_type, bignum_type));
+static bignum_digit_type EXFUN (bignum_divide_subtract,
+ (bignum_digit_type *, bignum_digit_type *,
+ bignum_digit_type, bignum_digit_type *));
+static void EXFUN (bignum_divide_unsigned_medium_denominator,
+ (bignum_type, bignum_digit_type, bignum_type *,
+ bignum_type *, int, int));
+static bignum_digit_type EXFUN (bignum_digit_divide,
+ (bignum_digit_type, bignum_digit_type,
+ bignum_digit_type, bignum_digit_type *));
+static bignum_digit_type EXFUN (bignum_digit_divide_subtract,
+ (bignum_digit_type, bignum_digit_type,
+ bignum_digit_type, bignum_digit_type *));
+static void EXFUN (bignum_divide_unsigned_small_denominator,
+ (bignum_type, bignum_digit_type, bignum_type *,
+ bignum_type *, int, int));
+static bignum_digit_type EXFUN (bignum_destructive_scale_down,
+ (bignum_type, bignum_digit_type));
+static bignum_type EXFUN (bignum_remainder_unsigned_small_denominator,
+ (bignum_type, bignum_digit_type, int));
+static bignum_type EXFUN (bignum_digit_to_bignum,
+ (bignum_digit_type, int));
+static bignum_type EXFUN (bignum_allocate,
+ (bignum_length_type, int));
+static bignum_type EXFUN (bignum_allocate_zeroed,
+ (bignum_length_type, int));
+static bignum_type EXFUN (bignum_shorten_length,
+ (bignum_type, bignum_length_type));
+static bignum_type EXFUN (bignum_trim,
+ (bignum_type));
+static bignum_type EXFUN (bignum_copy,
+ (bignum_type));
+static bignum_type EXFUN (bignum_new_sign,
+ (bignum_type, int));
+static bignum_type EXFUN (bignum_maybe_new_sign,
+ (bignum_type, int));
+static void EXFUN (bignum_destructive_copy,
+ (bignum_type, bignum_type));
+static void EXFUN (bignum_destructive_zero,
+ (bignum_type));
\f
/* Exports */
bignum_type
-bignum_make_zero ()
+DEFUN_VOID (bignum_make_zero)
{
fast bignum_type result = (BIGNUM_ALLOCATE (0));
BIGNUM_SET_HEADER (result, 0, 0);
}
bignum_type
-bignum_make_one (negative_p)
- int negative_p;
+DEFUN (bignum_make_one, (negative_p), int negative_p)
{
fast bignum_type result = (BIGNUM_ALLOCATE (1));
BIGNUM_SET_HEADER (result, 1, negative_p);
}
int
-bignum_equal_p (x, y)
- fast bignum_type x;
- fast bignum_type y;
+DEFUN (bignum_equal_p, (x, y),
+ fast bignum_type x AND fast bignum_type y)
{
return
((BIGNUM_ZERO_P (x))
}
enum bignum_comparison
-bignum_test (bignum)
- fast bignum_type bignum;
+DEFUN (bignum_test, (bignum), fast bignum_type bignum)
{
return
((BIGNUM_ZERO_P (bignum))
}
enum bignum_comparison
-bignum_compare (x, y)
- fast bignum_type x;
- fast bignum_type y;
+DEFUN (bignum_compare, (x, y),
+ fast bignum_type x AND fast bignum_type y)
{
return
((BIGNUM_ZERO_P (x))
}
\f
bignum_type
-bignum_add (x, y)
- fast bignum_type x;
- fast bignum_type y;
+DEFUN (bignum_add, (x, y),
+ fast bignum_type x AND fast bignum_type y)
{
return
((BIGNUM_ZERO_P (x))
}
bignum_type
-bignum_subtract (x, y)
- fast bignum_type x;
- fast bignum_type y;
+DEFUN (bignum_subtract, (x, y),
+ fast bignum_type x AND fast bignum_type y)
{
return
((BIGNUM_ZERO_P (x))
}
bignum_type
-bignum_negate (x)
- fast bignum_type x;
+DEFUN (bignum_negate, (x), fast bignum_type x)
{
return
((BIGNUM_ZERO_P (x))
}
\f
bignum_type
-bignum_multiply (x, y)
- fast bignum_type x;
- fast bignum_type y;
+DEFUN (bignum_multiply, (x, y),
+ fast bignum_type x AND fast bignum_type y)
{
fast bignum_length_type x_length = (BIGNUM_LENGTH (x));
fast bignum_length_type y_length = (BIGNUM_LENGTH (y));
}
\f
int
-bignum_divide (numerator, denominator, quotient, remainder)
- bignum_type numerator;
- bignum_type denominator;
- bignum_type * quotient;
- bignum_type * remainder;
+DEFUN (bignum_divide, (numerator, denominator, quotient, remainder),
+ bignum_type numerator AND bignum_type denominator
+ AND bignum_type * quotient AND bignum_type * remainder)
{
if (BIGNUM_ZERO_P (denominator))
return (1);
}
\f
bignum_type
-bignum_quotient (numerator, denominator)
- bignum_type numerator;
- bignum_type denominator;
+DEFUN (bignum_quotient, (numerator, denominator),
+ bignum_type numerator AND bignum_type denominator)
{
if (BIGNUM_ZERO_P (denominator))
return (BIGNUM_OUT_OF_BAND);
}
\f
bignum_type
-bignum_remainder (numerator, denominator)
- bignum_type numerator;
- bignum_type denominator;
+DEFUN (bignum_remainder, (numerator, denominator),
+ bignum_type numerator AND bignum_type denominator)
{
if (BIGNUM_ZERO_P (denominator))
return (BIGNUM_OUT_OF_BAND);
#ifndef BIGNUM_NO_ULONG
bignum_type
-long_to_bignum (n)
- long n;
+DEFUN (long_to_bignum, (n), long n)
{
int negative_p;
bignum_digit_type result_digits [BIGNUM_DIGITS_FOR_LONG];
}
long
-bignum_to_long (bignum)
- bignum_type bignum;
+DEFUN (bignum_to_long, (bignum), bignum_type bignum)
{
if (BIGNUM_ZERO_P (bignum))
return (0);
}
bignum_type
-double_to_bignum (x)
- double x;
+DEFUN (double_to_bignum, (x), double x)
{
extern double frexp ();
int exponent;
#undef DTB_WRITE_DIGIT
double
-bignum_to_double (bignum)
- bignum_type bignum;
+DEFUN (bignum_to_double, (bignum), bignum_type bignum)
{
if (BIGNUM_ZERO_P (bignum))
return (0);
}
\f
int
-bignum_fits_in_word_p (bignum, word_length, twos_complement_p)
- bignum_type bignum;
- long word_length;
- int twos_complement_p;
+DEFUN (bignum_fits_in_word_p, (bignum, word_length, twos_complement_p),
+ bignum_type bignum AND long word_length AND int twos_complement_p)
{
unsigned int n_bits = (twos_complement_p ? (word_length - 1) : word_length);
BIGNUM_ASSERT (n_bits > 0);
}
bignum_type
-bignum_length_in_bits (bignum)
- bignum_type bignum;
+DEFUN (bignum_length_in_bits, (bignum), bignum_type bignum)
{
if (BIGNUM_ZERO_P (bignum))
return (BIGNUM_ZERO ());
}
bignum_type
-bignum_length_upper_limit ()
+DEFUN_VOID (bignum_length_upper_limit)
{
fast bignum_type result = (bignum_allocate (2, 0));
(BIGNUM_REF (result, 0)) = 0;
}
\f
bignum_type
-digit_stream_to_bignum (n_digits, producer, context, radix, negative_p)
- fast unsigned int n_digits;
- unsigned int (*producer) ();
- bignum_procedure_context context;
- fast unsigned int radix;
- int negative_p;
+DEFUN (digit_stream_to_bignum,
+ (n_digits, producer, context, radix, negative_p),
+ fast unsigned int n_digits
+ AND unsigned int EXFUN ((*producer), (bignum_procedure_context))
+ AND bignum_procedure_context context
+ AND fast unsigned int radix
+ AND int negative_p)
{
BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
if (n_digits == 0)
}
void
-bignum_to_digit_stream (bignum, radix, consumer, context)
- bignum_type bignum;
- unsigned int radix;
- void (*consumer) ();
- bignum_procedure_context context;
+DEFUN (bignum_to_digit_stream, (bignum, radix, consumer, context),
+ bignum_type bignum
+ AND unsigned int radix
+ AND void EXFUN ((*consumer),
+ (bignum_procedure_context, bignum_digit_type))
+ AND bignum_procedure_context context)
{
BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
if (! (BIGNUM_ZERO_P (bignum)))
}
long
-bignum_max_digit_stream_radix ()
+DEFUN_VOID (bignum_max_digit_stream_radix)
{
return (BIGNUM_RADIX_ROOT);
}
/* Comparisons */
static int
-bignum_equal_p_unsigned (x, y)
- bignum_type x;
- bignum_type y;
+DEFUN (bignum_equal_p_unsigned, (x, y),
+ bignum_type x AND bignum_type y)
{
bignum_length_type length = (BIGNUM_LENGTH (x));
if (length != (BIGNUM_LENGTH (y)))
}
static enum bignum_comparison
-bignum_compare_unsigned (x, y)
- bignum_type x;
- bignum_type y;
+DEFUN (bignum_compare_unsigned, (x, y),
+ bignum_type x AND bignum_type y)
{
bignum_length_type x_length = (BIGNUM_LENGTH (x));
bignum_length_type y_length = (BIGNUM_LENGTH (y));
/* Addition */
static bignum_type
-bignum_add_unsigned (x, y, negative_p)
- bignum_type x;
- bignum_type y;
- int negative_p;
+DEFUN (bignum_add_unsigned, (x, y, negative_p),
+ bignum_type x AND bignum_type y AND int negative_p)
{
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
{
/* Subtraction */
static bignum_type
-bignum_subtract_unsigned (x, y)
- bignum_type x;
- bignum_type y;
+DEFUN (bignum_subtract_unsigned, (x, y),
+ bignum_type x AND bignum_type y)
{
int negative_p;
switch (bignum_compare_unsigned (x, y))
where R == BIGNUM_RADIX_ROOT */
static bignum_type
-bignum_multiply_unsigned (x, y, negative_p)
- bignum_type x;
- bignum_type y;
- int negative_p;
+DEFUN (bignum_multiply_unsigned, (x, y, negative_p),
+ bignum_type x AND bignum_type y AND int negative_p)
{
if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
{
}
\f
static bignum_type
-bignum_multiply_unsigned_small_factor (x, y, negative_p)
- bignum_type x;
- bignum_digit_type y;
- int negative_p;
+DEFUN (bignum_multiply_unsigned_small_factor, (x, y, negative_p),
+ bignum_type x AND bignum_digit_type y AND int negative_p)
{
bignum_length_type length_x = (BIGNUM_LENGTH (x));
bignum_type p = (bignum_allocate ((length_x + 1), negative_p));
}
static void
-bignum_destructive_scale_up (bignum, factor)
- bignum_type bignum;
- bignum_digit_type factor;
+DEFUN (bignum_destructive_scale_up, (bignum, factor),
+ bignum_type bignum AND bignum_digit_type factor)
{
fast bignum_digit_type carry = 0;
fast bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
}
static void
-bignum_destructive_add (bignum, n)
- bignum_type bignum;
- bignum_digit_type n;
+DEFUN (bignum_destructive_add, (bignum, n),
+ bignum_type bignum AND bignum_digit_type n)
{
fast bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
fast bignum_digit_type digit;
section 4.3.1, "Multiple-Precision Arithmetic". */
static void
-bignum_divide_unsigned_large_denominator (numerator, denominator,
- quotient, remainder,
- q_negative_p, r_negative_p)
- bignum_type numerator;
- bignum_type denominator;
- bignum_type * quotient;
- bignum_type * remainder;
- int q_negative_p;
- int r_negative_p;
+DEFUN (bignum_divide_unsigned_large_denominator, (numerator, denominator,
+ quotient, remainder,
+ q_negative_p, r_negative_p),
+ bignum_type numerator
+ AND bignum_type denominator
+ AND bignum_type * quotient
+ AND bignum_type * remainder
+ AND int q_negative_p
+ AND int r_negative_p)
{
bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
}
\f
static void
-bignum_divide_unsigned_normalized (u, v, q)
- bignum_type u;
- bignum_type v;
- bignum_type q;
+DEFUN (bignum_divide_unsigned_normalized, (u, v, q),
+ bignum_type u AND bignum_type v AND bignum_type q)
{
bignum_length_type u_length = (BIGNUM_LENGTH (u));
bignum_length_type v_length = (BIGNUM_LENGTH (v));
}
\f
static bignum_digit_type
-bignum_divide_subtract (v_start, v_end, guess, u_start)
- bignum_digit_type * v_start;
- bignum_digit_type * v_end;
- bignum_digit_type guess;
- bignum_digit_type * u_start;
+DEFUN (bignum_divide_subtract, (v_start, v_end, guess, u_start),
+ bignum_digit_type * v_start
+ AND bignum_digit_type * v_end
+ AND bignum_digit_type guess
+ AND bignum_digit_type * u_start)
{
bignum_digit_type * v_scan = v_start;
bignum_digit_type * u_scan = u_start;
}
\f
static void
-bignum_divide_unsigned_medium_denominator (numerator, denominator,
- quotient, remainder,
- q_negative_p, r_negative_p)
- bignum_type numerator;
- bignum_digit_type denominator;
- bignum_type * quotient;
- bignum_type * remainder;
- int q_negative_p;
- int r_negative_p;
+DEFUN (bignum_divide_unsigned_medium_denominator, (numerator, denominator,
+ quotient, remainder,
+ q_negative_p, r_negative_p),
+ bignum_type numerator
+ AND bignum_digit_type denominator
+ AND bignum_type * quotient
+ AND bignum_type * remainder
+ AND int q_negative_p
+ AND int r_negative_p)
{
bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
bignum_length_type length_q;
}
\f
static void
-bignum_destructive_normalization (source, target, shift_left)
- bignum_type source;
- bignum_type target;
- int shift_left;
+DEFUN (bignum_destructive_normalization, (source, target, shift_left),
+ bignum_type source AND bignum_type target AND int shift_left)
{
fast bignum_digit_type digit;
fast bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
}
static void
-bignum_destructive_unnormalization (bignum, shift_right)
- bignum_type bignum;
- int shift_right;
+DEFUN (bignum_destructive_unnormalization, (bignum, shift_right),
+ bignum_type bignum AND int shift_right)
{
bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
fast bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
}
static bignum_digit_type
-bignum_digit_divide (uh, ul, v, q)
- bignum_digit_type uh;
- bignum_digit_type ul;
- bignum_digit_type v;
- bignum_digit_type * q; /* return value */
+DEFUN (bignum_digit_divide, (uh, ul, v, q),
+ bignum_digit_type uh AND bignum_digit_type ul
+ AND bignum_digit_type v AND bignum_digit_type * q) /* return value */
{
fast bignum_digit_type guess;
fast bignum_digit_type comparand;
}
static bignum_digit_type
-bignum_digit_divide_subtract (v1, v2, guess, u)
- bignum_digit_type v1;
- bignum_digit_type v2;
- bignum_digit_type guess;
- bignum_digit_type u [];
+DEFUN (bignum_digit_divide_subtract, (v1, v2, guess, u),
+ bignum_digit_type v1 AND bignum_digit_type v2
+ AND bignum_digit_type guess AND bignum_digit_type * u)
{
{
fast bignum_digit_type product;
#undef BDDS_ADD
\f
static void
-bignum_divide_unsigned_small_denominator (numerator, denominator,
- quotient, remainder,
- q_negative_p, r_negative_p)
- bignum_type numerator;
- bignum_digit_type denominator;
- bignum_type * quotient;
- bignum_type * remainder;
- int q_negative_p;
- int r_negative_p;
+DEFUN (bignum_divide_unsigned_small_denominator, (numerator, denominator,
+ quotient, remainder,
+ q_negative_p, r_negative_p),
+ bignum_type numerator
+ AND bignum_digit_type denominator
+ AND bignum_type * quotient
+ AND bignum_type * remainder
+ AND int q_negative_p
+ AND int r_negative_p)
{
bignum_type q = (bignum_new_sign (numerator, q_negative_p));
bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
that all digits are < BIGNUM_RADIX. */
static bignum_digit_type
-bignum_destructive_scale_down (bignum, denominator)
- bignum_type bignum;
- fast bignum_digit_type denominator;
+DEFUN (bignum_destructive_scale_down, (bignum, denominator),
+ bignum_type bignum AND fast bignum_digit_type denominator)
{
fast bignum_digit_type numerator;
fast bignum_digit_type remainder = 0;
}
\f
static bignum_type
-bignum_remainder_unsigned_small_denominator (n, d, negative_p)
- bignum_type n;
- bignum_digit_type d;
- int negative_p;
+DEFUN (bignum_remainder_unsigned_small_denominator, (n, d, negative_p),
+ bignum_type n AND bignum_digit_type d AND int negative_p)
{
fast bignum_digit_type two_digits;
bignum_digit_type * start = (BIGNUM_START_PTR (n));
}
static bignum_type
-bignum_digit_to_bignum (digit, negative_p)
- fast bignum_digit_type digit;
- int negative_p;
+DEFUN (bignum_digit_to_bignum, (digit, negative_p),
+ fast bignum_digit_type digit AND int negative_p)
{
if (digit == 0)
return (BIGNUM_ZERO ());
/* Allocation */
static bignum_type
-bignum_allocate (length, negative_p)
- fast bignum_length_type length;
- int negative_p;
+DEFUN (bignum_allocate, (length, negative_p),
+ fast bignum_length_type length AND int negative_p)
{
BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
{
}
static bignum_type
-bignum_allocate_zeroed (length, negative_p)
- fast bignum_length_type length;
- int negative_p;
+DEFUN (bignum_allocate_zeroed, (length, negative_p),
+ fast bignum_length_type length AND int negative_p)
{
BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
{
}
static bignum_type
-bignum_shorten_length (bignum, length)
- fast bignum_type bignum;
- fast bignum_length_type length;
+DEFUN (bignum_shorten_length, (bignum, length),
+ fast bignum_type bignum AND fast bignum_length_type length)
{
fast bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
}
static bignum_type
-bignum_trim (bignum)
- bignum_type bignum;
+DEFUN (bignum_trim, (bignum), bignum_type bignum)
{
fast bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
fast bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
/* Copying */
static bignum_type
-bignum_copy (source)
- fast bignum_type source;
+DEFUN (bignum_copy, (source), fast bignum_type source)
{
fast bignum_type target =
(bignum_allocate ((BIGNUM_LENGTH (source)), (BIGNUM_NEGATIVE_P (source))));
}
static bignum_type
-bignum_new_sign (bignum, negative_p)
- fast bignum_type bignum;
- int negative_p;
+DEFUN (bignum_new_sign, (bignum, negative_p),
+ fast bignum_type bignum AND int negative_p)
{
fast bignum_type result =
(bignum_allocate ((BIGNUM_LENGTH (bignum)), negative_p));
}
static bignum_type
-bignum_maybe_new_sign (bignum, negative_p)
- fast bignum_type bignum;
- int negative_p;
+DEFUN (bignum_maybe_new_sign, (bignum, negative_p),
+ fast bignum_type bignum AND int negative_p)
{
#ifndef BIGNUM_FORCE_NEW_RESULTS
if ((BIGNUM_NEGATIVE_P (bignum)) ? negative_p : (! negative_p))
}
static void
-bignum_destructive_copy (source, target)
- bignum_type source;
- bignum_type target;
+DEFUN (bignum_destructive_copy, (source, target),
+ bignum_type source AND bignum_type target)
{
fast bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
fast bignum_digit_type * end_source =
}
static void
-bignum_destructive_zero (bignum)
- fast bignum_type bignum;
+DEFUN (bignum_destructive_zero, (bignum), fast bignum_type bignum)
{
fast bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
fast bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bigprm.c,v 1.1 1989/09/20 23:19:56 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bigprm.c,v 1.2 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1989 Massachusetts Institute of Technology
+Copyright (c) 1989-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
DEFINE_PRIMITIVE ("BIGNUM-REMAINDER", Prim_bignum_remainder, 2, 2, 0)
BIGNUM_QR (bignum_remainder)
\f
+static void
+DEFUN (listify_bignum_consumer, (previous_cdr, digit),
+ SCHEME_OBJECT * previous_cdr AND unsigned int digit)
+{
+ (*previous_cdr) =
+ (cons ((LONG_TO_UNSIGNED_FIXNUM (digit)), (*previous_cdr)));
+ return;
+}
+
DEFINE_PRIMITIVE ("LISTIFY-BIGNUM", Prim_listify_bignum, 2, 2,
"Returns a list of the digits of BIGNUM in RADIX.")
{
if (BIGNUM_ZERO_P (bignum))
PRIMITIVE_RETURN (cons ((LONG_TO_UNSIGNED_FIXNUM (0)), EMPTY_LIST));
{
- static void listify_bignum_consumer ();
SCHEME_OBJECT previous_cdr = EMPTY_LIST;
bignum_to_digit_stream
(bignum, radix, listify_bignum_consumer, (&previous_cdr));
}
}
-static void
-listify_bignum_consumer (previous_cdr, digit)
- SCHEME_OBJECT * previous_cdr;
- unsigned int digit;
-{
- (*previous_cdr) =
- (cons ((LONG_TO_UNSIGNED_FIXNUM (digit)), (*previous_cdr)));
- return;
-}
-
DEFINE_PRIMITIVE ("FIXNUM->BIGNUM", Prim_fixnum_to_bignum, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bitstr.c,v 9.48 1991/08/23 22:10:15 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bitstr.c,v 9.49 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
#include "bitstr.h"
\f
SCHEME_OBJECT
-allocate_bit_string (length)
- long length;
+DEFUN (allocate_bit_string, (length), long length)
{
long total_pointers;
SCHEME_OBJECT result;
}
\f
void
-fill_bit_string (bit_string, sense)
- SCHEME_OBJECT bit_string;
- Boolean sense;
+DEFUN (fill_bit_string, (bit_string, sense),
+ SCHEME_OBJECT bit_string AND Boolean sense)
{
SCHEME_OBJECT *scanner;
SCHEME_OBJECT filler;
}
void
-clear_bit_string (bit_string)
- SCHEME_OBJECT bit_string;
+DEFUN (clear_bit_string, (bit_string), SCHEME_OBJECT bit_string)
{
SCHEME_OBJECT *scanner;
long i;
starting with the MSB of a bit string and moving down. */
void
-copy_bits (source, source_offset, destination, destination_offset, nbits)
- SCHEME_OBJECT *source, *destination;
- long source_offset, destination_offset, nbits;
+DEFUN (copy_bits,
+ (source, source_offset, destination, destination_offset, nbits),
+ SCHEME_OBJECT * source AND long source_offset
+ AND SCHEME_OBJECT * destination AND long destination_offset
+ AND long nbits)
{
\f
/* This common case can be done very quickly, by splitting the
/* Integer <-> Bit-string Conversions */
long
-count_significant_bits (number, start)
- long number, start;
+DEFUN (count_significant_bits, (number, start), long number AND long start)
{
long significant_bits, i;
}
long
-long_significant_bits (number)
- long number;
+DEFUN (long_significant_bits, (number), long number)
{
return
((number < 0)
}
\f
SCHEME_OBJECT
-zero_to_bit_string (length)
- long length;
+DEFUN (zero_to_bit_string, (length), long length)
{
SCHEME_OBJECT result;
}
SCHEME_OBJECT
-long_to_bit_string (length, number)
- long length, number;
+DEFUN (long_to_bit_string, (length, number), long length AND long number)
{
if (number < 0)
error_bad_range_arg (2);
}
\f
SCHEME_OBJECT
-bignum_to_bit_string (length, bignum)
- long length;
- SCHEME_OBJECT bignum;
+DEFUN (bignum_to_bit_string, (length, bignum),
+ long length AND SCHEME_OBJECT bignum)
{
switch (bignum_test (bignum))
{
}
static void
-btbs_consumer (result_ptr, digit)
- unsigned char ** result_ptr;
- unsigned int digit;
+DEFUN (btbs_consumer, (result_ptr, digit),
+ unsigned char ** result_ptr
+ AND unsigned int digit)
{
(* (INC_BIT_STRING_PTR (*result_ptr))) = digit;
return;
};
SCHEME_OBJECT
-bit_string_to_bignum (nbits, bitstr)
- long nbits;
- SCHEME_OBJECT bitstr;
+DEFUN (bit_string_to_bignum, (nbits, bitstr),
+ long nbits AND SCHEME_OBJECT bitstr)
{
static unsigned int bstb_producer ();
struct bitstr_to_bignm_context context;
}
static unsigned int
-bstb_producer (context)
- struct bitstr_to_bignm_context *context;
+DEFUN (bstb_producer, (context),
+ struct bitstr_to_bignm_context * context)
{
unsigned int result;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bkpt.c,v 9.24 1990/08/07 23:06:06 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bkpt.c,v 9.25 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
sp_record_list SP_List = sp_nil;
-extern Boolean Add_a_Pop_Return_Breakpoint ();
+extern Boolean EXFUN (Add_a_Pop_Return_Breakpoint, (SCHEME_OBJECT *));
static struct sp_record One_Before =
{
};
Boolean
-Add_a_Pop_Return_Breakpoint (SP)
- SCHEME_OBJECT *SP;
+DEFUN (Add_a_Pop_Return_Breakpoint, (SP), SCHEME_OBJECT * SP)
{
sp_record_list old = SP_List;
SP_List = ((sp_record_list) (malloc (sizeof(struct sp_record))));
One_Before.next = SP_List;
return (true);
}
+\f
+/* A breakpoint can be placed here from a C debugger to examine
+ the state of the world. */
+
+extern Boolean EXFUN (Print_One_Continuation_Frame, (void));
+
+void
+DEFUN_VOID (Handle_Pop_Return_Break)
+{
+ Boolean ignore;
+ SCHEME_OBJECT *Old_Stack = Stack_Pointer;
+
+ printf ("Pop Return Break: SP = 0x%x\n", Stack_Pointer);
+ ignore = (Print_One_Continuation_Frame ());
+ Stack_Pointer = Old_Stack;
+ return;
+}
/* This uses register rather than fast because it is invoked
* very often and would make things too slow.
*/
void
-Pop_Return_Break_Point ()
+DEFUN_VOID (Pop_Return_Break_Point)
{
fast SCHEME_OBJECT *SP = Stack_Pointer;
fast sp_record_list previous = &One_Before;
return;
}
-/* A breakpoint can be placed here from a C debugger to examine
- the state of the world. */
-
-extern Boolean Print_One_Continuation_Frame ();
-
-Handle_Pop_Return_Break ()
-{
- Boolean ignore;
- SCHEME_OBJECT *Old_Stack = Stack_Pointer;
-
- printf ("Pop Return Break: SP = 0x%x\n", Stack_Pointer);
- ignore = (Print_One_Continuation_Frame ());
- Stack_Pointer = Old_Stack;
- return;
-}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.70 1991/05/05 00:45:37 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.71 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1988-1991 Massachusetts Institute of Technology
extern PTR EXFUN (malloc, (unsigned int size));
extern void EXFUN (free, (PTR ptr));
extern void EXFUN (init_exit_scheme, (void));
-extern void Clear_Memory ();
-extern void Setup_Memory ();
-extern void compiler_initialize ();
+extern void EXFUN (Clear_Memory, (int, int, int));
+extern void EXFUN (Setup_Memory, (int, int, int));
+extern void EXFUN (compiler_initialize, (long fasl_p));
\f
-forward void Start_Scheme ();
-forward void Enter_Interpreter ();
+static void EXFUN (Start_Scheme, (int, const char *));
+static void EXFUN (Enter_Interpreter, (void));
CONST char * scheme_program_name;
CONST char * OS_Name;
#endif
main_type
-DEFUN (main,
- (argc, argv),
- int argc AND
- CONST char ** argv)
+DEFUN (main, (argc, argv),
+ int argc AND CONST char ** argv)
{
init_exit_scheme ();
scheme_program_name = (argv[0]);
\f
/* Boot Scheme */
-void
-DEFUN (Start_Scheme,
- (Start_Prim, File_Name),
- int Start_Prim AND
- char * File_Name)
+static void
+DEFUN (Start_Scheme, (Start_Prim, File_Name),
+ int Start_Prim AND CONST char * File_Name)
{
extern SCHEME_OBJECT make_primitive ();
SCHEME_OBJECT FName, Init_Prog, *Fasload_Call, prim;
switch (Start_Prim)
{
case BOOT_FASLOAD: /* (SCODE-EVAL (BINARY-FASLOAD <file>) GLOBAL-ENV) */
- FName = char_pointer_to_string(File_Name);
- prim = make_primitive("BINARY-FASLOAD");
+ FName = (char_pointer_to_string ((unsigned char *) File_Name));
+ prim = (make_primitive ("BINARY-FASLOAD"));
Fasload_Call = Free;
*Free++ = prim;
*Free++ = FName;
break;
case BOOT_LOAD_BAND: /* (LOAD-BAND <file>) */
- FName = char_pointer_to_string(File_Name);
- prim = make_primitive("LOAD-BAND");
+ FName = (char_pointer_to_string ((unsigned char *) File_Name));
+ prim = (make_primitive ("LOAD-BAND"));
Fasload_Call = Free;
*Free++ = prim;
*Free++ = FName;
Enter_Interpreter ();
}
-void
+static void
DEFUN_VOID (Enter_Interpreter)
{
Interpret (scheme_dumped_p);
gc_death_message_buffer[100];
void
-DEFUN (gc_death,
- (code, message, scan, free),
- long code AND
- char *message AND
- SCHEME_OBJECT *scan AND
- SCHEME_OBJECT *free)
+DEFUN (gc_death, (code, message, scan, free),
+ long code AND char * message
+ AND SCHEME_OBJECT * scan AND SCHEME_OBJECT * free)
{
fprintf (stderr, "\n%s.\n", message);
fprintf (stderr, "scan = 0x%lx; free = 0x%lx\n", scan, free);
}
void
-DEFUN (stack_death, (name), CONST char *name)
+DEFUN (stack_death, (name), CONST char * name)
{
fprintf (stderr,
"\n%s: Constant space is no longer sealed!\n",
fast SCHEME_OBJECT Result;
PRIMITIVE_HEADER (0);
Result = (make_vector (IDENTITY_LENGTH, SHARP_F, true));
- FAST_VECTOR_SET
- (Result, ID_RELEASE, (char_pointer_to_string (RELEASE)));
+ FAST_VECTOR_SET (Result, ID_RELEASE,
+ (char_pointer_to_string ((unsigned char *) RELEASE)));
FAST_VECTOR_SET
(Result, ID_MICRO_VERSION, (LONG_TO_UNSIGNED_FIXNUM (VERSION)));
FAST_VECTOR_SET
FAST_VECTOR_SET
(Result, ID_FLONUM_EPSILON, (double_to_flonum ((double) DBL_EPSILON)));
FAST_VECTOR_SET
- (Result, ID_OS_NAME, (char_pointer_to_string (OS_Name)));
- FAST_VECTOR_SET
- (Result, ID_OS_VARIANT, (char_pointer_to_string (OS_Variant)));
- FAST_VECTOR_SET
- (Result, ID_STACK_TYPE, (char_pointer_to_string (STACK_TYPE_STRING)));
+ (Result, ID_OS_NAME, (char_pointer_to_string ((unsigned char *) OS_Name)));
+ FAST_VECTOR_SET (Result, ID_OS_VARIANT,
+ (char_pointer_to_string ((unsigned char *) OS_Variant)));
+ FAST_VECTOR_SET (Result, ID_STACK_TYPE,
+ (char_pointer_to_string
+ ((unsigned char *) STACK_TYPE_STRING)));
PRIMITIVE_RETURN (Result);
}
\f
DEFINE_PRIMITIVE ("MICROCODE-TABLES-FILENAME", Prim_microcode_tables_filename, 0, 0, 0)
{
PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (char_pointer_to_string (option_utabmd_file));
+ PRIMITIVE_RETURN
+ (char_pointer_to_string ((unsigned char *) option_utabmd_file));
}
DEFINE_PRIMITIVE ("MICROCODE-LIBRARY-PATH", Prim_microcode_library_path, 0, 0, 0)
(allocate_marked_vector (TC_VECTOR, (end - scan), 1));
SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
while (scan < end)
- (*scan_result++) = (char_pointer_to_string (*scan++));
+ (*scan_result++) =
+ (char_pointer_to_string ((unsigned char *) *scan++));
PRIMITIVE_RETURN (result);
}
}
CONST char ** end = (scan + argc);
SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
while (scan < end)
- (*scan_result++) = (char_pointer_to_string (*scan++));
+ (*scan_result++) = (char_pointer_to_string ((unsigned char *) *scan++));
return (result);
}
PRIMITIVE_RETURN (SHARP_F);
{
SCHEME_OBJECT result =
- (memory_to_string (reload_saved_string_length, reload_saved_string));
+ (memory_to_string (reload_saved_string_length,
+ ((unsigned char *) reload_saved_string)));
free (reload_saved_string);
reload_saved_string = 0;
PRIMITIVE_RETURN (result);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 9.28 1989/09/20 23:06:31 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 9.29 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include <ctype.h>
\f
long
-arg_ascii_char (n)
- int n;
+DEFUN (arg_ascii_char, (n), int n)
{
CHECK_ARG (n, CHARACTER_P);
{
}
long
-arg_ascii_integer (n)
- int n;
+DEFUN (arg_ascii_integer, (n), int n)
{
return (arg_index_integer (n, MAX_ASCII));
}
}
\f
long
-char_downcase (c)
- fast long c;
+DEFUN (char_downcase, (c), fast long c)
{
return ((isupper (c)) ? ((c - 'A') + 'a') : c);
}
long
-char_upcase (c)
- fast long c;
+DEFUN (char_upcase, (c), fast long c)
{
return ((islower (c)) ? ((c - 'a') + 'A') : c);
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/hppa.h,v 1.24 1991/08/13 18:23:23 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/hppa.h,v 1.25 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1989-1991 Massachusetts Institute of Technology
*/
unsigned long
-hppa_extract_absolute_address (addr)
- unsigned long *addr;
+DEFUN (hppa_extract_absolute_address, (addr), unsigned long * addr)
{
union short_pointer result;
union ble_inst ble;
}
void
-hppa_store_absolute_address (addr, sourcev, nullify_p)
- unsigned long *addr, sourcev, nullify_p;
+DEFUN (hppa_store_absolute_address, (addr, sourcev, nullify_p),
+ unsigned long * addr AND unsigned long sourcev
+ AND unsigned long nullify_p)
{
union short_pointer source;
union ldil_inst ldil;
static struct pdc_cache_dump cache_info;
-extern void
- flush_i_cache (),
- push_d_cache_region ();
+extern void EXFUN (flush_i_cache, (void));
+extern void EXFUN (push_d_cache_region, (PTR, unsigned long));
void
-flush_i_cache ()
+DEFUN_VOID (flush_i_cache)
{
- extern void cache_flush_all ();
- struct pdc_cache_result *cache_desc;
+ extern void EXFUN (cache_flush_all,
+ (unsigned int, struct pdc_cache_result *));
+ struct pdc_cache_result * cache_desc;
cache_desc = ((struct pdc_cache_result *) &(cache_info.cache_format));
}
void
-push_d_cache_region (start_address, block_size)
- void *start_address;
- unsigned long block_size;
+DEFUN (push_d_cache_region, (start_address, block_size),
+ PTR start_address AND unsigned long block_size)
{
- extern void cache_flush_region ();
- struct pdc_cache_result *cache_desc;
+ extern void EXFUN (cache_flush_region, (PTR, long, unsigned int));
+ struct pdc_cache_result * cache_desc;
cache_desc = ((struct pdc_cache_result *) &(cache_info.cache_format));
{
cache_flush_region (start_address, block_size, D_CACHE);
cache_flush_region (start_address, 1, I_CACHE);
- cache_flush_region (((void *)
+ cache_flush_region (((PTR)
(((unsigned long *) start_address)
+ (block_size - 1))),
1,
#define MODELS_FILENAME "HPPAmodels"
#endif
-void
-flush_i_cache_initialize ()
+static void
+DEFUN_VOID (flush_i_cache_initialize)
{
struct utsname sysinfo;
CONST char * models_filename =
/* A NOP on machines where instructions are longword-aligned. */
-#define ADJUST_CLOSURE_AT_CALL(entry_point, location) \
-do { \
+#define ADJUST_CLOSURE_AT_CALL(entry_point, location) do \
+{ \
} while (0)
/* Compiled closures */
On PA this is a NOP.
*/
-#define STORE_EXECUTE_CACHE_CODE(address) \
+#define STORE_EXECUTE_CACHE_CODE(address) do \
{ \
-}
+} while (0)
/* This is supposed to flush the Scheme portion of the I-cache.
It flushes the entire I-cache instead, since it is easier.
#define FLUSH_I_CACHE() do \
{ \
- extern void flush_i_cache (); \
+ extern void EXFUN (flush_i_cache, (void)); \
\
flush_i_cache (); \
} while (0)
#define FLUSH_I_CACHE_REGION(address, nwords) do \
{ \
- extern void cache_flush_region (); \
+ extern void EXFUN (cache_flush_region, (PTR, long, unsigned int)); \
\
- cache_flush_region (((void *) (address)), (nwords), \
+ cache_flush_region (((PTR) (address)), ((long) (nwords)), \
(D_CACHE | I_CACHE)); \
} while (0)
#define PUSH_D_CACHE_REGION(address, nwords) do \
{ \
- extern void push_d_cache_region (); \
+ extern void EXFUN (push_d_cache_region, (PTR, unsigned long)); \
\
- push_d_cache_region (((unsigned long *) (address)), \
+ push_d_cache_region (((PTR) (address)), \
((unsigned long) (nwords))); \
} while (0)
#ifdef IN_CMPINT_C
long
-DEFUN (assemble_17,
- (inst),
- union ble_inst inst)
+DEFUN (assemble_17, (inst), union ble_inst inst)
{
union bl_offset off;
#include <magic.h>
-void **
-DEFUN (transform_procedure_table,
- (table_length, old_table),
- long table_length AND
- void **old_table)
+PTR *
+DEFUN (transform_procedure_table, (table_length, old_table),
+ long table_length AND PTR * old_table)
{
- void **new_table;
+ PTR * new_table;
long counter;
- new_table = ((void **) (malloc (table_length * (sizeof (void *)))));
- if (new_table == ((void **) NULL))
+ new_table = ((PTR *) (malloc (table_length * (sizeof (PTR)))));
+ if (new_table == ((PTR *) NULL))
{
fprintf (stderr,
"transform_procedure_table: malloc (%d) failed.\n",
- (table_length * (sizeof (void *))));
+ (table_length * (sizeof (PTR))));
exit (1);
}
/* Test for HP-UX >= 8.0 */
#if defined(SHL_MAGIC) && !defined(__GNUC__)
- char *C_closure, *blp;
+ char * C_closure, * blp;
long offset;
- C_closure = ((char *) (old_table[counter]));
+ C_closure = ((char *) (old_table [counter]));
blp = (* ((char **) (C_closure - 2)));
blp = ((char *) (((unsigned long) blp) & ~3));
offset = (assemble_17 (* ((union ble_inst *) blp)));
- new_table[counter] = ((void *) ((blp + 8) + offset));
+ new_table[counter] = ((PTR) ((blp + 8) + offset));
#else
- new_table[counter] = ((void *) old_table[counter]);
+ new_table[counter] = ((PTR) (old_table [counter]));
#endif
}
return (new_table);
function pointer closure format problems for utilities for HP-UX >= 8.0 .
*/
-extern void **hppa_utility_table;
-void **hppa_utility_table;
+extern PTR * hppa_utility_table;
+PTR * hppa_utility_table;
void
-DEFUN (hppa_reset_hook,
- (table_length, utility_table),
- long table_length AND
- void **utility_table)
+DEFUN (hppa_reset_hook, (table_length, utility_table),
+ long table_length AND PTR * utility_table)
{
- extern void interface_initialize ();
+ extern void EXFUN (interface_initialize, (void));
flush_i_cache_initialize ();
interface_initialize ();
return;
}
-#define ASM_RESET_HOOK() \
-do { \
- hppa_reset_hook (((sizeof (utility_table)) / (sizeof (void *))), \
+#define ASM_RESET_HOOK() do \
+{ \
+ hppa_reset_hook (((sizeof (utility_table)) / (sizeof (PTR))), \
&utility_table[0]); \
} while (0)
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.20 1991/03/06 22:57:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.21 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
#include "prims.h"
extern SCHEME_OBJECT
- *compiled_entry_to_block_address();
+ * EXFUN (compiled_entry_to_block_address, (SCHEME_OBJECT));
extern long
- compiled_entry_to_block_offset(),
- coerce_to_compiled();
+ EXFUN (compiled_entry_to_block_offset, (SCHEME_OBJECT)),
+ EXFUN (coerce_to_compiled, (SCHEME_OBJECT, long, SCHEME_OBJECT *));
-extern void
- compiled_entry_type();
+extern void EXFUN (compiled_entry_type, (SCHEME_OBJECT, long *));
\f
DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->BLOCK", Prim_comp_code_address_block, 1, 1,
"Given a compiled code address, return its compiled code block.")
DEFINE_PRIMITIVE ("COMPILED-CLOSURE->ENTRY", Prim_compiled_closure_to_entry, 1, 1,
"Given a compiled closure, return the entry point which it invokes.")
{
- SCHEME_OBJECT entry_type [3];
+ long entry_type [3];
SCHEME_OBJECT closure;
- extern void compiled_entry_type ();
- extern long compiled_entry_closure_p ();
- extern SCHEME_OBJECT compiled_closure_to_entry ();
+ extern long EXFUN (compiled_entry_closure_p, (SCHEME_OBJECT));
+ extern SCHEME_OBJECT EXFUN (compiled_closure_to_entry, (SCHEME_OBJECT));
PRIMITIVE_HEADER (1);
CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/critsec.h,v 1.1 1990/06/20 19:35:41 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/critsec.h,v 1.2 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
extern char * critical_section_name;
extern int critical_section_hook_p;
-extern void (*critical_section_hook) ();
+extern void EXFUN ((*critical_section_hook), (char *));
#define DECLARE_CRITICAL_SECTION() \
char * critical_section_name = 0; \
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/daemon.c,v 9.28 1990/06/20 17:39:39 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/daemon.c,v 9.29 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
garbage collection, and at most that much is allocated now.
Therefore, there is no gc check here. */
-void
-rehash_pair (pair, hash_table, table_size)
- SCHEME_OBJECT pair, hash_table;
- long table_size;
-{ long object_datum, hash_address;
- SCHEME_OBJECT *new_pair;
+static void
+DEFUN (rehash_pair, (pair, hash_table, table_size),
+ SCHEME_OBJECT pair AND SCHEME_OBJECT hash_table
+ AND long table_size)
+{
+ long object_datum, hash_address;
+ SCHEME_OBJECT * new_pair;
- object_datum = OBJECT_DATUM (FAST_PAIR_CAR (pair));
- hash_address = 2+(object_datum % table_size);
+ object_datum = (OBJECT_DATUM (FAST_PAIR_CAR (pair)));
+ hash_address = (2 + (object_datum % table_size));
new_pair = Free;
*Free++ = (OBJECT_NEW_TYPE (TC_LIST, pair));
- *Free++ = FAST_MEMORY_REF (hash_table, hash_address);
+ *Free++ = (FAST_MEMORY_REF (hash_table, hash_address));
FAST_MEMORY_SET (hash_table,
hash_address,
- MAKE_POINTER_OBJECT (TC_LIST, new_pair));
+ (MAKE_POINTER_OBJECT (TC_LIST, new_pair)));
return;
}
-void
-rehash_bucket (bucket, hash_table, table_size)
- SCHEME_OBJECT *bucket, hash_table;
- long table_size;
-{ fast SCHEME_OBJECT weak_pair;
+static void
+DEFUN (rehash_bucket, (bucket, hash_table, table_size),
+ SCHEME_OBJECT * bucket AND SCHEME_OBJECT hash_table
+ AND long table_size)
+{
+ fast SCHEME_OBJECT weak_pair;
+
while (*bucket != EMPTY_LIST)
- { weak_pair = FAST_PAIR_CAR (*bucket);
- if (FAST_PAIR_CAR (weak_pair) != SHARP_F)
- { rehash_pair(weak_pair, hash_table, table_size);
+ {
+ weak_pair = (FAST_PAIR_CAR (*bucket));
+ if ((FAST_PAIR_CAR (weak_pair)) != SHARP_F)
+ {
+ rehash_pair (weak_pair, hash_table, table_size);
}
- bucket = PAIR_CDR_LOC (*bucket);
+ bucket = (PAIR_CDR_LOC (*bucket));
}
return;
}
-void
-splice_and_rehash_bucket(bucket, hash_table, table_size)
- SCHEME_OBJECT *bucket, hash_table;
- long table_size;
-{ fast SCHEME_OBJECT weak_pair;
- while (*bucket != EMPTY_LIST)
- { weak_pair = FAST_PAIR_CAR (*bucket);
- if (FAST_PAIR_CAR (weak_pair) != SHARP_F)
- { rehash_pair(weak_pair, hash_table, table_size);
- bucket = PAIR_CDR_LOC (*bucket);
+static void
+DEFUN (splice_and_rehash_bucket, (bucket, hash_table, table_size),
+ SCHEME_OBJECT * bucket AND SCHEME_OBJECT hash_table
+ AND long table_size)
+{
+ fast SCHEME_OBJECT weak_pair;
+
+ while ((*bucket) != EMPTY_LIST)
+ {
+ weak_pair = (FAST_PAIR_CAR (*bucket));
+ if ((FAST_PAIR_CAR (weak_pair)) != SHARP_F)
+ {
+ rehash_pair (weak_pair, hash_table, table_size);
+ bucket = (PAIR_CDR_LOC (*bucket));
}
else
- { *bucket = FAST_PAIR_CDR (*bucket);
- }
+ *bucket = (FAST_PAIR_CDR (*bucket));
}
return;
}
long table_size, counter;
SCHEME_OBJECT *bucket;
PRIMITIVE_HEADER (2);
- table_size = VECTOR_LENGTH (ARG_REF (1));
+ table_size = (VECTOR_LENGTH (ARG_REF (1)));
/* First cleanup the hash table */
counter = table_size;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/debug.c,v 9.38 1991/08/26 15:00:09 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/debug.c,v 9.39 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#include "trap.h"
#include "lookup.h"
-static void do_printing ();
-static Boolean print_primitive_name ();
+static void EXFUN (do_printing, (SCHEME_OBJECT, Boolean));
+static Boolean EXFUN (print_primitive_name, (SCHEME_OBJECT));
\f
/* Compiled Code Debugging */
static SCHEME_OBJECT
-compiled_block_debug_filename (block)
- SCHEME_OBJECT block;
+DEFUN (compiled_block_debug_filename, (block), SCHEME_OBJECT block)
{
- extern SCHEME_OBJECT compiled_block_debugging_info ();
+ extern SCHEME_OBJECT EXFUN (compiled_block_debugging_info, (SCHEME_OBJECT));
SCHEME_OBJECT info;
info = (compiled_block_debugging_info (block));
: SHARP_F);
}
-extern SCHEME_OBJECT *compiled_entry_to_block_address();
+extern SCHEME_OBJECT
+ * EXFUN (compiled_entry_to_block_address, (SCHEME_OBJECT));
#define COMPILED_ENTRY_TO_BLOCK(entry) \
(MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, \
(compiled_entry_to_block_address (entry))))
static SCHEME_OBJECT
-compiled_entry_debug_filename (entry)
- SCHEME_OBJECT entry;
+DEFUN (compiled_entry_debug_filename, (entry), SCHEME_OBJECT entry)
{
SCHEME_OBJECT results [3];
extern void compiled_entry_type ();
}
char *
-compiled_entry_filename (entry)
- SCHEME_OBJECT entry;
+DEFUN (compiled_entry_filename, (entry), SCHEME_OBJECT entry)
{
SCHEME_OBJECT result;
}
\f
void
-Show_Pure ()
+DEFUN_VOID (Show_Pure)
{
SCHEME_OBJECT *Obj_Address;
long Pure_Size, Total_Size;
}
\f
void
-Show_Env (The_Env)
- SCHEME_OBJECT The_Env;
+DEFUN (Show_Env, (The_Env), SCHEME_OBJECT The_Env)
{
SCHEME_OBJECT *name_ptr, procedure, *value_ptr, extension;
long count, i;
name_ptr = MEMORY_LOC (*name_ptr, 2);
for (i = 0; i < count; i++)
{
- Print_Expression(*name_ptr++, "Name ");
- Print_Expression(*value_ptr++, " Value ");
+ Print_Expression (*name_ptr++, "Name ");
+ Print_Expression (*value_ptr++, " Value ");
printf ("\n");
}
if (extension != SHARP_F)
}
\f
static void
-print_list (pair)
- SCHEME_OBJECT pair;
+DEFUN (print_list, (pair), SCHEME_OBJECT pair)
{
int count;
}
static void
-print_return_name (Ptr)
- SCHEME_OBJECT Ptr;
+DEFUN (print_return_name, (Ptr), SCHEME_OBJECT Ptr)
{
long index;
char * name;
}
void
-Print_Return (String)
- char * String;
+DEFUN (Print_Return, (String), char * String)
{
printf ("%s: ", String);
print_return_name (Fetch_Return ());
}
\f
static void
-print_string (string)
- SCHEME_OBJECT string;
+DEFUN (print_string, (string), SCHEME_OBJECT string)
{
long length;
long i;
}
static void
-print_symbol (symbol)
- SCHEME_OBJECT symbol;
+DEFUN (print_symbol, (symbol), SCHEME_OBJECT symbol)
{
SCHEME_OBJECT string;
long length;
}
\f
static void
-print_filename (filename)
- SCHEME_OBJECT filename;
+DEFUN (print_filename, (filename), SCHEME_OBJECT filename)
{
long length;
char * scan;
return;
}
-void
-print_object (object)
- SCHEME_OBJECT object;
+static void
+DEFUN (print_object, (object), SCHEME_OBJECT object)
{
do_printing (object, true);
printf ("\n");
return (SHARP_F);
}
-void
-print_objects (objects, n)
- SCHEME_OBJECT * objects;
- int n;
+static void
+DEFUN (print_objects, (objects, n),
+ SCHEME_OBJECT * objects AND int n)
{
SCHEME_OBJECT * scan;
SCHEME_OBJECT * end;
represent named structures, and most named structures don't want to
be printed out explicitly. */
-void
-print_vector (vector)
- SCHEME_OBJECT vector;
+static void
+DEFUN (print_vector, (vector), SCHEME_OBJECT vector)
{
print_objects
((MEMORY_LOC (vector, 1)), (OBJECT_DATUM (VECTOR_LENGTH (vector))));
if ((string [0]) != 0)
printf ("%s: ", string);
do_printing (expression, true);
+ return;
}
extern char * Type_Names [];
static void
-do_printing (Expr, Detailed)
- SCHEME_OBJECT Expr;
- Boolean Detailed;
+DEFUN (do_printing, (Expr, Detailed),
+ SCHEME_OBJECT Expr AND Boolean Detailed)
{
long Temp_Address;
Boolean handled_p;
return;
}
\f
-Boolean
-Print_One_Continuation_Frame (Temp)
- SCHEME_OBJECT Temp;
+static Boolean
+DEFUN (Print_One_Continuation_Frame, (Temp), SCHEME_OBJECT Temp)
{
SCHEME_OBJECT Expr;
*/
void
-Back_Trace (where)
- FILE *where;
+DEFUN (Back_Trace, (where), FILE * where)
{
- SCHEME_OBJECT Temp, *Old_Stack;
+ SCHEME_OBJECT Temp, * Old_Stack;
Back_Trace_Entry_Hook();
Old_Stack = Stack_Pointer;
return;
}
-void
-print_stack (sp)
- SCHEME_OBJECT * sp;
+static void
+DEFUN (print_stack, (sp), SCHEME_OBJECT * sp)
{
SCHEME_OBJECT * saved_sp;
}
\f
static Boolean
-print_primitive_name (primitive)
- SCHEME_OBJECT primitive;
+DEFUN (print_primitive_name, (primitive), SCHEME_OBJECT primitive)
{
extern char *primitive_to_name();
char *name;
}
void
-Print_Primitive (primitive)
- SCHEME_OBJECT primitive;
+DEFUN (Print_Primitive, (primitive), SCHEME_OBJECT primitive)
{
extern long primitive_to_arity();
- char buffer1[40], buffer2[40];
+ char buffer[40];
int NArgs, i;
printf ("Primitive: ");
for (i = 0; i < NArgs; i++)
{
- sprintf (buffer1, "STACK_REF (%d)", i);
- sprintf (buffer2, "...Arg %d", (i + 1));
- Print_Expression(buffer1, buffer2);
+ sprintf (buffer, "...Arg %d", (i + 1));
+ Print_Expression ((STACK_REF (i)), buffer);
printf ("\n");
}
+ return;
}
\f
/* Code for interactively setting and clearing the interpreter
i, (flag_name (i)), (value ? "set" : "clear"));
}
fflush (stdout);
+ return;
}
static int
(*flag) = value;
SET_FLAG_HOOK (flag);
}
+ return (0);
}
static int
DEFUN (debug_getdec, (string), CONST char * string)
{
int result;
+
sscanf (string, "%d", (&result));
return (result);
}
{
fprintf (stderr, "Not a debugging version. No flags to handle.\n");
fflush (stderr);
+ return;
}
#endif /* not ENABLE_DEBUGGING_TOOLS */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/dfloat.c,v 1.2 1991/08/14 02:02:53 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/dfloat.c,v 1.3 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1991 Massachusetts Institute of Technology
(arg_index_integer (argument_number, \
((VECTOR_LENGTH (vector)) / FLONUM_SIZE)))
-extern SCHEME_OBJECT allocate_non_marked_vector ();
-
DEFINE_PRIMITIVE ("FLOATING-VECTOR-CONS", Prim_floating_vector_cons, 1, 1, 0)
-{ long length = (arg_nonnegative_integer (1));
+{
+ long length = (arg_nonnegative_integer (1));
long length_in_words = length * FLONUM_SIZE;
SCHEME_OBJECT result;
fast double *vect;
PRIMITIVE_RETURN (FLOAT_TO_FLONUM(*where));
}
-extern double arg_flonum ();
+extern double EXFUN (arg_flonum, (int));
DEFINE_PRIMITIVE( "FLOATING-VECTOR-SET!", Prim_floating_vector_set,
3, 3, 0)
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.c,v 9.30 1990/02/13 16:00:06 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.c,v 9.31 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
PRIMITIVE_RETURN
((answer == ((char *) 0))
? SHARP_F
- : (char_pointer_to_string (answer)));
+ : (char_pointer_to_string ((unsigned char *) answer)));
}
}
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.41 1991/08/26 15:00:11 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.42 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
extern SCHEME_OBJECT * Highest_Allocated_Address;
\f
/* Environment lookup utilities. */
-extern long Lex_Ref ();
-extern long Local_Set ();
-extern long Lex_Set ();
-extern long Symbol_Lex_Ref ();
-extern long Symbol_Lex_Set ();
+extern long EXFUN (Lex_Ref, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern long EXFUN (Local_Set, (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT));
+extern long EXFUN (Lex_Set, (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT));
+extern long EXFUN (Symbol_Lex_Ref, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern long EXFUN (Symbol_Lex_Set,
+ (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT));
/* Arithmetic utilities */
-extern long fixnum_to_long ();
-extern SCHEME_OBJECT double_to_fixnum ();
-extern SCHEME_OBJECT double_to_flonum ();
-extern Boolean integer_to_long_p ();
-extern long integer_to_long ();
-extern SCHEME_OBJECT long_to_integer ();
-extern Boolean integer_to_double_p ();
-extern double integer_to_double ();
-extern SCHEME_OBJECT double_to_integer ();
-extern double double_truncate ();
-extern Boolean real_number_to_double_p ();
-extern double real_number_to_double ();
-extern SCHEME_OBJECT bignum_to_fixnum ();
-extern SCHEME_OBJECT bignum_to_integer ();
-extern SCHEME_OBJECT bignum_to_flonum ();
-extern SCHEME_OBJECT flonum_floor ();
-extern SCHEME_OBJECT flonum_ceiling ();
-extern SCHEME_OBJECT flonum_round ();
-extern SCHEME_OBJECT flonum_normalize ();
-extern SCHEME_OBJECT flonum_denormalize ();
-extern Boolean integer_zero_p ();
-extern Boolean integer_negative_p ();
-extern Boolean integer_positive_p ();
-extern Boolean integer_equal_p ();
-extern Boolean integer_less_p ();
-extern SCHEME_OBJECT integer_negate ();
-extern SCHEME_OBJECT integer_add ();
-extern SCHEME_OBJECT integer_add_1 ();
-extern SCHEME_OBJECT integer_subtract ();
-extern SCHEME_OBJECT integer_subtract_1 ();
-extern SCHEME_OBJECT integer_multiply ();
-extern Boolean integer_divide ();
-extern SCHEME_OBJECT integer_quotient ();
-extern SCHEME_OBJECT integer_remainder ();
+extern long EXFUN (fixnum_to_long, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (double_to_fixnum, (double));
+extern SCHEME_OBJECT EXFUN (double_to_flonum, (double));
+extern Boolean EXFUN (integer_to_long_p, (SCHEME_OBJECT));
+extern long EXFUN (integer_to_long, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (long_to_integer, (long));
+extern Boolean EXFUN (integer_to_double_p, (SCHEME_OBJECT));
+extern double EXFUN (integer_to_double, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (double_to_integer, (double));
+extern double EXFUN (double_truncate, (double));
+extern Boolean EXFUN (real_number_to_double_p, (SCHEME_OBJECT));
+extern double EXFUN (real_number_to_double, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (bignum_to_fixnum, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (bignum_to_integer, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (bignum_to_flonum, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (flonum_floor, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (flonum_ceiling, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (flonum_round, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (flonum_normalize, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (flonum_denormalize,
+ (SCHEME_OBJECT, SCHEME_OBJECT));
+extern Boolean EXFUN (integer_zero_p, (SCHEME_OBJECT));
+extern Boolean EXFUN (integer_negative_p, (SCHEME_OBJECT));
+extern Boolean EXFUN (integer_positive_p, (SCHEME_OBJECT));
+extern Boolean EXFUN (integer_equal_p, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern Boolean EXFUN (integer_less_p, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (integer_negate, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (integer_add, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (integer_add_1, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (integer_subtract, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (integer_subtract_1, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (integer_multiply, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern Boolean EXFUN (integer_divide,
+ (SCHEME_OBJECT, SCHEME_OBJECT,
+ SCHEME_OBJECT *, SCHEME_OBJECT *));
+extern SCHEME_OBJECT EXFUN (integer_quotient, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (integer_remainder, (SCHEME_OBJECT, SCHEME_OBJECT));
/* Character utilities */
-extern long char_downcase ();
-extern long char_upcase ();
+extern long EXFUN (char_downcase, (long));
+extern long EXFUN (char_upcase, (long));
/* Allocation utilities */
-extern SCHEME_OBJECT cons ();
-extern SCHEME_OBJECT system_pair_cons ();
-extern SCHEME_OBJECT hunk3_cons ();
-extern SCHEME_OBJECT allocate_non_marked_vector ();
-extern SCHEME_OBJECT allocate_marked_vector ();
-extern SCHEME_OBJECT make_vector ();
-extern SCHEME_OBJECT allocate_string ();
-extern SCHEME_OBJECT memory_to_string ();
-extern SCHEME_OBJECT char_pointer_to_string ();
+extern SCHEME_OBJECT EXFUN (cons, (SCHEME_OBJECT, SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (system_pair_cons,
+ (long, SCHEME_OBJECT, SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (hunk3_cons,
+ (SCHEME_OBJECT, SCHEME_OBJECT, SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN (allocate_non_marked_vector, (int, long, Boolean));
+extern SCHEME_OBJECT EXFUN (allocate_marked_vector, (int, long, Boolean));
+extern SCHEME_OBJECT EXFUN (make_vector, (long, SCHEME_OBJECT, Boolean));
+extern SCHEME_OBJECT EXFUN (allocate_string, (long));
+extern SCHEME_OBJECT EXFUN (memory_to_string, (long, unsigned char *));
+extern SCHEME_OBJECT EXFUN (char_pointer_to_string, (unsigned char *));
/* Random and OS utilities */
-extern Boolean Restore_History ();
-extern Boolean interpreter_applicable_p ();
+extern Boolean EXFUN (Restore_History, (SCHEME_OBJECT));
+extern Boolean EXFUN (interpreter_applicable_p, (SCHEME_OBJECT));
extern void EXFUN
(add_reload_cleanup, (void EXFUN ((*cleanup_procedure), (void))));
/* Memory management utilities */
-extern SCHEME_OBJECT Purify_Pass_2 ();
-extern SCHEME_OBJECT Fasload ();
-extern Boolean Pure_Test ();
+
+extern SCHEME_OBJECT EXFUN (Purify_Pass_2, (SCHEME_OBJECT));
+extern Boolean EXFUN (Pure_Test, (SCHEME_OBJECT *));
\f
/* Interpreter utilities */
extern void EXFUN (preserve_interrupt_mask, (void));
extern void EXFUN (back_out_of_primitive, (void));
-extern void
- Interpret (),
- Do_Micro_Error (),
- Translate_To_Point (),
- Stop_History (),
- Stack_Death ();
-
-#ifdef USE_STACKLETS
-extern void Allocate_New_Stacklet ();
-#endif
+extern void EXFUN (Interpret, (Boolean));
+extern void EXFUN (Do_Micro_Error, (long, Boolean));
+extern void EXFUN (Translate_To_Point, (SCHEME_OBJECT));
+extern void EXFUN (Stop_History, (void));
+extern void EXFUN (Stack_Death, (void));
-extern SCHEME_OBJECT * Make_Dummy_History ();
-extern SCHEME_OBJECT Find_State_Space ();
+extern SCHEME_OBJECT * EXFUN (Make_Dummy_History, (void));
+extern SCHEME_OBJECT EXFUN (Find_State_Space, (SCHEME_OBJECT));
/* Debugging utilities */
extern void EXFUN (debug_edit_flags, (void));
-extern void
- Back_Trace (),
- Show_Env (),
- Show_Pure (),
- Print_Return (),
- Print_Expression (),
- Print_Primitive ();
+extern void EXFUN (Back_Trace, (FILE *));
+extern void EXFUN (Show_Env, (SCHEME_OBJECT));
+extern void EXFUN (Show_Pure, (void));
+extern void EXFUN (Print_Return, (char *));
+extern void EXFUN (Print_Expression, (SCHEME_OBJECT, char *));
+extern void EXFUN (Print_Primitive, (SCHEME_OBJECT));
/* Conditional utilities */
+#ifdef USE_STACKLETS
+extern void EXFUN (Allocate_New_Stacklet, (long));
+#endif
+
#if false
-extern void Clear_Perfinfo_Data ();
+extern void EXFUN (Clear_Perfinfo_Data, ());
#endif
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.51 1991/05/10 00:07:08 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.52 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
#include "dump.c"
extern SCHEME_OBJECT
- dump_renumber_primitive (),
- *initialize_primitive_table (),
- *cons_primitive_table (),
- *cons_whole_primitive_table ();
+ EXFUN (dump_renumber_primitive, (SCHEME_OBJECT)),
+ * EXFUN (initialize_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *)),
+ * EXFUN (cons_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)),
+ * EXFUN (cons_whole_primitive_table,
+ (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
\f
/* Some statics used freely in this file */
#define FASDUMP_FIX_BUFFER 10
long
-DEFUN (DumpLoop, (Scan, mode),
- fast SCHEME_OBJECT *Scan AND int mode)
+DEFUN (DumpLoop, (Scan, mode), fast SCHEME_OBJECT * Scan AND int mode)
{
fast SCHEME_OBJECT *To, *Old, Temp, New_Address, *Fixes;
long result;
}
SCHEME_OBJECT
-DEFUN (Fasdump_Exit, (code, close_p),
- long code AND
- Boolean close_p)
+DEFUN (Fasdump_Exit, (code, close_p), long code AND Boolean close_p)
{
Boolean result;
fast SCHEME_OBJECT *Fixes;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.62 1991/05/05 00:45:46 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.63 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-1991 Massachusetts Institute of Technology
#include "load.c"
-extern char * malloc ();
+extern char * EXFUN (malloc, (int));
extern char * Error_Names [];
extern char * Abort_Names [];
extern SCHEME_OBJECT * load_renumber_table;
extern SCHEME_OBJECT compiler_utilities;
-extern SCHEME_OBJECT intern_symbol ();
-extern void install_primitive_table ();
-extern void compiler_reset_error ();
-extern void compiler_initialize ();
-extern void compiler_reset ();
+extern SCHEME_OBJECT EXFUN (intern_symbol, (SCHEME_OBJECT));
+extern void EXFUN (install_primitive_table,
+ (SCHEME_OBJECT *, long, Boolean));
+extern void EXFUN (compiler_reset_error, (void));
+extern void EXFUN (compiler_initialize, (long));
+extern void EXFUN (compiler_reset, (SCHEME_OBJECT));
\f
static long failed_heap_length = -1;
static void
DEFUN (read_channel_continue, (header, mode, repeat_p),
- SCHEME_OBJECT *header AND
- int mode AND
- Boolean repeat_p)
+ SCHEME_OBJECT * header AND int mode AND Boolean repeat_p)
{
long value, heap_length;
}
\f
static void
-DEFUN (read_channel_start, (channel, mode),
- Tchannel channel AND
- int mode)
+DEFUN (read_channel_start, (channel, mode), Tchannel channel AND int mode)
{
load_channel = channel;
static void
DEFUN (read_file_start, (file_name, from_band_load),
- CONST char * file_name AND
- Boolean from_band_load)
+ CONST char * file_name AND Boolean from_band_load)
{
Tchannel channel;
static Boolean Warned = false;
-SCHEME_OBJECT *
+static SCHEME_OBJECT *
DEFUN (Relocate, (P), long P)
{
SCHEME_OBJECT *Result;
block of memory.
*/
-void
+static void
DEFUN (Relocate_Block, (Scan, Stop_At),
- fast SCHEME_OBJECT *Scan AND
- fast SCHEME_OBJECT *Stop_At)
+ fast SCHEME_OBJECT * Scan AND fast SCHEME_OBJECT * Stop_At)
{
fast long address;
fast SCHEME_OBJECT Temp;
return;
}
\f
-Boolean
+static Boolean
DEFUN (check_primitive_numbers, (table, length),
- fast SCHEME_OBJECT *table AND
- fast long length)
+ fast SCHEME_OBJECT * table AND fast long length)
{
fast long count, top;
return (true);
}
+extern void EXFUN (get_band_parameters, (long * heap_size, long * const_size));
+
void
DEFUN (get_band_parameters, (heap_size, const_size),
- long * heap_size AND
- long * const_size)
+ long * heap_size AND long * const_size)
{
/* This assumes we have just aborted out of a band load. */
(*heap_size) = Heap_Count;
(*const_size) = Const_Count;
}
\f
-void
+static void
DEFUN (Intern_Block, (Next_Pointer, Stop_At),
- fast SCHEME_OBJECT *Next_Pointer AND
- fast SCHEME_OBJECT *Stop_At)
+ fast SCHEME_OBJECT * Next_Pointer AND fast SCHEME_OBJECT * Stop_At)
{
if (Reloc_Debug)
{
#define COMPUTE_RELOCATION(new, old) (((relocation_type) (new)) - (old))
#endif
-SCHEME_OBJECT
+static SCHEME_OBJECT
DEFUN (load_file, (mode), int mode)
{
SCHEME_OBJECT
Intern_Block (Orig_Constant, Constant_End);
}
- FASLOAD_RELOCATE_HOOK (Orig_Heap, primitive_table, Orig_Constant, Constant_End);
+ FASLOAD_RELOCATE_HOOK (Orig_Heap, primitive_table,
+ Orig_Constant, Constant_End);
Relocate_Into (temp, Dumped_Object);
return (*temp);
}
}
SCHEME_OBJECT
-DEFUN (continue_fasload, (reentry_record), SCHEME_OBJECT *reentry_record)
+DEFUN (continue_fasload, (reentry_record), SCHEME_OBJECT * reentry_record)
{
SCHEME_OBJECT header;
PRIMITIVE_HEADER (0);
PRIMITIVE_RETURN
((reload_band_name != 0)
- ? (char_pointer_to_string (reload_band_name))
+ ? (char_pointer_to_string ((unsigned char *) reload_band_name))
: (option_band_file != 0)
- ? (char_pointer_to_string (option_band_file))
+ ? (char_pointer_to_string ((unsigned char *) option_band_file))
: SHARP_F);
}
SCHEME_OBJECT String_Chain, Last_String;
-Setup_For_String_Inversion ()
+void
+DEFUN_VOID (Setup_For_String_Inversion)
{
String_Chain = SHARP_F;
Last_String = SHARP_F;
return;
}
-Finish_String_Inversion ()
+void
+DEFUN_VOID (Finish_String_Inversion)
{
if (Byte_Invert_Fasl_Files)
{
#define print_char(C) printf (((C < ' ') || (C > '|')) ? \
"\\%03o" : "%c", (C && MAX_CHAR));
-String_Inversion (Orig_Pointer)
- SCHEME_OBJECT *Orig_Pointer;
+void
+DEFUN (String_Inversion, (Orig_Pointer), SCHEME_OBJECT * Orig_Pointer)
{
SCHEME_OBJECT *Pointer_Address;
char *To_Char;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.63 1991/07/18 15:58:12 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.64 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
}
void
-Interpret(dumped_p)
- Boolean dumped_p;
+DEFUN (Interpret, (dumped_p), Boolean dumped_p)
{
long Which_Way;
fast SCHEME_OBJECT *Reg_Block, *Reg_Stack_Pointer, *Reg_History;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osscheme.c,v 1.2 1991/03/01 00:55:11 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osscheme.c,v 1.3 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
long address AND
CONST char * label)
{
- Print_Expression ((* ((SCHEME_OBJECT *) address)), label);
+ Print_Expression ((* ((SCHEME_OBJECT *) address)), ((char *) label));
}
/* -*-C-*-
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/primutl.c,v 9.53 1991/10/29 22:55:11 jinx Exp $
+
+Copyright (c) 1988-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/primutl.c,v 9.52 1989/09/21 22:48:51 cph Rel $
- *
+/*
* This file contains the support routines for mapping primitive names
* to numbers within the microcode. Primitives are written in C
* and available in Scheme, but not always present in all versions of
/* Common utilities. */
static int
-strcmp_ci (s1, s2)
- fast char * s1;
- fast char * s2;
+DEFUN (strcmp_ci, (s1, s2), fast char * s1 AND fast char * s2)
{
int length1 = (strlen (s1));
int length2 = (strlen (s2));
#include "prename.h"
static char *
-primitive_alias_to_name (alias)
- char *alias;
+DEFUN (primitive_alias_to_name, (alias), char * alias)
{
fast struct primitive_alias *alias_ptr;
fast struct primitive_alias *alias_end;
/* This version performs an expensive linear search. */
long
-primitive_name_to_code(name, table, size)
- char *name;
- char *table[];
- int size;
+DEFUN (primitive_name_to_code, (name, table, size),
+ char * name AND char * table[] AND int size)
{
fast int i;
*/
long
-primitive_name_to_code(name, table, size)
- char *name;
- fast char *table[];
- int size;
+DEFUN (primitive_name_to_code, (name, table, size),
+ char * name AND fast char *table[] AND int size)
{
fast int low, high, middle, result;
while(low < high)
{
middle = ((low + high) / 2);
- result = strcmp_ci(name, table[middle]);
+ result = strcmp_ci (name, table[middle]);
if (result < 0)
{
high = (middle - 1);
#endif /* false */
\f
long
-primitive_code_to_arity(number)
- long number;
+DEFUN (primitive_code_to_arity, (number), long number)
{
if (number <= MAX_PRIMITIVE)
{
}
char *
-primitive_code_to_documentation (number)
- long number;
+DEFUN (primitive_code_to_documentation, (number), long number)
{
return
((number > MAX_PRIMITIVE)
\f
/* Externally visible utilities */
-extern SCHEME_OBJECT make_primitive();
+extern SCHEME_OBJECT EXFUN (make_primitive, (char *));
SCHEME_OBJECT
-make_primitive(name)
- char *name;
+DEFUN (make_primitive, (name), char * name)
{
SCHEME_OBJECT search_for_primitive();
UNKNOWN_PRIMITIVE_ARITY));
}
-extern SCHEME_OBJECT find_primitive();
+extern SCHEME_OBJECT EXFUN
+ (find_primitive, (SCHEME_OBJECT, Boolean, Boolean, int));
SCHEME_OBJECT
-find_primitive(name, intern_p, allow_p, arity)
- SCHEME_OBJECT name;
- Boolean intern_p, allow_p;
- int arity;
+DEFUN (find_primitive, (name, intern_p, allow_p, arity),
+ SCHEME_OBJECT name
+ AND Boolean intern_p AND Boolean allow_p
+ AND int arity)
{
SCHEME_OBJECT search_for_primitive();
intern_p, allow_p, arity));
}
\f
-extern long primitive_to_arity();
+extern long EXFUN (primitive_to_arity, (SCHEME_OBJECT));
long
-primitive_to_arity(primitive)
- SCHEME_OBJECT primitive;
+DEFUN (primitive_to_arity, (primitive), SCHEME_OBJECT primitive)
{
return (primitive_code_to_arity(PRIMITIVE_NUMBER(primitive)));
}
-extern char * primitive_to_documentation ();
+extern char * EXFUN (primitive_to_documentation, (SCHEME_OBJECT));
char *
-primitive_to_documentation (primitive)
- SCHEME_OBJECT primitive;
+DEFUN (primitive_to_documentation, (primitive), SCHEME_OBJECT primitive)
{
return (primitive_code_to_documentation (PRIMITIVE_NUMBER (primitive)));
}
-extern long primitive_to_arguments();
+extern long EXFUN (primitive_to_arguments, (SCHEME_OBJECT));
/*
This is only valid during the invocation of a primitive.
*/
long
-primitive_to_arguments(primitive)
- SCHEME_OBJECT primitive;
+DEFUN (primitive_to_arguments, (primitive), SCHEME_OBJECT primitive)
{
long arity;
}
\f
char *
-primitive_code_to_name(code)
- int code;
+DEFUN (primitive_code_to_name, (code), int code)
{
char *string;
SCHEME_OBJECT scheme_string;
- scheme_string = VECTOR_REF (Undefined_Primitives, (code - MAX_PRIMITIVE));
+ scheme_string =
+ (VECTOR_REF (Undefined_Primitives, (code - MAX_PRIMITIVE)));
string = ((char *) (STRING_LOC (scheme_string, 0)));
}
return (string);
}
\f
-extern char *primitive_to_name();
+extern char *EXFUN (primitive_to_name, (SCHEME_OBJECT));
char *
-primitive_to_name(primitive)
- SCHEME_OBJECT primitive;
+DEFUN (primitive_to_name, (primitive), SCHEME_OBJECT primitive)
{
return (primitive_code_to_name(PRIMITIVE_NUMBER(primitive)));
}
/* this avoids some consing. */
SCHEME_OBJECT
-primitive_name(code)
- int code;
+DEFUN (primitive_name, (code), int code)
{
SCHEME_OBJECT scheme_string;
if (code <= MAX_PRIMITIVE)
{
- scheme_string = char_pointer_to_string(Primitive_Name_Table[code]);
+ scheme_string =
+ (char_pointer_to_string ((unsigned char *) Primitive_Name_Table[code]));
}
else
{
- scheme_string = VECTOR_REF (Undefined_Primitives, (code - MAX_PRIMITIVE));
+ scheme_string =
+ (VECTOR_REF (Undefined_Primitives, (code - MAX_PRIMITIVE)));
}
return (scheme_string);
}
*/
SCHEME_OBJECT
-search_for_primitive(scheme_name, c_name, intern_p, allow_p, arity)
- SCHEME_OBJECT scheme_name;
- char *c_name;
- Boolean intern_p, allow_p;
- int arity;
+DEFUN (search_for_primitive,
+ (scheme_name, c_name, intern_p, allow_p, arity),
+ SCHEME_OBJECT scheme_name AND char * c_name
+ AND Boolean intern_p AND Boolean allow_p
+ AND int arity)
{
long i, Max, old_arity;
SCHEME_OBJECT *Next;
SCHEME_OBJECT temp;
temp = *Next++;
- if (strcmp_ci(c_name, (STRING_LOC (temp, 0))) == 0)
+ if (strcmp_ci (c_name, ((char *) (STRING_LOC (temp, 0)))) == 0)
{
if (arity != UNKNOWN_PRIMITIVE_ARITY)
{
if (scheme_name == SHARP_F)
{
- scheme_name = char_pointer_to_string(c_name);
+ scheme_name = (char_pointer_to_string ((unsigned char *) c_name));
}
\f
if ((Max % CHUNK_SIZE) == 0)
/* Dumping and loading primitive object references. */
extern SCHEME_OBJECT
- *load_renumber_table,
- dump_renumber_primitive(),
- *initialize_primitive_table(),
- *cons_primitive_table(),
- *cons_whole_primitive_table();
+ * load_renumber_table,
+ EXFUN (dump_renumber_primitive, (SCHEME_OBJECT)),
+ * EXFUN (initialize_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *)),
+ * EXFUN (cons_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)),
+ * EXFUN (cons_whole_primitive_table,
+ (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
-extern void install_primitive_table();
+extern void EXFUN (install_primitive_table,
+ (SCHEME_OBJECT *, long, Boolean));
SCHEME_OBJECT *load_renumber_table;
static SCHEME_OBJECT *internal_renumber_table;
static long next_primitive_renumber;
SCHEME_OBJECT *
-initialize_primitive_table(where, end)
- fast SCHEME_OBJECT *where;
- SCHEME_OBJECT *end;
+DEFUN (initialize_primitive_table, (where, end),
+ fast SCHEME_OBJECT *where AND SCHEME_OBJECT *end)
{
SCHEME_OBJECT *top;
fast long number_of_primitives;
}
\f
SCHEME_OBJECT
-dump_renumber_primitive(primitive)
- fast SCHEME_OBJECT primitive;
+DEFUN (dump_renumber_primitive, (primitive), fast SCHEME_OBJECT primitive)
{
fast long number;
fast SCHEME_OBJECT result;
static char null_string [] = "";
SCHEME_OBJECT *
-copy_primitive_information(code, start, end)
- long code;
- fast SCHEME_OBJECT * start;
- fast SCHEME_OBJECT * end;
+DEFUN (copy_primitive_information, (code, start, end),
+ long code
+ AND fast SCHEME_OBJECT * start AND fast SCHEME_OBJECT * end)
{
if (start < end)
(*start++) = (LONG_TO_FIXNUM (primitive_code_to_arity ((int) code)));
}
\f
SCHEME_OBJECT *
-cons_primitive_table(start, end, length)
- SCHEME_OBJECT *start, *end;
- long *length;
+DEFUN (cons_primitive_table, (start, end, length),
+ SCHEME_OBJECT * start AND SCHEME_OBJECT * end AND
+ long * length)
{
SCHEME_OBJECT *saved;
long count, code;
}
SCHEME_OBJECT *
-cons_whole_primitive_table(start, end, length)
- SCHEME_OBJECT *start, *end;
- long *length;
+DEFUN (cons_whole_primitive_table, (start, end, length),
+ SCHEME_OBJECT * start AND SCHEME_OBJECT * end
+ AND long * length)
{
SCHEME_OBJECT *saved;
long count, number_of_primitives;
}
\f
void
-install_primitive_table(table, length, flush_p)
- fast SCHEME_OBJECT *table;
- fast long length;
- Boolean flush_p;
+DEFUN (install_primitive_table, (table, length, flush_p),
+ fast SCHEME_OBJECT * table
+ AND fast long length
+ AND Boolean flush_p)
{
fast SCHEME_OBJECT *translation_table;
SCHEME_OBJECT result;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosenv.c,v 1.4 1991/01/24 11:25:05 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosenv.c,v 1.5 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
"Return the current working directory as a string.")
{
PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (char_pointer_to_string (OS_working_dir_pathname ()));
+ PRIMITIVE_RETURN (char_pointer_to_string
+ ((unsigned char *) OS_working_dir_pathname ()));
}
DEFINE_PRIMITIVE ("SET-WORKING-DIRECTORY-PATHNAME!", Prim_set_working_dir_pathname, 1, 1,
PRIMITIVE_RETURN
((variable_value == 0)
? SHARP_F
- : (char_pointer_to_string (variable_value)));
+ : (char_pointer_to_string ((unsigned char *) variable_value)));
}
}
"Return (as a string) the user name of the user running Scheme.")
{
PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (char_pointer_to_string (OS_current_user_name ()));
+ PRIMITIVE_RETURN (char_pointer_to_string
+ ((unsigned char *) OS_current_user_name ()));
}
DEFINE_PRIMITIVE ("CURRENT-USER-HOME-DIRECTORY", Prim_current_user_home_directory, 0, 0,
{
PRIMITIVE_HEADER (0);
PRIMITIVE_RETURN
- (char_pointer_to_string (OS_current_user_home_directory ()));
+ (char_pointer_to_string ((unsigned char *)
+ OS_current_user_home_directory ()));
}
DEFINE_PRIMITIVE ("SYSTEM-CALL-ERROR-MESSAGE", Prim_system_call_error_message, 1, 1, 0)
CONST char * message =
(OS_error_code_to_message (arg_nonnegative_integer (1)));
PRIMITIVE_RETURN
- ((message == 0) ? SHARP_F : (char_pointer_to_string (message)));
+ ((message == 0) ? SHARP_F
+ : (char_pointer_to_string ((unsigned char *) message)));
}
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosfs.c,v 1.4 1991/10/29 13:58:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosfs.c,v 1.5 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
PRIMITIVE_RETURN \
((result == 0) \
? SHARP_F \
- : (char_pointer_to_string (result))); \
+ : (char_pointer_to_string ((unsigned char *) result))); \
}
\f
DEFINE_PRIMITIVE ("FILE-EXISTS?", Prim_file_exists_p, 1, 1,
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.8 1991/03/14 04:22:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.9 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
(allocate_marked_vector (TC_VECTOR, (end_environ - environ), 1));
SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
while (scan_environ < end_environ)
- (*scan_result++) = (char_pointer_to_string (*scan_environ++));
+ (*scan_result++) =
+ (char_pointer_to_string ((unsigned char *) (*scan_environ++)));
PRIMITIVE_RETURN (result);
}
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosterm.c,v 1.9 1991/03/14 04:22:54 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosterm.c,v 1.10 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
{
SCHEME_OBJECT vector = (allocate_marked_vector (TC_VECTOR, 3, 1));
VECTOR_SET (vector, 0, (long_to_integer (channel)));
- VECTOR_SET (vector, 1, (char_pointer_to_string (master_name)));
- VECTOR_SET (vector, 2, (char_pointer_to_string (slave_name)));
+ VECTOR_SET (vector, 1,
+ (char_pointer_to_string ((unsigned char *) master_name)));
+ VECTOR_SET (vector, 2,
+ (char_pointer_to_string ((unsigned char *) slave_name)));
transaction_commit ();
PRIMITIVE_RETURN (vector);
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prostty.c,v 1.2 1990/11/05 11:55:15 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prostty.c,v 1.3 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1987-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
"Return a string that, when written to the display, will make it beep.")
{
PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (char_pointer_to_string (OS_tty_command_beep ()));
+ PRIMITIVE_RETURN
+ (char_pointer_to_string ((unsigned char *) (OS_tty_command_beep ())));
}
DEFINE_PRIMITIVE ("TTY-COMMAND-CLEAR", Prim_tty_command_clear, 0, 0,
"Return a string that, when written to the display, will clear it.")
{
PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (char_pointer_to_string (OS_tty_command_clear ()));
+ PRIMITIVE_RETURN
+ (char_pointer_to_string ((unsigned char *) (OS_tty_command_clear ())));
}
DEFINE_PRIMITIVE ("TTY-NEXT-INTERRUPT-CHAR", Prim_tty_next_interrupt_char, 0, 0,
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxenv.c,v 1.4 1991/09/25 20:37:33 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxenv.c,v 1.5 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
time_t clock = (arg_integer (1));
char * time_string = (UX_ctime (&clock));
(time_string[24]) = '\0';
- PRIMITIVE_RETURN (char_pointer_to_string (time_string));
+ PRIMITIVE_RETURN (char_pointer_to_string ((unsigned char *) time_string));
}
}
{
struct passwd * entry = (UX_getpwnam (STRING_ARG (1)));
PRIMITIVE_RETURN
- ((entry == 0) ? SHARP_F : (char_pointer_to_string (entry -> pw_dir)));
+ ((entry == 0) ? SHARP_F
+ : (char_pointer_to_string ((unsigned char *) (entry -> pw_dir))));
}
}
{
struct passwd * entry = (UX_getpwuid (arg_nonnegative_integer (1)));
PRIMITIVE_RETURN
- ((entry == 0) ? SHARP_F : (char_pointer_to_string (entry -> pw_name)));
+ ((entry == 0) ? SHARP_F
+ : (char_pointer_to_string ((unsigned char *) (entry -> pw_name))));
}
}
{
struct group * entry = (UX_getgrgid (arg_nonnegative_integer (1)));
PRIMITIVE_RETURN
- ((entry == 0) ? SHARP_F : (char_pointer_to_string (entry -> gr_name)));
+ ((entry == 0) ? SHARP_F
+ : (char_pointer_to_string ((unsigned char *) (entry -> gr_name))));
}
}
(allocate_marked_vector (TC_VECTOR, (end - scan), 1));
SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
while (scan < end)
- (*scan_result++) = (char_pointer_to_string (*scan++));
+ (*scan_result++) =
+ (char_pointer_to_string ((unsigned char *) (*scan++)));
PRIMITIVE_RETURN (result);
}
}
#ifdef HAVE_SOCKETS
this_host_entry = gethostbyname (this_host_name);
- PRIMITIVE_RETURN (char_pointer_to_string (this_host_entry->h_name));
+ PRIMITIVE_RETURN
+ (char_pointer_to_string ((unsigned char *) (this_host_entry->h_name)));
#else
- PRIMITIVE_RETURN (char_pointer_to_string (this_host_name));
+ PRIMITIVE_RETURN
+ (char_pointer_to_string ((unsigned char *) this_host_name));
#endif
}
}
STD_VOID_SYSTEM_CALL (syscall_gethostname,
UX_gethostname (this_host_name, HOSTNAMESIZE));
- PRIMITIVE_RETURN (char_pointer_to_string (this_host_name));
+ PRIMITIVE_RETURN
+ (char_pointer_to_string ((unsigned char *) this_host_name));
}
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.46 1991/10/29 13:59:04 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxfs.c,v 9.47 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
case S_IFLNK:
VECTOR_SET (result, 0,
(char_pointer_to_string
- (OS_file_soft_link_p
- ((CONST char *) (STRING_LOC ((ARG_REF (1)), 0))))));
+ ((unsigned char *)
+ (OS_file_soft_link_p
+ ((CONST char *) (STRING_LOC ((ARG_REF (1)), 0)))))));
break;
#endif
default:
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxsock.c,v 1.3 1990/11/14 17:01:59 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxsock.c,v 1.4 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
unsigned int length = (OS_host_address_length ());
while (addresses < end)
- (*scan_result++) = (memory_to_string (length, (*addresses++)));
+ (*scan_result++) =
+ (memory_to_string (length, ((unsigned char *) (*addresses++))));
PRIMITIVE_RETURN (result);
}
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/string.c,v 9.33 1989/09/20 23:11:55 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/string.c,v 9.34 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
unsigned char * char_pointer;
{
unsigned char * scan = char_pointer;
- while ((*scan++) != '\0')
- ;
+ if (scan == ((unsigned char *) NULL))
+ scan += 1;
+ else
+ while ((*scan++) != '\0')
+ ;
return (memory_to_string (((scan - 1) - char_pointer), char_pointer));
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/tterm.c,v 1.1 1990/10/16 20:52:15 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/tterm.c,v 1.2 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
DEFUN (tputs_write_char, (c), int c)
{
(*tputs_output_scan++) = c;
+ return;
}
\f
DEFINE_PRIMITIVE ("TERMCAP-INITIALIZE", Prim_termcap_initialize, 1, 1, 0)
{
char * result = (tgetstr ((STRING_ARG (1)), (&tgetstr_pointer)));
PRIMITIVE_RETURN
- ((result == 0) ? SHARP_F : (char_pointer_to_string (result)));
+ ((result == 0) ? SHARP_F
+ : (char_pointer_to_string ((unsigned char *) result)));
}
}
(arg_nonnegative_integer (3)),
(arg_nonnegative_integer (4)),
(arg_nonnegative_integer (5))));
- SCHEME_OBJECT result = (char_pointer_to_string (s));
+ SCHEME_OBJECT result = (char_pointer_to_string ((unsigned char *) s));
free (s);
PRIMITIVE_RETURN (result);
}
UP = (((ARG_REF (5)) == SHARP_F) ? 0 : (STRING_ARG (5)));
PRIMITIVE_RETURN
(char_pointer_to_string
- (tgoto ((STRING_ARG (1)),
+ ((unsigned char *)
+ (tgoto ((STRING_ARG (1)),
(arg_nonnegative_integer (2)),
- (arg_nonnegative_integer (3)))));
+ (arg_nonnegative_integer (3))))));
}
}
tputs_output_scan = tputs_output;
tputs ((STRING_ARG (1)), (arg_nonnegative_integer (2)), tputs_write_char);
PRIMITIVE_RETURN
- (memory_to_string ((tputs_output_scan - tputs_output), tputs_output));
+ (memory_to_string ((tputs_output_scan - tputs_output),
+ ((unsigned char *) tputs_output)));
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.50 1991/08/27 07:58:21 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.51 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
Pushed();
/* Turn off interrupts */
SET_INTERRUPT_MASK(New_Int_Enb);
+ return;
}
\f
/* Error processing utilities */
void
-err_print (error_code, where)
- long error_code;
- FILE * where;
+DEFUN (err_print, (error_code, where), long error_code AND FILE * where)
{
extern char * Error_Names [];
long death_blow;
void
-error_death (code, message)
- long code;
- char * message;
+DEFUN (error_death, (code, message), long code AND char * message)
{
death_blow = code;
fprintf (stderr, "\nMicrocode Error: %s.\n", message);
}
void
-Stack_Death ()
+DEFUN_VOID (Stack_Death)
{
fprintf (stderr, "\nWill_Push vs. Pushed inconsistency.\n");
Microcode_Termination (TERM_BAD_STACK);
Store_Expression (LONG_TO_FIXNUM (FETCH_INTERRUPT_MASK ()));
Save_Cont ();
Pushed ();
+ return;
}
/* back_out_of_primitive sets the registers up so that the backout
Store_Return (RC_INTERNAL_APPLY);
Store_Expression (SHARP_F);
(Regs [REGBLOCK_PRIMITIVE]) = SHARP_F;
+ return;
}
void
{
back_out_of_primitive_internal ();
Save_Cont ();
+ return;
}
\f
/* canonicalize_primitive_context should be used by "unsafe" primitives
Note: This is called only from the macro PRIMITIVE_CANONICALIZE_CONTEXT,
so that the work can be divided between them if it is an issue. */
-extern void canonicalize_primitive_context ();
+extern void EXFUN (canonicalize_primitive_context, (void));
void
-canonicalize_primitive_context ()
+DEFUN_VOID (canonicalize_primitive_context)
{
long nargs;
SCHEME_OBJECT primitive;
}
void
-error_wrong_type_arg (n)
- int n;
+DEFUN (error_wrong_type_arg, (n), int n)
{
fast long error_code;
}
void
-error_bad_range_arg (n)
- int n;
+DEFUN (error_bad_range_arg, (n), int n)
{
fast long error_code;
}
void
-error_external_return ()
+DEFUN_VOID (error_external_return)
{
signal_error_from_primitive (ERR_EXTERNAL_RETURN);
}
\f
long
-arg_integer (arg_number)
- int arg_number;
+DEFUN (arg_integer, (arg_number), int arg_number)
{
fast SCHEME_OBJECT object = (ARG_REF (arg_number));
if (! (INTEGER_P (object)))
}
long
-arg_nonnegative_integer (arg_number)
- int arg_number;
+DEFUN (arg_nonnegative_integer, (arg_number), int arg_number)
{
fast long result = (arg_integer (arg_number));
if (result < 0)
}
long
-arg_index_integer (arg_number, upper_limit)
- int arg_number;
- long upper_limit;
+DEFUN (arg_index_integer, (arg_number, upper_limit),
+ int arg_number AND long upper_limit)
{
fast long result = (arg_integer (arg_number));
if ((result < 0) || (result >= upper_limit))
}
long
-arg_integer_in_range (arg_number, lower_limit, upper_limit)
- int arg_number;
- long lower_limit;
- long upper_limit;
+DEFUN (arg_integer_in_range,
+ (arg_number, lower_limit, upper_limit),
+ int arg_number AND long lower_limit AND long upper_limit)
{
fast long result = (arg_integer (arg_number));
if ((result < lower_limit) || (result >= upper_limit))
}
\f
Boolean
-real_number_to_double_p (x)
- fast SCHEME_OBJECT x;
+DEFUN (real_number_to_double_p, (x), fast SCHEME_OBJECT x)
{
return ((! (BIGNUM_P (x))) || (BIGNUM_TO_DOUBLE_P (x)));
}
double
-real_number_to_double (x)
- fast SCHEME_OBJECT x;
+DEFUN (real_number_to_double, (x), fast SCHEME_OBJECT x)
{
return
((FIXNUM_P (x))
}
double
-arg_real_number (arg_number)
- int arg_number;
+DEFUN (arg_real_number, (arg_number), int arg_number)
{
fast SCHEME_OBJECT number = (ARG_REF (arg_number));
if (! (REAL_P (number)))
}
double
-arg_real_in_range (arg_number, lower_limit, upper_limit)
- int arg_number;
- double lower_limit;
- double upper_limit;
+DEFUN (arg_real_in_range, (arg_number, lower_limit, upper_limit),
+ int arg_number AND double lower_limit AND double upper_limit)
{
fast double result = (arg_real_number (arg_number));
if ((result < lower_limit) || (result > upper_limit))
}
\f
Boolean
-interpreter_applicable_p (object)
- fast SCHEME_OBJECT object;
+DEFUN (interpreter_applicable_p, (object), fast SCHEME_OBJECT object)
{
extern void compiled_entry_type ();
tail_recurse:
unsigned int syscall_error_name;
void
-Do_Micro_Error (Err, From_Pop_Return)
- long Err;
- Boolean From_Pop_Return;
+DEFUN (Do_Micro_Error, (Err, From_Pop_Return),
+ long Err AND Boolean From_Pop_Return)
{
SCHEME_OBJECT Error_Vector, Handler;
/* HISTORY manipulation */
SCHEME_OBJECT *
-Make_Dummy_History ()
+DEFUN_VOID (Make_Dummy_History)
{
SCHEME_OBJECT *History_Rib = Free;
SCHEME_OBJECT *Result;
*/
void
-Stop_History ()
+DEFUN_VOID (Stop_History)
{
SCHEME_OBJECT Saved_Expression;
long Saved_Return_Code;
*/
SCHEME_OBJECT
-DEFUN (copy_history, (hist_obj),
- SCHEME_OBJECT hist_obj)
+DEFUN (copy_history, (hist_obj), SCHEME_OBJECT hist_obj)
{
long space_left, vert_type, rib_type;
SCHEME_OBJECT *fast_free;
*/
Boolean
-DEFUN (Restore_History, (hist_obj),
- SCHEME_OBJECT hist_obj)
+DEFUN (Restore_History, (hist_obj), SCHEME_OBJECT hist_obj)
{
SCHEME_OBJECT new_hist;
*/
void
-record_primitive_entry (primitive)
- SCHEME_OBJECT primitive;
+DEFUN (record_primitive_entry, (primitive), SCHEME_OBJECT primitive)
{
SCHEME_OBJECT table;
/******************/
void
-Allocate_New_Stacklet (N)
- long N;
+DEFUN (Allocate_New_Stacklet, (N), long N)
{
SCHEME_OBJECT Old_Expression, *Old_Stacklet, Old_Return;
/* Dynamic Winder support code */
SCHEME_OBJECT
-Find_State_Space (State_Point)
- SCHEME_OBJECT State_Point;
+DEFUN (Find_State_Space, (State_Point), SCHEME_OBJECT State_Point)
{
long How_Far =
(UNSIGNED_FIXNUM_TO_LONG
*/
\f
void
-Translate_To_Point (Target)
- SCHEME_OBJECT Target;
+DEFUN (Translate_To_Point, (Target), SCHEME_OBJECT Target)
{
SCHEME_OBJECT State_Space, Current_Location, *Path;
fast SCHEME_OBJECT Path_Point, *Path_Ptr;
/*NOTREACHED*/
}
\f
-extern SCHEME_OBJECT Compiler_Get_Fixed_Objects();
+extern SCHEME_OBJECT EXFUN (Compiler_Get_Fixed_Objects, (void));
SCHEME_OBJECT
-Compiler_Get_Fixed_Objects()
+DEFUN_VOID (Compiler_Get_Fixed_Objects)
{
if (Valid_Fixed_Obj_Vector())
{
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxsig.c,v 1.17 1991/10/15 18:01:55 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxsig.c,v 1.18 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
fputs ("\n", stdout);
}
\f
+static void
+DEFUN (invoke_soft_reset, (name), char * name)
+{
+ soft_reset ();
+ /*NOTREACHED*/
+}
+
static void
DEFUN (reset_query, (scp), struct FULL_SIGCONTEXT * scp)
{
fprintf (stderr, "Problems reading keyboard input -- exitting.\n");
termination_eof ();
case 'D':
- SET_CRITICAL_SECTION_HOOK (soft_reset);
+ SET_CRITICAL_SECTION_HOOK (invoke_soft_reset);
return;
case 'N':
CLEAR_CRITICAL_SECTION_HOOK ();
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxtrap.c,v 1.15 1991/08/06 22:15:09 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxtrap.c,v 1.16 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
}
}
return (cons ((long_to_integer ((long) code)),
- ((name == 0) ? SHARP_F : (char_pointer_to_string (name)))));
+ ((name == 0) ? SHARP_F
+ : (char_pointer_to_string ((unsigned char *) name)))));
}
\f
static void
signal_name =
((signo == 0)
? SHARP_F
- : (char_pointer_to_string (find_signal_name (signo))));
+ : (char_pointer_to_string
+ ((unsigned char *) (find_signal_name (signo)))));
signal_code = (find_signal_code_name (signo, info, scp));
if (!stack_recovered_p)
{
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/vector.c,v 9.33 1989/10/31 12:42:53 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/vector.c,v 9.34 1991/10/29 22:55:11 jinx Exp $
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987-1991 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
: ((error_wrong_type_arg (argument_number)), ((SCHEME_OBJECT) 0)))
SCHEME_OBJECT
-allocate_non_marked_vector (type_code, length, gc_check_p)
- int type_code;
- fast long length;
- Boolean gc_check_p;
+DEFUN (allocate_non_marked_vector, (type_code, length, gc_check_p),
+ int type_code AND fast long length AND Boolean gc_check_p)
{
fast SCHEME_OBJECT result;
}
SCHEME_OBJECT
-allocate_marked_vector (type_code, length, gc_check_p)
- int type_code;
- fast long length;
- Boolean gc_check_p;
+DEFUN (allocate_marked_vector, (type_code, length, gc_check_p),
+ int type_code AND fast long length AND Boolean gc_check_p)
{
if (gc_check_p)
Primitive_GC_If_Needed (length + 1);
}
SCHEME_OBJECT
-make_vector (length, contents, gc_check_p)
- fast long length;
- fast SCHEME_OBJECT contents;
- Boolean gc_check_p;
+DEFUN (make_vector, (length, contents, gc_check_p),
+ fast long length AND fast SCHEME_OBJECT contents AND Boolean gc_check_p)
{
if (gc_check_p)
Primitive_GC_If_Needed (length + 1);
}
static SCHEME_OBJECT
-subvector_to_list (vector, start, end)
- SCHEME_OBJECT vector;
- long start;
- long end;
+DEFUN (subvector_to_list, (vector, start, end),
+ SCHEME_OBJECT vector AND long start AND long end)
{
SCHEME_OBJECT result;
fast SCHEME_OBJECT *scan;
SUBVECTOR_TO_LIST_PRIMITIVE (ARG_GC_VECTOR)
\f
static SCHEME_OBJECT
-list_to_vector (result_type, argument_number)
- long argument_number;
- long result_type;
+DEFUN (list_to_vector, (result_type, argument_number),
+ long result_type AND long argument_number)
{
fast SCHEME_OBJECT list;
fast long count;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.26 1991/10/02 21:17:07 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.27 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1989-91 Massachusetts Institute of Technology
bucky |= 8;
if ((event -> state) & Mod4Mask) /* Top */
bucky |= 16;
- VECTOR_SET (result, EVENT_0, (memory_to_string (nbytes, copy_buffer)));
+ VECTOR_SET (result, EVENT_0,
+ (memory_to_string (nbytes,
+ ((unsigned char *) copy_buffer))));
VECTOR_SET (result, EVENT_1, LONG_TO_UNSIGNED_FIXNUM (bucky));
/* Move vendor-specific bit from bit 28 (zero-based) to bit 23 */
/* so that all keysym values will fit in Scheme fixnums. */
(XGetDefault
((XD_DISPLAY (x_display_arg (1))), (STRING_ARG (2)), (STRING_ARG (3))));
PRIMITIVE_RETURN
- ((result == 0) ? SHARP_F : (char_pointer_to_string (result)));
+ ((result == 0) ? SHARP_F
+ : (char_pointer_to_string ((unsigned char *) result)));
}
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpintmd/hppa.h,v 1.24 1991/08/13 18:23:23 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpintmd/hppa.h,v 1.25 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1989-1991 Massachusetts Institute of Technology
*/
unsigned long
-hppa_extract_absolute_address (addr)
- unsigned long *addr;
+DEFUN (hppa_extract_absolute_address, (addr), unsigned long * addr)
{
union short_pointer result;
union ble_inst ble;
}
void
-hppa_store_absolute_address (addr, sourcev, nullify_p)
- unsigned long *addr, sourcev, nullify_p;
+DEFUN (hppa_store_absolute_address, (addr, sourcev, nullify_p),
+ unsigned long * addr AND unsigned long sourcev
+ AND unsigned long nullify_p)
{
union short_pointer source;
union ldil_inst ldil;
static struct pdc_cache_dump cache_info;
-extern void
- flush_i_cache (),
- push_d_cache_region ();
+extern void EXFUN (flush_i_cache, (void));
+extern void EXFUN (push_d_cache_region, (PTR, unsigned long));
void
-flush_i_cache ()
+DEFUN_VOID (flush_i_cache)
{
- extern void cache_flush_all ();
- struct pdc_cache_result *cache_desc;
+ extern void EXFUN (cache_flush_all,
+ (unsigned int, struct pdc_cache_result *));
+ struct pdc_cache_result * cache_desc;
cache_desc = ((struct pdc_cache_result *) &(cache_info.cache_format));
}
void
-push_d_cache_region (start_address, block_size)
- void *start_address;
- unsigned long block_size;
+DEFUN (push_d_cache_region, (start_address, block_size),
+ PTR start_address AND unsigned long block_size)
{
- extern void cache_flush_region ();
- struct pdc_cache_result *cache_desc;
+ extern void EXFUN (cache_flush_region, (PTR, long, unsigned int));
+ struct pdc_cache_result * cache_desc;
cache_desc = ((struct pdc_cache_result *) &(cache_info.cache_format));
{
cache_flush_region (start_address, block_size, D_CACHE);
cache_flush_region (start_address, 1, I_CACHE);
- cache_flush_region (((void *)
+ cache_flush_region (((PTR)
(((unsigned long *) start_address)
+ (block_size - 1))),
1,
#define MODELS_FILENAME "HPPAmodels"
#endif
-void
-flush_i_cache_initialize ()
+static void
+DEFUN_VOID (flush_i_cache_initialize)
{
struct utsname sysinfo;
CONST char * models_filename =
/* A NOP on machines where instructions are longword-aligned. */
-#define ADJUST_CLOSURE_AT_CALL(entry_point, location) \
-do { \
+#define ADJUST_CLOSURE_AT_CALL(entry_point, location) do \
+{ \
} while (0)
/* Compiled closures */
On PA this is a NOP.
*/
-#define STORE_EXECUTE_CACHE_CODE(address) \
+#define STORE_EXECUTE_CACHE_CODE(address) do \
{ \
-}
+} while (0)
/* This is supposed to flush the Scheme portion of the I-cache.
It flushes the entire I-cache instead, since it is easier.
#define FLUSH_I_CACHE() do \
{ \
- extern void flush_i_cache (); \
+ extern void EXFUN (flush_i_cache, (void)); \
\
flush_i_cache (); \
} while (0)
#define FLUSH_I_CACHE_REGION(address, nwords) do \
{ \
- extern void cache_flush_region (); \
+ extern void EXFUN (cache_flush_region, (PTR, long, unsigned int)); \
\
- cache_flush_region (((void *) (address)), (nwords), \
+ cache_flush_region (((PTR) (address)), ((long) (nwords)), \
(D_CACHE | I_CACHE)); \
} while (0)
#define PUSH_D_CACHE_REGION(address, nwords) do \
{ \
- extern void push_d_cache_region (); \
+ extern void EXFUN (push_d_cache_region, (PTR, unsigned long)); \
\
- push_d_cache_region (((unsigned long *) (address)), \
+ push_d_cache_region (((PTR) (address)), \
((unsigned long) (nwords))); \
} while (0)
#ifdef IN_CMPINT_C
long
-DEFUN (assemble_17,
- (inst),
- union ble_inst inst)
+DEFUN (assemble_17, (inst), union ble_inst inst)
{
union bl_offset off;
#include <magic.h>
-void **
-DEFUN (transform_procedure_table,
- (table_length, old_table),
- long table_length AND
- void **old_table)
+PTR *
+DEFUN (transform_procedure_table, (table_length, old_table),
+ long table_length AND PTR * old_table)
{
- void **new_table;
+ PTR * new_table;
long counter;
- new_table = ((void **) (malloc (table_length * (sizeof (void *)))));
- if (new_table == ((void **) NULL))
+ new_table = ((PTR *) (malloc (table_length * (sizeof (PTR)))));
+ if (new_table == ((PTR *) NULL))
{
fprintf (stderr,
"transform_procedure_table: malloc (%d) failed.\n",
- (table_length * (sizeof (void *))));
+ (table_length * (sizeof (PTR))));
exit (1);
}
/* Test for HP-UX >= 8.0 */
#if defined(SHL_MAGIC) && !defined(__GNUC__)
- char *C_closure, *blp;
+ char * C_closure, * blp;
long offset;
- C_closure = ((char *) (old_table[counter]));
+ C_closure = ((char *) (old_table [counter]));
blp = (* ((char **) (C_closure - 2)));
blp = ((char *) (((unsigned long) blp) & ~3));
offset = (assemble_17 (* ((union ble_inst *) blp)));
- new_table[counter] = ((void *) ((blp + 8) + offset));
+ new_table[counter] = ((PTR) ((blp + 8) + offset));
#else
- new_table[counter] = ((void *) old_table[counter]);
+ new_table[counter] = ((PTR) (old_table [counter]));
#endif
}
return (new_table);
function pointer closure format problems for utilities for HP-UX >= 8.0 .
*/
-extern void **hppa_utility_table;
-void **hppa_utility_table;
+extern PTR * hppa_utility_table;
+PTR * hppa_utility_table;
void
-DEFUN (hppa_reset_hook,
- (table_length, utility_table),
- long table_length AND
- void **utility_table)
+DEFUN (hppa_reset_hook, (table_length, utility_table),
+ long table_length AND PTR * utility_table)
{
- extern void interface_initialize ();
+ extern void EXFUN (interface_initialize, (void));
flush_i_cache_initialize ();
interface_initialize ();
return;
}
-#define ASM_RESET_HOOK() \
-do { \
- hppa_reset_hook (((sizeof (utility_table)) / (sizeof (void *))), \
+#define ASM_RESET_HOOK() do \
+{ \
+ hppa_reset_hook (((sizeof (utility_table)) / (sizeof (PTR))), \
&utility_table[0]); \
} while (0)
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.63 1991/07/18 15:58:12 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.64 1991/10/29 22:55:11 jinx Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
}
void
-Interpret(dumped_p)
- Boolean dumped_p;
+DEFUN (Interpret, (dumped_p), Boolean dumped_p)
{
long Which_Way;
fast SCHEME_OBJECT *Reg_Block, *Reg_Stack_Pointer, *Reg_History;
projects / mit-scheme.git / commitdiff