guile-cvs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

guile/guile-core/libguile weaks.c vports.c vect...


From: Marius Vollmer
Subject: guile/guile-core/libguile weaks.c vports.c vect...
Date: Sun, 25 Nov 2001 10:21:07 -0500

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/11/25 10:21:07

Modified files:
        guile-core/libguile: weaks.c vports.c vectors.c variable.c 
                             unif.c symbols.c struct.c strports.c 
                             strings.c smob.h smob.c procs.c print.c 
                             ports.c pairs.c numbers.c num2float.i.c 
                             list.c lang.c guardians.c goops.c gh_data.c 
                             fports.c eval.c environments.c debug.c 
                             coop-threads.c alist.c 

Log message:
        Replaced SCM_NEWCELL and SCM_NEWCELL2 with scm_alloc_cell and
        scm_alloc_double_cell, respectively.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/weaks.c.diff?cvsroot=OldCVS&tr1=1.44&tr2=1.45&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/vports.c.diff?cvsroot=OldCVS&tr1=1.50&tr2=1.51&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/vectors.c.diff?cvsroot=OldCVS&tr1=1.58&tr2=1.59&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/variable.c.diff?cvsroot=OldCVS&tr1=1.42&tr2=1.43&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/unif.c.diff?cvsroot=OldCVS&tr1=1.125&tr2=1.126&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/symbols.c.diff?cvsroot=OldCVS&tr1=1.94&tr2=1.95&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/struct.c.diff?cvsroot=OldCVS&tr1=1.87&tr2=1.88&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/strports.c.diff?cvsroot=OldCVS&tr1=1.86&tr2=1.87&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/strings.c.diff?cvsroot=OldCVS&tr1=1.66&tr2=1.67&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/smob.h.diff?cvsroot=OldCVS&tr1=1.44&tr2=1.45&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/smob.c.diff?cvsroot=OldCVS&tr1=1.49&tr2=1.50&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/procs.c.diff?cvsroot=OldCVS&tr1=1.63&tr2=1.64&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/print.c.diff?cvsroot=OldCVS&tr1=1.136&tr2=1.137&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ports.c.diff?cvsroot=OldCVS&tr1=1.160&tr2=1.161&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/pairs.c.diff?cvsroot=OldCVS&tr1=1.26&tr2=1.27&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/numbers.c.diff?cvsroot=OldCVS&tr1=1.154&tr2=1.155&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/num2float.i.c.diff?cvsroot=OldCVS&tr1=1.2&tr2=1.3&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/list.c.diff?cvsroot=OldCVS&tr1=1.61&tr2=1.62&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/lang.c.diff?cvsroot=OldCVS&tr1=1.23&tr2=1.24&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/guardians.c.diff?cvsroot=OldCVS&tr1=1.40&tr2=1.41&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/goops.c.diff?cvsroot=OldCVS&tr1=1.42&tr2=1.43&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gh_data.c.diff?cvsroot=OldCVS&tr1=1.64&tr2=1.65&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/fports.c.diff?cvsroot=OldCVS&tr1=1.106&tr2=1.107&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/eval.c.diff?cvsroot=OldCVS&tr1=1.248&tr2=1.249&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/environments.c.diff?cvsroot=OldCVS&tr1=1.23&tr2=1.24&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/debug.c.diff?cvsroot=OldCVS&tr1=1.96&tr2=1.97&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/coop-threads.c.diff?cvsroot=OldCVS&tr1=1.32&tr2=1.33&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/alist.c.diff?cvsroot=OldCVS&tr1=1.36&tr2=1.37&r1=text&r2=text

Patches:
Index: guile/guile-core/libguile/alist.c
diff -u guile/guile-core/libguile/alist.c:1.36 
guile/guile-core/libguile/alist.c:1.37
--- guile/guile-core/libguile/alist.c:1.36      Fri Nov 16 10:04:16 2001
+++ guile/guile-core/libguile/alist.c   Sun Nov 25 10:21:07 2001
@@ -58,18 +58,9 @@
            "function is @emph{not} destructive; @var{alist} is not modified.")
 #define FUNC_NAME s_scm_acons
 {
-  SCM pair;
-  SCM head;
-
-  SCM_NEWCELL (pair);
-  SCM_SET_CELL_OBJECT_0 (pair, key);
-  SCM_SET_CELL_OBJECT_1 (pair, value);
-
-  SCM_NEWCELL (head);
-  SCM_SET_CELL_OBJECT_0 (head, pair);
-  SCM_SET_CELL_OBJECT_1 (head, alist);
-
-  return head;
+  return scm_alloc_cell (SCM_UNPACK (scm_alloc_cell (SCM_UNPACK (key),
+                                                    SCM_UNPACK (value))),
+                        SCM_UNPACK (alist));
 }
 #undef FUNC_NAME
 
