microcode/pruxffi (arg_pointer): Correct address of first double.

Convert flonums/flovecs to the address of the first double, not the
manifest.  Punt flovec_ref and flovec_loc.  This simplifies callouts
to e.g. glVertex3dv.

diff --git a/src/gl/gl-adapter.c b/src/gl/gl-adapter.c
index cdbea1b926c615d0cae40a4871c5b102f73eb219..565ed85fcd6a7b933f1d35dd33d97409ebc21dad 100644 (file)
--- a/src/gl/gl-adapter.c
+++ b/src/gl/gl-adapter.c
@@ -33,80 +33,59 @@ USA.
 #include "gl-shim.h"
 
 void
-gl_clear_color (SCM color)
+gl_clear_color (double *color)
 {
-  glClearColor (flovec_ref (color, 0),
-               flovec_ref (color, 1),
-               flovec_ref (color, 2),
-               flovec_ref (color, 3));
+  glClearColor (color[0], color[1], color[2], color[3]);
 }
 
 void
-gl_color (SCM color)
+gl_light (GLenum light, GLenum pname, double *params)
 {
-  glColor4dv (flovec_loc (color));
-}
-
-void
-gl_vertex (SCM point)
-{
-  glVertex3dv (flovec_loc (point));
-}
-
-void
-gl_light (GLenum light, GLenum pname, SCM params)
-{
-  int i, len = flovec_length (params);
+  int i,len = flovec_length (params);
   GLfloat *fvec = malloc (len * sizeof (GLfloat));
   if (!fvec)
     error_external_return ();
   for (i = 0; i < len; i++) {
-    fvec[i] = flovec_ref (params, i);
+    fvec[i] = params[i];
   }
   glLightfv (light, pname, fvec);
   free (fvec);
 }
 
 void
-gl_light_model_v (GLenum pname, const GLfloat *params)
+gl_light_model_v (GLenum pname, double *params)
 {
   int i, len = flovec_length (params);
   GLfloat *fvec = malloc (len * sizeof (GLfloat));
   if (!fvec)
     error_external_return ();
   for (i = 0; i < len; i++) {
-    fvec[i] = flovec_ref (params, i);
+    fvec[i] = params[i];
   }
   glLightModelfv (pname, fvec);
   free (fvec);
 }
 
 void
-gl_material (GLenum face, GLenum pname, SCM params)
+gl_material (GLenum face, GLenum pname, double *params)
 {
   int i, len = flovec_length (params);
   GLfloat *fvec = malloc (len * sizeof (GLfloat));
   if (!fvec)
     error_external_return ();
   for (i = 0; i < len; i++) {
-    fvec[i] = flovec_ref (params, i);
+    fvec[i] = params[i];
   }
   glMaterialfv (face, pname, fvec);
   free (fvec);
 }
 
 void
-gl_normal (SCM point)
-{
-  glNormal3dv (flovec_loc (point));
-}
-
-void
-glu_look_at (SCM eye, SCM center, SCM up)
+glu_look_at (double *eye, double *center, double *up)
 {
-  gluLookAt (flovec_ref (eye, 0), flovec_ref (eye, 1), flovec_ref (eye, 2),
-            flovec_ref(center,0),flovec_ref(center,1),flovec_ref(center,2),
-            flovec_ref (up,  0), flovec_ref (up,  1), flovec_ref (up,  2));
+  gluLookAt (eye[0], eye[1], eye[2],
+            center[0], center[1], center[2],
+            up[0], up[1], up[2]);
 }
 
 static int gdk_visual_get_visual_class (GdkVisual *v);

diff --git a/src/gl/gl-shim.h b/src/gl/gl-shim.h
index 160eea432de6b1997759e156e005320c36f6be37..587f38ea29f430b254a870ec410d977aed3f8f61 100644 (file)
--- a/src/gl/gl-shim.h
+++ b/src/gl/gl-shim.h
@@ -29,14 +29,14 @@ USA.
 
 /* Do not declare in gl-const.c, which does not include mit-scheme.h. */
 #ifdef CSTACK_PUSH
-extern void gl_clear_color (SCM color);
-extern void gl_color (SCM color);
-extern void gl_vertex (SCM point);
-extern void gl_light (GLenum light, GLenum pname, SCM params);
-extern void gl_light_model_v (GLenum pname, const GLfloat *params);
-extern void gl_material (GLenum face, GLenum pname, SCM params);
-extern void gl_normal (SCM point);
-extern void glu_look_at (SCM eye, SCM center, SCM up);
+extern void gl_clear_color (double *color);
+extern void gl_color (double *color);
+extern void gl_vertex (double *point);
+extern void gl_light (GLenum light, GLenum pname, double *params);
+extern void gl_light_model_v (GLenum pname, double *params);
+extern void gl_material (GLenum face, GLenum pname, double *params);
+extern void gl_normal (double *point);
+extern void glu_look_at (double *eye, double *center, double *up);
 extern GdkVisual* glx_find_gdkvisual (GdkWindow *window, XVisualInfo *visinfo);
 extern int gdk_window_xid (GdkWindow *window);
 extern Display* gdk_window_xdisplay (GdkWindow *window);

diff --git a/src/gl/gl.cdecl b/src/gl/gl.cdecl
index bb1210ec50db2fe349c3418caf32dc37e73728b5..42093dad07194c41dbc138f29750ec0d2c3da313 100644 (file)
--- a/src/gl/gl.cdecl
+++ b/src/gl/gl.cdecl
@@ -30,13 +30,12 @@ USA.
 (typedef GLsizei int)
 (typedef GLfloat float)
 (typedef GLdouble double)
-(typedef SCM (* void))
 
 (extern void glShadeModel (mode GLenum))
 
 (enum (GL_SMOOTH))
 
-(extern void gl_clear_color (color SCM))
+(extern void gl_clear_color (color (* double)))
 
 (extern void glClearDepth (depth GLdouble))
 
@@ -97,9 +96,9 @@ USA.
       (GL_QUAD_STRIP)
       (GL_POLYGON))
 
-(extern void gl_color (color SCM))
+(extern void glColor4dv (color (* double)))
 
-(extern void gl_vertex (point SCM))
+(extern void glVertex3dv (point (* double)))
 
 (extern void glEnd)
 
@@ -114,11 +113,11 @@ USA.
 
 (extern GLuint glGenLists (range GLsizei))
 
-(extern void gl_light (light GLenum) (pname GLenum) (params SCM))
+(extern void gl_light (light GLenum) (pname GLenum) (params (* double)))
 
 (extern void glLightModelf (pname GLenum) (param GLfloat))
 (extern void glLightModeli (pname GLenum) (param GLint))
-(extern void gl_light_model_v (pname GLenum) (params SCM))
+(extern void gl_light_model_v (pname GLenum) (params (* double)))
 
 (enum (GL_LIGHT_MODEL_AMBIENT)
       (GL_LIGHT_MODEL_COLOR_CONTROL)
@@ -127,7 +126,7 @@ USA.
       (GL_SEPARATE_SPECULAR_COLOR)
       (GL_SINGLE_COLOR))
 
-(extern void gl_material (face GLenum) (pname GLenum) (params SCM))
+(extern void gl_material (face GLenum) (pname GLenum) (params (* double)))
 
 (extern void glMatrixMode (mode GLenum))
 (enum (GL_PROJECTION) (GL_MODELVIEW))
@@ -138,7 +137,7 @@ USA.
 
 (extern void glDeleteLists (list GLuint) (range GLsizei))
 
-(extern void gl_normal (point SCM))
+(extern void glNormal3dv (point (* double)))
 
 (extern void glPopMatrix)
 
@@ -167,7 +166,7 @@ USA.
       (GL_COMPILE)
       (GL_FLAT))
 
-(extern void glu_look_at (eye SCM) (center SCM) (up SCM))
+(extern void glu_look_at (eye (* double)) (center (* double)) (up (* double)))
 
 (extern void gluPerspective
        (fovy GLdouble) (aspect GLdouble) (zNear GLdouble) (zFar GLdouble))

