HCoop / bpt / guile.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
2002-07-20 Han-Wen <hanwen@cs.uu.nl>
[bpt/guile.git] / libguile / srcprop.c
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index 606a623..a47dfc0 100644 (file)
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 Free Software Foundation
  * 
  * 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
@@ -42,8 +42,6 @@
  * The author can be reached at djurfeldt@nada.kth.se
  * Mikael Djurfeldt, SANS/NADA KTH, 10044 STOCKHOLM, SWEDEN */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 \f
 
@@ -83,9 +81,9 @@ SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
 SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
 SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
 
-scm_bits_t scm_tc16_srcprops;
-static scm_srcprops_chunk *srcprops_chunklist = 0;
-static scm_srcprops *srcprops_freelist = 0;
+scm_t_bits scm_tc16_srcprops;
+static scm_t_srcprops_chunk *srcprops_chunklist = 0;
+static scm_t_srcprops *srcprops_freelist = 0;
 
 
 static SCM
@@ -97,11 +95,11 @@ srcprops_mark (SCM obj)
 }
 
 
-static scm_sizet
+static size_t
 srcprops_free (SCM obj)
 {
-  *((scm_srcprops **) SCM_CELL_WORD_1 (obj)) = srcprops_freelist;
-  srcprops_freelist = (scm_srcprops *) SCM_CELL_WORD_1 (obj);
+  *((scm_t_srcprops **) SCM_CELL_WORD_1 (obj)) = srcprops_freelist;
+  srcprops_freelist = (scm_t_srcprops *) SCM_CELL_WORD_1 (obj);
   return 0; /* srcprops_chunks are not freed until leaving guile */
 }
 
@@ -119,20 +117,28 @@ srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
 }
 
 
+int
+scm_c_source_property_breakpoint_p (SCM form)
+{
+  SCM obj = scm_whash_lookup (scm_source_whash, form);
+  return SRCPROPSP (obj) && SRCPROPBRK (obj);
+}
+
+
 SCM