Index: guile/guile-core/libguile/coop-threads.c
diff -u guile/guile-core/libguile/coop-threads.c:1.32 
guile/guile-core/libguile/coop-threads.c:1.33
--- guile/guile-core/libguile/coop-threads.c:1.32       Mon Jul  9 03:36:47 2001
+++ guile/guile-core/libguile/coop-threads.c    Sun Nov 25 10:21:07 2001
@@ -257,9 +257,8 @@
     /* Allocate thread locals. */
     root = scm_make_root (scm_root->handle);
     /* Make thread. */
-    SCM_NEWCELL (thread);
+    thread = scm_alloc_cell (scm_tc16_thread, 0);
     SCM_DEFER_INTS;
-    SCM_SETCAR (thread, scm_tc16_thread);
     argl = scm_cons (thread, argl);
     /* Note that we couldn't pass a pointer to argl as data since the
        argl variable may not exist in memory when the thread starts.  */
@@ -345,9 +344,8 @@
   /* Allocate thread locals. */
   root = scm_make_root (scm_root->handle);
   /* Make thread. */
-  SCM_NEWCELL (thread);
+  thread = scm_alloc_cell (scm_tc16_thread, 0);
   SCM_DEFER_INTS;
-  SCM_SETCAR (thread, scm_tc16_thread);
 
   data->u.thread = thread;
   data->body = body;
Index: guile/guile-core/libguile/debug.c
diff -u guile/guile-core/libguile/debug.c:1.96 
guile/guile-core/libguile/debug.c:1.97
--- guile/guile-core/libguile/debug.c:1.96      Fri Oct 12 05:02:03 2001
+++ guile/guile-core/libguile/debug.c   Sun Nov 25 10:21:07 2001
@@ -539,13 +539,7 @@
 SCM
 scm_make_debugobj (scm_t_debug_frame *frame)
 {
-  register SCM z;
-  SCM_NEWCELL (z);
-  SCM_ENTER_A_SECTION;
-  SCM_SET_DEBUGOBJ_FRAME (z, frame);
-  SCM_SET_CELL_TYPE (z, scm_tc16_debugobj);
-  SCM_EXIT_A_SECTION;
-  return z;
+  return scm_alloc_cell (scm_tc16_debugobj, (scm_t_bits) frame);
 }
 
 
Index: guile/guile-core/libguile/environments.c
diff -u guile/guile-core/libguile/environments.c:1.23 
guile/guile-core/libguile/environments.c:1.24
--- guile/guile-core/libguile/environments.c:1.23       Wed Jun 27 21:11:58 2001
+++ guile/guile-core/libguile/environments.c    Sun Nov 25 10:21:07 2001
@@ -119,13 +119,7 @@
 SCM
 scm_make_environment (void *type)
 {
-  SCM env;
-
-  SCM_NEWCELL (env);
-  SCM_SET_CELL_WORD_1 (env, type);
-  SCM_SET_CELL_TYPE (env, scm_tc16_environment);
-
-  return env;
+  return scm_alloc_cell (scm_tc16_environment, (scm_t_bits) type);
 }
 
 
@@ -669,11 +663,10 @@
 {
   SCM observer;
 
-  SCM_NEWCELL2 (observer);
-  SCM_SET_CELL_OBJECT_1 (observer, env);
-  SCM_SET_CELL_OBJECT_2 (observer, data);
-  SCM_SET_CELL_WORD_3 (observer, proc);
-  SCM_SET_CELL_TYPE (observer, scm_tc16_observer);
+  observer = scm_alloc_double_cell (scm_tc16_observer,
+                                   SCM_UNPACK (env),
+                                   SCM_UNPACK (data),
+                                   (scm_t_bits) proc);
 
   if (!weak_p)
     {
Index: guile/guile-core/libguile/eval.c
diff -u guile/guile-core/libguile/eval.c:1.248 
guile/guile-core/libguile/eval.c:1.249
--- guile/guile-core/libguile/eval.c:1.248      Sat Nov 17 07:16:05 2001
+++ guile/guile-core/libguile/eval.c    Sun Nov 25 10:21:07 2001
@@ -3864,11 +3864,11 @@
 SCM 
 scm_closure (SCM code, SCM env)
 {
-  register SCM z;
-
-  SCM_NEWCELL (z);
-  SCM_SETCODE (z, code);
-  SCM_SETENV (z, env);
+  SCM z;
+  SCM closcar = scm_cons (code, SCM_EOL);
+  z = scm_alloc_cell (SCM_UNPACK (closcar) + scm_tc3_closure,
+                     (scm_t_bits) env);
+  scm_remember_upto_here (closcar);
   return z;
 }
 
@@ -3939,9 +3939,7 @@
 #define FUNC_NAME s_scm_cons_source
 {
   SCM p, z;
-  SCM_NEWCELL (z);
-  SCM_SET_CELL_OBJECT_0 (z, x);
-  SCM_SET_CELL_OBJECT_1 (z, y);
+  z = scm_cons (x, y);
   /* Copy source properties possibly associated with xorig. */
   p = scm_whash_lookup (scm_source_whash, xorig);
   if (!SCM_IMP (p))
Index: guile/guile-core/libguile/fports.c
diff -u guile/guile-core/libguile/fports.c:1.106 
guile/guile-core/libguile/fports.c:1.107
--- guile/guile-core/libguile/fports.c:1.106    Sun Nov  4 10:52:29 2001
+++ guile/guile-core/libguile/fports.c  Sun Nov 25 10:21:07 2001
@@ -428,7 +428,7 @@
       SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL);
     }
 
-  SCM_NEWCELL (port);
+  port = scm_alloc_cell (scm_tc16_fport, 0);
   SCM_DEFER_INTS;
   pt = scm_add_to_port_table (port);
   SCM_SETPTAB_ENTRY (port, pt);
Index: guile/guile-core/libguile/gh_data.c
diff -u guile/guile-core/libguile/gh_data.c:1.64 
guile/guile-core/libguile/gh_data.c:1.65
--- guile/guile-core/libguile/gh_data.c:1.64    Fri Aug 31 10:42:31 2001
+++ guile/guile-core/libguile/gh_data.c Sun Nov 25 10:21:07 2001
@@ -149,13 +149,7 @@
 static SCM
 makvect (char *m, size_t len, int type)
 {
-  SCM ans;
-  SCM_NEWCELL (ans);
-  SCM_DEFER_INTS;
-  SCM_SET_UVECTOR_BASE (ans, m);
-  SCM_SET_UVECTOR_LENGTH (ans, len, type);
-  SCM_ALLOW_INTS;
-  return ans;
+  return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (len, type), (scm_t_bits) m);
 }
 
 SCM
Index: guile/guile-core/libguile/goops.c
diff -u guile/guile-core/libguile/goops.c:1.42 
guile/guile-core/libguile/goops.c:1.43
--- guile/guile-core/libguile/goops.c:1.42      Sun Jul 29 16:46:37 2001
+++ guile/guile-core/libguile/goops.c   Sun Nov 25 10:21:07 2001
@@ -1301,20 +1301,15 @@
 static SCM
 wrap_init (SCM class, SCM *m, long n)
 {
-  SCM z;
   long i;
   
   /* Set all slots to unbound */
   for (i = 0; i < n; i++)
     m[i] = SCM_GOOPS_UNBOUND;
 
-  SCM_NEWCELL2 (z);
-  SCM_SET_STRUCT_GC_CHAIN (z, 0);
-  SCM_SET_CELL_WORD_1 (z, m);
-  SCM_SET_CELL_WORD_0 (z, (scm_t_bits) SCM_STRUCT_DATA (class)
-                         | scm_tc3_struct);
-
-  return z;
+  return scm_alloc_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (class))
+                                | scm_tc3_struct),
+                               (scm_t_bits) m, 0, 0);
 }
 
 SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
@@ -2589,12 +2584,9 @@
 SCM
 scm_wrap_object (SCM class, void *data)
 {
-  SCM z;
-  SCM_NEWCELL2 (z);
-  SCM_SETCDR (z, SCM_PACK ((scm_t_bits) data));
-  SCM_SET_STRUCT_GC_CHAIN (z, 0);
-  SCM_SETCAR (z, SCM_UNPACK (SCM_CDR (class)) | scm_tc3_struct);
-  return z;
+  return scm_alloc_double_cell (SCM_UNPACK (SCM_CDR (class)) | scm_tc3_struct,
+                               (scm_t_bits) data,
+                               0, 0);
 }
 
 SCM scm_components;
Index: guile/guile-core/libguile/guardians.c
diff -u guile/guile-core/libguile/guardians.c:1.40 
guile/guile-core/libguile/guardians.c:1.41
--- guile/guile-core/libguile/guardians.c:1.40  Sun Nov 11 10:01:51 2001
+++ guile/guile-core/libguile/guardians.c       Sun Nov 25 10:21:07 2001
@@ -248,8 +248,6 @@
     {
       SCM z;
 
-      SCM_NEWCELL (z);
-      
       /* This critical section barrier will be replaced by a mutex. */
       SCM_DEFER_INTS;
 
@@ -272,6 +270,7 @@
                                        obj, guardian);
         }
 
+      z = scm_cons (SCM_BOOL_F, SCM_BOOL_F);
       TCONC_IN (g->live, obj, z);
 
       SCM_ALLOW_INTS;
Index: guile/guile-core/libguile/lang.c
diff -u guile/guile-core/libguile/lang.c:1.23 
guile/guile-core/libguile/lang.c:1.24
--- guile/guile-core/libguile/lang.c:1.23       Thu Jul 19 17:08:49 2001
+++ guile/guile-core/libguile/lang.c    Sun Nov 25 10:21:07 2001
@@ -69,11 +69,7 @@
            "a LISP nil.")
 #define FUNC_NAME s_scm_nil_cons
 {
-  register SCM z;
-  SCM_NEWCELL (z);
-  SCM_SETCAR (z, x);
-  SCM_SETCDR (z, SCM_NIL2EOL (y, y));
-  return z;
+  return scm_cons (x, SCM_NIL2EOL (y, y));
 }
 #undef FUNC_NAME
 
Index: guile/guile-core/libguile/list.c
diff -u guile/guile-core/libguile/list.c:1.61 
guile/guile-core/libguile/list.c:1.62
--- guile/guile-core/libguile/list.c:1.61       Fri Nov 16 10:04:17 2001
+++ guile/guile-core/libguile/list.c    Sun Nov 25 10:21:07 2001
@@ -60,9 +60,7 @@
 
 #define SCM_I_CONS(cell,x,y)                   \
 do {                                           \
-  SCM_NEWCELL (cell);                          \
-  SCM_SET_CELL_OBJECT_1 (cell, y);             \
-  SCM_SET_CELL_OBJECT_0 (cell, x);             \
+  cell = scm_alloc_cell ((scm_t_bits)x, (scm_t_bits)y);                        
\
 } while (0)
 
 SCM
Index: guile/guile-core/libguile/num2float.i.c
diff -u guile/guile-core/libguile/num2float.i.c:1.2 
guile/guile-core/libguile/num2float.i.c:1.3
--- guile/guile-core/libguile/num2float.i.c:1.2 Sat Sep 22 17:39:42 2001
+++ guile/guile-core/libguile/num2float.i.c     Sun Nov 25 10:21:07 2001
@@ -32,8 +32,7 @@
 FLOAT2NUM (FTYPE n)
 {
   SCM z;
-  SCM_NEWCELL2 (z);
-  SCM_SET_CELL_TYPE (z, scm_tc16_real);
+  z = scm_alloc_double_cell (scm_tc16_real, 0, 0, 0);
   SCM_REAL_VALUE (z) = n;
   return z;
 }
Index: guile/guile-core/libguile/numbers.c
diff -u guile/guile-core/libguile/numbers.c:1.154 
guile/guile-core/libguile/numbers.c:1.155
--- guile/guile-core/libguile/numbers.c:1.154   Thu Nov 22 16:30:24 2001
+++ guile/guile-core/libguile/numbers.c Sun Nov 25 10:21:07 2001
@@ -1390,9 +1390,7 @@
 
   base = scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum);
 
-  SCM_NEWCELL (v);
-  SCM_SET_BIGNUM_BASE (v, base);
-  SCM_SETNUMDIGS (v, nlen, sign);
+  v = scm_alloc_cell (SCM_MAKE_BIGNUM_TAG (nlen, sign), (scm_t_bits) base);
   return v;
 }
 
@@ -2829,8 +2827,7 @@
 scm_make_real (double x)
 {
   SCM z;
-  SCM_NEWCELL2 (z);
-  SCM_SET_CELL_TYPE (z, scm_tc16_real);
+  z = scm_alloc_double_cell (scm_tc16_real, 0, 0, 0);
   SCM_REAL_VALUE (z) = x;
   return z;
 }
Index: guile/guile-core/libguile/pairs.c
diff -u guile/guile-core/libguile/pairs.c:1.26 
guile/guile-core/libguile/pairs.c:1.27
--- guile/guile-core/libguile/pairs.c:1.26      Mon Jul  9 03:36:47 2001
+++ guile/guile-core/libguile/pairs.c   Sun Nov 25 10:21:07 2001
@@ -80,11 +80,7 @@
            "sense of @code{eq?}) from every previously existing object.")
 #define FUNC_NAME s_scm_cons
 {
-  SCM z;
-  SCM_NEWCELL (z);
-  SCM_SET_CELL_OBJECT_0 (z, x);
-  SCM_SET_CELL_OBJECT_1 (z, y);
-  return z;
+  return scm_alloc_cell (SCM_UNPACK (x), SCM_UNPACK (y));
 }
 #undef FUNC_NAME
 
@@ -92,18 +88,7 @@
 SCM 
 scm_cons2 (SCM w, SCM x, SCM y)
 {
-  SCM z1;
-  SCM z2;
-
-  SCM_NEWCELL (z1);
-  SCM_SET_CELL_OBJECT_0 (z1, x);
-  SCM_SET_CELL_OBJECT_1 (z1, y);
-
-  SCM_NEWCELL (z2);
-  SCM_SET_CELL_OBJECT_0 (z2, w);
-  SCM_SET_CELL_OBJECT_1 (z2, z1);
-
-  return z2;
+  return scm_cons (w, scm_cons (x, y));
 }
 
 
