From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 16 Dec 1987 19:38:05 +0000 (+0000)
Subject: Fix several bugs found by Morry Katz, mostly having to do with indices
X-Git-Tag: 20090517-FFI~12983
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c9a85b64f5ca62f0af61f611abab05b5a0c1b14c;p=mit-scheme.git

Fix several bugs found by Morry Katz, mostly having to do with indices
not being checked to eliminate negative numbers.  Reorganize and
update all of the code.
---

diff --git a/v7/src/microcode/vector.c b/v7/src/microcode/vector.c
index a31625dd5..c8d821acc 100644
--- a/v7/src/microcode/vector.c
+++ b/v7/src/microcode/vector.c
@@ -30,15 +30,45 @@ Technology nor of any adaptation thereof in any advertising,
 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"
 
+#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)))
+
 Pointer
 allocate_non_marked_vector (type_code, length, gc_check_p)
      int type_code;
@@ -86,325 +116,243 @@ make_vector (length, contents)
   return (result);
 }
 
-                       /*********************/
-                       /* 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;
-}
-
-/* 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);
-}
-
-/* (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);
 }
 
-/* (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); }
 
-/* (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); }
 
-/* (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));
 }
-
-/* (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));
 }
 
 /* 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);
 }
 
-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);
 }