diff --git a/src/gl/gl.scm b/src/gl/gl.scm
index 0a6475a8290c5d9761679d3c575d50def47edf99..c5c5f259ed08dcc47dd0e22c87a0ac6ef849e975 100644 (file)
--- a/src/gl/gl.scm
+++ b/src/gl/gl.scm
@@ -180,12 +180,12 @@ USA.
 (define (gl:color color)
   (guarantee-current 'GL:COLOR)
   (guarantee-color color 'GL:COLOR)
-  (C-call "gl_color" color))
+  (C-call "glColor4dv" color))
 
 (define (gl:vertex point)
   (guarantee-current 'GL:VERTEX)
   (guarantee-3d point 'GL:VERTEX)
-  (C-call "gl_vertex" point))
+  (C-call "glVertex3dv" point))
 
 (define (gl:end)
   (guarantee-current 'GL:END)
@@ -330,7 +330,7 @@ USA.
 (define (gl:normal 3d)
   (guarantee-current 'GL:NORMAL)
   (guarantee-3d 3d 'GL:NORMAL)
-  (C-call "gl_normal" 3d))
+  (C-call "glNormal3dv" 3d))
 
 (define (gl:pop-matrix)
   (guarantee-current 'GL:POP-MATRIX)

diff --git a/src/microcode/pruxffi.c b/src/microcode/pruxffi.c
index f6c3ca54ed3852b3de433ea982daaf35d7a4d593..e8c6c2c57a286700a09104c548dee026174e2290 100644 (file)
--- a/src/microcode/pruxffi.c
+++ b/src/microcode/pruxffi.c
@@ -837,7 +837,7 @@ arg_pointer (int argn)
   if (is_alien (arg))
     return (alien_address (arg));
   if (FLONUM_P (arg))
-    return ((void *) (OBJECT_ADDRESS (arg)));
+    return ((void *) (MEMORY_LOC ((arg), 1)));
 
   error_wrong_type_arg (argn);
   /*NOTREACHED*/
@@ -1046,24 +1046,12 @@ empty_list (void)
 }
 
 int
-flovec_length (SCM vector)
+flovec_length (double *first)
 {
-  return (FLOATING_VECTOR_LENGTH (vector));
-}
-
-double*
-flovec_loc (SCM vector)
-{
-  return (FLOATING_VECTOR_LOC (vector, 0));
-}
+  /* FIRST must be the first double in a flonum/flovec. */
 
-double
-flovec_ref (SCM vector, int index)
-{
-  int len = FLOATING_VECTOR_LENGTH (vector);
-  if (0 <= index && index < len)
-    return (FLOATING_VECTOR_REF (vector, index));
-  error_external_return ();
+  SCM object = MAKE_POINTER_OBJECT (TC_BIG_FLONUM, (((SCM *)first) - 1));
+  return (FLOATING_VECTOR_LENGTH (object));
 }
 
 DEFINE_PRIMITIVE ("OUTF-ERROR", Prim_outf_error, 1, 1, 0)

diff --git a/src/microcode/pruxffi.h b/src/microcode/pruxffi.h
index 9f999ad8b14ccc1f81e3677f109f0e471ebc9748..a78b2a02f05c21480db9f7f7177ea4905adb6539 100644 (file)
--- a/src/microcode/pruxffi.h
+++ b/src/microcode/pruxffi.h
@@ -90,9 +90,7 @@ extern void* pointer_value (void);
 extern void check_number_of_args (int num);
 extern SCM unspecific (void);
 extern SCM empty_list (void);
-extern int flovec_length (SCM vector);
-extern double* flovec_loc (SCM vector);
-extern double flovec_ref (SCM vector, int index);
+extern int flovec_length (double *first);
 
 #ifndef MIT_SCHEME /* Do not include in the microcode, just shims. */
 extern SCM cons (SCM car, SCM cdr);