Index: guile/guile-core/libguile/ports.c
diff -u guile/guile-core/libguile/ports.c:1.160 
guile/guile-core/libguile/ports.c:1.161
--- guile/guile-core/libguile/ports.c:1.160     Fri Nov 16 10:04:17 2001
+++ guile/guile-core/libguile/ports.c   Sun Nov 25 10:21:06 2001
@@ -1527,7 +1527,7 @@
   SCM answer;
   scm_t_port * pt;
 
-  SCM_NEWCELL (answer);
+  answer = scm_alloc_cell (scm_tc16_void_port, 0);
   SCM_DEFER_INTS;
   mode_bits = scm_mode_bits (mode_str);
   pt = scm_add_to_port_table (answer);
Index: guile/guile-core/libguile/print.c
diff -u guile/guile-core/libguile/print.c:1.136 
guile/guile-core/libguile/print.c:1.137
--- guile/guile-core/libguile/print.c:1.136     Fri Nov 16 10:04:17 2001
+++ guile/guile-core/libguile/print.c   Sun Nov 25 10:21:06 2001
@@ -249,10 +249,8 @@
    */
   pstate->fancyp = 0;
   pstate->revealed = 0;
-  SCM_NEWCELL (handle);
   SCM_DEFER_INTS;
-  SCM_SET_CELL_WORD_0 (handle, print_state);
-  SCM_SET_CELL_WORD_1 (handle, print_state_pool);
+  handle = scm_cons (print_state, print_state_pool);
   print_state_pool = handle;
   SCM_ALLOW_INTS;
 }
Index: guile/guile-core/libguile/procs.c
diff -u guile/guile-core/libguile/procs.c:1.63 
guile/guile-core/libguile/procs.c:1.64
--- guile/guile-core/libguile/procs.c:1.63      Fri Aug 31 08:13:50 2001
+++ guile/guile-core/libguile/procs.c   Sun Nov 25 10:21:06 2001
@@ -86,16 +86,12 @@
       scm_subr_table_room = new_size;
     }
 
-  SCM_NEWCELL (z);
-
   entry = scm_subr_table_size;
+  z = scm_alloc_cell ((entry << 8) + type, (scm_t_bits) fcn);
   scm_subr_table[entry].handle = z;
   scm_subr_table[entry].name = scm_str2symbol (name);
   scm_subr_table[entry].generic = 0;
   scm_subr_table[entry].properties = SCM_EOL;
-  
-  SCM_SET_SUBRF (z, fcn);
-  SCM_SET_CELL_TYPE (z, (entry << 8) + type);
   scm_subr_table_size++;
   
   return z;
@@ -165,12 +161,8 @@
   for (i = 0; i < len; ++i)
     base [i] = SCM_UNPACK (SCM_UNSPECIFIED);
 
-  SCM_NEWCELL (s);
-  SCM_DEFER_INTS;
-  SCM_SET_CCLO_BASE (s, base);
-  SCM_SET_CCLO_LENGTH (s, len);
+  s = scm_alloc_cell (SCM_MAKE_CCLO_TAG (len), (scm_t_bits) base);
   SCM_SET_CCLO_SUBR (s, proc);
-  SCM_ALLOW_INTS;
   return s;
 }
 
@@ -327,16 +319,11 @@
            "with the associated setter @var{setter}.")
 #define FUNC_NAME s_scm_make_procedure_with_setter
 {
-  SCM z;
   SCM_VALIDATE_PROC (1, procedure);
   SCM_VALIDATE_PROC (2, setter);
-  SCM_NEWCELL2 (z);
-  SCM_ENTER_A_SECTION;
-  SCM_SET_CELL_OBJECT_1 (z, procedure);
-  SCM_SET_CELL_OBJECT_2 (z, setter);
-  SCM_SET_CELL_TYPE (z, scm_tc7_pws);
-  SCM_EXIT_A_SECTION;
-  return z;
+  return scm_alloc_double_cell (scm_tc7_pws,
+                               SCM_UNPACK (procedure),
+                               SCM_UNPACK (setter), 0);
 }
 #undef FUNC_NAME
 
Index: guile/guile-core/libguile/smob.c
diff -u guile/guile-core/libguile/smob.c:1.49 
guile/guile-core/libguile/smob.c:1.50
--- guile/guile-core/libguile/smob.c:1.49       Fri Aug 31 08:13:50 2001
+++ guile/guile-core/libguile/smob.c    Sun Nov 25 10:21:06 2001
@@ -456,23 +456,10 @@
 {
   long n = SCM_TC2SMOBNUM (tc);
   size_t size = scm_smobs[n].size;
-  SCM z;
-  SCM_NEWCELL (z);
-  if (size != 0)
-    {
-#if 0
-      if (scm_smobs[n].mark != 0)
-       {
-         fprintf
-           (stderr,
-            "forbidden operation for smobs with GC data, use SCM_NEWSMOB\n");
-         abort ();
-       }
-#endif
-      SCM_SET_SMOB_DATA (z, scm_must_malloc (size, SCM_SMOBNAME (n)));
-    }
-  SCM_SET_CELL_TYPE (z, tc);
-  return z;
+  scm_t_bits data = (size > 0
+                    ? (scm_t_bits) scm_must_malloc (size, SCM_SMOBNAME (n))
+                    : 0);
+  return scm_alloc_cell (tc, data);
 }
 
 