-scm_make_srcprops (int line, int col, SCM filename, SCM copy, SCM plist)
+scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist)
 {
-  register scm_srcprops *ptr;
+  register scm_t_srcprops *ptr;
   SCM_DEFER_INTS;
   if ((ptr = srcprops_freelist) != NULL)
-    srcprops_freelist = *(scm_srcprops **)ptr;
+    srcprops_freelist = *(scm_t_srcprops **)ptr;
   else
     {
-      int i;
-      scm_srcprops_chunk *mem;
-      scm_sizet n = sizeof (scm_srcprops_chunk)
-                   + sizeof (scm_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
-      SCM_SYSCALL (mem = (scm_srcprops_chunk *) malloc (n));
+      size_t i;
+      scm_t_srcprops_chunk *mem;
+      size_t n = sizeof (scm_t_srcprops_chunk)
+                   + sizeof (scm_t_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
+      SCM_SYSCALL (mem = (scm_t_srcprops_chunk *) malloc (n));
       if (mem == NULL)
        scm_memory_error ("srcprops");
       scm_mallocated += n;
@@ -140,9 +146,9 @@ scm_make_srcprops (int line, int col, SCM filename, SCM copy, SCM plist)
       srcprops_chunklist = mem;
       ptr = &mem->srcprops[0];
       for (i = 1; i < SRCPROPS_CHUNKSIZE - 1; ++i)
-       *(scm_srcprops **)&ptr[i] = &ptr[i + 1];
-      *(scm_srcprops **)&ptr[SRCPROPS_CHUNKSIZE - 1] = 0;
-      srcprops_freelist = (scm_srcprops *) &ptr[1];
+       *(scm_t_srcprops **)&ptr[i] = &ptr[i + 1];
+      *(scm_t_srcprops **)&ptr[SRCPROPS_CHUNKSIZE - 1] = 0;
+      srcprops_freelist = (scm_t_srcprops *) &ptr[1];
     }
   ptr->pos = SRCPROPMAKPOS (line, col);
   ptr->fname = filename;
@@ -163,7 +169,7 @@ scm_srcprops_to_plist (SCM obj)
     plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist);
   plist = scm_acons (scm_sym_column, SCM_MAKINUM (SRCPROPCOL (obj)), plist);
   plist = scm_acons (scm_sym_line, SCM_MAKINUM (SRCPROPLINE (obj)), plist);
-  plist = scm_acons (scm_sym_breakpoint, SRCPROPBRK (obj), plist);
+  plist = scm_acons (scm_sym_breakpoint, SCM_BOOL (SRCPROPBRK (obj)), plist);
   return plist;
 }
 
@@ -173,13 +179,11 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
 #define FUNC_NAME s_scm_source_properties
 {
   SCM p;
-  SCM_VALIDATE_NIM (1,obj);
+  SCM_VALIDATE_NIM (1, obj);
   if (SCM_MEMOIZEDP (obj))
     obj = SCM_MEMOIZED_EXP (obj);
-#ifndef SCM_RECKLESS
-  else if (SCM_NCONSP (obj))
+  else if (!SCM_CONSP (obj))
     SCM_WRONG_TYPE_ARG (1, obj);
-#endif
   p = scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F);
   if (SRCPROPSP (p))
     return scm_srcprops_to_plist (p);
@@ -196,13 +200,11 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
 #define FUNC_NAME s_scm_set_source_properties_x
 {
   SCM handle;
-  SCM_VALIDATE_NIM (1,obj);
+  SCM_VALIDATE_NIM (1, obj);
   if (SCM_MEMOIZEDP (obj))
     obj = SCM_MEMOIZED_EXP (obj);
-#ifndef SCM_RECKLESS
-  else if (SCM_NCONSP (obj))
+  else if (!SCM_CONSP (obj))
     SCM_WRONG_TYPE_ARG(1, obj);
-#endif
   handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist);
   SCM_SETCDR (handle, plist);
   return plist;
@@ -216,17 +218,15 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
 #define FUNC_NAME s_scm_source_property
 {
   SCM p;
-  SCM_VALIDATE_NIM (1,obj);
+  SCM_VALIDATE_NIM (1, obj);
   if (SCM_MEMOIZEDP (obj))
     obj = SCM_MEMOIZED_EXP (obj);
-#ifndef SCM_RECKLESS
-  else if (SCM_NECONSP (obj))
+  else if (!SCM_CONSP (obj))
     SCM_WRONG_TYPE_ARG (1, obj);
-#endif
   p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
-  if (SCM_IMP (p) || !SRCPROPSP (p))
+  if (!SRCPROPSP (p))
     goto plist;
-  if      (SCM_EQ_P (scm_sym_breakpoint, key)) p = SRCPROPBRK (p);
+  if      (SCM_EQ_P (scm_sym_breakpoint, key)) p = SCM_BOOL (SRCPROPBRK (p));
   else if (SCM_EQ_P (scm_sym_line,       key)) p = SCM_MAKINUM (SRCPROPLINE (p));
   else if (SCM_EQ_P (scm_sym_column,     key)) p = SCM_MAKINUM (SRCPROPCOL (p));
   else if (SCM_EQ_P (scm_sym_filename,   key)) p = SRCPROPFNAME (p);
@@ -250,13 +250,11 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
 {
   scm_whash_handle h;
   SCM p;
-  SCM_VALIDATE_NIM (1,obj);
+  SCM_VALIDATE_NIM (1, obj);
   if (SCM_MEMOIZEDP (obj))
     obj = SCM_MEMOIZED_EXP (obj);
-#ifndef SCM_RECKLESS
-  else if (SCM_NCONSP (obj))
+  else if (!SCM_CONSP (obj))
     SCM_WRONG_TYPE_ARG (1, obj);
-#endif
   h = scm_whash_get_handle (scm_source_whash, obj);
   if (SCM_WHASHFOUNDP (h))
     p = SCM_WHASHREF (scm_source_whash, h);
@@ -286,7 +284,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
     }
   else if (SCM_EQ_P (scm_sym_line, key))
     {
-      SCM_VALIDATE_INUM (3,datum);
+      SCM_VALIDATE_INUM (3, datum);
       if (SRCPROPSP (p))
        SETSRCPROPLINE (p, SCM_INUM (datum));
       else
@@ -296,7 +294,7 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
     }
   else if (SCM_EQ_P (scm_sym_column, key))
     {
-      SCM_VALIDATE_INUM (3,datum);
+      SCM_VALIDATE_INUM (3, datum);
       if (SRCPROPSP (p))
        SETSRCPROPCOL (p, SCM_INUM (datum));
       else
@@ -319,7 +317,12 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
        SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, SCM_UNDEFINED, datum, p));
     }
   else
-    SCM_WHASHSET (scm_source_whash, h, scm_acons (key, datum, p));
+    {
+      if (SRCPROPSP (p))
+       SRCPROPPLIST (p) = scm_acons (key, datum, SRCPROPPLIST (p));
+      else
+       SCM_WHASHSET (scm_source_whash, h, scm_acons (key, datum, p));
+    }
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -334,23 +337,21 @@ scm_init_srcprop ()
   scm_set_smob_print (scm_tc16_srcprops, srcprops_print);
 
   scm_source_whash = scm_make_weak_key_hash_table (SCM_MAKINUM (2047));
-  scm_sysintern ("source-whash", scm_source_whash);
+  scm_c_define ("source-whash", scm_source_whash);
 
-#ifndef SCM_MAGIC_SNARFER
 #include "libguile/srcprop.x"
-#endif
 }
 
 void
 scm_finish_srcprop ()
 {
-  register scm_srcprops_chunk *ptr = srcprops_chunklist, *next;
+  register scm_t_srcprops_chunk *ptr = srcprops_chunklist, *next;
   while (ptr)
     {
       next = ptr->next;
       free ((char *) ptr);
-      scm_mallocated -= sizeof (scm_srcprops_chunk)
-                       + sizeof (scm_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
+      scm_mallocated -= sizeof (scm_t_srcprops_chunk)
+                       + sizeof (scm_t_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
       ptr = next;
     }
 }
Unnamed repository; edit this file 'description' to name the repository.