* filesys.c (scm_stat): Slightly optimized.

[bpt/guile.git] / libguile / struct.c

diff --git a/libguile/struct.c b/libguile/struct.c
index 51f934e..a693135 100644 (file)
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1996 Free Software Foundation, Inc.
+/*     Copyright (C) 1996, 1997 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -12,7 +12,8 @@
  * 
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
  *
  * As a special exception, the Free Software Foundation gives permission
  * for additional uses of the text contained in its release of GUILE.
@@ -36,13 +37,14 @@
  *
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  
- */
+ * If you do not wish that, delete this exception notice.  */
 \f
 
 #include <stdio.h>
 #include "_scm.h"
 #include "chars.h"
+#include "genio.h"
+#include "eval.h"
 
 #include "struct.h"
 
@@ -195,7 +197,7 @@ init_struct (handle, tail_elts, inits)
 
        case 'p':
          if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
-           *mem = SCM_EOL;
+           *mem = SCM_BOOL_F;
          else
            {
              *mem = SCM_CAR (inits);
@@ -354,7 +356,7 @@ scm_make_struct (vtable, tail_array_size, init)
   SCM_ASSERT (SCM_INUMP (tail_array_size), tail_array_size, SCM_ARG2,
              s_make_struct);
 
-  layout = SCM_STRUCT_DATA (vtable)[scm_struct_i_layout];
+  layout = SCM_STRUCT_DATA (vtable)[scm_vtable_index_layout];
   basic_size = SCM_LENGTH (layout) / 2;
   tail_elts = SCM_INUM (tail_array_size);
   SCM_NEWCELL (handle);
@@ -434,7 +436,7 @@ scm_struct_ref (handle, pos)
   p = SCM_INUM (pos);
 
   fields_desc = (unsigned char *)SCM_CHARS (layout);
-  n_fields = data[- scm_struct_n_extra_words] - scm_struct_n_extra_words;
+  n_fields = data[scm_struct_i_n_words] - scm_struct_n_extra_words;
   
   SCM_ASSERT (p < n_fields, pos, SCM_OUTOFRANGE, s_struct_ref);
 
@@ -516,7 +518,7 @@ scm_struct_set_x (handle, pos, val)
   p = SCM_INUM (pos);
 
   fields_desc = (unsigned char *)SCM_CHARS (layout);
-  n_fields = data[- scm_struct_n_extra_words] - scm_struct_n_extra_words;
+  n_fields = data[scm_struct_i_n_words] - scm_struct_n_extra_words;
 
   SCM_ASSERT (p < n_fields, pos, SCM_OUTOFRANGE, s_struct_set_x);
 
@@ -595,13 +597,32 @@ scm_struct_vtable_tag (handle)
 
 \f
 
+void
+scm_print_struct (exp, port, pstate)
+     SCM exp;
+     SCM port;
+     scm_print_state *pstate;
+{
+  if (SCM_NFALSEP (scm_procedure_p (SCM_STRUCT_PRINTER (exp))))
+    scm_printer_apply (SCM_STRUCT_PRINTER (exp), exp, port, pstate);
+  else
+    {
+      scm_lfwrite ("#<struct ", sizeof ("#<struct ") - 1, port);
+      scm_intprint (SCM_STRUCT_VTABLE (exp), 16, port);
+      scm_putc (':', port);
+      scm_intprint (exp, 16, port);
+      scm_putc ('>', port);
+    }
+}
 
 void
 scm_init_struct ()
 {
-  required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosr", sizeof ("pruosr") - 1, SCM_BOOL_F));
+  required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosrpw", sizeof ("pruosrpw") - 1, SCM_BOOL_F));
   scm_permanent_object (required_vtable_fields);
-  scm_sysintern ("struct-vtable-offset", SCM_MAKINUM (scm_struct_i_vtable_offset));
+  scm_sysintern ("vtable-index-layout", SCM_MAKINUM (scm_vtable_index_layout));
+  scm_sysintern ("vtable-index-vtable", SCM_MAKINUM (scm_vtable_index_vtable));
+  scm_sysintern ("vtable-index-printer", SCM_MAKINUM (scm_vtable_index_printer));
+  scm_sysintern ("vtable-offset-user", SCM_MAKINUM (scm_vtable_offset_user));
 #include "struct.x"
 }
-