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/vector.c,v 9.27 1987/11/17 08:21:09 jinx Exp $
- *
- * This file contains procedures for handling vectors and conversion
- * back and forth to lists.
- */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/vector.c,v 9.28 1987/12/16 19:38:05 cph Exp $ */
+
+/* This file contains procedures for handling vectors and conversion
+ back and forth to lists. */
#include "scheme.h"
#include "primitive.h"
\f
+#define ARG_VECTOR(argument_number) \
+((VECTOR_P (ARG_REF (argument_number))) \
+ ? (ARG_REF (argument_number)) \
+ : ((Pointer) (error_wrong_type_arg (argument_number))))
+
+/* Flush old definition -- we won't use it. */
+#ifdef VECTOR_LENGTH
+#undef VECTOR_LENGTH
+#endif
+
+#define VECTOR_LENGTH(vector) \
+(UNSIGNED_FIXNUM_VALUE (Fast_Vector_Ref ((vector), 0)))
+
+#define ARG_VECTOR_INDEX(argument_number, vector) \
+(arg_index_integer (argument_number, (Vector_Length (vector))))
+
+#define GC_VECTOR_P(object) ((GC_Type (object)) == GC_Vector)
+
+#define ARG_GC_VECTOR(argument_number) \
+((GC_VECTOR_P (ARG_REF (argument_number))) \
+ ? (ARG_REF (argument_number)) \
+ : ((Pointer) (error_wrong_type_arg (argument_number))))
+
+/* VECTOR_TOUCH does nothing, this is copied from a previous version
+ of this code. Perhaps it should do a touch? -- CPH */
+#define VECTOR_TOUCH(vector)
+#define GC_VECTOR_TOUCH(vector) Touch_In_Primitive (vector, vector)
+
+#define VECTOR_REF(vector, index) (Vector_Ref ((vector), ((index) + 1)))
+#define VECTOR_LOC(vector, index) (Nth_Vector_Loc ((vector), ((index) + 1)))
+\f
Pointer
allocate_non_marked_vector (type_code, length, gc_check_p)
int type_code;
return (result);
}
\f
- /*********************/
- /* VECTORS <-> LISTS */
- /*********************/
-
-/* Subvector_To_List is a utility routine used by both
- SUBVECTOR_TO_LIST and SYS_SUBVECTOR_TO_LIST. It copies the entries
- in a vector (first argument) starting with the entry specified by
- argument 2 and ending at the one specified by argument 3. The copy
- includes the starting entry but does NOT include the ending entry.
- Thus the entire vector is converted to a list by setting argument 2
- to 0 and argument 3 to the length of the vector.
-*/
-
-Pointer Subvector_To_List()
-{ Pointer *From, Result;
- long Length, Start, End, Count, i;
- Primitive_3_Args();
- if (Type_Code(Arg2) != TC_FIXNUM) Primitive_Error(ERR_ARG_2_WRONG_TYPE);
- if (Type_Code(Arg3) != TC_FIXNUM) Primitive_Error(ERR_ARG_3_WRONG_TYPE);
- if (Type_Code(Vector_Ref(Arg1, VECTOR_TYPE)) != TC_MANIFEST_VECTOR)
- Primitive_Error(ERR_ARG_1_WRONG_TYPE);
- Length = Vector_Length(Arg1);
- Start = Get_Integer(Arg2);
- End = Get_Integer(Arg3);
- if (End > Length) Primitive_Error(ERR_ARG_3_BAD_RANGE);
- if (Start > End) Primitive_Error(ERR_ARG_3_BAD_RANGE);
- if (Start == End) return NIL;
- Primitive_GC_If_Needed(2*(End-Start));
- Result = Make_Pointer(TC_LIST, Free);
- From = Nth_Vector_Loc(Arg1, Start+1);
- Count = End-Start;
- for (i=0; i < Count; i++)
- { *Free++ = Fetch(*From++);
- *Free = Make_Pointer(TC_LIST, Free+1);
- Free += 1;
- }
- Free[-1] = NIL;
- return Result;
-}
-\f
-/* Called by the primitives LIST_TO_VECTOR and SYS_LIST_TO_VECTOR.
- This utility routine converts a list into a vector.
-*/
-
-Pointer L_To_V(Result_Type, List)
-long Result_Type;
-fast Pointer List;
-{ Pointer *Orig_Free;
- long Count;
- Touch_In_Primitive(List, List);
- Count = 0;
- Orig_Free = Free++;
- while (Type_Code(List) == TC_LIST)
- { Primitive_GC_If_Needed(0);
- Count += 1;
- *Free++ = Vector_Ref(List, CONS_CAR);
- Touch_In_Primitive(Vector_Ref(List, CONS_CDR), List);
- }
- if (List != NIL) Primitive_Error(ERR_ARG_1_WRONG_TYPE);
- *Orig_Free = Make_Non_Pointer(TC_MANIFEST_VECTOR, Count);
- return Make_Pointer(Result_Type, Orig_Free);
-}
-
-/* (LIST->VECTOR LIST)
- Returns a vector made from the items in LIST.
-*/
-
-Built_In_Primitive(Prim_List_To_Vector, 1, "LIST->VECTOR", 0x7C)
-Define_Primitive(Prim_List_To_Vector, 1, "LIST->VECTOR")
-{
- Primitive_1_Arg();
-
- return L_To_V(TC_VECTOR, Arg1);
-}
-\f
-/* (SUBVECTOR->LIST VECTOR FROM TO)
- Returns a list of the FROMth through TO-1st items in the vector.
- Thus (SUBVECTOR_TO_LIST V 0 (VECTOR_LENGTH V)) returns a list of
- all the items in V.
-*/
-Built_In_Primitive(Prim_Subvector_To_List, 3, "SUBVECTOR->LIST", 0x7D)
-Define_Primitive(Prim_Subvector_To_List, 3, "SUBVECTOR->LIST")
+DEFINE_PRIMITIVE ("VECTOR-CONS", Prim_Vector_Cons, 2)
{
- Primitive_3_Args();
+ PRIMITIVE_HEADER (2);
- Arg_1_Type(TC_VECTOR);
- return Subvector_To_List();
+ PRIMITIVE_RETURN
+ (make_vector ((arg_nonnegative_integer (1)), (ARG_REF (2))));
}
-/* (VECTOR_CONS LENGTH CONTENTS)
- Create a new vector to hold LENGTH entries, all of which are
- initialized to CONTENTS. */
-
-Built_In_Primitive (Prim_Vector_Cons, 2, "VECTOR-CONS", 0x2C)
-Define_Primitive (Prim_Vector_Cons, 2, "VECTOR-CONS")
+DEFINE_PRIMITIVE ("SYSTEM-VECTOR?", Prim_Sys_Vector, 1)
{
- Primitive_2_Args ();
+ fast Pointer object;
+ PRIMITIVE_HEADER (1);
- CHECK_ARG (1, FIXNUM_P);
- return (make_vector ((Get_Integer (Arg1)), Arg2));
-}
-
-/* (VECTOR-REF VECTOR OFFSET)
- Return the OFFSETth entry in VECTOR. Entries are numbered from 0.
-*/
-Built_In_Primitive(Prim_Vector_Ref, 2, "VECTOR-REF", 0x2E)
-Define_Primitive(Prim_Vector_Ref, 2, "VECTOR-REF")
-{
- long Offset;
- Primitive_2_Args();
-
- Arg_1_Type(TC_VECTOR);
- Arg_2_Type(TC_FIXNUM);
- Range_Check(Offset, Arg2,
- 0, (Vector_Length(Arg1) - 1), ERR_ARG_2_BAD_RANGE);
- return User_Vector_Ref(Arg1, Offset);
+ object = (ARG_REF (1));
+ Touch_In_Primitive (object, object);
+ PRIMITIVE_RETURN ((GC_VECTOR_P (object)) ? TRUTH : NIL);
}
\f
-/* (VECTOR-SET! VECTOR OFFSET VALUE)
- Store VALUE as the OFFSETth entry in VECTOR. Entries are
- numbered from 0. Returns (bad style to rely on this) the
- previous value of the entry.
-*/
-Built_In_Primitive(Prim_Vector_Set, 3, "VECTOR-SET!", 0x30)
-Define_Primitive(Prim_Vector_Set, 3, "VECTOR-SET!")
-{
- long Offset;
- Primitive_3_Args();
-
- Arg_1_Type(TC_VECTOR);
- Arg_2_Type(TC_FIXNUM);
- Range_Check(Offset, Arg2,
- 0, (Vector_Length(Arg1) - 1), ERR_ARG_2_BAD_RANGE);
- Side_Effect_Impurify(Arg1, Arg3);
- return Swap_Pointers(Nth_Vector_Loc(Arg1, (Offset + 1)), Arg3);
-}
-
-/* (VECTOR-LENGTH VECTOR)
- Returns the number of entries in VECTOR.
-*/
-Built_In_Primitive(Prim_Vector_Size, 1, "VECTOR-LENGTH", 0x2D)
-Define_Primitive(Prim_Vector_Size, 1, "VECTOR-LENGTH")
-{
- Primitive_1_Arg();
-
- Arg_1_Type(TC_VECTOR);
- return Make_Unsigned_Fixnum(Vector_Length(Arg1));
-}
+#define VECTOR_LENGTH_PRIMITIVE(arg_type, arg_touch) \
+ fast Pointer vector; \
+ PRIMITIVE_HEADER (1); \
+ \
+ vector = (arg_type (1)); \
+ arg_touch (vector); \
+ PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (VECTOR_LENGTH (vector)))
+
+DEFINE_PRIMITIVE ("VECTOR-LENGTH", Prim_Vector_Size, 1)
+{ VECTOR_LENGTH_PRIMITIVE (ARG_VECTOR, VECTOR_TOUCH); }
+
+DEFINE_PRIMITIVE ("SYSTEM-VECTOR-SIZE", Prim_Sys_Vec_Size, 1)
+{ VECTOR_LENGTH_PRIMITIVE (ARG_GC_VECTOR, GC_VECTOR_TOUCH); }
+
+#define VECTOR_REF_PRIMITIVE(arg_type, arg_touch) \
+ fast Pointer vector; \
+ PRIMITIVE_HEADER (2); \
+ \
+ vector = (arg_type (1)); \
+ arg_touch (vector); \
+ PRIMITIVE_RETURN (VECTOR_REF (vector, (ARG_VECTOR_INDEX (2, vector))))
+
+DEFINE_PRIMITIVE ("VECTOR-REF", Prim_Vector_Ref, 2)
+{ VECTOR_REF_PRIMITIVE (ARG_VECTOR, VECTOR_TOUCH); }
+
+DEFINE_PRIMITIVE ("SYSTEM-VECTOR-REF", Prim_Sys_Vector_Ref, 2)
+{ VECTOR_REF_PRIMITIVE (ARG_GC_VECTOR, GC_VECTOR_TOUCH); }
+
+#define VECTOR_SET_PRIMITIVE(arg_type, arg_touch) \
+ fast Pointer vector; \
+ fast Pointer new_value; \
+ fast Pointer *locative; \
+ PRIMITIVE_HEADER (3); \
+ \
+ vector = (arg_type (1)); \
+ arg_touch (vector); \
+ new_value = (ARG_REF (3)); \
+ locative = (VECTOR_LOC (vector, (ARG_VECTOR_INDEX (2, vector)))); \
+ Side_Effect_Impurify (vector, new_value); \
+ PRIMITIVE_RETURN (Swap_Pointers (locative, new_value))
+
+DEFINE_PRIMITIVE ("VECTOR-SET!", Prim_Vector_Set, 3)
+{ VECTOR_SET_PRIMITIVE (ARG_VECTOR, VECTOR_TOUCH); }
+
+DEFINE_PRIMITIVE ("SYSTEM-VECTOR-SET!", Prim_Sys_Vec_Set, 3)
+{ VECTOR_SET_PRIMITIVE (ARG_GC_VECTOR, GC_VECTOR_TOUCH); }
\f
-/* (SYSTEM-LIST-TO-VECTOR GC-LIST)
- Same as LIST_TO_VECTOR except that the resulting vector has the
- specified type code. This can be used, for example, to create
- an environment from a list of values.
-*/
-Built_In_Primitive(Prim_Sys_List_To_Vector, 2, "SYSTEM-LIST-TO-VECTOR", 0x97)
-Define_Primitive(Prim_Sys_List_To_Vector, 2, "SYSTEM-LIST-TO-VECTOR")
+#define SUBVECTOR_TO_LIST_PRIMITIVE(arg_type, arg_touch) \
+ fast Pointer vector; \
+ fast long start; \
+ fast long end; \
+ PRIMITIVE_HEADER (3); \
+ \
+ vector = (arg_type (1)); \
+ arg_touch (vector); \
+ start = (arg_nonnegative_integer (2)); \
+ end = (arg_nonnegative_integer (3)); \
+ if (end > (VECTOR_LENGTH (vector))) \
+ error_bad_range_arg (3); \
+ if (start > end) \
+ error_bad_range_arg (2); \
+ PRIMITIVE_RETURN (subvector_to_list (vector, start, end))
+
+static Pointer
+subvector_to_list (vector, start, end)
+ Pointer vector;
+ long start;
+ long end;
{
- long Type;
- Primitive_2_Args();
-
- Arg_1_Type(TC_FIXNUM);
- Range_Check(Type, Arg1, 0, MAX_TYPE_CODE, ERR_ARG_1_BAD_RANGE);
- if (GC_Type_Code(Type) == GC_Vector)
- return L_To_V(Type, Arg2);
- else
- Primitive_Error(ERR_ARG_1_BAD_RANGE);
- /*NOTREACHED*/
+ Pointer result;
+ fast Pointer *scan;
+ fast Pointer *end_scan;
+ fast Pointer *pair_scan;
+
+ if (start == end)
+ return (NIL);
+ Primitive_GC_If_Needed (2 * (end - start));
+ result = (Make_Pointer (TC_LIST, Free));
+ scan = (VECTOR_LOC (vector, start));
+ end_scan = (VECTOR_LOC (vector, (end - 1)));
+ pair_scan = Free;
+ while (scan < end_scan)
+ {
+ Free += 2;
+ (*pair_scan++) = (Fetch (*scan++));
+ (*pair_scan++) = (Make_Pointer (TC_LIST, Free));
+ }
+ Free += 2;
+ (*pair_scan++) = (Fetch (*scan));
+ (*pair_scan) = NIL;
+ return (result);
}
-/* (SYSTEM-SUBVECTOR-TO-LIST GC-VECTOR FROM TO)
- Same as SUBVECTOR->LIST, but accepts anything with a GC type
- of VECTOR.
-*/
-Built_In_Primitive(Prim_Sys_Subvector_To_List, 3,
- "SYSTEM-SUBVECTOR-TO-LIST", 0x98)
-Define_Primitive(Prim_Sys_Subvector_To_List, 3,
- "SYSTEM-SUBVECTOR-TO-LIST")
-{
- Primitive_3_Args();
- Touch_In_Primitive(Arg1, Arg1);
+DEFINE_PRIMITIVE ("SUBVECTOR->LIST", Prim_Subvector_To_List, 3)
+{ SUBVECTOR_TO_LIST_PRIMITIVE (ARG_VECTOR, VECTOR_TOUCH); }
- Arg_1_GC_Type(GC_Vector);
- return Subvector_To_List();
-}
+DEFINE_PRIMITIVE ("SYSTEM-SUBVECTOR-TO-LIST", Prim_Sys_Subvector_To_List, 3)
+{ SUBVECTOR_TO_LIST_PRIMITIVE (ARG_GC_VECTOR, GC_VECTOR_TOUCH); }
\f
-/* (SYSTEM-VECTOR? OBJECT)
- Returns #!TRUE if OBJECT is of GC type VECTOR. Otherwise
- returns NIL.
-*/
-Built_In_Primitive(Prim_Sys_Vector, 1, "SYSTEM-VECTOR?", 0x99)
-Define_Primitive(Prim_Sys_Vector, 1, "SYSTEM-VECTOR?")
+static Pointer
+list_to_vector (result_type, argument_number)
+ long argument_number;
+ long result_type;
{
- Primitive_1_Arg();
-
- Touch_In_Primitive(Arg1, Arg1);
- if (GC_Type_Vector(Arg1))
- return TRUTH;
- else
- return NIL;
+ fast Pointer list;
+ fast long count;
+ Pointer *result;
+
+ list = (ARG_REF (argument_number));
+ Touch_In_Primitive (list, list);
+ count = 0;
+ result = (Free++);
+ while (PAIR_P (list))
+ {
+ Primitive_GC_If_Needed (0);
+ count += 1;
+ (*Free++) = (Vector_Ref (list, CONS_CAR));
+ Touch_In_Primitive ((Vector_Ref (list, CONS_CDR)), list);
+ }
+ if (list != NIL)
+ error_wrong_type_arg (argument_number);
+ (*result) = (Make_Non_Pointer (TC_MANIFEST_VECTOR, count));
+ return (Make_Pointer (result_type, result));
}
-/* (SYSTEM-VECTOR-REF GC-VECTOR OFFSET)
- Like VECTOR_REF, but for anything of GC type VECTOR.
-*/
-Built_In_Primitive(Prim_Sys_Vector_Ref, 2, "SYSTEM-VECTOR-REF", 0x9A)
-Define_Primitive(Prim_Sys_Vector_Ref, 2, "SYSTEM-VECTOR-REF")
+DEFINE_PRIMITIVE ("LIST->VECTOR", Prim_List_To_Vector, 1)
{
- long Offset;
- Primitive_2_Args();
-
- Touch_In_Primitive(Arg1, Arg1);
- Arg_1_GC_Type(GC_Vector);
- Range_Check(Offset, Arg2, 0,
- (Vector_Length(Arg1) - 1), ERR_ARG_2_BAD_RANGE);
- return User_Vector_Ref(Arg1, Offset);
-}
+ PRIMITIVE_HEADER (1);
-/* (SYSTEM-VECTOR-SET! GC-VECTOR OFFSET VALUE)
- Like VECTOR_SET, but for anything of GC type VECTOR.
-*/
-Built_In_Primitive(Prim_Sys_Vec_Set, 3, "SYSTEM-VECTOR-SET!", 0x9B)
-Define_Primitive(Prim_Sys_Vec_Set, 3, "SYSTEM-VECTOR-SET!")
-{
- long Offset;
- Primitive_3_Args();
-
- Touch_In_Primitive(Arg1, Arg1);
- Arg_1_GC_Type(GC_Vector);
- Range_Check(Offset, Arg2, 0,
- Vector_Length(Arg1)-1, ERR_ARG_2_BAD_RANGE);
- Side_Effect_Impurify(Arg1, Arg3);
- return Swap_Pointers(Nth_Vector_Loc(Arg1, (Offset + 1)), Arg3);
+ PRIMITIVE_RETURN (list_to_vector (TC_VECTOR, 1));
}
-\f
-/* (SYSTEM-VECTOR-SIZE GC-VECTOR)
- Like VECTOR_SIZE, but for anything of GC type VECTOR.
-*/
-Built_In_Primitive(Prim_Sys_Vec_Size, 1, "SYSTEM-VECTOR-SIZE", 0xAE)
-Define_Primitive(Prim_Sys_Vec_Size, 1, "SYSTEM-VECTOR-SIZE")
+
+DEFINE_PRIMITIVE ("SYSTEM-LIST-TO-VECTOR", Prim_Sys_List_To_Vector, 2)
{
- Primitive_1_Arg();
+ long type_code;
+ PRIMITIVE_HEADER (2);
- Touch_In_Primitive(Arg1, Arg1);
- Arg_1_GC_Type(GC_Vector);
- return Make_Unsigned_Fixnum(Vector_Length(Arg1));
+ type_code = (arg_index_integer (1, (MAX_TYPE_CODE + 1)));
+ if ((GC_Type_Code (type_code)) != GC_Vector)
+ error_bad_range_arg (1);
+ PRIMITIVE_RETURN (list_to_vector (type_code, 2));
}
\f
/* Primitive vector copy and fill */
-#define subvector_move_prefix() \
- long start1, end1, start2, end2, length; \
- Pointer *scan1, *scan2; \
- Primitive_5_Args (); \
- \
- CHECK_ARG (1, VECTOR_P); \
- start1 = (arg_nonnegative_integer (2)); \
- end1 = (arg_nonnegative_integer (3)); \
- CHECK_ARG (4, VECTOR_P); \
- start2 = (arg_nonnegative_integer (5)); \
- \
- if (end1 > (Vector_Length (Arg1))) \
- error_bad_range_arg (3); \
- if (start1 > end1) \
- error_bad_range_arg (2); \
- length = (end1 - start1); \
- \
- end2 = (start2 + length); \
- if (end2 > (Vector_Length (Arg4))) \
- error_bad_range_arg (5); \
- \
- if (Is_Pure (Get_Pointer (Arg2))) \
- Primitive_Error (ERR_WRITE_INTO_PURE_SPACE);
-
-Built_In_Primitive (Prim_subvector_move_right, 5, "SUBVECTOR-MOVE-RIGHT!",
- 0x9D)
-Define_Primitive (Prim_subvector_move_right, 5, "SUBVECTOR-MOVE-RIGHT!")
+#define subvector_move_prefix() \
+ Pointer vector1, vector2; \
+ long start1, end1, start2, end2; \
+ fast long length; \
+ fast Pointer *scan1, *scan2; \
+ PRIMITIVE_HEADER (5); \
+ \
+ vector1 = (ARG_VECTOR (1)); \
+ VECTOR_TOUCH (vector1); \
+ start1 = (arg_nonnegative_integer (2)); \
+ end1 = (arg_nonnegative_integer (3)); \
+ vector2 = (ARG_VECTOR (2)); \
+ VECTOR_TOUCH (vector2); \
+ start2 = (arg_nonnegative_integer (5)); \
+ \
+ if (end1 > (VECTOR_LENGTH (vector1))) \
+ error_bad_range_arg (3); \
+ if (start1 > end1) \
+ error_bad_range_arg (2); \
+ length = (end1 - start1); \
+ \
+ end2 = (start2 + length); \
+ if (end2 > (VECTOR_LENGTH (vector2))) \
+ error_bad_range_arg (5); \
+ \
+ if (Is_Pure (Get_Pointer (vector2))) \
+ Primitive_Error (ERR_WRITE_INTO_PURE_SPACE)
+
+DEFINE_PRIMITIVE ("SUBVECTOR-MOVE-RIGHT!", Prim_subvector_move_right, 5)
{
subvector_move_prefix ();
- scan1 = (Nth_Vector_Loc (Arg1, (end1 + 1)));
- scan2 = (Nth_Vector_Loc (Arg4, (end2 + 1)));
- while (length-- > 0)
- *--scan2 = *--scan1;
- return (NIL);
+ scan1 = (VECTOR_LOC (vector1, end1));
+ scan2 = (VECTOR_LOC (vector2, end2));
+ while ((length--) > 0)
+ (*--scan2) = (*--scan1);
+ PRIMITIVE_RETURN (NIL);
}
-Built_In_Primitive (Prim_subvector_move_left, 5, "SUBVECTOR-MOVE-LEFT!", 0x9E)
-Define_Primitive (Prim_subvector_move_left, 5, "SUBVECTOR-MOVE-LEFT!")
+DEFINE_PRIMITIVE ("SUBVECTOR-MOVE-LEFT!", Prim_subvector_move_left, 5)
{
subvector_move_prefix ();
- scan1 = (Nth_Vector_Loc (Arg1, (start1 + 1)));
- scan2 = (Nth_Vector_Loc (Arg4, (start2 + 1)));
- while (length-- > 0)
- *scan2++ = *scan1++;
- return (NIL);
+ scan1 = (VECTOR_LOC (vector1, start1));
+ scan2 = (VECTOR_LOC (vector2, start2));
+ while ((length--) > 0)
+ (*scan2++) = (*scan1++);
+ PRIMITIVE_RETURN (NIL);
}
\f
-Built_In_Primitive (Prim_vector_fill, 4, "SUBVECTOR-FILL!", 0x9F)
-Define_Primitive (Prim_vector_fill, 4, "SUBVECTOR-FILL!")
+DEFINE_PRIMITIVE ("SUBVECTOR-FILL!", Prim_vector_fill, 4)
{
- Pointer *scan;
- long start, end, length;
- Primitive_4_Args ();
-
- CHECK_ARG (1, VECTOR_P);
+ Pointer vector;
+ long start, end;
+ fast Pointer fill_value;
+ fast Pointer *scan;
+ fast long length;
+ PRIMITIVE_HEADER (4);
+
+ vector = (ARG_VECTOR (1));
+ VECTOR_TOUCH (1);
start = (arg_nonnegative_integer (2));
end = (arg_nonnegative_integer (3));
+ fill_value = (ARG_REF (4));
- if (end > (Vector_Length (Arg1)))
+ if (end > (VECTOR_LENGTH (vector)))
error_bad_range_arg (3);
if (start > end)
error_bad_range_arg (2);
length = (end - start);
- Side_Effect_Impurify (Arg1, Arg4);
-
- scan = (Nth_Vector_Loc (Arg1, (start + 1)));
- while (length-- > 0)
- *scan++ = Arg4;
- return (NIL);
+ Side_Effect_Impurify (vector, fill_value);
+ scan = (VECTOR_LOC (vector, start));
+ while ((length--) > 0)
+ (*scan++) = fill_value;
+ PRIMITIVE_RETURN (NIL);
}
projects / mit-scheme.git / commitdiff