Add mechanism to support conversion of primitive arguments from Scheme

integers to C `unsigned long' integers.

diff --git a/v7/src/microcode/artutl.c b/v7/src/microcode/artutl.c
index 1c12f94af79e3305a19379afbb05037fb0b428f4..15fa583907e5a0e7ae98be79920938384df847ef 100644 (file)
--- a/v7/src/microcode/artutl.c
+++ b/v7/src/microcode/artutl.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: artutl.c,v 1.11 1992/09/18 19:40:07 jinx Exp $
+$Id: artutl.c,v 1.12 1995/09/18 22:32:53 cph Exp $
 
-Copyright (c) 1989-1992 Massachusetts Institute of Technology
+Copyright (c) 1989-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -79,6 +79,12 @@ DEFUN (long_to_integer, (number), long number)
      : (long_to_bignum (number)));
 }
 
+Boolean
+DEFUN (integer_to_ulong_p, (n), fast SCHEME_OBJECT n)
+{
+  return ((FIXNUM_P (n)) || (BIGNUM_TO_ULONG_P (n)));
+}
+
 unsigned long
 DEFUN (integer_to_ulong,
        (n),

diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h
index 238d3df37e98c3617487e77d091e542dc522079c..6b106e18063ea41b9a9af8b4e45e7a2e8e75497a 100644 (file)
--- a/v7/src/microcode/extern.h
+++ b/v7/src/microcode/extern.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: extern.h,v 9.52 1995/07/26 21:06:15 adams Exp $
+$Id: extern.h,v 9.53 1995/09/18 22:32:54 cph Exp $
 
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -171,6 +171,7 @@ extern SCHEME_OBJECT EXFUN (double_to_flonum, (double));
 extern Boolean EXFUN (integer_to_long_p, (SCHEME_OBJECT));
 extern long EXFUN (integer_to_long, (SCHEME_OBJECT));
 extern SCHEME_OBJECT EXFUN (long_to_integer, (long));
+extern Boolean EXFUN (integer_to_ulong_p, (SCHEME_OBJECT));
 extern unsigned long EXFUN (integer_to_ulong, (SCHEME_OBJECT));
 extern SCHEME_OBJECT EXFUN (ulong_to_integer, (unsigned long));
 extern Boolean EXFUN (integer_to_double_p, (SCHEME_OBJECT));

diff --git a/v7/src/microcode/object.h b/v7/src/microcode/object.h
index d7814df5c5874e084b9d017b8a31e5d9ed1ccf95..bad06f70e2e29a16609373979480a774fdc55fc0 100644 (file)
--- a/v7/src/microcode/object.h
+++ b/v7/src/microcode/object.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: object.h,v 9.45 1993/12/05 06:35:45 cph Exp $
+$Id: object.h,v 9.46 1995/09/18 22:33:38 cph Exp $
 
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -440,6 +440,9 @@ extern SCHEME_OBJECT * memory_base;
 #define BIGNUM_TO_LONG_P(bignum)                                       \
   (bignum_fits_in_word_p ((bignum), ((sizeof (long)) * CHAR_BIT), 1))
 
+#define BIGNUM_TO_ULONG_P(bignum)                                      \
+  (bignum_fits_in_word_p ((bignum), ((sizeof (unsigned long)) * CHAR_BIT), 0))
+
 /* If precision should not be lost,
    compare to DBL_MANT_DIG instead. */
 #define BIGNUM_TO_DOUBLE_P(bignum)                                     \

diff --git a/v7/src/microcode/prims.h b/v7/src/microcode/prims.h
index 040d2e1e85503e6df8100ad0dd4f4ed13c95312f..ff534399a119dfb76163473ab28a1ec0d2872c21 100644 (file)
--- a/v7/src/microcode/prims.h
+++ b/v7/src/microcode/prims.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: prims.h,v 9.44 1993/12/05 06:08:03 cph Exp $
+$Id: prims.h,v 9.45 1995/09/18 22:33:00 cph Exp $
 
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -97,6 +97,8 @@ extern long EXFUN (arg_integer, (int));
 extern long EXFUN (arg_nonnegative_integer, (int));
 extern long EXFUN (arg_index_integer, (int, long));
 extern long EXFUN (arg_integer_in_range, (int, long, long));
+extern unsigned long EXFUN (arg_ulong_integer, (int));
+extern unsigned long EXFUN (arg_ulong_index_integer, (int, unsigned long));
 extern double EXFUN (arg_real_number, (int));
 extern double EXFUN (arg_real_in_range, (int, double, double));
 extern long EXFUN (arg_ascii_char, (int));

diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c
index f1159647a427eaac598f57838ab507a297224fd3..3bb86b62bc2e7cb4ab8957b7761a6c7b25d281b0 100644 (file)
--- a/v7/src/microcode/utils.c
+++ b/v7/src/microcode/utils.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: utils.c,v 9.67 1994/11/28 04:37:22 cph Exp $
+$Id: utils.c,v 9.68 1995/09/18 22:33:04 cph Exp $
 
-Copyright (c) 1987-94 Massachusetts Institute of Technology
+Copyright (c) 1987-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -439,6 +439,27 @@ DEFUN (arg_integer_in_range,
     error_bad_range_arg (arg_number);
   return (result);
 }
+
+unsigned long
+DEFUN (arg_ulong_integer, (arg_number), int arg_number)
+{
+  fast SCHEME_OBJECT object = (ARG_REF (arg_number));
+  if (! (INTEGER_P (object)))
+    error_wrong_type_arg (arg_number);
+  if (! (integer_to_ulong_p (object)))
+    error_bad_range_arg (arg_number);
+  return (integer_to_ulong (object));
+}
+
+unsigned long
+DEFUN (arg_ulong_index_integer, (arg_number, upper_limit),
+       int arg_number AND unsigned long upper_limit)
+{
+  fast unsigned long result = (arg_ulong_integer (arg_number));
+  if (result >= upper_limit)
+    error_bad_range_arg (arg_number);
+  return (result);
+}
 \f
 Boolean
 DEFUN (real_number_to_double_p, (x), fast SCHEME_OBJECT x)

diff --git a/v7/src/microcode/x11graph.c b/v7/src/microcode/x11graph.c
index d84077aae196b2649e172b9d5ee1acad844ad875..49c8a0e5d28381aa250fd2f0d8ccc1474e8d11c7 100644 (file)
--- a/v7/src/microcode/x11graph.c
+++ b/v7/src/microcode/x11graph.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: x11graph.c,v 1.33 1994/09/26 23:08:46 cph Exp $
+$Id: x11graph.c,v 1.34 1995/09/18 22:33:08 cph Exp $
 
-Copyright (c) 1989-94 Massachusetts Institute of Technology
+Copyright (c) 1989-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -262,8 +262,8 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-RECONFIGURE", Prim_x_graphics_reconfigure, 3, 3, 0
 {
   PRIMITIVE_HEADER (3);
   reconfigure ((x_window_arg (1)),
-              (arg_nonnegative_integer (2)),
-              (arg_nonnegative_integer (3)));
+              (arg_ulong_integer (2)),
+              (arg_ulong_integer (3)));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
@@ -487,7 +487,7 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-FUNCTION", Prim_x_graphics_set_function, 2, 2,
   {
     struct xwindow * xw = (x_window_arg (1));
     Display * display = (XW_DISPLAY (xw));
-    unsigned int function = (arg_index_integer (2, 16));
+    unsigned int function = (arg_ulong_index_integer (2, 16));
     XSetFunction (display, (XW_NORMAL_GC (xw)), function);
     XSetFunction (display, (XW_REVERSE_GC (xw)), function);
   }
@@ -593,7 +593,7 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-FILL-STYLE", Prim_x_graphics_set_fill_style, 2
   {
     struct xwindow * xw = (x_window_arg (1));
     Display * display = (XW_DISPLAY (xw));
-    unsigned int fill_style = (arg_index_integer (2, 4));
+    unsigned int fill_style = (arg_ulong_index_integer (2, 4));
     XSetFillStyle (display, (XW_NORMAL_GC (xw)), fill_style);
     XSetFillStyle (display, (XW_REVERSE_GC (xw)), fill_style);
   }
@@ -606,7 +606,7 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-LINE-STYLE", Prim_x_graphics_set_line_style, 2
   {
     struct xwindow * xw = (x_window_arg (1));
     Display * display = (XW_DISPLAY (xw));
-    unsigned int style = (arg_index_integer (2, 3));
+    unsigned int style = (arg_ulong_index_integer (2, 3));
     XSetLineAttributes
       (display, (XW_NORMAL_GC (xw)), 0, style, CapButt, JoinMiter);
     XSetLineAttributes
@@ -623,7 +623,7 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-DASHES", Prim_x_graphics_set_dashes, 3, 3, 0)
     Display * display = (XW_DISPLAY (xw));
     char * dash_list = (STRING_ARG (3));
     unsigned int dash_list_length = (STRING_LENGTH (ARG_REF (3)));
-    unsigned int dash_offset = (arg_index_integer (2, dash_list_length));
+    unsigned int dash_offset = (arg_ulong_index_integer (2, dash_list_length));
     XSetDashes
       (display, (XW_NORMAL_GC (xw)), dash_offset, dash_list, dash_list_length);
     XSetDashes
@@ -743,8 +743,8 @@ information needed to crate an XImage structure.")
     struct xwindow * xw = (x_window_arg (1));
     Window window = (XW_WINDOW (xw));
     Display * dpy = (XW_DISPLAY (xw));
-    unsigned int width = (arg_nonnegative_integer (2));
-    unsigned int height = (arg_nonnegative_integer (3));
+    unsigned int width = (arg_ulong_integer (2));
+    unsigned int height = (arg_ulong_integer (3));
     unsigned int bitmap_pad = (BitmapPad (dpy));
     unsigned int byte_pad = (bitmap_pad / CHAR_BIT);
     unsigned int bytes_per_line =
@@ -775,8 +775,8 @@ DEFINE_PRIMITIVE ("X-BYTES-INTO-IMAGE", Prim_x_bytes_into_image, 2, 2,
 {
   PRIMITIVE_HEADER (2);
   {
-    SCHEME_OBJECT vector = ARG_REF (1);
-    XImage * image = XI_IMAGE (x_image_arg (2));
+    SCHEME_OBJECT vector = (ARG_REF (1));
+    XImage * image = (XI_IMAGE (x_image_arg (2)));
     char * image_scan;
     unsigned long width = (image -> width);
     unsigned long height = (image -> height);
@@ -795,20 +795,20 @@ DEFINE_PRIMITIVE ("X-BYTES-INTO-IMAGE", Prim_x_bytes_into_image, 2, 2,
   }
 }
 \f
-DEFINE_PRIMITIVE("X-GET-PIXEL-FROM-IMAGE", Prim_x_get_image_pixel, 3, 3, 0)
+DEFINE_PRIMITIVE ("X-GET-PIXEL-FROM-IMAGE", Prim_x_get_image_pixel, 3, 3, 0)
 {
   PRIMITIVE_HEADER (3);
   {
     XImage * image = (XI_IMAGE (x_image_arg (1)));
     PRIMITIVE_RETURN
-      (long_to_integer
+      (ulong_to_integer
        (XGetPixel (image,
                   (arg_index_integer (2, (image -> width))),
                   (arg_index_integer (3, (image -> height))))));
   }
 }
 
-DEFINE_PRIMITIVE("X-SET-PIXEL-IN-IMAGE", Prim_x_set_image_pixel, 4, 4, 0)
+DEFINE_PRIMITIVE ("X-SET-PIXEL-IN-IMAGE", Prim_x_set_image_pixel, 4, 4, 0)
 {
   PRIMITIVE_HEADER (4);
   {
@@ -816,7 +816,7 @@ DEFINE_PRIMITIVE("X-SET-PIXEL-IN-IMAGE", Prim_x_set_image_pixel, 4, 4, 0)
     XPutPixel (image,
               (arg_index_integer (2, (image -> width))),
               (arg_index_integer (3, (image -> height))),
-              (arg_integer (4)));
+              (arg_ulong_integer (4)));
     PRIMITIVE_RETURN (UNSPECIFIC);
   }
 }
@@ -842,8 +842,8 @@ DEFINE_PRIMITIVE ("X-DISPLAY-IMAGE", Prim_x_display_image, 8, 8, 0)
     XImage * image = (XI_IMAGE (x_image_arg (1)));
     unsigned int image_width = (image -> width);
     unsigned int image_height = (image -> height);
-    unsigned int x_offset = (arg_index_integer (2, image_width));
-    unsigned int y_offset = (arg_index_integer (3, image_height));
+    unsigned int x_offset = (arg_ulong_index_integer (2, image_width));
+    unsigned int y_offset = (arg_ulong_index_integer (3, image_height));
     struct xwindow * xw = (x_window_arg (4));
     XPutImage
       ((XW_DISPLAY (xw)),(XW_WINDOW (xw)),(XW_NORMAL_GC (xw)),
@@ -894,7 +894,7 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-MAP-X-COORDINATE", Prim_x_graphics_map_x_coordinat
   PRIMITIVE_HEADER (2);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int xp = (arg_nonnegative_integer (2));
+    unsigned int xp = (arg_ulong_integer (2));
     int bx = (xp - (XW_INTERNAL_BORDER_WIDTH (xw)));
     PRIMITIVE_RETURN
       (x_coordinate_map
@@ -910,7 +910,7 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-MAP-Y-COORDINATE", Prim_x_graphics_map_y_coordinat
   PRIMITIVE_HEADER (2);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int yp = (arg_nonnegative_integer (2));
+    unsigned int yp = (arg_ulong_integer (2));
     int by = (yp - (XW_INTERNAL_BORDER_WIDTH (xw)));
     PRIMITIVE_RETURN
       (y_coordinate_map

diff --git a/v7/src/microcode/x11term.c b/v7/src/microcode/x11term.c
index 93e857c683db0b2469df8c2e641dcd07cd3af396..1bf69cf4cb47af82cd384bb30a9795997a0aa17a 100644 (file)
--- a/v7/src/microcode/x11term.c
+++ b/v7/src/microcode/x11term.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: x11term.c,v 1.23 1993/08/16 08:12:32 cph Exp $
+$Id: x11term.c,v 1.24 1995/09/18 22:33:14 cph Exp $
 
-Copyright (c) 1989-93 Massachusetts Institute of Technology
+Copyright (c) 1989-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -221,13 +221,13 @@ DEFUN (xterm_deallocate, (xw), struct xwindow * xw)
 static SCHEME_OBJECT
 DEFUN (xterm_x_coordinate_map, (xw, x), struct xwindow * xw AND unsigned int x)
 {
-  return (long_to_integer (x / (FONT_WIDTH (XW_FONT (xw)))));
+  return (ulong_to_integer (x / (FONT_WIDTH (XW_FONT (xw)))));
 }
 
 static SCHEME_OBJECT
 DEFUN (xterm_y_coordinate_map, (xw, y), struct xwindow * xw AND unsigned int y)
 {
-  return (long_to_integer (y / (FONT_HEIGHT (XW_FONT (xw)))));
+  return (ulong_to_integer (y / (FONT_HEIGHT (XW_FONT (xw)))));
 }
 
 static void
@@ -423,8 +423,8 @@ DEFINE_PRIMITIVE ("XTERM-RECONFIGURE", Prim_xterm_reconfigure, 3, 3, 0)
 {
   PRIMITIVE_HEADER (3);
   xterm_reconfigure ((x_window_arg (1)),
-                    (arg_nonnegative_integer (2)),
-                    (arg_nonnegative_integer (3)));
+                    (arg_ulong_integer (2)),
+                    (arg_ulong_integer (3)));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
@@ -432,10 +432,10 @@ DEFINE_PRIMITIVE ("XTERM-DUMP-RECTANGLE", Prim_xterm_dump_rectangle, 5, 5, 0)
 {
   PRIMITIVE_HEADER (5);
   xterm_dump_rectangle ((x_window_arg (1)),
-                       (arg_nonnegative_integer (2)),
-                       (arg_nonnegative_integer (3)),
-                       (arg_nonnegative_integer (4)),
-                       (arg_nonnegative_integer (5)));
+                       (arg_ulong_integer (2)),
+                       (arg_ulong_integer (3)),
+                       (arg_ulong_integer (4)),
+                       (arg_ulong_integer (5)));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
@@ -444,7 +444,7 @@ DEFINE_PRIMITIVE ("XTERM-MAP-X-COORDINATE", Prim_xterm_map_x_coordinate, 2, 2, 0
   PRIMITIVE_HEADER (2);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int xp = (arg_nonnegative_integer (2));
+    unsigned int xp = (arg_ulong_integer (2));
     int bx = (xp - (XW_INTERNAL_BORDER_WIDTH (xw)));
     PRIMITIVE_RETURN
       (long_to_integer
@@ -460,7 +460,7 @@ DEFINE_PRIMITIVE ("XTERM-MAP-Y-COORDINATE", Prim_xterm_map_y_coordinate, 2, 2, 0
   PRIMITIVE_HEADER (2);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int yp = (arg_nonnegative_integer (2));
+    unsigned int yp = (arg_ulong_integer (2));
     int by = (yp - (XW_INTERNAL_BORDER_WIDTH (xw)));
     PRIMITIVE_RETURN
       (long_to_integer
@@ -479,7 +479,7 @@ DEFINE_PRIMITIVE ("XTERM-MAP-X-SIZE", Prim_xterm_map_x_size, 2, 2, 0)
     int width =
       ((arg_nonnegative_integer (2)) - (2 * (XW_INTERNAL_BORDER_WIDTH (xw))));
     PRIMITIVE_RETURN
-      (long_to_integer
+      (ulong_to_integer
        ((width < 0) ? 0 : (width / (FONT_WIDTH (XW_FONT (xw))))));
   }
 }
@@ -492,7 +492,7 @@ DEFINE_PRIMITIVE ("XTERM-MAP-Y-SIZE", Prim_xterm_map_y_size, 2, 2, 0)
     int height =
       ((arg_nonnegative_integer (2)) - (2 * (XW_INTERNAL_BORDER_WIDTH (xw))));
     PRIMITIVE_RETURN
-      (long_to_integer
+      (ulong_to_integer
        ((height < 0) ? 0 : (height / (FONT_HEIGHT (XW_FONT (xw))))));
   }
 }
@@ -600,13 +600,13 @@ DEFINE_PRIMITIVE ("XTERM-OPEN-WINDOW", Prim_xterm_open_window, 3, 3, 0)
 DEFINE_PRIMITIVE ("XTERM-X-SIZE", Prim_xterm_x_size, 1, 1, 0)
 {
   PRIMITIVE_HEADER (1);
-  PRIMITIVE_RETURN (long_to_integer (XW_X_CSIZE (x_window_arg (1))));
+  PRIMITIVE_RETURN (ulong_to_integer (XW_X_CSIZE (x_window_arg (1))));
 }
 
 DEFINE_PRIMITIVE ("XTERM-Y-SIZE", Prim_xterm_y_size, 1, 1, 0)
 {
   PRIMITIVE_HEADER (1);
-  PRIMITIVE_RETURN (long_to_integer (XW_Y_CSIZE (x_window_arg (1))));
+  PRIMITIVE_RETURN (ulong_to_integer (XW_Y_CSIZE (x_window_arg (1))));
 }
 
 DEFINE_PRIMITIVE ("XTERM-SET-SIZE", Prim_xterm_set_size, 3, 3, 0)
@@ -621,8 +621,8 @@ DEFINE_PRIMITIVE ("XTERM-SET-SIZE", Prim_xterm_set_size, 3, 3, 0)
   XResizeWindow
     ((XW_DISPLAY (xw)),
      (XW_WINDOW (xw)),
-     (((arg_nonnegative_integer (2)) * (FONT_WIDTH (font))) + extra),
-     (((arg_nonnegative_integer (3)) * (FONT_HEIGHT (font))) + extra));
+     (((arg_ulong_integer (2)) * (FONT_WIDTH (font))) + extra),
+     (((arg_ulong_integer (3)) * (FONT_HEIGHT (font))) + extra));
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
@@ -652,8 +652,8 @@ DEFINE_PRIMITIVE ("XTERM-WRITE-CURSOR!", Prim_xterm_write_cursor, 3, 3, 0)
   PRIMITIVE_HEADER (3);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
-    unsigned int y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
+    unsigned int x = (arg_ulong_index_integer (2, (XW_X_CSIZE (xw))));
+    unsigned int y = (arg_ulong_index_integer (3, (XW_Y_CSIZE (xw))));
     if ((x != (XW_CURSOR_X (xw))) || (y != (XW_CURSOR_Y (xw))))
       {
        xterm_erase_cursor (xw);
@@ -670,8 +670,8 @@ DEFINE_PRIMITIVE ("XTERM-WRITE-CHAR!", Prim_xterm_write_char, 5, 5, 0)
   PRIMITIVE_HEADER (5);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
-    unsigned int y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
+    unsigned int x = (arg_ulong_index_integer (2, (XW_X_CSIZE (xw))));
+    unsigned int y = (arg_ulong_index_integer (3, (XW_Y_CSIZE (xw))));
     int c = (arg_ascii_char (4));
     unsigned int hl = (HL_ARG (5));
     unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
@@ -694,11 +694,12 @@ DEFINE_PRIMITIVE ("XTERM-WRITE-SUBSTRING!", Prim_xterm_write_substring, 7, 7, 0)
   CHECK_ARG (4, STRING_P);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
-    unsigned int y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
+    unsigned int x = (arg_ulong_index_integer (2, (XW_X_CSIZE (xw))));
+    unsigned int y = (arg_ulong_index_integer (3, (XW_Y_CSIZE (xw))));
     SCHEME_OBJECT string = (ARG_REF (4));
-    unsigned int end = (arg_index_integer (6, ((STRING_LENGTH (string)) + 1)));
-    unsigned int start = (arg_index_integer (5, (end + 1)));
+    unsigned int end
+      = (arg_ulong_index_integer (6, ((STRING_LENGTH (string)) + 1)));
+    unsigned int start = (arg_ulong_index_integer (5, (end + 1)));
     unsigned int hl = (HL_ARG (7));
     unsigned int length = (end - start);
     unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
@@ -778,10 +779,12 @@ DEFINE_PRIMITIVE ("XTERM-CLEAR-RECTANGLE!", Prim_xterm_clear_rectangle, 6, 6, 0)
   PRIMITIVE_HEADER (6);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
-    unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
-    unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
-    unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
+    unsigned int x_end
+      = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+    unsigned int y_end
+      = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+    unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
+    unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
     unsigned int hl = (HL_ARG (6));
     if ((x_start < x_end) && (y_start < y_end))
       {
@@ -830,11 +833,13 @@ Scroll the contents of the region up by LINES.")
   PRIMITIVE_HEADER (6);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
-    unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
-    unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
-    unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
-    unsigned int lines = (arg_index_integer (6, (y_end - y_start)));
+    unsigned int x_end
+      = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+    unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
+    unsigned int y_end
+      = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+    unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
+    unsigned int lines = (arg_ulong_index_integer (6, (y_end - y_start)));
     if ((0 < lines) && (x_start < x_end) && (y_start < y_end))
       {
        if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, (y_start + lines), y_end))
@@ -892,11 +897,13 @@ Scroll the contents of the region down by LINES.")
   PRIMITIVE_HEADER (6);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
-    unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
-    unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
-    unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
-    unsigned int lines = (arg_index_integer (6, (y_end - y_start)));
+    unsigned int x_end
+      = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+    unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
+    unsigned int y_end
+      = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+    unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
+    unsigned int lines = (arg_ulong_index_integer (6, (y_end - y_start)));
     if ((0 < lines) && (x_start < x_end) && (y_start < y_end))
       {
        if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_start, (y_end - lines)))
@@ -931,10 +938,12 @@ The pairs are organized in row-major order from (X-START, Y-START).")
   PRIMITIVE_HEADER (5);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
-    unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
-    unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
-    unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
+    unsigned int x_end
+      = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+    unsigned int y_end
+      = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+    unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
+    unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
     unsigned int x_length = (x_end - x_start);
     unsigned int string_length = (2 * x_length * (y_end - y_start));
     SCHEME_OBJECT string = (allocate_string (string_length));
@@ -968,10 +977,12 @@ See `XTERM-SCREEN-CONTENTS' for the format of CONTENTS.")
   CHECK_ARG (6, STRING_P);
   {
     struct xwindow * xw = (x_window_arg (1));
-    unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
-    unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
-    unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
-    unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
+    unsigned int x_end
+      = (arg_ulong_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+    unsigned int y_end
+      = (arg_ulong_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+    unsigned int x_start = (arg_ulong_index_integer (2, (x_end + 1)));
+    unsigned int y_start = (arg_ulong_index_integer (4, (y_end + 1)));
     unsigned int x_length = (x_end - x_start);
     unsigned int string_length = (2 * x_length * (y_end - y_start));
     SCHEME_OBJECT string = (ARG_REF (6));

diff --git a/v8/src/microcode/object.h b/v8/src/microcode/object.h
index 94b402c1c45ef025fdd4053f830552565b611f43..a66aabdbae838a9d3f7bbb07a1fb437d5aad7035 100644 (file)
--- a/v8/src/microcode/object.h
+++ b/v8/src/microcode/object.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: object.h,v 9.46 1995/07/27 00:06:04 adams Exp $
+$Id: object.h,v 9.47 1995/09/18 22:32:56 cph Exp $
 
-Copyright (c) 1987-1993 Massachusetts Institute of Technology
+Copyright (c) 1987-95 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -496,6 +496,9 @@ extern SCHEME_OBJECT * memory_base;
 #define BIGNUM_TO_LONG_P(bignum)                                       \
   (bignum_fits_in_word_p ((bignum), ((sizeof (long)) * CHAR_BIT), 1))
 
+#define BIGNUM_TO_ULONG_P(bignum)                                      \
+  (bignum_fits_in_word_p ((bignum), ((sizeof (unsigned long)) * CHAR_BIT), 0))
+
 /* If precision should not be lost,
    compare to DBL_MANT_DIG instead. */
 #define BIGNUM_TO_DOUBLE_P(bignum)                                     \