Index: guile/guile-core/libguile/smob.h
diff -u guile/guile-core/libguile/smob.h:1.44 
guile/guile-core/libguile/smob.h:1.45
--- guile/guile-core/libguile/smob.h:1.44       Thu Nov  1 19:19:11 2001
+++ guile/guile-core/libguile/smob.h    Sun Nov 25 10:21:06 2001
@@ -72,9 +72,7 @@
 
 #define SCM_NEWSMOB(z, tc, data) \
 do { \
-  SCM_NEWCELL (z); \
-  SCM_SET_CELL_WORD_1 ((z), (data)); \
-  SCM_SET_CELL_TYPE ((z), (tc)); \
+  z = scm_alloc_cell ((tc), (scm_t_bits) (data)); \
 } while (0)
 
 #define SCM_RETURN_NEWSMOB(tc, data) \
@@ -85,10 +83,8 @@
 
 #define SCM_NEWSMOB2(z, tc, data1, data2) \
 do { \
-  SCM_NEWCELL2 (z); \
-  SCM_SET_CELL_WORD_1 ((z), (data1)); \
-  SCM_SET_CELL_WORD_2 ((z), (data2)); \
-  SCM_SET_CELL_TYPE ((z), (tc)); \
+  z = scm_alloc_double_cell ((tc), (scm_t_bits)(data1), \
+                             (scm_t_bits)(data2), 0); \
 } while (0)
 
 #define SCM_RETURN_NEWSMOB2(tc, data1, data2) \
@@ -99,11 +95,8 @@
 
 #define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
 do { \
-  SCM_NEWCELL2 (z); \
-  SCM_SET_CELL_WORD_1 ((z), (data1)); \
-  SCM_SET_CELL_WORD_2 ((z), (data2)); \
-  SCM_SET_CELL_WORD_3 ((z), (data3)); \
-  SCM_SET_CELL_TYPE ((z), (tc)); \
+  z = scm_alloc_double_cell ((tc), (scm_t_bits)(data1), \
+                             (scm_t_bits)(data2), (scm_t_bits)(data3)); \
 } while (0)
 
 #define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \
Index: guile/guile-core/libguile/strings.c
diff -u guile/guile-core/libguile/strings.c:1.66 
guile/guile-core/libguile/strings.c:1.67
--- guile/guile-core/libguile/strings.c:1.66    Fri Nov 16 10:04:17 2001
+++ guile/guile-core/libguile/strings.c Sun Nov 25 10:21:06 2001
@@ -132,9 +132,7 @@
 
   SCM_ASSERT_RANGE (2, scm_ulong2num (len), len <= SCM_STRING_MAX_LENGTH);
 
-  SCM_NEWCELL (answer);
-  SCM_SET_STRING_CHARS (answer, s);
-  SCM_SET_STRING_LENGTH (answer, len);
+  answer = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) s);
   scm_done_malloc (len + 1);
 
   return answer;
@@ -196,9 +194,7 @@
   mem = (char *) scm_must_malloc (len + 1, FUNC_NAME);
   mem[len] = 0;
 
-  SCM_NEWCELL (s);
-  SCM_SET_STRING_CHARS (s, mem);
-  SCM_SET_STRING_LENGTH (s, len);
+  s = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) mem);
 
   return s;
 }
Index: guile/guile-core/libguile/strports.c
diff -u guile/guile-core/libguile/strports.c:1.86 
guile/guile-core/libguile/strports.c:1.87
--- guile/guile-core/libguile/strports.c:1.86   Fri Aug 31 08:13:50 2001
+++ guile/guile-core/libguile/strports.c        Sun Nov 25 10:21:06 2001
@@ -279,7 +279,7 @@
     scm_out_of_range (caller, pos);
   if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
     scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
-  SCM_NEWCELL (z);
+  z = scm_alloc_cell (scm_tc16_strport, 0);
   SCM_DEFER_INTS;
   pt = scm_add_to_port_table (z);
   SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
Index: guile/guile-core/libguile/struct.c
diff -u guile/guile-core/libguile/struct.c:1.87 
guile/guile-core/libguile/struct.c:1.88
--- guile/guile-core/libguile/struct.c:1.87     Fri Nov 16 10:04:17 2001
+++ guile/guile-core/libguile/struct.c  Sun Nov 25 10:21:06 2001
@@ -450,7 +450,6 @@
   layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
   basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
   tail_elts = SCM_INUM (tail_array_size);
-  SCM_NEWCELL2 (handle);
   SCM_DEFER_INTS;
   if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
     {
@@ -464,11 +463,10 @@
     data = scm_alloc_struct (basic_size + tail_elts,
                             scm_struct_n_extra_words,
                             "make-struct");
-  SCM_SET_CELL_WORD_1 (handle, data);
-  SCM_SET_STRUCT_GC_CHAIN (handle, 0);
+  handle = scm_alloc_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (vtable))
+                                  + scm_tc3_struct),
+                                 (scm_t_bits) data, 0, 0);
   scm_struct_init (handle, layout, data, tail_elts, init);
-  SCM_SET_CELL_WORD_0 (handle,
-                      (scm_t_bits) SCM_STRUCT_DATA (vtable) + scm_tc3_struct);
   SCM_ALLOW_INTS;
   return handle;
 }
@@ -540,16 +538,14 @@
   layout = scm_make_struct_layout (fields);
   basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
   tail_elts = SCM_INUM (tail_array_size);
-  SCM_NEWCELL2 (handle);
   SCM_DEFER_INTS;
   data = scm_alloc_struct (basic_size + tail_elts,
                           scm_struct_n_extra_words,
                           "make-vtable-vtable");
-  SCM_SET_CELL_WORD_1 (handle, data);
-  SCM_SET_STRUCT_GC_CHAIN (handle, 0);
+  handle = scm_alloc_double_cell ((scm_t_bits) data + scm_tc3_struct,
+                                 (scm_t_bits) data, 0, 0);
   data [scm_vtable_index_layout] = SCM_UNPACK (layout);
   scm_struct_init (handle, layout, data, tail_elts, scm_cons (layout, init));
-  SCM_SET_CELL_WORD_0 (handle, (scm_t_bits) data + scm_tc3_struct);
   SCM_ALLOW_INTS;
   return handle;
 }
Index: guile/guile-core/libguile/symbols.c
diff -u guile/guile-core/libguile/symbols.c:1.94 
guile/guile-core/libguile/symbols.c:1.95
--- guile/guile-core/libguile/symbols.c:1.94    Fri Aug 31 08:13:50 2001
+++ guile/guile-core/libguile/symbols.c Sun Nov 25 10:21:06 2001
@@ -125,11 +125,11 @@
     SCM cell;
     SCM slot;
 
-    SCM_NEWCELL2 (symbol);
-    SCM_SET_SYMBOL_CHARS (symbol, scm_must_strndup (name, len));
-    SCM_SET_SYMBOL_HASH (symbol, raw_hash);
-    SCM_SET_PROP_SLOTS (symbol, scm_cons (SCM_BOOL_F, SCM_EOL));
-    SCM_SET_SYMBOL_LENGTH (symbol, (long) len);
+    symbol = scm_alloc_double_cell (SCM_MAKE_SYMBOL_TAG (len),
+                                   (scm_t_bits) scm_must_strndup (name, len),
+                                   raw_hash,
+                                   SCM_UNPACK (scm_cons (SCM_BOOL_F,
+                                                         SCM_EOL)));
 
     slot = SCM_VELTS (symbols) [hash];
     cell = scm_cons (symbol, SCM_UNDEFINED);
Index: guile/guile-core/libguile/unif.c
diff -u guile/guile-core/libguile/unif.c:1.125 
guile/guile-core/libguile/unif.c:1.126
--- guile/guile-core/libguile/unif.c:1.125      Fri Nov 16 10:04:17 2001
+++ guile/guile-core/libguile/unif.c    Sun Nov 25 10:21:06 2001
@@ -165,19 +165,16 @@
 
   if (SCM_EQ_P (prot, SCM_BOOL_T))
     {
-      SCM_NEWCELL (v);
       if (k > 0)
        {
-         SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH);
+         SCM_ASSERT_RANGE (1,
+                           scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH);
          i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
-         SCM_SET_BITVECTOR_BASE (v, (char *) scm_must_malloc (i, "vector"));
-         SCM_SET_BITVECTOR_LENGTH (v, k);
+         v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (k), 
+                             (scm_t_bits) scm_must_malloc (i, "vector"));
        }
       else
-       {
-         SCM_SET_BITVECTOR_BASE (v, 0);
-         SCM_SET_BITVECTOR_LENGTH (v, 0);
-       }
+       v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (0), 0);
       return v;
     }
   else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
@@ -242,12 +239,8 @@
 
   SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
 
-  SCM_NEWCELL (v);
-  SCM_DEFER_INTS;
-  SCM_SET_UVECTOR_BASE (v, (char *) scm_must_malloc (i ? i : 1, "vector"));
-  SCM_SET_UVECTOR_LENGTH (v, k, type);
-  SCM_ALLOW_INTS;
-  return v;
+  return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (k, type),
+                        (scm_t_bits) scm_must_malloc (i ? i : 1, "vector"));
 }
 #undef FUNC_NAME
 
@@ -525,7 +518,6 @@
 scm_make_ra (int ndim)
 {
   SCM ra;
-  SCM_NEWCELL (ra);
   SCM_DEFER_INTS;
   SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_tc16_array,
               scm_must_malloc ((sizeof (scm_t_array) +
Index: guile/guile-core/libguile/variable.c
diff -u guile/guile-core/libguile/variable.c:1.42 
guile/guile-core/libguile/variable.c:1.43
--- guile/guile-core/libguile/variable.c:1.42   Sun Nov 11 10:01:52 2001
+++ guile/guile-core/libguile/variable.c        Sun Nov 25 10:21:06 2001
@@ -68,12 +68,7 @@
 static SCM
 make_variable (SCM init)
 {
-  SCM z;
-  SCM_NEWCELL (z);
-  SCM_SET_CELL_WORD_1 (z, SCM_UNPACK (init));
-  SCM_SET_CELL_TYPE (z, scm_tc7_variable);
-  scm_remember_upto_here_1 (init);
-  return z;
+  return scm_alloc_cell (scm_tc7_variable, SCM_UNPACK (init));
 }
 
 SCM_DEFINE (scm_make_variable, "make-variable", 1, 0, 0, 
Index: guile/guile-core/libguile/vectors.c
diff -u guile/guile-core/libguile/vectors.c:1.58 
guile/guile-core/libguile/vectors.c:1.59
--- guile/guile-core/libguile/vectors.c:1.58    Sun Nov 18 17:10:41 2001
+++ guile/guile-core/libguile/vectors.c Sun Nov 25 10:21:06 2001
@@ -214,9 +214,8 @@
   else
     base = NULL;
 
-  SCM_NEWCELL (v);
-  SCM_SET_VECTOR_BASE (v, base);
-  SCM_SET_VECTOR_LENGTH (v, k, scm_tc7_vector);
+  v = scm_alloc_cell (SCM_MAKE_VECTOR_TAG (k, scm_tc7_vector),
+                     (scm_t_bits) base);
   scm_remember_upto_here_1 (fill);
 
   return v;
Index: guile/guile-core/libguile/vports.c
diff -u guile/guile-core/libguile/vports.c:1.50 
guile/guile-core/libguile/vports.c:1.51
--- guile/guile-core/libguile/vports.c:1.50     Fri Aug 31 10:42:31 2001
+++ guile/guile-core/libguile/vports.c  Sun Nov 25 10:21:06 2001
@@ -189,7 +189,7 @@
   SCM z;
   SCM_VALIDATE_VECTOR_LEN (1,pv,5);
   SCM_VALIDATE_STRING (2, modes);
-  SCM_NEWCELL (z);
+  z = scm_alloc_cell (scm_tc16_sfport, 0);
   SCM_DEFER_INTS;
   pt = scm_add_to_port_table (z);
   scm_port_non_buffer (pt);
Index: guile/guile-core/libguile/weaks.c
diff -u guile/guile-core/libguile/weaks.c:1.44 
guile/guile-core/libguile/weaks.c:1.45
--- guile/guile-core/libguile/weaks.c:1.44      Fri Nov 16 10:04:17 2001
+++ guile/guile-core/libguile/weaks.c   Sun Nov 25 10:21:06 2001
@@ -71,10 +71,6 @@
       SCM_ASSERT_RANGE (1, size, SCM_INUM (size) >= 0);
       c_size = SCM_INUM (size);
 
-      SCM_NEWCELL2 (v);
-      SCM_SET_WVECT_GC_CHAIN (v, SCM_EOL);
-      SCM_SET_WVECT_TYPE (v, type);
-
       if (c_size > 0)
        {
          scm_t_bits *base;
@@ -87,14 +83,20 @@
          base = scm_must_malloc (c_size * sizeof (scm_t_bits), FUNC_NAME);
          for (j = 0; j != c_size; ++j)
            base[j] = SCM_UNPACK (fill);
-         SCM_SET_VECTOR_BASE (v, base);
-         SCM_SET_VECTOR_LENGTH (v, c_size, scm_tc7_wvect);
+         v = scm_alloc_double_cell (SCM_MAKE_VECTOR_TAG (c_size,
+                                                         scm_tc7_wvect),
+                                    (scm_t_bits) base,
+                                    type,
+                                    SCM_UNPACK (SCM_EOL));
          scm_remember_upto_here_1 (fill);
        }
       else
        {
-         SCM_SET_VECTOR_BASE (v, NULL);
-         SCM_SET_VECTOR_LENGTH (v, 0, scm_tc7_wvect);
+         v = scm_alloc_double_cell (SCM_MAKE_VECTOR_TAG (0,
+                                                         scm_tc7_wvect),
+                                    (scm_t_bits) NULL,
+                                    type,
+                                    SCM_UNPACK (SCM_EOL));
        }
 
       return v;



reply via email to

[Prev in Thread] Current Thread [Next in Thread]