default for HP 9000 series 300.
* Update Ppband to handle compiled code.
* Significant rewrite of parts of the bignum code. This is the
beginning of a redesign of this code.
* Regularize some of the object selector macros.
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/Attic/bchmmg.c,v 9.46 1989/08/15 07:15:47 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.47 1989/08/28 18:28:15 cph Exp $ */
\f
/* Memory management top level. Garbage collection to disk.
Setup_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size)
int Our_Heap_Size, Our_Stack_Size, Our_Constant_Size;
{
+ Pointer test_value;
int Real_Stack_Size;
Real_Stack_Size = Stack_Allocation_Size(Our_Stack_Size);
gc_disk_buffer_2 = (gc_disk_buffer_1 + GC_BUFFER_SPACE);
/* Consistency check 3 */
- if (((C_To_Scheme(Highest_Allocated_Address)) & TYPE_CODE_MASK) != 0)
+ test_value = (Make_Pointer(LAST_TYPE_CODE, Highest_Allocated_Address));
+
+ if (((OBJECT_TYPE(test_value)) != LAST_TYPE_CODE) ||
+ ((Get_Pointer(test_value)) != Highest_Allocated_Address))
{
fprintf(stderr,
"Largest address does not fit in datum field of Pointer.\n");
}
ENTER_CRITICAL_SECTION ("garbage collector");
gc_counter += 1;
- GC_Reserve = Get_Integer(Arg1);
+ GC_Reserve = (UNSIGNED_FIXNUM_VALUE (Arg1));
GC(EMPTY_LIST);
CLEAR_INTERRUPT(INT_GC);
Pop_Primitive_Frame(1);
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bignum.c,v 9.27 1989/08/28 18:28:19 cph Exp $
+
+Copyright (c) 1987, 1988, 1989 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/bignum.c,v 9.26 1988/08/15 20:36:45 cph Rel $
-
- This file contains the procedures for handling BIGNUM Arithmetic.
-*/
+/* BIG NUMber arithmetic */
#include "scheme.h"
#include <math.h>
#include "flonum.h"
#include "zones.h"
\f
-/* General Purpose Utilities */
+/* The following macros are the beginnings of a redesign of the bignum
+ code. Some of the procedures and primitives defined here use these
+ new conventions. Please update things as you work on them. */
-Pointer
-return_bignum_zero()
+#define DIGITS_PER_POINTER ((sizeof (Pointer)) / (sizeof (bigdigit)))
+
+#define DIGITS_TO_POINTERS(n_digits) \
+ (((n_digits) + (DIGITS_PER_POINTER - 1)) / DIGITS_PER_POINTER)
+
+#define DIGITS_TO_GC_LENGTH(n_digits) (DIGITS_TO_POINTERS ((n_digits) + 2))
+
+#define DIGITS_TO_GC_HEADER(n_digits) \
+ (Make_Non_Pointer (TC_MANIFEST_NM_VECTOR, (DIGITS_TO_GC_LENGTH (n_digits))))
+
+#define BIGNUM_PTR(bignum, index) \
+ (((bigdigit *) (Nth_Vector_Loc ((bignum), 1))) + (index))
+
+#define BIGNUM_REF(bignum, index) (* (BIGNUM_PTR ((bignum), (index))))
+#define BIGNUM_SIGN(bignum) (BIGNUM_REF ((bignum), 0))
+#define BIGNUM_LENGTH(bignum) (BIGNUM_REF ((bignum), 1))
+#define BIGNUM_START_PTR(bignum) (BIGNUM_PTR ((bignum), 2))
+#define BIGNUM_END_PTR(bignum) \
+ (BIGNUM_PTR ((bignum), (2 + (BIGNUM_LENGTH (bignum)))))
+
+#define BIGNUM_NEGATIVE_P(bignum) ((BIGNUM_SIGN (bignum)) == 0)
+#define BIGNUM_ZERO_P(bignum) ((BIGNUM_LENGTH (bignum)) == 0)
+\f
+static Pointer
+make_bignum_zero ()
+{
+ Pointer bignum =
+ (allocate_non_marked_vector
+ (TC_BIG_FIXNUM, (DIGITS_TO_GC_LENGTH (0)), true));
+ (BIGNUM_SIGN (bignum)) = 1;
+ (BIGNUM_LENGTH (bignum)) = 0;
+ return (bignum);
+}
+
+static Pointer
+bignum_allocate (n_digits, negative_p)
+ long n_digits;
+ Boolean negative_p;
+{
+ Pointer bignum =
+ (allocate_non_marked_vector
+ (TC_BIG_FIXNUM, (DIGITS_TO_GC_LENGTH (n_digits)), true));
+ (BIGNUM_SIGN (bignum)) = (negative_p ? 0 : 1);
+ (BIGNUM_LENGTH (bignum)) = n_digits;
+ return (bignum);
+}
+
+static void
+bignum_destructive_copy (source, target)
+ Pointer source;
+ Pointer target;
+{
+ fast bigdigit * scan_source;
+ fast bigdigit * end_source;
+ fast bigdigit * scan_target;
+
+ (BIGNUM_SIGN (target)) = (BIGNUM_SIGN (source));
+ (BIGNUM_LENGTH (target)) = (BIGNUM_LENGTH (source));
+ scan_source = (BIGNUM_START_PTR (source));
+ end_source = (BIGNUM_END_PTR (source));
+ scan_target = (BIGNUM_START_PTR (target));
+ while (scan_source < end_source)
+ (*scan_target++) = (*scan_source++);
+ return;
+}
+
+static Pointer
+bignum_copy (source)
+ Pointer source;
+{
+ Pointer target =
+ (allocate_non_marked_vector
+ (TC_BIG_FIXNUM, (DIGITS_TO_GC_LENGTH (BIGNUM_LENGTH (source))), true));
+ bignum_destructive_copy (source, target);
+ return (target);
+}
+
+static int
+bignum_length_in_bits (bignum)
+ Pointer bignum;
+{
+ if (BIGNUM_ZERO_P (bignum))
+ return (0);
+ {
+ int max_index = ((BIGNUM_LENGTH (bignum)) - 1);
+ fast int result = (max_index * SHIFT);
+ fast unsigned long max_digit = (BIGNUM_REF (bignum, max_index));
+ while (max_digit > 0)
+ {
+ result += 1;
+ max_digit >>= 1;
+ }
+ return (result);
+ }
+}
+\f
+static unsigned long
+scale_down (source, target, denominator)
+ Pointer source;
+ Pointer target;
+ unsigned long denominator;
{
- bigdigit *REG;
- long Align_0 = Align(0);
- Primitive_GC_If_Needed(Align_0);
- REG = BIGNUM(Free);
- Prepare_Header(REG, 0, POSITIVE);
- Free += Align_0;
- return Make_Pointer(TC_BIG_FIXNUM, Free-Align_0);
+ fast unsigned long remainder;
+ fast unsigned long quotient;
+ fast bigdigit * scan_source;
+ fast bigdigit * scan_target;
+ fast bigdigit * start_source;
+
+ (BIGNUM_SIGN (target)) = (BIGNUM_SIGN (source));
+ (BIGNUM_LENGTH (target)) = (BIGNUM_LENGTH (source));
+ scan_source = (BIGNUM_END_PTR (source));
+ start_source = (BIGNUM_START_PTR (source));
+ scan_target = (BIGNUM_END_PTR (target));
+ remainder = 0;
+ while (scan_source > start_source)
+ {
+ remainder = ((remainder << SHIFT) + (*--scan_source));
+ quotient = (remainder / denominator);
+ remainder = (remainder % denominator);
+ (*--scan_target) = quotient;
+ }
+ return (remainder);
}
+static unsigned long
+scale_down_self (bignum, denominator)
+ Pointer bignum;
+ unsigned long denominator;
+{
+ fast unsigned long remainder;
+ fast unsigned long quotient;
+ fast bigdigit * scan;
+ fast bigdigit * start;
+
+ scan = (BIGNUM_END_PTR (bignum));
+ start = (BIGNUM_START_PTR (bignum));
+ remainder = 0;
+ while (scan > start)
+ {
+ remainder = ((remainder << SHIFT) + (*--scan));
+ quotient = (remainder / denominator);
+ remainder = (remainder % denominator);
+ (*scan) = quotient;
+ }
+ return (remainder);
+}
+\f
void
trim_bignum(ARG)
bigdigit *ARG;
*TARGET++ = *SOURCE++;
return;
}
-
-long
-Find_Length(pradix, length)
- fast long pradix;
- bigdigit length;
-{
- fast int log_pradix;
-
- log_pradix = 0;
- while (pradix != 1)
- {
- pradix = pradix >> 1;
- log_pradix += 1;
- }
- return (((SHIFT / log_pradix) + 1) * length);
-}
\f
/* scale() and unscale() used by Division and Listify */
}
\f
Pointer
-Fix_To_Big(Arg1)
- Pointer Arg1;
+Fix_To_Big (object)
+ Pointer object;
{
- fast bigdigit *Answer, *SCAN, *size;
- long Length, ARG1;
-
- if (Type_Code(Arg1) != TC_FIXNUM) Primitive_Error(ERR_ARG_1_WRONG_TYPE);
- if (Get_Integer(Arg1) == 0)
- { long Align_0 = Align(0);
- bigdigit *REG;
- Primitive_GC_If_Needed(2);
- REG = BIGNUM(Free);
- Prepare_Header(REG, 0, POSITIVE);
- Free += Align_0;
- return Make_Pointer(TC_BIG_FIXNUM, Free-Align_0);
- }
- Length = Align(FIXNUM_LENGTH_AS_BIGNUM);
- Primitive_GC_If_Needed(Length);
- Sign_Extend(Arg1, ARG1);
- Answer = BIGNUM(Free);
- Prepare_Header(Answer, 0, (ARG1 >= 0) ? POSITIVE : NEGATIVE);
- size = &LEN(Answer);
- if (ARG1 < 0) ARG1 = - ARG1;
- for (SCAN = Bignum_Bottom(Answer); ARG1 != 0; *size += 1)
- { *SCAN++ = Rem_Radix(ARG1);
- ARG1 = Div_Radix(ARG1);
+ fast long value;
+ fast Pointer result;
+
+ FIXNUM_VALUE (object, value);
+ if (value == 0)
+ return (make_bignum_zero ());
+ else if (value > 0)
+ result = (bignum_allocate (FIXNUM_LENGTH_AS_BIGNUM, false));
+ else
+ {
+ result = (bignum_allocate (FIXNUM_LENGTH_AS_BIGNUM, true));
+ value = (- value);
+ }
+ {
+ fast bigdigit * scan = (BIGNUM_START_PTR (result));
+ fast long length = 0;
+ while (value > 0)
+ {
+ (*scan++) = (value & DIGIT_MASK);
+ value = (value >> SHIFT);
+ length += 1;
+ }
+ (BIGNUM_LENGTH (result)) = length;
+ Fast_Vector_Set (result, 0, (DIGITS_TO_GC_HEADER (length)));
}
- Length = Align(*size);
- *((Pointer *) Answer) = Make_Header(Length);
- Free += Length;
- Debug_Test(Free-Length);
- return Make_Pointer(TC_BIG_FIXNUM, Free-Length);
+ return (result);
}
-\f
+
Pointer
-Big_To_Fix (bignum_object)
- Pointer bignum_object;
+Big_To_Fix (object)
+ Pointer object;
{
- fast bigdigit *bptr, *scan;
- fast long result, i;
- long Length;
-
- if ((Type_Code (bignum_object)) != TC_BIG_FIXNUM)
- return (bignum_object);
- bptr = BIGNUM (Get_Pointer (bignum_object));
- Length = LEN (bptr);
- if (Length == 0)
- return (Make_Unsigned_Fixnum(0));
- if (Length > FIXNUM_LENGTH_AS_BIGNUM)
- return (bignum_object);
-
- scan = Bignum_Top (bptr);
- result = *scan--;
-
- if (result < 0)
- return (bignum_object);
-
- if (Length == FIXNUM_LENGTH_AS_BIGNUM)
+ if (! (BIGNUM_P (object)))
+ return (object);
+ if (BIGNUM_ZERO_P (object))
+ return (MAKE_UNSIGNED_FIXNUM (0));
{
- long saved_result, length_in_bits;
-
- saved_result = result;
-
- for (i = 0; result != 0; i+= 1)
- result = result >> 1;
-
- length_in_bits = i + ((Length == 0) ? 0 : ((Length - 1) * SHIFT));
-
- if (length_in_bits > FIXNUM_LENGTH)
- return (bignum_object);
-
- result = (saved_result &
- ((1 << ((FIXNUM_LENGTH + 1) -
- ((FIXNUM_LENGTH + 1) % SHIFT))) - 1));
-
+ long length = (BIGNUM_LENGTH (object));
+ if (length > FIXNUM_LENGTH_AS_BIGNUM)
+ return (object);
+ {
+ fast bigdigit * start = (BIGNUM_START_PTR (object));
+ fast bigdigit * scan = (start + length);
+ fast long result = (*--scan);
+ if (length == FIXNUM_LENGTH_AS_BIGNUM)
+ {
+ long max_value = (1 << (FIXNUM_LENGTH - ((length - 1) * SHIFT)));
+
+ if ((result > max_value) ||
+ ((result == max_value) && (! (BIGNUM_NEGATIVE_P (object)))))
+ return (object);
+ }
+ while (scan > start)
+ result = ((result << SHIFT) + (*--scan));
+ if (BIGNUM_NEGATIVE_P (object))
+ result = (- result);
+ return ((Fixnum_Fits (result)) ? (MAKE_SIGNED_FIXNUM (result)) : object);
+ }
}
-
- for (i = (Length - 1); (i > 0); i -= 1)
- result = (Mul_Radix (result) + *scan--);
-
- if (result < 0)
- return (bignum_object);
- if (NEG_BIGNUM (bptr))
- result = (- result);
- return (Fixnum_Fits (result)
- ? Make_Signed_Fixnum (result)
- : bignum_object);
}
\f
-Boolean
-Fits_Into_Flonum(Bignum)
- bigdigit *Bignum;
-{
- fast int k;
- quick bigdigit top_digit;
-
- k = (LEN(Bignum) - 1) * SHIFT;
- for (top_digit = *Bignum_Top(Bignum); top_digit != 0; k++)
- top_digit >>= 1;
-
-/* If precision should not be lost,
- if (k <= FLONUM_MANTISSA_BITS) return true;
- Otherwise,
-*/
-
- if (k <= MAX_FLONUM_EXPONENT) return true;
- return false;
-}
-
Pointer
-Big_To_Float(Arg1)
- Pointer Arg1;
+Big_To_Float (bignum)
+ Pointer bignum;
{
- fast bigdigit *ARG1, *LIMIT;
- fast double F = 0.0;
-
- ARG1 = BIGNUM(Get_Pointer(Arg1));
- if (!Fits_Into_Flonum(ARG1)) return Arg1;
- Primitive_GC_If_Needed(FLONUM_SIZE+1);
- LIMIT = Bignum_Bottom(ARG1);
- ARG1 = Bignum_Top(ARG1);
- while (ARG1 >= LIMIT) F = (F * ((double) RADIX)) + ((double) *ARG1--);
- if (NEG_BIGNUM(BIGNUM(Get_Pointer(Arg1)))) F = -F;
- return Allocate_Float(F);
+ /* If precision should not be lost,
+ compare to FLONUM_MANTISSA_BITS instead. */
+ if ((bignum_length_in_bits (bignum)) > MAX_FLONUM_EXPONENT)
+ return (bignum);
+ {
+ fast bigdigit * start = (BIGNUM_START_PTR (bignum));
+ fast bigdigit * scan = (BIGNUM_END_PTR (bignum));
+ fast double accumulator = (0.0);
+ while (scan > start)
+ accumulator = ((accumulator * ((double) RADIX)) + ((double) (*--scan)));
+ if (BIGNUM_NEGATIVE_P (bignum))
+ accumulator = (- accumulator);
+ Primitive_GC_If_Needed (FLONUM_SIZE + 1);
+ return (Allocate_Float (accumulator));
+ }
}
-
\f
#ifdef HAS_FREXP
extern double frexp(), ldexp();
long Align_size;
if (flonum == 0.0)
- return return_bignum_zero();
+ return (make_bignum_zero ());
mantissa = frexp(flonum, &exponent);
if (flonum < 0) mantissa = -mantissa;
if (mantissa >= 1.0)
bigdigit *ARG1, *ARG2;
{ /* Special Case for answer being zero */
if (ZERO_BIGNUM(ARG1) && ZERO_BIGNUM(ARG2))
- return return_bignum_zero();
+ return (make_bignum_zero ());
switch(Categorize_Sign(ARG1, ARG2))
{ case BOTH_POSITIVE : return(plus_unsigned_bignum(ARG1, ARG2, POSITIVE));
case ARG1_NEGATIVE : return(minus_unsigned_bignum(ARG2, ARG1, POSITIVE));
/* Special Case for answer being zero */
if (ZERO_BIGNUM(ARG1) && ZERO_BIGNUM(ARG2))
- return return_bignum_zero();
+ return (make_bignum_zero ());
/* Dispatches According to Sign of Args */
bigdigit *ARG1, *ARG2;
{
if (ZERO_BIGNUM(ARG1) || ZERO_BIGNUM(ARG2))
- return return_bignum_zero();
+ return (make_bignum_zero ());
switch(Categorize_Sign(ARG1,ARG2))
{ case BOTH_POSITIVE :
*/
Pointer
-div_signed_bignum(ARG1, ARG2)
+div_signed_bignum (ARG1, ARG2)
bigdigit *ARG1, *ARG2;
{
bigdigit *SARG2;
if (big_compare_unsigned(ARG1, ARG2) == TWO_BIGGER)
{
/* Trivial Solution for ARG1 > ARG2
- * Quotient is zero and the remainder is just a copy of Arg_1.
- */
+ Quotient is zero and the remainder is just a copy of Arg_1. */
Primitive_GC_If_Needed(Align(0)+Align(LEN(ARG1)));
QUOT = BIGNUM(Free);
else if (LEN(ARG2)==1)
{
/* Divisor is only one digit long.
- * unscale() is used to divide out Arg_1 and the remainder is the
- * single digit returned by unscale(), coerced to a bignum.
- */
+ unscale() is used to divide out Arg_1 and the remainder is the
+ single digit returned by unscale(), coerced to a bignum. */
Primitive_GC_If_Needed(Align(LEN(ARG1))+Align(1));
QUOT = BIGNUM(Free);
trim_bignum(QUOT);
}
else
-\f
{
/* Usual case. div_internal() is called. A normalized copy of Arg_1
- * resides in REMD, which ultimately becomes the remainder. The
- * normalized copy of Arg_2 is in SARG2.
- */
+ resides in REMD, which ultimately becomes the remainder. The
+ normalized copy of Arg_2 is in SARG2. */
- bigdouble temp;
-
- temp = (Align(LEN(ARG1)-LEN(ARG2)+1) + Align(LEN(ARG1)+1)
- + Align(LEN(ARG2)+1));
- Primitive_GC_If_Needed(temp);
+ bigdouble temp =
+ (Align(LEN(ARG1)-LEN(ARG2)+1) + Align(LEN(ARG1)+1) + Align(LEN(ARG2)+1));
+ Primitive_GC_If_Needed (temp);
QUOT = BIGNUM(Free);
*Free = Make_Header(Align(LEN(ARG1)-LEN(ARG2)+1));
Free += Align(LEN(ARG1)-LEN(ARG2)+1);
}
#endif
\f
-/* Top level bignum primitives */
-/* Coercion primitives. */
-
-/* (COERCE-FIXNUM-TO-BIGNUM FIXNUM)
- Returns its argument if FIXNUM isn't a fixnum. Otherwise
- it returns the corresponding bignum.
-*/
-DEFINE_PRIMITIVE ("COERCE-FIXNUM-TO-BIGNUM", Prim_fix_to_big, 1, 1, 0)
+DEFINE_PRIMITIVE ("COERCE-FIXNUM-TO-BIGNUM", Prim_fix_to_big, 1, 1,
+ "Returns the bignum that corresponds to FIXNUM.")
{
- Primitive_1_Arg();
+ PRIMITIVE_HEADER (1);
- Arg_1_Type(TC_FIXNUM);
- return Fix_To_Big(Arg1);
+ CHECK_ARG (1, FIXNUM_P);
+ PRIMITIVE_RETURN (Fix_To_Big (ARG_REF (1)));
}
-/* (COERCE-BIGNUM-TO-FIXNUM BIGNUM)
- When given a bignum, returns the equivalent fixnum if there is
- one. If BIGNUM is out of range, or isn't a bignum, returns
- BIGNUM. */
-
-DEFINE_PRIMITIVE ("COERCE-BIGNUM-TO-FIXNUM", Prim_big_to_fix, 1, 1, 0)
+DEFINE_PRIMITIVE ("COERCE-BIGNUM-TO-FIXNUM", Prim_big_to_fix, 1, 1,
+ "Returns the fixnum that corresponds to BIGNUM.
+If BIGNUM cannot be represented as a fixnum, returns BIGNUM.")
{
- Primitive_1_Arg ();
+ PRIMITIVE_HEADER (1);
- Arg_1_Type (TC_BIG_FIXNUM);
- return (Big_To_Fix (Arg1));
+ CHECK_ARG (1, BIGNUM_P);
+ PRIMITIVE_RETURN (Big_To_Fix (ARG_REF (1)));
}
-\f
-/* (LISTIFY-BIGNUM BIGNUM RADIX)
- Returns a list of numbers, in the range 0 through RADIX-1, which
- represent the BIGNUM in that radix.
-*/
-DEFINE_PRIMITIVE ("LISTIFY-BIGNUM", Prim_listify_bignum, 2, 2, 0)
+
+DEFINE_PRIMITIVE ("LISTIFY-BIGNUM", Prim_listify_bignum, 2, 2,
+ "Returns a list of the digits of BIGNUM in RADIX.")
{
- fast bigdigit *TOP1, *size;
- quick Pointer *RFree;
- fast bigdigit *ARG1;
- fast long pradix;
- Primitive_2_Args();
+ Pointer bignum;
+ long radix;
+ PRIMITIVE_HEADER (2);
- Arg_1_Type(TC_BIG_FIXNUM);
- Arg_2_Type(TC_FIXNUM);
- Set_Time_Zone(Zone_Math);
+ Set_Time_Zone (Zone_Math);
- ARG1 = BIGNUM(Get_Pointer(Arg1));
- size = &LEN(ARG1);
- if (*size == 0)
- {
- Primitive_GC_If_Needed(2);
- *Free++ = Make_Unsigned_Fixnum(0);
- *Free++ = EMPTY_LIST;
- return Make_Pointer(TC_LIST, Free-2);
- }
- Sign_Extend(Arg2, pradix);
- Primitive_GC_If_Needed(Find_Length(pradix, *size)+Align(*size));
- ARG1 = BIGNUM(Free);
- copy_bignum(BIGNUM(Get_Pointer(Arg1)), ARG1);
- Free += Align(*size);
- RFree = Free;
- size = &LEN(ARG1);
- TOP1 = Bignum_Top(ARG1);
- while (*size > 0)
+ CHECK_ARG (1, BIGNUM_P);
+ bignum = (ARG_REF (1));
+ radix = (arg_nonnegative_integer (2, (BIGGEST_FIXNUM + 1)));
+ if (BIGNUM_ZERO_P (bignum))
+ PRIMITIVE_RETURN (cons ((MAKE_UNSIGNED_FIXNUM (0)), EMPTY_LIST));
{
- *RFree++ = Make_Unsigned_Fixnum(unscale(ARG1, ARG1, pradix));
- *RFree = Make_Pointer(TC_LIST, RFree-3);
- RFree += 1;
- if (*TOP1 == 0)
- {
- *size -= 1;
- TOP1--;
- }
+ Pointer working_copy = (bignum_copy (bignum));
+ fast bigdigit * start_copy = (BIGNUM_START_PTR (working_copy));
+ fast bigdigit * end_copy = (BIGNUM_END_PTR (working_copy));
+ fast Pointer previous_cdr = EMPTY_LIST;
+ while (end_copy > start_copy)
+ {
+ if ((end_copy [-1]) == 0)
+ end_copy -= 1;
+ else
+ previous_cdr =
+ (cons
+ ((MAKE_UNSIGNED_FIXNUM (scale_down_self (working_copy, radix))),
+ previous_cdr));
+ }
+ PRIMITIVE_RETURN (previous_cdr);
}
- Free[CONS_CDR] = EMPTY_LIST;
- Free = RFree;
- return Make_Pointer(TC_LIST, RFree-2);
}
\f
-/* All the binary bignum primitives take two arguments and return NIL
- if either of them is not a bignum. If both arguments are bignums,
- the perform the operation and return the answer.
-*/
-
-#define Binary_Primitive(Op) \
+#define BINARY_PRIMITIVE(operator) \
{ \
- Pointer Result, *Orig_Free; \
- Primitive_2_Args(); \
+ PRIMITIVE_HEADER (2); \
\
- Arg_1_Type(TC_BIG_FIXNUM); \
- Arg_2_Type(TC_BIG_FIXNUM); \
- Set_Time_Zone(Zone_Math); \
- Orig_Free = Free; \
- Result = Op(BIGNUM(Get_Pointer(Arg1)), BIGNUM(Get_Pointer(Arg2))); \
- if (Consistency_Check && (Get_Pointer(Result) != Orig_Free)) \
- { \
- fprintf(stderr, "\nBignum operation result at 0x%x, Free was 0x%x\n", \
- Address(Result), Free); \
- Microcode_Termination(TERM_EXIT); \
- } \
- Free = Nth_Vector_Loc(Result, Vector_Length(Result)+1); \
- if (Consistency_Check && (Free > Heap_Top)) \
+ Set_Time_Zone (Zone_Math); \
+ CHECK_ARG (1, BIGNUM_P); \
+ CHECK_ARG (2, BIGNUM_P); \
{ \
- fprintf(stderr, "\nBignum operation result at 0x%x, length 0x%x\n", \
- Address(Result), Vector_Length(Result)); \
- Microcode_Termination(TERM_EXIT); \
+ Pointer * original_free = Free; \
+ Pointer result = \
+ (operator \
+ ((BIGNUM (Get_Pointer (ARG_REF (1)))), \
+ (BIGNUM (Get_Pointer (ARG_REF (2)))))); \
+ if (Consistency_Check && ((Get_Pointer (result)) != original_free)) \
+ { \
+ fprintf (stderr, \
+ "\nBignum operation result at 0x%x, Free was 0x%x\n", \
+ (Address (result)), \
+ Free); \
+ Microcode_Termination (TERM_EXIT); \
+ } \
+ Free = (Nth_Vector_Loc (result, ((Vector_Length (result)) + 1))); \
+ if (Consistency_Check && (Free > Heap_Top)) \
+ { \
+ fprintf (stderr, \
+ "\nBignum operation result at 0x%x, length 0x%x\n", \
+ (Address (result)), \
+ (Vector_Length (result))); \
+ Microcode_Termination (TERM_EXIT); \
+ } \
+ PRIMITIVE_RETURN (result); \
} \
- return Result; \
}
DEFINE_PRIMITIVE ("PLUS-BIGNUM", Prim_plus_bignum, 2, 2, 0)
-Binary_Primitive(plus_signed_bignum)
+BINARY_PRIMITIVE (plus_signed_bignum)
DEFINE_PRIMITIVE ("MINUS-BIGNUM", Prim_minus_bignum, 2, 2, 0)
-Binary_Primitive(minus_signed_bignum)
+BINARY_PRIMITIVE (minus_signed_bignum)
DEFINE_PRIMITIVE ("MULTIPLY-BIGNUM", Prim_multiply_bignum, 2, 2, 0)
-Binary_Primitive(multiply_signed_bignum)
+BINARY_PRIMITIVE (multiply_signed_bignum)
\f
/* (DIVIDE-BIGNUM ONE-BIGNUM ANOTHER_BIGNUM)
* returns a cons of the bignum quotient and remainder of both arguments.
DEFINE_PRIMITIVE ("DIVIDE-BIGNUM", Prim_divide_bignum, 2, 2, 0)
{
- Pointer Result, *End_Of_First, *First, *Second, *Orig_Free=Free;
+ Pointer Result, *End_Of_First, *First, *Second, *original_free=Free;
Primitive_2_Args();
Arg_1_Type(TC_BIG_FIXNUM);
fprintf(stderr, "\nBignum_Divide: results swapped.\n");
Microcode_Termination(TERM_EXIT);
}
- else if (First != Orig_Free+2)
+ else if (First != original_free+2)
{
fprintf(stderr, "\nBignum Divide: hole at start\n");
Microcode_Termination(TERM_EXIT);
}
}
- End_Of_First = First + 1 + Get_Integer(First[0]);
+ End_Of_First = First + 1 + (OBJECT_DATUM (First[0]));
if (Bignum_Debug)
printf("\nEnd_Of_First=0x%x\n", End_Of_First);
if (End_Of_First != Second)
if (Bignum_Debug)
printf("\nGap=0x%x\n", (Second-End_Of_First)-1);
}
- Free = Second + 1 + Get_Integer(Second[0]);
+ Free = Second + 1 + (OBJECT_DATUM (Second[0]));
if (Bignum_Debug)
printf("\nEnd=0x%x\n", Free);
return Result;
Arg_1_Type(TC_BIG_FIXNUM); \
Set_Time_Zone(Zone_Math); \
ARG = BIGNUM(Get_Pointer(Arg1)); \
- return Make_Unsigned_Fixnum(((Test) ? 1 : 0)); \
+ return (MAKE_UNSIGNED_FIXNUM (((Test) ? 1 : 0))); \
}
DEFINE_PRIMITIVE ("ZERO-BIGNUM?", Prim_zero_bignum, 1, 1, 0)
result = 1; \
else \
result = 0; \
- return Make_Unsigned_Fixnum(result); \
+ return (MAKE_UNSIGNED_FIXNUM (result)); \
}
DEFINE_PRIMITIVE ("EQUAL-BIGNUM?", Prim_equal_bignum, 2, 2, 0)
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/char.c,v 9.26 1988/08/15 20:43:16 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 9.27 1989/08/28 18:28:24 cph Exp $ */
/* Character primitives. */
CHECK_ARG (n, CHARACTER_P);
ascii = ARG_REF(n);
- if (pointer_datum(ascii) >= MAX_ASCII)
+ if (OBJECT_DATUM(ascii) >= MAX_ASCII)
error_bad_range_arg (n);
return (scheme_char_to_c_char(ascii));
}
CHECK_ARG (1, CHARACTER_P);
character = ARG_REF (1);
PRIMITIVE_RETURN
- ((pointer_datum(character) >= MAX_ASCII) ?
+ ((OBJECT_DATUM(character) >= MAX_ASCII) ?
NIL :
(MAKE_UNSIGNED_FIXNUM (scheme_char_to_c_char(character))));
}
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/Attic/config.h,v 9.45 1989/08/02 17:04:43 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.46 1989/08/28 18:28:38 cph Exp $
*
* This file contains the configuration information and the information
* given on the command line on Unix.
#define FLONUM_MANTISSA_BITS 53
#define MAX_FLONUM_EXPONENT 2047
#endif
-
+\f
#ifdef hp9000s800
-/* Heap resides in "Quad 1", and hence memory addresses have a 1
- in the second MSBit. This is taken care of in object.h, and is
- still considered Heap_In_Low_Memory.
-*/
#define MACHINE_TYPE "hp9000s800"
-#define Heap_In_Low_Memory
#define UNSIGNED_SHIFT
#define CHAR_SIZE 8
#define USHORT_SIZE 16
#define FLOATING_ALIGNMENT 0x7 /* Low 3 MBZ for float storage */
#define HAS_FLOOR
#define HAS_FREXP
-#endif
+
+#ifndef AVOID_SPECTRUM_TC_KLUDGE
+
+/* Heap resides in "Quad 1", and hence memory addresses have a 1
+ in the second MSBit. This is kludged by the definitions below, and is
+ still considered Heap_In_Low_Memory.
+*/
+
+#define Heap_In_Low_Memory
+
+/* It must be at least one more than the minimum necessary,
+ and it may not work if it is not even.
+ */
+
+#define TYPE_CODE_LENGTH 8
+
+/* Clear the quad tag if there */
+
+#define TC_BITS_TO_TC(BITS) ((BITS) & 0x3F)
+
+/* This assumes that the max type code is 6, so that it does not
+ overflow into the quad tag.
+ */
+
+#define TC_TO_TC_BITS(TC) (TC)
+
+#define OBJECT_TYPE(O) (TC_BITS_TO_TC((O) >> ADDRESS_LENGTH))
+
+/* Keep quad bit. */
+
+#define OBJECT_DATUM(O) ((O) & 0x40FFFFFF)
+
+#define MAKE_OBJECT(TC, D) \
+ ((((unsigned) (TC_TO_TC_BITS(TC))) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
+
+#endif /* AVOID_SPECTRUM_TC_KLUDGE */
+#endif /* spectrum */
\f
#ifdef umax
#define MACHINE_TYPE "umax"
#endif
#ifndef COMPILER_HEAP_SIZE
-#define COMPILER_HEAP_SIZE 1000
+#define COMPILER_HEAP_SIZE 500
#endif
#ifndef COMPILER_CONSTANT_SIZE
-#define COMPILER_CONSTANT_SIZE 800
+#define COMPILER_CONSTANT_SIZE 1000
#endif
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/const.h,v 9.33 1989/06/16 09:37:04 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.34 1989/08/28 18:28:42 cph Exp $
*
* Named constants used throughout the interpreter
*
#define STACK_FRAME_HEADER 1
/* Precomputed typed pointers */
-#ifndef b32 /* Safe version */
+#ifdef b32 /* 32 bit word */
-#define SHARP_F Make_Non_Pointer(TC_NULL, 0)
-#define SHARP_T Make_Non_Pointer(TC_TRUE, 0)
-#define UNSPECIFIC Make_Non_Pointer(TC_TRUE, 1)
-#define FIXNUM_ZERO Make_Non_Pointer(TC_FIXNUM, 0)
-#define BROKEN_HEART_ZERO Make_Non_Pointer(TC_BROKEN_HEART, 0)
-
-#else /* 32 bit word */
+#if (TYPE_CODE_LENGTH == 8)
#define SHARP_F 0x00000000
#define SHARP_T 0x08000000
#define UNSPECIFIC 0x08000001
#define FIXNUM_ZERO 0x1A000000
#define BROKEN_HEART_ZERO 0x22000000
-#endif /* b32 */
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define SHARP_F 0x00000000
+#define SHARP_T 0x20000000
+#define UNSPECIFIC 0x20000001
+#define FIXNUM_ZERO 0x68000000
+#define BROKEN_HEART_ZERO 0x88000000
+#endif /* (TYPE_CODE_LENGTH == 6) */
+
+#endif /* b32 */
+
+#ifndef SHARP_F /* Safe version */
+#define SHARP_F Make_Non_Pointer(TC_NULL, 0)
+#define SHARP_T Make_Non_Pointer(TC_TRUE, 0)
+#define UNSPECIFIC Make_Non_Pointer(TC_TRUE, 1)
+#define FIXNUM_ZERO Make_Non_Pointer(TC_FIXNUM, 0)
+#define BROKEN_HEART_ZERO Make_Non_Pointer(TC_BROKEN_HEART, 0)
+#endif /* SHARP_F */
#define EMPTY_LIST SHARP_F
#define NIL SHARP_F
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/edwin.h,v 1.2 1988/08/15 20:45:21 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/edwin.h,v 1.3 1989/08/28 18:28:45 cph Exp $
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
/* Definitions for Edwin data structures.
This MUST match the definitions in the Edwin source code. */
\f
-#define GROUP_P(object) ((pointer_type (object)) == TC_VECTOR)
+#define GROUP_P(object) ((OBJECT_TYPE (object)) == TC_VECTOR)
#define GROUP_TEXT(group) (User_Vector_Ref ((group), 1))
-#define GROUP_GAP_START(group) (Get_Integer (User_Vector_Ref ((group), 2)))
-#define GROUP_GAP_LENGTH(group) (Get_Integer (User_Vector_Ref ((group), 3)))
-#define GROUP_GAP_END(group) (Get_Integer (User_Vector_Ref ((group), 4)))
+#define GROUP_GAP_START(group) (UNSIGNED_FIXNUM_VALUE (User_Vector_Ref ((group), 2)))
+#define GROUP_GAP_LENGTH(group) (UNSIGNED_FIXNUM_VALUE (User_Vector_Ref ((group), 3)))
+#define GROUP_GAP_END(group) (UNSIGNED_FIXNUM_VALUE (User_Vector_Ref ((group), 4)))
#define GROUP_START_MARK(group) (User_Vector_Ref ((group), 6))
#define GROUP_END_MARK(group) (User_Vector_Ref ((group), 7))
#define MARK_GROUP(mark) (User_Vector_Ref ((mark), 1))
-#define MARK_POSITION(mark) (Get_Integer (User_Vector_Ref ((mark), 2)))
-#define MARK_LEFT_INSERTING(mark) ((User_Vector_Ref ((mark), 3)) != NIL)
+#define MARK_POSITION(mark) (UNSIGNED_FIXNUM_VALUE (User_Vector_Ref ((mark), 2)))
+#define MARK_LEFT_INSERTING(mark) ((User_Vector_Ref ((mark), 3)) != SHARP_F)
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/extern.h,v 9.31 1989/06/16 09:37:49 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.32 1989/08/28 18:28:48 cph Exp $
*
* External declarations.
*
extern Boolean Restore_History();
extern long NColumns(), NLines(), OS_process_clock ();
extern void OS_Flush_Output_Buffer(), OS_Re_Init();
+extern Pointer cons ();
+extern Pointer allocate_non_marked_vector ();
+extern Pointer allocate_marked_vector ();
+extern Pointer make_vector ();
/* Memory management utilities */
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/Attic/gctype.c,v 9.29 1988/08/15 20:48:26 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/gctype.c,v 9.30 1989/08/28 18:28:51 cph Rel $
*
* This file contains the table which maps between Types and
* GC Types.
GC_Pair, /* TC_COMPLEX */
GC_Vector, /* TC_COMPILED_CODE_BLOCK */
GC_Undefined, /* 0x3E */
+
+#if (TYPE_CODE_LENGTH == 6)
+
+ GC_Undefined /* 0x3F */
+
+#else /* (TYPE_CODE_LENGTH != 6) */
+
GC_Undefined, /* 0x3F */
GC_Undefined, /* 0x40 */
GC_Undefined, /* 0x41 */
GC_Undefined, /* 0xFC */
GC_Undefined, /* 0xFD */
GC_Undefined, /* 0xFE */
- GC_Undefined /* 0xFF */
+ GC_Undefined /* last */
+#endif /* (TYPE_CODE_LENGTH != 6) */
+
};
+#if (TYPE_CODE_LENGTH == 6)
+
+#if (MAX_TYPE_CODE != 0x3F)
+#include "gctype.c and object.h inconsistent -- GC_Type_Map"
+#endif
+
+#else /* (TYPE_CODE_LENGTH != 6) */
+
#if (MAX_TYPE_CODE != 0xFF)
-#include "gctype.c and scheme.h inconsistent -- GC_Type_Map"
+#include "gctype.c and object.h inconsistent -- GC_Type_Map"
#endif
+#endif /* (TYPE_CODE_LENGTH == 6) */
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/intern.c,v 9.49 1989/07/05 18:45:54 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/intern.c,v 9.50 1989/08/28 18:28:55 cph Exp $ */
/* String hash functions and interning of symbols. */
list in the bucket by 1 new element). */
fast Pointer result =
- (Make_Object (TC_INTERNED_SYMBOL, (OBJECT_DATUM (symbol))));
+ (MAKE_OBJECT (TC_INTERNED_SYMBOL, (OBJECT_DATUM (symbol))));
Primitive_GC_If_Needed (2);
(*cell) = (Make_Pointer (TC_LIST, Free));
(Free [CONS_CAR]) = result;
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/list.c,v 9.26 1988/08/15 20:50:44 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/list.c,v 9.27 1989/08/28 18:28:59 cph Exp $
*
* List creation and manipulation primitives.
*/
#include "scheme.h"
#include "prims.h"
\f
-/* (CONS LEFT RIGHT)
- Creates a pair with left component LEFT and right component
- RIGHT.
-*/
-DEFINE_PRIMITIVE ("CONS", Prim_cons, 2, 2, 0)
+Pointer
+cons (car, cdr)
+ Pointer car;
+ Pointer cdr;
{
- Primitive_2_Args();
-
- Primitive_GC_If_Needed(2);
- *Free++ = Arg1;
- *Free++ = Arg2;
- return Make_Pointer(TC_LIST, Free-2);
+ Pointer result = (Make_Pointer (TC_LIST, Free));
+ Primitive_GC_If_Needed (2);
+ (*Free++) = car;
+ (*Free++) = cdr;
+ return (result);
}
-/* (CDR PAIR)
- Returns the second element in the pair.
-*/
-DEFINE_PRIMITIVE ("CDR", Prim_cdr, 1, 1, 0)
+DEFINE_PRIMITIVE ("CONS", Prim_cons, 2, 2, 0)
{
- Primitive_1_Arg();
-
- Arg_1_Type(TC_LIST);
- return Vector_Ref(Arg1, CONS_CDR);
+ PRIMITIVE_HEADER (2);
+ PRIMITIVE_RETURN (cons ((ARG_REF (1)), (ARG_REF (2))));
}
-/* (CAR PAIR)
- Returns the first element in the pair.
-*/
DEFINE_PRIMITIVE ("CAR", Prim_car, 1, 1, 0)
{
- Primitive_1_Arg();
+ PRIMITIVE_HEADER (1);
+ CHECK_ARG (1, PAIR_P);
+ PRIMITIVE_RETURN (Vector_Ref ((ARG_REF (1)), CONS_CAR));
+}
- Arg_1_Type(TC_LIST);
- return Vector_Ref(Arg1, CONS_CAR);
+DEFINE_PRIMITIVE ("CDR", Prim_cdr, 1, 1, 0)
+{
+ PRIMITIVE_HEADER (1);
+ CHECK_ARG (1, PAIR_P);
+ PRIMITIVE_RETURN (Vector_Ref ((ARG_REF (1)), CONS_CDR));
}
\f
/* (GENERAL-CAR-CDR LIST DIRECTIONS)
/* -*-C-*-
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 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/lookup.h,v 9.42 1989/05/31 01:50:41 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.h,v 9.43 1989/08/28 18:29:03 cph Exp $ */
/* Macros and declarations for the variable lookup code. */
/* Common constants. */
-#ifndef b32
-#define UNCOMPILED_VARIABLE Make_Non_Pointer(UNCOMPILED_REF, 0)
-#else
+#ifdef b32 /* 32 bit objects */
+
+#if (TYPE_CODE_LENGTH == 8)
#define UNCOMPILED_VARIABLE 0x08000000
#endif
+#if (TYPE_CODE_LENGTH == 6)
+#define UNCOMPILED_VARIABLE 0x20000000
+#endif
+
+#if (TC_TRUE != 0x08)
+#include "error:lookup.h and types.h are inconsistent"
+#endif
+
+#endif /* b32 */
+
+#ifndef UNCOMPILED_VARIABLE /* Safe version */
+#define UNCOMPILED_VARIABLE Make_Non_Pointer(UNCOMPILED_REF, 0)
+#endif
+
/* Macros for speedy variable reference. */
#if (LOCAL_REF == 0)
fast long depth; \
\
verify(FORMAL_REF, offset, get_offset(hunk), label); \
- depth = Get_Integer(frame); \
+ depth = (OBJECT_DATUM (frame)); \
frame = env; \
while(--depth >= 0) \
{ \
fast long depth; \
\
verify(AUX_REF, offset, get_offset(hunk), label); \
- depth = Get_Integer(frame); \
+ depth = (OBJECT_DATUM (frame)); \
frame = env; \
while(--depth >= 0) \
{ \
/* -*-C-*-
Machine file for HP9000 series 300 (or 200)
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/m/Attic/hp9k300.h,v 1.4 1989/07/27 08:17:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/m/Attic/hp9k300.h,v 1.5 1989/08/28 18:30:12 cph Exp $
Copyright (c) 1989 Massachusetts Institute of Technology
model 310. */
#define PROC_TYPE PROC_TYPE_68020
+#define C_SWITCH_MACHINE -DTYPE_CODE_LENGTH=6
+
#if (PROC_TYPE == PROC_TYPE_68020)
-#define M4_SWITCH_MACHINE -DMC68881
+#define M4_SWITCH_MACHINE -DMC68881 -DTYPE_CODE_LENGTH=6
#define AS_SWITCH_MACHINE +x -V 3
#else
#define M4_SWITCH_MACHINE
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/memmag.c,v 9.38 1989/06/08 00:24:10 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.39 1989/08/28 18:29:06 cph Exp $ */
/* Memory management top level.
Setup_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size)
int Our_Heap_Size, Our_Stack_Size, Our_Constant_Size;
{
+ Pointer test_value;
+
/* Consistency check 1 */
if (Our_Heap_Size == 0)
{
Align_Float(Constant_Space);
/* Consistency check 3 */
- if (((C_To_Scheme(Highest_Allocated_Address)) & TYPE_CODE_MASK) != 0)
+
+ test_value = (Make_Pointer(LAST_TYPE_CODE, Highest_Allocated_Address));
+
+ if (((OBJECT_TYPE(test_value)) != LAST_TYPE_CODE) ||
+ ((Get_Pointer(test_value)) != Highest_Allocated_Address))
{
fprintf(stderr,
"Largest address does not fit in datum field of Pointer.\n");
}
ENTER_CRITICAL_SECTION ("garbage collector");
gc_counter += 1;
- GC_Reserve = Get_Integer(Arg1);
+ GC_Reserve = (UNSIGNED_FIXNUM_VALUE (Arg1));
GCFlip();
GC();
CLEAR_INTERRUPT(INT_GC);
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/object.h,v 9.30 1989/05/24 18:14:52 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/object.h,v 9.31 1989/08/28 18:29:10 cph Exp $ */
/* This file contains definitions pertaining to the C view of
Scheme pointers: widths of fields, extraction macros, pre-computed
POINTER_LENGTH is defined this way to make it available to
the preprocessor. */
-/* TYPE_CODE_LENGTH must match the value in Wsize.c! */
-#define TYPE_CODE_LENGTH 8 /* Not CHAR_SIZE!! */
-#define MAX_TYPE_CODE 0xFF /* ((1<<TYPE_CODE_LENGTH) - 1) */
-#define POINTER_LENGTH ULONG_SIZE
-
-#ifndef b32 /* Portable versions */
+/* The value in Wsize.c for TYPE_CODE_LENGTH must match this!! */
+
+#ifndef TYPE_CODE_LENGTH
+#define TYPE_CODE_LENGTH 8
+#endif
+
+#if (TYPE_CODE_LENGTH == 8)
+#define MAX_TYPE_CODE 0xFF
+#endif
+
+#if (TYPE_CODE_LENGTH == 6)
+#define MAX_TYPE_CODE 0x3F
+#endif
-#define ADDRESS_LENGTH (POINTER_LENGTH-TYPE_CODE_LENGTH)
-#define ADDRESS_MASK ((1 << ADDRESS_LENGTH) - 1)
-#define TYPE_CODE_MASK (~ADDRESS_MASK)
-/* FIXNUM_LENGTH does NOT include the sign bit! */
-#define FIXNUM_LENGTH (ADDRESS_LENGTH - 1)
-#define FIXNUM_SIGN_BIT (1 << FIXNUM_LENGTH)
-#define SIGN_MASK (TYPE_CODE_MASK | FIXNUM_SIGN_BIT)
-#define SMALLEST_FIXNUM ((long) (-1 << FIXNUM_LENGTH))
-#define BIGGEST_FIXNUM ((long) (~(-1 << FIXNUM_LENGTH)))
+#ifdef MIN_TYPE_CODE_LENGTH
+#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#endif
+#endif
+
+#ifndef MAX_TYPE_CODE
+#define MAX_TYPE_CODE ((1 << TYPE_CODE_LENGTH) - 1)
+#endif
-#define HALF_ADDRESS_LENGTH (ADDRESS_LENGTH / 2)
-#define HALF_ADDRESS_MASK ((1 << HALF_ADDRESS_LENGTH) - 1)
+#define POINTER_LENGTH ULONG_SIZE
+
+#ifdef b32 /* 32 bit word versions */
-#else /* 32 bit word versions */
+#if (TYPE_CODE_LENGTH == 8)
#define ADDRESS_LENGTH 24
#define ADDRESS_MASK 0x00FFFFFF
#define SIGN_MASK 0xFF800000
#define SMALLEST_FIXNUM ((long) 0xFF800000)
#define BIGGEST_FIXNUM ((long) 0x007FFFFF)
-
#define HALF_ADDRESS_LENGTH 12
#define HALF_ADDRESS_MASK 0x00000FFF
-
-#endif
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define ADDRESS_LENGTH 26
+#define ADDRESS_MASK 0x03FFFFFF
+#define TYPE_CODE_MASK 0XFC000000
+#define FIXNUM_LENGTH 25
+#define FIXNUM_SIGN_BIT 0x02000000
+#define SIGN_MASK 0xFE000000
+#define SMALLEST_FIXNUM ((long) 0xFE000000)
+#define BIGGEST_FIXNUM ((long) 0x01FFFFFF)
+#define HALF_ADDRESS_LENGTH 13
+#define HALF_ADDRESS_MASK 0x00001FFF
+#endif /* (TYPE_CODE_LENGTH == 6) */
+
+#endif /* b32 */
+
+#ifndef ADDRESS_LENGTH /* Safe versions */
+#define ADDRESS_LENGTH (POINTER_LENGTH-TYPE_CODE_LENGTH)
+#define ADDRESS_MASK ((1 << ADDRESS_LENGTH) - 1)
+#define TYPE_CODE_MASK (~ADDRESS_MASK)
+/* FIXNUM_LENGTH does NOT include the sign bit! */
+#define FIXNUM_LENGTH (ADDRESS_LENGTH - 1)
+#define FIXNUM_SIGN_BIT (1 << FIXNUM_LENGTH)
+#define SIGN_MASK (TYPE_CODE_MASK | FIXNUM_SIGN_BIT)
+#define SMALLEST_FIXNUM ((long) (-1 << FIXNUM_LENGTH))
+#define BIGGEST_FIXNUM ((long) (~(-1 << FIXNUM_LENGTH)))
+#define HALF_ADDRESS_LENGTH (ADDRESS_LENGTH / 2)
+#define HALF_ADDRESS_MASK ((1 << HALF_ADDRESS_LENGTH) - 1)
+#endif /* ADDRESS_LENGTH */
\f
+#ifndef OBJECT_TYPE
#ifndef UNSIGNED_SHIFT /* Portable version */
#define OBJECT_TYPE(P) (((P) >> ADDRESS_LENGTH) & MAX_TYPE_CODE)
#else /* Faster for logical shifts */
#define OBJECT_TYPE(P) ((P) >> ADDRESS_LENGTH)
#endif
+#endif /* OBJECT_TYPE */
+#ifndef OBJECT_DATUM
#define OBJECT_DATUM(P) ((P) & ADDRESS_MASK)
+#endif
+
+#ifndef MAKE_OBJECT
+#define MAKE_OBJECT(TC, D) \
+ ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
+#endif
/* compatibility definitions */
#define Type_Code(P) (OBJECT_TYPE (P))
#define Datum(P) (OBJECT_DATUM (P))
-
-#define pointer_type(P) (OBJECT_TYPE (P))
-#define pointer_datum(P) (OBJECT_DATUM (P))
-
-#define Make_Object(TC, D) \
- ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
\f
#ifndef Heap_In_Low_Memory /* Portable version */
#define Get_Pointer(P) ((Pointer *) (Memory_Base + (OBJECT_DATUM (P))))
#define C_To_Scheme(P) ((Pointer) ((P) - Memory_Base))
-#else /* Storing absolute addresses */
+#else /* not Heap_In_Low_Memory */
+/* Storing absolute addresses */
typedef long relocation_type; /* Used to relocate pointers on fasload */
(Heap = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \
((Heap + (space)) - 1))
-#ifdef spectrum
-
-#define Quad1_Tag 0x40000000
-#define Get_Pointer(P) ((Pointer *) (((P) & ADDRESS_MASK) | Quad1_Tag))
-#define C_To_Scheme(P) ((Pointer) (((long) (P)) & ADDRESS_MASK))
-
-#else /* Not Spectrum, fast case */
-
#define Get_Pointer(P) ((Pointer *) (OBJECT_DATUM (P)))
#define C_To_Scheme(P) ((Pointer) (P))
-#endif /* spectrum */
#endif /* Heap_In_Low_Memory */
\f
-#define Make_Pointer(TC, A) Make_Object((TC), C_To_Scheme(A))
-#define Make_Non_Pointer(TC, D) Make_Object(TC, ((Pointer) (D)))
+#define Make_Pointer(TC, A) MAKE_OBJECT((TC), C_To_Scheme(A))
+#define Make_Non_Pointer(TC, D) MAKE_OBJECT(TC, ((Pointer) (D)))
/* (Make_New_Pointer (TC, A)) may be more efficient than
(Make_Pointer (TC, (Get_Pointer (A)))) */
-#define Make_New_Pointer(TC, A) (Make_Object (TC, ((Pointer) A)))
+#define Make_New_Pointer(TC, A) (MAKE_OBJECT (TC, ((Pointer) A)))
-#define Store_Type_Code(P, TC) P = (Make_Object ((TC), (P)))
+#define Store_Type_Code(P, TC) P = (MAKE_OBJECT ((TC), (P)))
#define Store_Address(P, A) \
P = (((P) & TYPE_CODE_MASK) | (OBJECT_DATUM ((Pointer) (A))))
#define Fast_User_Vector_Ref(P, N) Fast_Vector_Ref(P, (N)+1)
#define Fast_User_Vector_Set(P, N, S) Fast_Vector_Set(P, (N)+1, S)
#define Nth_Vector_Loc(P, N) (&(Fast_Vector_Ref(P, N)))
-#define Vector_Length(P) (Get_Integer(Fast_Vector_Ref((P), 0)))
+#define Vector_Length(P) (OBJECT_DATUM (Fast_Vector_Ref((P), 0)))
/* General case vector handling requires atomicity for parallel processors */
#define MAKE_FIXNUM(N) (Make_Non_Pointer (TC_FIXNUM, (N)))
#define FIXNUM_NEGATIVE_P(fixnum) (((fixnum) & FIXNUM_SIGN_BIT) != 0)
#define MAKE_UNSIGNED_FIXNUM(N) (FIXNUM_ZERO + (N))
-#define UNSIGNED_FIXNUM_VALUE(fixnum) (OBJECT_DATUM (fixnum))
-#define MAKE_SIGNED_FIXNUM Make_Signed_Fixnum
-#define long_to_object C_Integer_To_Scheme_Integer
+#define UNSIGNED_FIXNUM_VALUE OBJECT_DATUM
+#define MAKE_SIGNED_FIXNUM MAKE_FIXNUM
+#define NONNEGATIVE_FIXNUM_P(x) ((FIXNUM_P (x)) && (! (FIXNUM_NEGATIVE_P (x))))
#define FIXNUM_VALUE(fixnum, target) \
do \
(target) |= (-1 << ADDRESS_LENGTH); \
} while (0)
+/* Compatibility */
+#define Make_Unsigned_Fixnum MAKE_UNSIGNED_FIXNUM
+#define Make_Signed_Fixnum MAKE_FIXNUM
+#define Get_Integer OBJECT_DATUM
+#define Sign_Extend FIXNUM_VALUE
+
#define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F)
#define Make_Broken_Heart(N) (BROKEN_HEART_ZERO + (N))
-#define Make_Unsigned_Fixnum(N) (FIXNUM_ZERO + (N))
-#define Make_Signed_Fixnum(N) Make_Non_Pointer( TC_FIXNUM, (N))
#define Get_Float(P) (* ((double *) (Nth_Vector_Loc ((P), 1))))
-#define Get_Integer(P) (OBJECT_DATUM (P))
-
-#define Sign_Extend(P, S) \
-{ \
- (S) = (Get_Integer (P)); \
- if (((S) & FIXNUM_SIGN_BIT) != 0) \
- (S) |= (-1 << ADDRESS_LENGTH); \
-}
#define Fixnum_Fits(x) \
((((x) & SIGN_MASK) == 0) || \
/* -*-C-*-
-Copyright (c) 1987 Massachusetts Institute of Technology
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/ppband.c,v 9.34 1989/08/28 18:28:03 cph Exp $
+
+Copyright (c) 1987, 1989 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/Attic/ppband.c,v 9.33 1989/02/14 20:41:32 jinx Rel $
- *
- * Dumps Scheme FASL in user-readable form .
- */
+/* Dumps Scheme FASL in user-readable form. */
#include <stdio.h>
#include "config.h"
#include "types.h"
#include "const.h"
#include "object.h"
+#include "gccode.h"
#include "sdata.h"
#define fast register
}
\f
Pointer *
-show_area(area, size, name)
+show_area(area, start, end, name)
fast Pointer *area;
- fast long size;
+ long start;
+ fast long end;
char *name;
{
fast long i;
printf("\n%s contents:\n\n", name);
- for (i = 0; i < size; area++, i++)
+ for (i = start; i < end; area++, i++)
{
- if (OBJECT_TYPE(*area) == TC_MANIFEST_NM_VECTOR)
+ if ((OBJECT_TYPE(*area) == TC_MANIFEST_NM_VECTOR) ||
+ (OBJECT_TYPE(*area) == TC_MANIFEST_CLOSURE) ||
+ (OBJECT_TYPE(*area) == TC_LINKAGE_SECTION))
{
fast long j, count;
- count = Get_Integer(*area);
+ count =
+ ((OBJECT_TYPE(*area) == TC_LINKAGE_SECTION)
+ ? (READ_CACHE_LINKAGE_COUNT (*area))
+ : (OBJECT_DATUM (*area)));
Display(i, OBJECT_TYPE(*area), OBJECT_DATUM(*area));
area += 1;
for (j = 0; j < count ; j++, area++)
\f
if (Heap_Count > 0)
{
- Next = show_area(Data, Heap_Count, "Heap");
+ Next = show_area(Data, 0, Heap_Count, "Heap");
}
if (Const_Count > 0)
{
- Next = show_area(Next, Const_Count, "Constant Space");
+ Next = show_area(Next, Heap_Count, Const_Count, "Constant Space");
}
if ((Primitive_Table_Size > 0) && (Next < end_of_memory))
{
count += 1)
{
Sign_Extend(*Next++, arity);
- size = Get_Integer(*Next);
+ size = (OBJECT_DATUM (*Next));
printf("Number = %3lx; Arity = %2ld; Name = ", count, arity);
scheme_string((Next - Data), true);
Next += (1 + size);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.c,v 9.31 1988/08/15 20:52:46 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.c,v 9.32 1989/08/28 18:29:14 cph Exp $
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 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 (C_Integer_To_Scheme_Integer (OBJECT_DATUM (ARG_REF (1))));
}
\f
-/* (MAKE-NON-POINTER-OBJECT NUMBER)
- Converts the unsigned integer NUMBER into a fixnum, by creating an
- object whose type is TC_FIXNUM and whose datum is NUMBER. */
-
-DEFINE_PRIMITIVE ("MAKE-NON-POINTER-OBJECT", Prim_make_non_pointer_object, 1, 1, 0)
+DEFINE_PRIMITIVE ("MAKE-NON-POINTER-OBJECT", Prim_make_non_pointer_object, 1, 1,
+ "Convert the unsigned integer NUMBER into a fixnum.\n\
+The result has a fixnum type and a datum of NUMBER.")
{
+ fast Pointer result;
fast long datum;
PRIMITIVE_HEADER (1);
datum = (object_to_long ((ARG_REF (1)),
ERR_ARG_1_WRONG_TYPE,
ERR_ARG_1_BAD_RANGE));
- if ((datum < 0) || (datum > ADDRESS_MASK))
+
+ result = (MAKE_FIXNUM (datum));
+ if ((datum < 0) ||
+ (!(FIXNUM_P(result))) ||
+ ((OBJECT_DATUM(result)) != datum))
+ {
error_bad_range_arg (1);
- PRIMITIVE_RETURN (MAKE_FIXNUM (datum));
+ }
+ PRIMITIVE_RETURN (result);
}
/* (PRIMITIVE-OBJECT-SET-TYPE TYPE-CODE OBJECT)
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/prims.h,v 9.34 1989/05/31 01:50:51 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.35 1989/08/28 18:29:17 cph Exp $ */
/* This file contains some macros for defining primitives,
for argument type or value checking, and for accessing
}
#define Primitive_GC_If_Needed(Amount) \
- if (GC_Check (Amount)) Primitive_GC(Amount)
+{ \
+ if (GC_Check (Amount)) Primitive_GC(Amount); \
+}
#define Range_Check(To_Where, P, Low, High, Error) \
{ \
- To_Where = Get_Integer (P); \
+ To_Where = UNSIGNED_FIXNUM_VALUE (P); \
if ((To_Where < (Low)) || (To_Where > (High))) \
Primitive_Error (Error); \
}
/* Instances of the following should be flushed. */
#define Arg_1_Type(TC) \
-do { if ((pointer_type (Arg1)) != (TC)) error_wrong_type_arg (1); } while (0)
+do { if ((OBJECT_TYPE (Arg1)) != (TC)) error_wrong_type_arg (1); } while (0)
#define Arg_2_Type(TC) \
-do { if ((pointer_type (Arg2)) != (TC)) error_wrong_type_arg (2); } while (0)
+do { if ((OBJECT_TYPE (Arg2)) != (TC)) error_wrong_type_arg (2); } while (0)
#define Arg_3_Type(TC) \
-do { if ((pointer_type (Arg3)) != (TC)) error_wrong_type_arg (3); } while (0)
+do { if ((OBJECT_TYPE (Arg3)) != (TC)) error_wrong_type_arg (3); } while (0)
#define Arg_4_Type(TC) \
-do { if ((pointer_type (Arg4)) != (TC)) error_wrong_type_arg (4); } while (0)
+do { if ((OBJECT_TYPE (Arg4)) != (TC)) error_wrong_type_arg (4); } while (0)
#define Arg_5_Type(TC) \
-do { if ((pointer_type (Arg5)) != (TC)) error_wrong_type_arg (5); } while (0)
+do { if ((OBJECT_TYPE (Arg5)) != (TC)) error_wrong_type_arg (5); } while (0)
#define Arg_6_Type(TC) \
-do { if ((pointer_type (Arg6)) != (TC)) error_wrong_type_arg (6); } while (0)
+do { if ((OBJECT_TYPE (Arg6)) != (TC)) error_wrong_type_arg (6); } while (0)
#define Arg_7_Type(TC) \
-do { if ((pointer_type (Arg7)) != (TC)) error_wrong_type_arg (7); } while (0)
+do { if ((OBJECT_TYPE (Arg7)) != (TC)) error_wrong_type_arg (7); } while (0)
#define Arg_8_Type(TC) \
-do { if ((pointer_type (Arg8)) != (TC)) error_wrong_type_arg (8); } while (0)
+do { if ((OBJECT_TYPE (Arg8)) != (TC)) error_wrong_type_arg (8); } while (0)
#define Arg_9_Type(TC) \
-do { if ((pointer_type (Arg9)) != (TC)) error_wrong_type_arg (9); } while (0)
+do { if ((OBJECT_TYPE (Arg9)) != (TC)) error_wrong_type_arg (9); } while (0)
#define Arg_10_Type(TC) \
-do { if ((pointer_type (Arg10)) != (TC)) error_wrong_type_arg (10); } while (0)
+do { if ((OBJECT_TYPE (Arg10)) != (TC)) error_wrong_type_arg (10); } while (0)
#define Arg_1_GC_Type(GCTC) \
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/Attic/psbmap.h,v 9.27 1988/08/15 20:53:22 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbmap.h,v 9.28 1989/08/28 18:29:21 cph Exp $
*
* This file contains macros and declarations for Bintopsb.c
* and Psbtobin.c
#include <stdio.h>
#include "config.h"
+#include "types.h"
#include "object.h"
#include "bignum.h"
#include "bitstr.h"
-#include "types.h"
#include "sdata.h"
#include "const.h"
#include "gccode.h"
/* -*-C-*-
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1989 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/Attic/psbtobin.c,v 9.34 1988/04/25 17:30:02 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbtobin.c,v 9.35 1989/08/28 18:28:07 cph Exp $
*
* This File contains the code to translate portable format binary
* files to internal format.
case TC_BIG_FIXNUM:
case TC_BIG_FLONUM:
case TC_CHARACTER_STRING:
- *from++ == Make_Object(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
+ *from++ == MAKE_OBJECT(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
break;
default:
fprintf(stderr,
"Table[%6d] = Character %c = 0x%02x\n",
(N - (Table_End - Table)),
- Get_Integer(*Table),
- Get_Integer(*Table));
+ (OBJECT_DATUM (*Table)),
+ (OBJECT_DATUM (*Table)));
break;
case TC_CHARACTER_STRING:
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.c,v 1.18 1989/05/16 18:19:32 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.c,v 1.19 1989/08/28 18:29:24 cph Exp $
Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
in_comment = 0;
quoted = false;
}
- else if (((pointer_type (state_argument)) == TC_VECTOR) &&
+ else if (((OBJECT_TYPE (state_argument)) == TC_VECTOR) &&
(Vector_Length (state_argument)) == 7)
{
Pointer temp;
temp = (User_Vector_Ref (state_argument, 1));
if (temp == NIL)
in_string = -1;
- else if ((FIXNUM_P (temp)) && ((pointer_datum (temp)) < MAX_ASCII))
- in_string = (pointer_datum (temp));
+ else if ((FIXNUM_P (temp)) && ((OBJECT_DATUM (temp)) < MAX_ASCII))
+ in_string = (OBJECT_DATUM (temp));
else
error_bad_range_arg (7);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.h,v 1.5 1989/05/16 16:39:58 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.h,v 1.6 1989/08/28 18:29:28 cph Exp $
Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
extern char syntax_spec_code[0200];
#define SYNTAX_TABLE_P(argument) \
- (((pointer_type (argument)) == TC_VECTOR) && \
- ((Vector_Length (argument)) == 0x100))
+ ((VECTOR_P (argument)) && ((Vector_Length (argument)) == 0x100))
#define SYNTAX_TABLE_TYPE Pointer
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/trap.h,v 9.40 1988/08/15 20:56:29 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/trap.h,v 9.41 1989/08/28 18:29:32 cph Exp $ */
\f
/* Kinds of traps:
\f
/* Common constants */
-#ifndef b32
-#define UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
-#define DANGEROUS_UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
-#define UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
-#define DANGEROUS_UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
-#define ILLEGAL_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL)
-#define DANGEROUS_ILLEGAL_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
-#define EXPENSIVE_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
-#define DANGEROUS_EXPENSIVE_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
-#else
+#ifdef b32 /* 32 bit objects */
+
+#if (TYPE_CODE_LENGTH == 8)
#define UNASSIGNED_OBJECT 0x32000000
#define DANGEROUS_UNASSIGNED_OBJECT 0x32000001
#define UNBOUND_OBJECT 0x32000002
#define DANGEROUS_ILLEGAL_OBJECT 0x32000005
#define EXPENSIVE_OBJECT 0x32000006
#define DANGEROUS_EXPENSIVE_OBJECT 0x32000007
-#endif
-
-#define NOP_OBJECT Make_Unsigned_Fixnum(TRAP_NOP)
-#define DANGEROUS_OBJECT Make_Unsigned_Fixnum(TRAP_DANGEROUS)
-#define REQUEST_RECACHE_OBJECT DANGEROUS_ILLEGAL_OBJECT
-#define EXPENSIVE_ASSIGNMENT_OBJECT EXPENSIVE_OBJECT
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define UNASSIGNED_OBJECT 0xc8000000
+#define DANGEROUS_UNASSIGNED_OBJECT 0xc8000001
+#define UNBOUND_OBJECT 0xc8000002
+#define DANGEROUS_UNBOUND_OBJECT 0xc8000003
+#define ILLEGAL_OBJECT 0xc8000004
+#define DANGEROUS_ILLEGAL_OBJECT 0xc8000005
+#define EXPENSIVE_OBJECT 0xc8000006
+#define DANGEROUS_EXPENSIVE_OBJECT 0xc8000007
+#endif /* (TYPE_CODE_LENGTH == 6) */
#if (TC_REFERENCE_TRAP != 0x32)
#include "error: trap.h and types.h are inconsistent"
#endif
+#endif /* b32 */
+
+#ifndef UNASSIGNED_OBJECT /* Safe version */
+#define UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
+#define DANGEROUS_UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
+#define UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
+#define DANGEROUS_UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
+#define ILLEGAL_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL)
+#define DANGEROUS_ILLEGAL_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
+#define EXPENSIVE_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
+#define DANGEROUS_EXPENSIVE_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
+#endif /* UNASSIGNED_OBJECT */
+
+#define NOP_OBJECT MAKE_UNSIGNED_FIXNUM(TRAP_NOP)
+#define DANGEROUS_OBJECT MAKE_UNSIGNED_FIXNUM(TRAP_DANGEROUS)
+#define REQUEST_RECACHE_OBJECT DANGEROUS_ILLEGAL_OBJECT
+#define EXPENSIVE_ASSIGNMENT_OBJECT EXPENSIVE_OBJECT
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/types.h,v 9.29 1988/08/15 20:56:46 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/types.h,v 9.30 1989/08/28 18:29:35 cph Exp $
*
* Type code definitions, numerical order
*
*/
#define LAST_TYPE_CODE 0X3D
+
+#define MIN_TYPE_CODE_LENGTH 6
+
+#ifdef TYPE_CODE_LENGTH
+#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#endif
+#endif
\f
#define TYPE_NAME_TABLE \
{ \
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/utils.c,v 9.42 1989/05/31 01:51:07 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.43 1989/08/28 18:29:38 cph Exp $ */
/* This file contains utilities for interrupts, errors, etc. */
{
long index, old_value;
- index = (1 + (pointer_datum (primitive)));
+ index = (1 + (OBJECT_DATUM (primitive)));
Scheme_Integer_To_C_Integer ((Vector_Ref (table, index)), &old_value);
Vector_Set (table, index, (C_Integer_To_Scheme_Integer (1 + old_value)));
}
Terminate_Old_Stacklet();
if ((Free_Stacklets == NULL) ||
((N + STACKLET_SLACK) >
- Get_Integer(Free_Stacklets[STACKLET_LENGTH])))
+ (OBJECT_DATUM (Free_Stacklets[STACKLET_LENGTH]))))
{
long size;
New_Stacklet = Free_Stacklets;
Free_Stacklets = ((Pointer *) Free_Stacklets[STACKLET_FREE_LIST_LINK]);
Stack_Pointer =
- &New_Stacklet[1 + Get_Integer(New_Stacklet[STACKLET_LENGTH])];
+ &New_Stacklet[1 + (OBJECT_DATUM (New_Stacklet[STACKLET_LENGTH]))];
Stack_Guard = &New_Stacklet[STACKLET_HEADER_SIZE];
}
Old_Expression = Fetch_Expression();
Find_State_Space (State_Point)
Pointer State_Point;
{
- long How_Far = Get_Integer(Fast_Vector_Ref(State_Point,
- STATE_POINT_DISTANCE_TO_ROOT));
+ long How_Far =
+ (UNSIGNED_FIXNUM_VALUE
+ (Fast_Vector_Ref (State_Point, STATE_POINT_DISTANCE_TO_ROOT)));
long i;
fast Pointer Point = State_Point;
Path = Free;
guarantee_state_point();
Distance =
- Get_Integer(Fast_Vector_Ref(Target, STATE_POINT_DISTANCE_TO_ROOT));
+ (UNSIGNED_FIXNUM_VALUE
+ (Fast_Vector_Ref (Target, STATE_POINT_DISTANCE_TO_ROOT)));
if (State_Space == NIL)
{
Current_Location = Current_State_Point;
}
From_Depth =
- Get_Integer(Fast_Vector_Ref(Current_Location, STATE_POINT_DISTANCE_TO_ROOT));
+ (UNSIGNED_FIXNUM_VALUE
+ (Fast_Vector_Ref (Current_Location, STATE_POINT_DISTANCE_TO_ROOT)));
\f
for (Path_Point = Current_Location, Merge_Depth = From_Depth;
Merge_Depth > Distance;
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.87 1989/08/04 02:08:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.88 1989/08/28 18:29:43 cph Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 87
+#define SUBVERSION 88
#endif
#ifndef UCODE_TABLES_FILENAME
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/Attic/wsize.c,v 9.26 1989/05/24 18:42:37 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/wsize.c,v 9.27 1989/08/28 18:28:11 cph Exp $ */
\f
#include <stdio.h>
#include <math.h>
#include <errno.h>
+#ifndef TYPE_CODE_LENGTH
/* This MUST match object.h */
#define TYPE_CODE_LENGTH 8
+#endif
#define ASCII_LOWER_A 0141
#define ASCII_UPPER_A 0101
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.33 1989/06/16 09:37:04 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.34 1989/08/28 18:28:42 cph Exp $
*
* Named constants used throughout the interpreter
*
#define STACK_FRAME_HEADER 1
/* Precomputed typed pointers */
-#ifndef b32 /* Safe version */
+#ifdef b32 /* 32 bit word */
-#define SHARP_F Make_Non_Pointer(TC_NULL, 0)
-#define SHARP_T Make_Non_Pointer(TC_TRUE, 0)
-#define UNSPECIFIC Make_Non_Pointer(TC_TRUE, 1)
-#define FIXNUM_ZERO Make_Non_Pointer(TC_FIXNUM, 0)
-#define BROKEN_HEART_ZERO Make_Non_Pointer(TC_BROKEN_HEART, 0)
-
-#else /* 32 bit word */
+#if (TYPE_CODE_LENGTH == 8)
#define SHARP_F 0x00000000
#define SHARP_T 0x08000000
#define UNSPECIFIC 0x08000001
#define FIXNUM_ZERO 0x1A000000
#define BROKEN_HEART_ZERO 0x22000000
-#endif /* b32 */
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define SHARP_F 0x00000000
+#define SHARP_T 0x20000000
+#define UNSPECIFIC 0x20000001
+#define FIXNUM_ZERO 0x68000000
+#define BROKEN_HEART_ZERO 0x88000000
+#endif /* (TYPE_CODE_LENGTH == 6) */
+
+#endif /* b32 */
+
+#ifndef SHARP_F /* Safe version */
+#define SHARP_F Make_Non_Pointer(TC_NULL, 0)
+#define SHARP_T Make_Non_Pointer(TC_TRUE, 0)
+#define UNSPECIFIC Make_Non_Pointer(TC_TRUE, 1)
+#define FIXNUM_ZERO Make_Non_Pointer(TC_FIXNUM, 0)
+#define BROKEN_HEART_ZERO Make_Non_Pointer(TC_BROKEN_HEART, 0)
+#endif /* SHARP_F */
#define EMPTY_LIST SHARP_F
#define NIL SHARP_F
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/v8/src/microcode/gctype.c,v 9.29 1988/08/15 20:48:26 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/gctype.c,v 9.30 1989/08/28 18:28:51 cph Rel $
*
* This file contains the table which maps between Types and
* GC Types.
GC_Pair, /* TC_COMPLEX */
GC_Vector, /* TC_COMPILED_CODE_BLOCK */
GC_Undefined, /* 0x3E */
+
+#if (TYPE_CODE_LENGTH == 6)
+
+ GC_Undefined /* 0x3F */
+
+#else /* (TYPE_CODE_LENGTH != 6) */
+
GC_Undefined, /* 0x3F */
GC_Undefined, /* 0x40 */
GC_Undefined, /* 0x41 */
GC_Undefined, /* 0xFC */
GC_Undefined, /* 0xFD */
GC_Undefined, /* 0xFE */
- GC_Undefined /* 0xFF */
+ GC_Undefined /* last */
+#endif /* (TYPE_CODE_LENGTH != 6) */
+
};
+#if (TYPE_CODE_LENGTH == 6)
+
+#if (MAX_TYPE_CODE != 0x3F)
+#include "gctype.c and object.h inconsistent -- GC_Type_Map"
+#endif
+
+#else /* (TYPE_CODE_LENGTH != 6) */
+
#if (MAX_TYPE_CODE != 0xFF)
-#include "gctype.c and scheme.h inconsistent -- GC_Type_Map"
+#include "gctype.c and object.h inconsistent -- GC_Type_Map"
#endif
+#endif /* (TYPE_CODE_LENGTH == 6) */
/* -*-C-*-
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 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/v8/src/microcode/lookup.h,v 9.42 1989/05/31 01:50:41 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.h,v 9.43 1989/08/28 18:29:03 cph Exp $ */
/* Macros and declarations for the variable lookup code. */
/* Common constants. */
-#ifndef b32
-#define UNCOMPILED_VARIABLE Make_Non_Pointer(UNCOMPILED_REF, 0)
-#else
+#ifdef b32 /* 32 bit objects */
+
+#if (TYPE_CODE_LENGTH == 8)
#define UNCOMPILED_VARIABLE 0x08000000
#endif
+#if (TYPE_CODE_LENGTH == 6)
+#define UNCOMPILED_VARIABLE 0x20000000
+#endif
+
+#if (TC_TRUE != 0x08)
+#include "error:lookup.h and types.h are inconsistent"
+#endif
+
+#endif /* b32 */
+
+#ifndef UNCOMPILED_VARIABLE /* Safe version */
+#define UNCOMPILED_VARIABLE Make_Non_Pointer(UNCOMPILED_REF, 0)
+#endif
+
/* Macros for speedy variable reference. */
#if (LOCAL_REF == 0)
fast long depth; \
\
verify(FORMAL_REF, offset, get_offset(hunk), label); \
- depth = Get_Integer(frame); \
+ depth = (OBJECT_DATUM (frame)); \
frame = env; \
while(--depth >= 0) \
{ \
fast long depth; \
\
verify(AUX_REF, offset, get_offset(hunk), label); \
- depth = Get_Integer(frame); \
+ depth = (OBJECT_DATUM (frame)); \
frame = env; \
while(--depth >= 0) \
{ \
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/v8/src/microcode/object.h,v 9.30 1989/05/24 18:14:52 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/object.h,v 9.31 1989/08/28 18:29:10 cph Exp $ */
/* This file contains definitions pertaining to the C view of
Scheme pointers: widths of fields, extraction macros, pre-computed
POINTER_LENGTH is defined this way to make it available to
the preprocessor. */
-/* TYPE_CODE_LENGTH must match the value in Wsize.c! */
-#define TYPE_CODE_LENGTH 8 /* Not CHAR_SIZE!! */
-#define MAX_TYPE_CODE 0xFF /* ((1<<TYPE_CODE_LENGTH) - 1) */
-#define POINTER_LENGTH ULONG_SIZE
-
-#ifndef b32 /* Portable versions */
+/* The value in Wsize.c for TYPE_CODE_LENGTH must match this!! */
+
+#ifndef TYPE_CODE_LENGTH
+#define TYPE_CODE_LENGTH 8
+#endif
+
+#if (TYPE_CODE_LENGTH == 8)
+#define MAX_TYPE_CODE 0xFF
+#endif
+
+#if (TYPE_CODE_LENGTH == 6)
+#define MAX_TYPE_CODE 0x3F
+#endif
-#define ADDRESS_LENGTH (POINTER_LENGTH-TYPE_CODE_LENGTH)
-#define ADDRESS_MASK ((1 << ADDRESS_LENGTH) - 1)
-#define TYPE_CODE_MASK (~ADDRESS_MASK)
-/* FIXNUM_LENGTH does NOT include the sign bit! */
-#define FIXNUM_LENGTH (ADDRESS_LENGTH - 1)
-#define FIXNUM_SIGN_BIT (1 << FIXNUM_LENGTH)
-#define SIGN_MASK (TYPE_CODE_MASK | FIXNUM_SIGN_BIT)
-#define SMALLEST_FIXNUM ((long) (-1 << FIXNUM_LENGTH))
-#define BIGGEST_FIXNUM ((long) (~(-1 << FIXNUM_LENGTH)))
+#ifdef MIN_TYPE_CODE_LENGTH
+#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#endif
+#endif
+
+#ifndef MAX_TYPE_CODE
+#define MAX_TYPE_CODE ((1 << TYPE_CODE_LENGTH) - 1)
+#endif
-#define HALF_ADDRESS_LENGTH (ADDRESS_LENGTH / 2)
-#define HALF_ADDRESS_MASK ((1 << HALF_ADDRESS_LENGTH) - 1)
+#define POINTER_LENGTH ULONG_SIZE
+
+#ifdef b32 /* 32 bit word versions */
-#else /* 32 bit word versions */
+#if (TYPE_CODE_LENGTH == 8)
#define ADDRESS_LENGTH 24
#define ADDRESS_MASK 0x00FFFFFF
#define SIGN_MASK 0xFF800000
#define SMALLEST_FIXNUM ((long) 0xFF800000)
#define BIGGEST_FIXNUM ((long) 0x007FFFFF)
-
#define HALF_ADDRESS_LENGTH 12
#define HALF_ADDRESS_MASK 0x00000FFF
-
-#endif
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define ADDRESS_LENGTH 26
+#define ADDRESS_MASK 0x03FFFFFF
+#define TYPE_CODE_MASK 0XFC000000
+#define FIXNUM_LENGTH 25
+#define FIXNUM_SIGN_BIT 0x02000000
+#define SIGN_MASK 0xFE000000
+#define SMALLEST_FIXNUM ((long) 0xFE000000)
+#define BIGGEST_FIXNUM ((long) 0x01FFFFFF)
+#define HALF_ADDRESS_LENGTH 13
+#define HALF_ADDRESS_MASK 0x00001FFF
+#endif /* (TYPE_CODE_LENGTH == 6) */
+
+#endif /* b32 */
+
+#ifndef ADDRESS_LENGTH /* Safe versions */
+#define ADDRESS_LENGTH (POINTER_LENGTH-TYPE_CODE_LENGTH)
+#define ADDRESS_MASK ((1 << ADDRESS_LENGTH) - 1)
+#define TYPE_CODE_MASK (~ADDRESS_MASK)
+/* FIXNUM_LENGTH does NOT include the sign bit! */
+#define FIXNUM_LENGTH (ADDRESS_LENGTH - 1)
+#define FIXNUM_SIGN_BIT (1 << FIXNUM_LENGTH)
+#define SIGN_MASK (TYPE_CODE_MASK | FIXNUM_SIGN_BIT)
+#define SMALLEST_FIXNUM ((long) (-1 << FIXNUM_LENGTH))
+#define BIGGEST_FIXNUM ((long) (~(-1 << FIXNUM_LENGTH)))
+#define HALF_ADDRESS_LENGTH (ADDRESS_LENGTH / 2)
+#define HALF_ADDRESS_MASK ((1 << HALF_ADDRESS_LENGTH) - 1)
+#endif /* ADDRESS_LENGTH */
\f
+#ifndef OBJECT_TYPE
#ifndef UNSIGNED_SHIFT /* Portable version */
#define OBJECT_TYPE(P) (((P) >> ADDRESS_LENGTH) & MAX_TYPE_CODE)
#else /* Faster for logical shifts */
#define OBJECT_TYPE(P) ((P) >> ADDRESS_LENGTH)
#endif
+#endif /* OBJECT_TYPE */
+#ifndef OBJECT_DATUM
#define OBJECT_DATUM(P) ((P) & ADDRESS_MASK)
+#endif
+
+#ifndef MAKE_OBJECT
+#define MAKE_OBJECT(TC, D) \
+ ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
+#endif
/* compatibility definitions */
#define Type_Code(P) (OBJECT_TYPE (P))
#define Datum(P) (OBJECT_DATUM (P))
-
-#define pointer_type(P) (OBJECT_TYPE (P))
-#define pointer_datum(P) (OBJECT_DATUM (P))
-
-#define Make_Object(TC, D) \
- ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
\f
#ifndef Heap_In_Low_Memory /* Portable version */
#define Get_Pointer(P) ((Pointer *) (Memory_Base + (OBJECT_DATUM (P))))
#define C_To_Scheme(P) ((Pointer) ((P) - Memory_Base))
-#else /* Storing absolute addresses */
+#else /* not Heap_In_Low_Memory */
+/* Storing absolute addresses */
typedef long relocation_type; /* Used to relocate pointers on fasload */
(Heap = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))), \
((Heap + (space)) - 1))
-#ifdef spectrum
-
-#define Quad1_Tag 0x40000000
-#define Get_Pointer(P) ((Pointer *) (((P) & ADDRESS_MASK) | Quad1_Tag))
-#define C_To_Scheme(P) ((Pointer) (((long) (P)) & ADDRESS_MASK))
-
-#else /* Not Spectrum, fast case */
-
#define Get_Pointer(P) ((Pointer *) (OBJECT_DATUM (P)))
#define C_To_Scheme(P) ((Pointer) (P))
-#endif /* spectrum */
#endif /* Heap_In_Low_Memory */
\f
-#define Make_Pointer(TC, A) Make_Object((TC), C_To_Scheme(A))
-#define Make_Non_Pointer(TC, D) Make_Object(TC, ((Pointer) (D)))
+#define Make_Pointer(TC, A) MAKE_OBJECT((TC), C_To_Scheme(A))
+#define Make_Non_Pointer(TC, D) MAKE_OBJECT(TC, ((Pointer) (D)))
/* (Make_New_Pointer (TC, A)) may be more efficient than
(Make_Pointer (TC, (Get_Pointer (A)))) */
-#define Make_New_Pointer(TC, A) (Make_Object (TC, ((Pointer) A)))
+#define Make_New_Pointer(TC, A) (MAKE_OBJECT (TC, ((Pointer) A)))
-#define Store_Type_Code(P, TC) P = (Make_Object ((TC), (P)))
+#define Store_Type_Code(P, TC) P = (MAKE_OBJECT ((TC), (P)))
#define Store_Address(P, A) \
P = (((P) & TYPE_CODE_MASK) | (OBJECT_DATUM ((Pointer) (A))))
#define Fast_User_Vector_Ref(P, N) Fast_Vector_Ref(P, (N)+1)
#define Fast_User_Vector_Set(P, N, S) Fast_Vector_Set(P, (N)+1, S)
#define Nth_Vector_Loc(P, N) (&(Fast_Vector_Ref(P, N)))
-#define Vector_Length(P) (Get_Integer(Fast_Vector_Ref((P), 0)))
+#define Vector_Length(P) (OBJECT_DATUM (Fast_Vector_Ref((P), 0)))
/* General case vector handling requires atomicity for parallel processors */
#define MAKE_FIXNUM(N) (Make_Non_Pointer (TC_FIXNUM, (N)))
#define FIXNUM_NEGATIVE_P(fixnum) (((fixnum) & FIXNUM_SIGN_BIT) != 0)
#define MAKE_UNSIGNED_FIXNUM(N) (FIXNUM_ZERO + (N))
-#define UNSIGNED_FIXNUM_VALUE(fixnum) (OBJECT_DATUM (fixnum))
-#define MAKE_SIGNED_FIXNUM Make_Signed_Fixnum
-#define long_to_object C_Integer_To_Scheme_Integer
+#define UNSIGNED_FIXNUM_VALUE OBJECT_DATUM
+#define MAKE_SIGNED_FIXNUM MAKE_FIXNUM
+#define NONNEGATIVE_FIXNUM_P(x) ((FIXNUM_P (x)) && (! (FIXNUM_NEGATIVE_P (x))))
#define FIXNUM_VALUE(fixnum, target) \
do \
(target) |= (-1 << ADDRESS_LENGTH); \
} while (0)
+/* Compatibility */
+#define Make_Unsigned_Fixnum MAKE_UNSIGNED_FIXNUM
+#define Make_Signed_Fixnum MAKE_FIXNUM
+#define Get_Integer OBJECT_DATUM
+#define Sign_Extend FIXNUM_VALUE
+
#define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F)
#define Make_Broken_Heart(N) (BROKEN_HEART_ZERO + (N))
-#define Make_Unsigned_Fixnum(N) (FIXNUM_ZERO + (N))
-#define Make_Signed_Fixnum(N) Make_Non_Pointer( TC_FIXNUM, (N))
#define Get_Float(P) (* ((double *) (Nth_Vector_Loc ((P), 1))))
-#define Get_Integer(P) (OBJECT_DATUM (P))
-
-#define Sign_Extend(P, S) \
-{ \
- (S) = (Get_Integer (P)); \
- if (((S) & FIXNUM_SIGN_BIT) != 0) \
- (S) |= (-1 << ADDRESS_LENGTH); \
-}
#define Fixnum_Fits(x) \
((((x) & SIGN_MASK) == 0) || \
/* -*-C-*-
-Copyright (c) 1987 Massachusetts Institute of Technology
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/ppband.c,v 9.34 1989/08/28 18:28:03 cph Exp $
+
+Copyright (c) 1987, 1989 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/v8/src/microcode/ppband.c,v 9.33 1989/02/14 20:41:32 jinx Rel $
- *
- * Dumps Scheme FASL in user-readable form .
- */
+/* Dumps Scheme FASL in user-readable form. */
#include <stdio.h>
#include "config.h"
#include "types.h"
#include "const.h"
#include "object.h"
+#include "gccode.h"
#include "sdata.h"
#define fast register
}
\f
Pointer *
-show_area(area, size, name)
+show_area(area, start, end, name)
fast Pointer *area;
- fast long size;
+ long start;
+ fast long end;
char *name;
{
fast long i;
printf("\n%s contents:\n\n", name);
- for (i = 0; i < size; area++, i++)
+ for (i = start; i < end; area++, i++)
{
- if (OBJECT_TYPE(*area) == TC_MANIFEST_NM_VECTOR)
+ if ((OBJECT_TYPE(*area) == TC_MANIFEST_NM_VECTOR) ||
+ (OBJECT_TYPE(*area) == TC_MANIFEST_CLOSURE) ||
+ (OBJECT_TYPE(*area) == TC_LINKAGE_SECTION))
{
fast long j, count;
- count = Get_Integer(*area);
+ count =
+ ((OBJECT_TYPE(*area) == TC_LINKAGE_SECTION)
+ ? (READ_CACHE_LINKAGE_COUNT (*area))
+ : (OBJECT_DATUM (*area)));
Display(i, OBJECT_TYPE(*area), OBJECT_DATUM(*area));
area += 1;
for (j = 0; j < count ; j++, area++)
\f
if (Heap_Count > 0)
{
- Next = show_area(Data, Heap_Count, "Heap");
+ Next = show_area(Data, 0, Heap_Count, "Heap");
}
if (Const_Count > 0)
{
- Next = show_area(Next, Const_Count, "Constant Space");
+ Next = show_area(Next, Heap_Count, Const_Count, "Constant Space");
}
if ((Primitive_Table_Size > 0) && (Next < end_of_memory))
{
count += 1)
{
Sign_Extend(*Next++, arity);
- size = Get_Integer(*Next);
+ size = (OBJECT_DATUM (*Next));
printf("Number = %3lx; Arity = %2ld; Name = ", count, arity);
scheme_string((Next - Data), true);
Next += (1 + size);
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/v8/src/microcode/psbmap.h,v 9.27 1988/08/15 20:53:22 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbmap.h,v 9.28 1989/08/28 18:29:21 cph Exp $
*
* This file contains macros and declarations for Bintopsb.c
* and Psbtobin.c
#include <stdio.h>
#include "config.h"
+#include "types.h"
#include "object.h"
#include "bignum.h"
#include "bitstr.h"
-#include "types.h"
#include "sdata.h"
#include "const.h"
#include "gccode.h"
/* -*-C-*-
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1989 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/v8/src/microcode/psbtobin.c,v 9.34 1988/04/25 17:30:02 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbtobin.c,v 9.35 1989/08/28 18:28:07 cph Exp $
*
* This File contains the code to translate portable format binary
* files to internal format.
case TC_BIG_FIXNUM:
case TC_BIG_FLONUM:
case TC_CHARACTER_STRING:
- *from++ == Make_Object(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
+ *from++ == MAKE_OBJECT(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
break;
default:
fprintf(stderr,
"Table[%6d] = Character %c = 0x%02x\n",
(N - (Table_End - Table)),
- Get_Integer(*Table),
- Get_Integer(*Table));
+ (OBJECT_DATUM (*Table)),
+ (OBJECT_DATUM (*Table)));
break;
case TC_CHARACTER_STRING:
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/v8/src/microcode/trap.h,v 9.40 1988/08/15 20:56:29 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/trap.h,v 9.41 1989/08/28 18:29:32 cph Exp $ */
\f
/* Kinds of traps:
\f
/* Common constants */
-#ifndef b32
-#define UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
-#define DANGEROUS_UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
-#define UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
-#define DANGEROUS_UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
-#define ILLEGAL_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL)
-#define DANGEROUS_ILLEGAL_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
-#define EXPENSIVE_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
-#define DANGEROUS_EXPENSIVE_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
-#else
+#ifdef b32 /* 32 bit objects */
+
+#if (TYPE_CODE_LENGTH == 8)
#define UNASSIGNED_OBJECT 0x32000000
#define DANGEROUS_UNASSIGNED_OBJECT 0x32000001
#define UNBOUND_OBJECT 0x32000002
#define DANGEROUS_ILLEGAL_OBJECT 0x32000005
#define EXPENSIVE_OBJECT 0x32000006
#define DANGEROUS_EXPENSIVE_OBJECT 0x32000007
-#endif
-
-#define NOP_OBJECT Make_Unsigned_Fixnum(TRAP_NOP)
-#define DANGEROUS_OBJECT Make_Unsigned_Fixnum(TRAP_DANGEROUS)
-#define REQUEST_RECACHE_OBJECT DANGEROUS_ILLEGAL_OBJECT
-#define EXPENSIVE_ASSIGNMENT_OBJECT EXPENSIVE_OBJECT
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define UNASSIGNED_OBJECT 0xc8000000
+#define DANGEROUS_UNASSIGNED_OBJECT 0xc8000001
+#define UNBOUND_OBJECT 0xc8000002
+#define DANGEROUS_UNBOUND_OBJECT 0xc8000003
+#define ILLEGAL_OBJECT 0xc8000004
+#define DANGEROUS_ILLEGAL_OBJECT 0xc8000005
+#define EXPENSIVE_OBJECT 0xc8000006
+#define DANGEROUS_EXPENSIVE_OBJECT 0xc8000007
+#endif /* (TYPE_CODE_LENGTH == 6) */
#if (TC_REFERENCE_TRAP != 0x32)
#include "error: trap.h and types.h are inconsistent"
#endif
+#endif /* b32 */
+
+#ifndef UNASSIGNED_OBJECT /* Safe version */
+#define UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
+#define DANGEROUS_UNASSIGNED_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
+#define UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
+#define DANGEROUS_UNBOUND_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
+#define ILLEGAL_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL)
+#define DANGEROUS_ILLEGAL_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
+#define EXPENSIVE_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
+#define DANGEROUS_EXPENSIVE_OBJECT Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
+#endif /* UNASSIGNED_OBJECT */
+
+#define NOP_OBJECT MAKE_UNSIGNED_FIXNUM(TRAP_NOP)
+#define DANGEROUS_OBJECT MAKE_UNSIGNED_FIXNUM(TRAP_DANGEROUS)
+#define REQUEST_RECACHE_OBJECT DANGEROUS_ILLEGAL_OBJECT
+#define EXPENSIVE_ASSIGNMENT_OBJECT EXPENSIVE_OBJECT
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 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/v8/src/microcode/types.h,v 9.29 1988/08/15 20:56:46 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/types.h,v 9.30 1989/08/28 18:29:35 cph Exp $
*
* Type code definitions, numerical order
*
*/
#define LAST_TYPE_CODE 0X3D
+
+#define MIN_TYPE_CODE_LENGTH 6
+
+#ifdef TYPE_CODE_LENGTH
+#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#endif
+#endif
\f
#define TYPE_NAME_TABLE \
{ \
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.87 1989/08/04 02:08:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.88 1989/08/28 18:29:43 cph Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 87
+#define SUBVERSION 88
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff