* Putting an end to "compiled closures"
@ 2009-02-16 0:22 Ludovic Courtès
2009-02-23 22:10 ` Ludovic Courtès
2009-03-01 23:34 ` Ludovic Courtès
0 siblings, 2 replies; 7+ messages in thread
From: Ludovic Courtès @ 2009-02-16 0:22 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 1383 bytes --]
Hello Guilers!
Following our discussion on the unpleasant static initialization code
(in the `bdw-gc-static-alloc' branch) for subrs because of the dichotomy
between "simple subrs" (with few arguments) and "generic subrs" (with an
arbitrary number of arguments), I investigated all this.
Currently, "generic subrs" (or "gsubrs") are implemented using "compiled
closures" (or "cclos"), as can be seen in `create_gsubr ()'. Compiled
closures are essentially a wrapper (a cell) around a zero-argument subr
that conveys information about the real number of required, optional,
and rest arguments.
Prior to the switch to double-cells as the storage unit for subrs, the
24 MSBs of the type tag of a subr were used to store the "subr table
entry number" of that subr. Now that we no longer use a table, those 24
bits are unused.
The attached patch creates a new type tag, `scm_tc7_gsubr', whereby the
24 MSBs are used to store gsubr arity information as returned by
`SCM_GSUBR_MAKTYPE ()'. This makes cclos useless, which simplifies the
code and reduces the overhead when creating and invoking such
procedures.
In theory all subrs could be encoded as gsubrs, but the interpreter
would need to be able to handle them as efficiently as the specialize
`scm_tc7_subr*', and fiddling with the interpreter may not be so useful
these days.
Objections to committing this?
Thanks,
Ludo'.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 25519 bytes --]
From 885993c8af22e52a0a0f698b317b10cf93dd3b3c Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 16 Feb 2009 00:24:00 +0100
Subject: [PATCH] Remove "compiled closures" ("cclos") in favor of a simpler mechanism.
The idea is to introduce `gsubrs' whose arity is encoded in their type
(more precisely in the sizeof (void *) - 8 MSBs). This removes the
indirection introduced by cclos and simplifies the code.
* libguile/__scm.h (CCLO): Remove.
* libguile/debug.c (scm_procedure_source, scm_procedure_environment):
Remove references to `scm_tc7_cclo'.
* libguile/eval.c (scm_trampoline_0, scm_trampoline_1,
scm_trampoline_2): Replace `scm_tc7_cclo' with `scm_tc7_gsubr'.
* libguile/eval.i.c (CEVAL): Likewise. No longer make PROC the first
argument. Directly invoke `scm_gsubr_apply ()' instead of jump to the
`evap(N+1)' label.
* libguile/evalext.c (scm_self_evaluating_p): Remove reference to
`scm_tc7_cclo'.
* libguile/gc-card.c (scm_i_sweep_card, scm_i_tag_name): Likewise.
* libguile/gc-mark.c (scm_gc_mark_dependencies): Likewise.
* libguile/goops.c (scm_class_of): Likewise.
* libguile/print.c (iprin1): Likewise.
* libguile/gsubr.c (create_gsubr): Use `unsigned int's for REQ, OPT and
RST. Use `scm_tc7_gsubr' instead of `scm_makcclo ()' in the default
case.
(scm_gsubr_apply): Remove calls to `SCM_GSUBR_PROC ()'.
* libguile/gsubr.h (SCM_GSUBR_TYPE): New definition.
(SCM_GSUBR_MAX): Changed to 33.
(SCM_SET_GSUBR_TYPE, SCM_GSUBR_PROC, SCM_SET_GSUBR_PROC,
scm_f_gsubr_apply): Remove.
* libguile/procprop.c (scm_i_procedure_arity): Remove reference to
`scm_tc7_cclo'; add proper handling of `scm_tc7_gsubr'.
* libguile/procs.c (scm_makcclo, scm_make_cclo): Remove.
(scm_procedure_p): Remove reference to `scm_tc7_cclo'.
(scm_thunk_p): Likewise, plus add proper `scm_tc7_gsubr' handling.
* libguile/procs.h (SCM_CCLO_LENGTH, SCM_MAKE_CCLO_TAG,
SCM_SET_CCLO_LENGTH, SCM_CCLO_BASE, SCM_SET_CCLO_BASE, SCM_CCLO_REF,
SCM_CCLO_SET, SCM_CCLO_SUBR, SCM_SET_CCLO_SUBR, scm_makcclo,
scm_make_cclo): Remove.
* libguile/stacks.c (read_frames): Remove reference to `scm_f_gsubr_apply'.
* libguile/tags.h (scm_tc7_cclo): Remove.
(scm_tc7_gsubr): New.
(scm_tcs_subrs): Add `scm_tc7_gsubr'.
---
libguile/__scm.h | 4 +--
libguile/debug.c | 8 +-----
libguile/eval.c | 8 +++---
libguile/eval.i.c | 42 +++++++++++-------------------
libguile/evalext.c | 3 +-
libguile/gc-card.c | 14 +---------
libguile/gc-mark.c | 15 -----------
libguile/goops.c | 4 +-
libguile/gsubr.c | 70 ++++++++++++++++++++------------------------------
libguile/gsubr.h | 16 +++++------
libguile/print.c | 27 +------------------
libguile/procprop.c | 25 ++++++-----------
libguile/procs.c | 47 +--------------------------------
libguile/procs.h | 17 ------------
libguile/stacks.c | 5 +---
libguile/tags.h | 5 ++-
16 files changed, 78 insertions(+), 232 deletions(-)
diff --git a/libguile/__scm.h b/libguile/__scm.h
index d486b69..3672b1c 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -3,7 +3,7 @@
#ifndef SCM___SCM_H
#define SCM___SCM_H
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -140,8 +140,6 @@
*/
-#define CCLO
-
/* Guile Scheme supports the #f/() distinction; Guile Lisp won't. We
have horrible plans for their unification. */
#undef SICP
diff --git a/libguile/debug.c b/libguile/debug.c
index 7b91cd3..0ac4442 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -1,5 +1,5 @@
/* Debugging extensions for Guile
- * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008 Free Software Foundation
+ * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009 Free Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -352,9 +352,6 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
if (!SCM_SMOB_DESCRIPTOR (proc).apply)
break;
case scm_tcs_subrs:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
procprop:
/* It would indeed be a nice thing if we supplied source even for
built in procedures! */
@@ -385,9 +382,6 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
case scm_tcs_closures:
return SCM_ENV (proc);
case scm_tcs_subrs:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
return SCM_EOL;
default:
SCM_WRONG_TYPE_ARG (1, proc);
diff --git a/libguile/eval.c b/libguile/eval.c
index 14dc3c3..d20f72e 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -3243,7 +3243,7 @@ scm_trampoline_0 (SCM proc)
break;
case scm_tc7_asubr:
case scm_tc7_rpsubr:
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
case scm_tc7_pws:
trampoline = scm_call_0;
break;
@@ -3369,7 +3369,7 @@ scm_trampoline_1 (SCM proc)
break;
case scm_tc7_asubr:
case scm_tc7_rpsubr:
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
case scm_tc7_pws:
trampoline = scm_call_1;
break;
@@ -3463,7 +3463,7 @@ scm_trampoline_2 (SCM proc)
else
return NULL;
break;
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
case scm_tc7_pws:
trampoline = scm_call_2;
break;
diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index 83878ff..83c476a 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -1,7 +1,7 @@
/*
* eval.i.c - actual evaluator code for GUILE
*
- * Copyright (C) 2002, 03, 04, 05, 06, 07 Free Software Foundation, Inc.
+ * Copyright (C) 2002, 03, 04, 05, 06, 07, 09 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -1124,14 +1124,12 @@ dispatch:
if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun;
RETURN (SCM_SMOB_APPLY_0 (proc));
- case scm_tc7_cclo:
- arg1 = proc;
- proc = SCM_CCLO_SUBR (proc);
+ case scm_tc7_gsubr:
#ifdef DEVAL
debug.info->a.proc = proc;
- debug.info->a.args = scm_list_1 (arg1);
+ debug.info->a.args = SCM_EOL;
#endif
- goto evap1;
+ RETURN (scm_gsubr_apply (scm_list_1 (proc)));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL
@@ -1245,15 +1243,12 @@ dispatch:
if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun;
RETURN (SCM_SMOB_APPLY_1 (proc, arg1));
- case scm_tc7_cclo:
- arg2 = arg1;
- arg1 = proc;
- proc = SCM_CCLO_SUBR (proc);
+ case scm_tc7_gsubr:
#ifdef DEVAL
debug.info->a.args = scm_cons (arg1, debug.info->a.args);
debug.info->a.proc = proc;
#endif
- goto evap2;
+ RETURN (scm_gsubr_apply (scm_list_2 (proc, arg1)));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL
@@ -1351,16 +1346,15 @@ dispatch:
goto badfun;
RETURN (SCM_SMOB_APPLY_2 (proc, arg1, arg2));
cclon:
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
#ifdef DEVAL
- RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc),
- scm_cons (proc, debug.info->a.args),
+ RETURN (SCM_APPLY (proc, debug.info->a.args,
SCM_EOL));
#else
- RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc),
- scm_cons2 (proc, arg1,
- scm_cons (arg2,
- scm_ceval_args (x,
+ RETURN (SCM_APPLY (proc,
+ scm_cons (arg1,
+ scm_cons (arg2,
+ scm_ceval_args (x,
env,
proc))),
SCM_EOL));
@@ -1492,7 +1486,7 @@ dispatch:
goto badfun;
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2,
SCM_CDDR (debug.info->a.args)));
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
goto cclon;
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
@@ -1555,7 +1549,7 @@ dispatch:
goto badfun;
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2,
scm_ceval_args (x, env, proc)));
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
goto cclon;
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
@@ -1867,19 +1861,15 @@ tail:
RETURN (SCM_SMOB_APPLY_2 (proc, arg1, SCM_CAR (args)));
else
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, SCM_CAR (args), SCM_CDR (args)));
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
#ifdef DEVAL
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);
- arg1 = proc;
- proc = SCM_CCLO_SUBR (proc);
debug.vect[0].a.proc = proc;
debug.vect[0].a.args = scm_cons (arg1, args);
#else
args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
- arg1 = proc;
- proc = SCM_CCLO_SUBR (proc);
#endif
- goto tail;
+ RETURN (scm_gsubr_apply (scm_cons (proc, args)));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 9bec8f4..5ca7806 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -106,7 +106,6 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
case scm_tc7_number:
case scm_tc7_string:
case scm_tc7_smob:
- case scm_tc7_cclo:
case scm_tc7_pws:
case scm_tcs_subrs:
case scm_tcs_struct:
diff --git a/libguile/gc-card.c b/libguile/gc-card.c
index 1948aff..0629da0 100644
--- a/libguile/gc-card.c
+++ b/libguile/gc-card.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -131,14 +131,6 @@ scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg)
scm_i_vector_free (scmptr);
break;
-#ifdef CCLO
- case scm_tc7_cclo:
- scm_gc_free (SCM_CCLO_BASE (scmptr),
- SCM_CCLO_LENGTH (scmptr) * sizeof (SCM),
- "compiled closure");
- break;
-#endif
-
case scm_tc7_number:
switch SCM_TYP16 (scmptr)
{
@@ -397,10 +389,6 @@ scm_i_tag_name (scm_t_bits tag)
return "weak vector";
case scm_tc7_vector:
return "vector";
-#ifdef CCLO
- case scm_tc7_cclo:
- return "compiled closure";
-#endif
case scm_tc7_number:
switch (tag)
{
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index e73f6e1..1a66900 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -294,21 +294,6 @@ scm_gc_mark_dependencies (SCM p)
}
ptr = SCM_SIMPLE_VECTOR_REF (ptr, 0);
goto gc_mark_loop;
-#ifdef CCLO
- case scm_tc7_cclo:
- {
- size_t i = SCM_CCLO_LENGTH (ptr);
- size_t j;
- for (j = 1; j != i; ++j)
- {
- SCM obj = SCM_CCLO_REF (ptr, j);
- if (!SCM_IMP (obj))
- scm_gc_mark (obj);
- }
- ptr = SCM_CCLO_REF (ptr, 0);
- goto gc_mark_loop;
- }
-#endif
case scm_tc7_string:
ptr = scm_i_string_mark (ptr);
diff --git a/libguile/goops.c b/libguile/goops.c
index 4e64586..cc4e1eb 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008
+/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -233,7 +233,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return scm_class_primitive_generic;
else
return scm_class_procedure;
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
return scm_class_procedure;
case scm_tc7_pws:
return scm_class_procedure_with_setter;
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index fdb70ed..4288633 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -44,7 +44,8 @@ SCM scm_f_gsubr_apply;
static SCM
create_gsubr (int define, const char *name,
- int req, int opt, int rst, SCM (*fcn)())
+ unsigned int req, unsigned int opt, unsigned int rst,
+ SCM (*fcn) ())
{
SCM subr;
@@ -52,53 +53,39 @@ create_gsubr (int define, const char *name,
{
case SCM_GSUBR_MAKTYPE(0, 0, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_0, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(1, 0, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_1, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(0, 1, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_1o, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(1, 1, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_2o, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(2, 0, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_2, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(3, 0, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_3, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(0, 0, 1):
subr = scm_c_make_subr (name, scm_tc7_lsubr, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(2, 0, 1):
subr = scm_c_make_subr (name, scm_tc7_lsubr_2, fcn);
- create_subr:
- if (define)
- scm_define (SCM_SNAME (subr), subr);
- return subr;
+ break;
default:
- {
- SCM cclo = scm_makcclo (scm_f_gsubr_apply, 3L);
- SCM subr = scm_c_make_subr (name, scm_tc7_subr_0, fcn);
- SCM sym = SCM_SNAME (subr);
- if (SCM_GSUBR_MAX < req + opt + rst)
- {
- fprintf (stderr,
- "ERROR in scm_c_make_gsubr: too many args (%d) to %s\n",
- req + opt + rst, name);
- exit (1);
- }
- SCM_SET_GSUBR_PROC (cclo, subr);
- SCM_SET_GSUBR_TYPE (cclo,
- scm_from_int (SCM_GSUBR_MAKTYPE (req, opt, rst)));
- if (SCM_REC_PROCNAMES_P)
- scm_set_procedure_property_x (cclo, scm_sym_name, sym);
- if (define)
- scm_define (sym, cclo);
- return cclo;
- }
+ subr = scm_c_make_subr (name,
+ scm_tc7_gsubr
+ | (SCM_GSUBR_MAKTYPE (req, opt, rst) << 8U),
+ fcn);
}
+
+ if (define)
+ scm_define (SCM_SNAME (subr), subr);
+
+ return subr;
}
SCM
@@ -190,20 +177,15 @@ scm_gsubr_apply (SCM args)
#define FUNC_NAME "scm_gsubr_apply"
{
SCM self = SCM_CAR (args);
- SCM (*fcn)() = SCM_SUBRF (SCM_GSUBR_PROC (self));
+ SCM (*fcn)() = SCM_SUBRF (self);
SCM v[SCM_GSUBR_MAX];
- int typ = scm_to_int (SCM_GSUBR_TYPE (self));
+ unsigned int typ = SCM_GSUBR_TYPE (self);
long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
-#if 0
- if (n > SCM_GSUBR_MAX)
- scm_misc_error (FUNC_NAME,
- "Function ~S has illegal arity ~S.",
- scm_list_2 (self, scm_from_int (n)));
-#endif
+
args = SCM_CDR (args);
for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
if (scm_is_null (args))
- scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
+ scm_wrong_num_args (SCM_SNAME (self));
v[i] = SCM_CAR(args);
args = SCM_CDR(args);
}
@@ -218,7 +200,7 @@ scm_gsubr_apply (SCM args)
if (SCM_GSUBR_REST(typ))
v[i] = args;
else if (!scm_is_null (args))
- scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
+ scm_wrong_num_args (SCM_SNAME (self));
switch (n) {
case 2: return (*fcn)(v[0], v[1]);
case 3: return (*fcn)(v[0], v[1], v[2]);
@@ -229,6 +211,10 @@ scm_gsubr_apply (SCM args)
case 8: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7]);
case 9: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8]);
case 10: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8], v[9]);
+ default:
+ scm_misc_error ((char *) SCM_SNAME (self),
+ "gsubr invocation with more than 10 arguments not implemented",
+ SCM_EOL);
}
return SCM_BOOL_F; /* Never reached. */
}
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 4185649..ea48436 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -3,7 +3,7 @@
#ifndef SCM_GSUBR_H
#define SCM_GSUBR_H
-/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -26,19 +26,17 @@
\f
+/* Return an integer describing the arity of GSUBR, a subr of type
+ `scm_tc7_gsubr'. The result can be interpreted with `SCM_GSUBR_REQ ()'
+ and similar. */
+#define SCM_GSUBR_TYPE(gsubr) (SCM_CELL_TYPE (gsubr) >> 8)
+
#define SCM_GSUBR_MAKTYPE(req, opt, rst) ((req)|((opt)<<4)|((rst)<<8))
+#define SCM_GSUBR_MAX 33
#define SCM_GSUBR_REQ(x) ((long)(x)&0xf)
#define SCM_GSUBR_OPT(x) (((long)(x)&0xf0)>>4)
#define SCM_GSUBR_REST(x) ((long)(x)>>8)
-#define SCM_GSUBR_MAX 10
-#define SCM_GSUBR_TYPE(cclo) (SCM_CCLO_REF ((cclo), 1))
-#define SCM_SET_GSUBR_TYPE(cclo, type) (SCM_CCLO_SET ((cclo), 1, (type)))
-#define SCM_GSUBR_PROC(cclo) (SCM_CCLO_REF ((cclo), 2))
-#define SCM_SET_GSUBR_PROC(cclo, proc) (SCM_CCLO_SET ((cclo), 2, (proc)))
-
-SCM_API SCM scm_f_gsubr_apply;
-
SCM_API SCM scm_c_make_gsubr (const char *name,
int req, int opt, int rst, SCM (*fcn) ());
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
diff --git a/libguile/print.c b/libguile/print.c
index d218837..fa4cb1e 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -657,30 +657,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
scm_puts (scm_i_symbol_chars (SCM_SNAME (exp)), port);
scm_putc ('>', port);
break;
-#ifdef CCLO
- case scm_tc7_cclo:
- {
- SCM proc = SCM_CCLO_SUBR (exp);
- if (scm_is_eq (proc, scm_f_gsubr_apply))
- {
- /* Print gsubrs as primitives */
- SCM name = scm_procedure_name (exp);
- scm_puts ("#<primitive-procedure", port);
- if (scm_is_true (name))
- {
- scm_putc (' ', port);
- scm_puts (scm_i_symbol_chars (name), port);
- }
- }
- else
- {
- scm_puts ("#<compiled-closure ", port);
- scm_iprin1 (proc, port, pstate);
- }
- scm_putc ('>', port);
- }
- break;
-#endif
+
case scm_tc7_pws:
scm_puts ("#<procedure-with-setter", port);
{
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 88f2c22..db16834 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -88,21 +88,14 @@ scm_i_procedure_arity (SCM proc)
{
return SCM_BOOL_F;
}
- case scm_tc7_cclo:
- if (scm_is_eq (SCM_CCLO_SUBR (proc), scm_f_gsubr_apply))
- {
- int type = scm_to_int (SCM_GSUBR_TYPE (proc));
- a += SCM_GSUBR_REQ (type);
- o = SCM_GSUBR_OPT (type);
- r = SCM_GSUBR_REST (type);
- break;
- }
- else
- {
- proc = SCM_CCLO_SUBR (proc);
- a -= 1;
- goto loop;
- }
+ case scm_tc7_gsubr:
+ {
+ unsigned int type = SCM_GSUBR_TYPE (proc);
+ a = SCM_GSUBR_REQ (type);
+ o = SCM_GSUBR_OPT (type);
+ r = SCM_GSUBR_REST (type);
+ break;
+ }
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
goto loop;
diff --git a/libguile/procs.c b/libguile/procs.c
index af7f071..2215147 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -90,39 +90,6 @@ scm_c_define_subr_with_generic (const char *name,
}
-#ifdef CCLO
-SCM
-scm_makcclo (SCM proc, size_t len)
-{
- scm_t_bits *base = scm_gc_malloc (len * sizeof (scm_t_bits),
- "compiled closure");
- unsigned long i;
- SCM s;
-
- for (i = 0; i < len; ++i)
- base [i] = SCM_UNPACK (SCM_UNSPECIFIED);
-
- s = scm_cell (SCM_MAKE_CCLO_TAG (len), (scm_t_bits) base);
- SCM_SET_CCLO_SUBR (s, proc);
- return s;
-}
-
-/* Undocumented debugging procedure */
-#ifdef GUILE_DEBUG
-SCM_DEFINE (scm_make_cclo, "make-cclo", 2, 0, 0,
- (SCM proc, SCM len),
- "Create a compiled closure for @var{proc}, which reserves\n"
- "@var{len} objects for its usage.")
-#define FUNC_NAME s_scm_make_cclo
-{
- return scm_makcclo (proc, scm_to_size_t (len));
-}
-#undef FUNC_NAME
-#endif
-#endif
-
-
-
SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a procedure.")
@@ -136,9 +103,6 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
break;
case scm_tcs_closures:
case scm_tcs_subrs:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
case scm_tc7_pws:
return SCM_BOOL_T;
case scm_tc7_smob:
@@ -176,10 +140,9 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
case scm_tc7_lsubr:
case scm_tc7_rpsubr:
case scm_tc7_asubr:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
return SCM_BOOL_T;
+ case scm_tc7_gsubr:
+ return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0);
case scm_tc7_pws:
obj = SCM_PROCEDURE (obj);
goto again;
@@ -230,12 +193,6 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
return SCM_BOOL_F;
default:
return SCM_BOOL_F;
-/*
- case scm_tcs_subrs:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
-*/
}
}
#undef FUNC_NAME
diff --git a/libguile/procs.h b/libguile/procs.h
index f0c0ee3..b7ab614 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -40,18 +40,6 @@
#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))
#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) g))
-#define SCM_CCLO_LENGTH(x) (SCM_CELL_WORD_0 (x) >> 8)
-#define SCM_MAKE_CCLO_TAG(v) (((v) << 8) + scm_tc7_cclo)
-#define SCM_SET_CCLO_LENGTH(x, v) (SCM_SET_CELL_WORD_0 ((x), SCM_MAKE_CCLO_TAG(v)))
-#define SCM_CCLO_BASE(x) ((scm_t_bits *) SCM_CELL_WORD_1 (x))
-#define SCM_SET_CCLO_BASE(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
-
-#define SCM_CCLO_REF(x, i) (SCM_PACK (SCM_CCLO_BASE (x) [i]))
-#define SCM_CCLO_SET(x, i, v) (SCM_CCLO_BASE (x) [i] = SCM_UNPACK (v))
-
-#define SCM_CCLO_SUBR(x) (SCM_CCLO_REF ((x), 0))
-#define SCM_SET_CCLO_SUBR(x, v) (SCM_CCLO_SET ((x), 0, (v)))
-
/* Closures
*/
@@ -129,7 +117,6 @@ SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type,
SCM_API SCM scm_c_define_subr (const char *name, long type, SCM (*fcn)());
SCM_API SCM scm_c_define_subr_with_generic (const char *name, long type,
SCM (*fcn)(), SCM *gf);
-SCM_API SCM scm_makcclo (SCM proc, size_t len);
SCM_API SCM scm_procedure_p (SCM obj);
SCM_API SCM scm_closure_p (SCM obj);
SCM_API SCM scm_thunk_p (SCM obj);
@@ -141,10 +128,6 @@ SCM_API SCM scm_procedure (SCM proc);
SCM_API SCM scm_setter (SCM proc);
SCM_INTERNAL void scm_init_procs (void);
-#ifdef GUILE_DEBUG
-SCM_API SCM scm_make_cclo (SCM proc, SCM len);
-#endif /*GUILE_DEBUG*/
-
#endif /* SCM_PROCS_H */
/*
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 4b97a18..86597fa 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,5 +1,5 @@
/* Representation of stack frame debug information
- * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009 Free Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -293,9 +293,6 @@ read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
NEXT_FRAME (iframe, n, quit);
}
}
- else if (scm_is_eq (iframe->proc, scm_f_gsubr_apply))
- /* Skip gsubr apply frames. */
- continue;
else
{
NEXT_FRAME (iframe, n, quit);
diff --git a/libguile/tags.h b/libguile/tags.h
index 4e0700b..2f30369 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -455,7 +455,7 @@ typedef unsigned long scm_t_bits;
#define scm_tc7_unused_9 79
#define scm_tc7_dsubr 61
-#define scm_tc7_cclo 63
+#define scm_tc7_gsubr 63
#define scm_tc7_rpsubr 69
#define scm_tc7_subr_0 85
#define scm_tc7_subr_1 87
@@ -677,7 +677,8 @@ enum scm_tc8_tags
case scm_tc7_subr_1o:\
case scm_tc7_subr_2o:\
case scm_tc7_lsubr_2:\
- case scm_tc7_lsubr
+ case scm_tc7_lsubr: \
+ case scm_tc7_gsubr
\f
--
1.6.0.4
^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: Putting an end to "compiled closures"
2009-02-16 0:22 Putting an end to "compiled closures" Ludovic Courtès
@ 2009-02-23 22:10 ` Ludovic Courtès
2009-03-01 23:34 ` Ludovic Courtès
1 sibling, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2009-02-23 22:10 UTC (permalink / raw)
To: guile-devel
[-- Attachment #1: Type: text/plain, Size: 462 bytes --]
Hello,
ludo@gnu.org (Ludovic Courtès) writes:
> The attached patch creates a new type tag, `scm_tc7_gsubr', whereby the
> 24 MSBs are used to store gsubr arity information as returned by
> `SCM_GSUBR_MAKTYPE ()'. This makes cclos useless, which simplifies the
> code and reduces the overhead when creating and invoking such
> procedures.
Unless there are objections, I'll commit it by the end of the week
(slightly modified patch attached).
Thanks,
Ludo'.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 26227 bytes --]
From 6178d6088d623a7de53653bea4209c105bc0c12d Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 16 Feb 2009 00:24:00 +0100
Subject: [PATCH] Remove "compiled closures" ("cclos") in favor of a simpler mechanism.
The idea is to introduce `gsubrs' whose arity is encoded in their type
(more precisely in the sizeof (void *) - 8 MSBs). This removes the
indirection introduced by cclos and simplifies the code.
* libguile/__scm.h (CCLO): Remove.
* libguile/debug.c (scm_procedure_source, scm_procedure_environment):
Remove references to `scm_tc7_cclo'.
* libguile/eval.c (scm_trampoline_0, scm_trampoline_1,
scm_trampoline_2): Replace `scm_tc7_cclo' with `scm_tc7_gsubr'.
* libguile/eval.i.c (CEVAL): Likewise. No longer make PROC the first
argument. Directly invoke `scm_gsubr_apply ()' instead of jump to the
`evap(N+1)' label or call to `SCM_APPLY ()'.
* libguile/evalext.c (scm_self_evaluating_p): Remove reference to
`scm_tc7_cclo'.
* libguile/gc-card.c (scm_i_sweep_card, scm_i_tag_name): Likewise.
* libguile/gc-mark.c (scm_gc_mark_dependencies): Likewise.
* libguile/goops.c (scm_class_of): Likewise.
* libguile/print.c (iprin1): Likewise.
* libguile/gsubr.c (create_gsubr): Use `unsigned int's for REQ, OPT and
RST. Use `scm_tc7_gsubr' instead of `scm_makcclo ()' in the default
case.
(scm_gsubr_apply): Remove calls to `SCM_GSUBR_PROC ()'.
(scm_f_gsubr_apply): Remove.
* libguile/gsubr.h (SCM_GSUBR_TYPE): New definition.
(SCM_GSUBR_MAX): Changed to 33.
(SCM_SET_GSUBR_TYPE, SCM_GSUBR_PROC, SCM_SET_GSUBR_PROC,
scm_f_gsubr_apply): Remove.
* libguile/procprop.c (scm_i_procedure_arity): Remove reference to
`scm_tc7_cclo'; add proper handling of `scm_tc7_gsubr'.
* libguile/procs.c (scm_makcclo, scm_make_cclo): Remove.
(scm_procedure_p): Remove reference to `scm_tc7_cclo'.
(scm_thunk_p): Likewise, plus add proper `scm_tc7_gsubr' handling.
* libguile/procs.h (SCM_CCLO_LENGTH, SCM_MAKE_CCLO_TAG,
SCM_SET_CCLO_LENGTH, SCM_CCLO_BASE, SCM_SET_CCLO_BASE, SCM_CCLO_REF,
SCM_CCLO_SET, SCM_CCLO_SUBR, SCM_SET_CCLO_SUBR, scm_makcclo,
scm_make_cclo): Remove.
* libguile/stacks.c (read_frames): Remove reference to `scm_f_gsubr_apply'.
* libguile/tags.h (scm_tc7_cclo): Remove.
(scm_tc7_gsubr): New.
(scm_tcs_subrs): Add `scm_tc7_gsubr'.
---
libguile/__scm.h | 4 +--
libguile/debug.c | 8 +----
libguile/eval.c | 8 ++--
libguile/eval.i.c | 46 ++++++++++-------------------
libguile/evalext.c | 3 +-
libguile/gc-card.c | 14 +--------
libguile/gc-mark.c | 15 ----------
libguile/goops.c | 4 +-
libguile/gsubr.c | 78 ++++++++++++++++++++++----------------------------
libguile/gsubr.h | 16 ++++------
libguile/print.c | 27 +----------------
libguile/procprop.c | 25 ++++++----------
libguile/procs.c | 47 +-----------------------------
libguile/procs.h | 17 -----------
libguile/stacks.c | 5 +--
libguile/tags.h | 5 ++-
16 files changed, 84 insertions(+), 238 deletions(-)
diff --git a/libguile/__scm.h b/libguile/__scm.h
index d486b69..3672b1c 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -3,7 +3,7 @@
#ifndef SCM___SCM_H
#define SCM___SCM_H
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -140,8 +140,6 @@
*/
-#define CCLO
-
/* Guile Scheme supports the #f/() distinction; Guile Lisp won't. We
have horrible plans for their unification. */
#undef SICP
diff --git a/libguile/debug.c b/libguile/debug.c
index 7b91cd3..0ac4442 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -1,5 +1,5 @@
/* Debugging extensions for Guile
- * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008 Free Software Foundation
+ * Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009 Free Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -352,9 +352,6 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
if (!SCM_SMOB_DESCRIPTOR (proc).apply)
break;
case scm_tcs_subrs:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
procprop:
/* It would indeed be a nice thing if we supplied source even for
built in procedures! */
@@ -385,9 +382,6 @@ SCM_DEFINE (scm_procedure_environment, "procedure-environment", 1, 0, 0,
case scm_tcs_closures:
return SCM_ENV (proc);
case scm_tcs_subrs:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
return SCM_EOL;
default:
SCM_WRONG_TYPE_ARG (1, proc);
diff --git a/libguile/eval.c b/libguile/eval.c
index 14dc3c3..d20f72e 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -3243,7 +3243,7 @@ scm_trampoline_0 (SCM proc)
break;
case scm_tc7_asubr:
case scm_tc7_rpsubr:
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
case scm_tc7_pws:
trampoline = scm_call_0;
break;
@@ -3369,7 +3369,7 @@ scm_trampoline_1 (SCM proc)
break;
case scm_tc7_asubr:
case scm_tc7_rpsubr:
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
case scm_tc7_pws:
trampoline = scm_call_1;
break;
@@ -3463,7 +3463,7 @@ scm_trampoline_2 (SCM proc)
else
return NULL;
break;
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
case scm_tc7_pws:
trampoline = scm_call_2;
break;
diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index 83878ff..65e2744 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -1,7 +1,7 @@
/*
* eval.i.c - actual evaluator code for GUILE
*
- * Copyright (C) 2002, 03, 04, 05, 06, 07 Free Software Foundation, Inc.
+ * Copyright (C) 2002, 03, 04, 05, 06, 07, 09 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -1124,14 +1124,12 @@ dispatch:
if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun;
RETURN (SCM_SMOB_APPLY_0 (proc));
- case scm_tc7_cclo:
- arg1 = proc;
- proc = SCM_CCLO_SUBR (proc);
+ case scm_tc7_gsubr:
#ifdef DEVAL
debug.info->a.proc = proc;
- debug.info->a.args = scm_list_1 (arg1);
+ debug.info->a.args = SCM_EOL;
#endif
- goto evap1;
+ RETURN (scm_gsubr_apply (scm_list_1 (proc)));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL
@@ -1245,15 +1243,12 @@ dispatch:
if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun;
RETURN (SCM_SMOB_APPLY_1 (proc, arg1));
- case scm_tc7_cclo:
- arg2 = arg1;
- arg1 = proc;
- proc = SCM_CCLO_SUBR (proc);
+ case scm_tc7_gsubr:
#ifdef DEVAL
debug.info->a.args = scm_cons (arg1, debug.info->a.args);
debug.info->a.proc = proc;
#endif
- goto evap2;
+ RETURN (scm_gsubr_apply (scm_list_2 (proc, arg1)));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL
@@ -1351,19 +1346,14 @@ dispatch:
goto badfun;
RETURN (SCM_SMOB_APPLY_2 (proc, arg1, arg2));
cclon:
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
#ifdef DEVAL
- RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc),
- scm_cons (proc, debug.info->a.args),
- SCM_EOL));
+ RETURN (scm_gsubr_apply (scm_cons (proc, debug.info->a.args)));
#else
- RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc),
- scm_cons2 (proc, arg1,
- scm_cons (arg2,
- scm_ceval_args (x,
- env,
- proc))),
- SCM_EOL));
+ RETURN (scm_gsubr_apply
+ (scm_cons (proc,
+ scm_cons2 (arg1, arg2,
+ scm_ceval_args (x, env, proc)))));
#endif
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
@@ -1492,7 +1482,7 @@ dispatch:
goto badfun;
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2,
SCM_CDDR (debug.info->a.args)));
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
goto cclon;
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
@@ -1555,7 +1545,7 @@ dispatch:
goto badfun;
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2,
scm_ceval_args (x, env, proc)));
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
goto cclon;
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
@@ -1867,19 +1857,15 @@ tail:
RETURN (SCM_SMOB_APPLY_2 (proc, arg1, SCM_CAR (args)));
else
RETURN (SCM_SMOB_APPLY_3 (proc, arg1, SCM_CAR (args), SCM_CDR (args)));
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
#ifdef DEVAL
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);
- arg1 = proc;
- proc = SCM_CCLO_SUBR (proc);
debug.vect[0].a.proc = proc;
debug.vect[0].a.args = scm_cons (arg1, args);
#else
args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
- arg1 = proc;
- proc = SCM_CCLO_SUBR (proc);
#endif
- goto tail;
+ RETURN (scm_gsubr_apply (scm_cons (proc, args)));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
#ifdef DEVAL
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 9bec8f4..5ca7806 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -106,7 +106,6 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
case scm_tc7_number:
case scm_tc7_string:
case scm_tc7_smob:
- case scm_tc7_cclo:
case scm_tc7_pws:
case scm_tcs_subrs:
case scm_tcs_struct:
diff --git a/libguile/gc-card.c b/libguile/gc-card.c
index 1948aff..0629da0 100644
--- a/libguile/gc-card.c
+++ b/libguile/gc-card.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -131,14 +131,6 @@ scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg)
scm_i_vector_free (scmptr);
break;
-#ifdef CCLO
- case scm_tc7_cclo:
- scm_gc_free (SCM_CCLO_BASE (scmptr),
- SCM_CCLO_LENGTH (scmptr) * sizeof (SCM),
- "compiled closure");
- break;
-#endif
-
case scm_tc7_number:
switch SCM_TYP16 (scmptr)
{
@@ -397,10 +389,6 @@ scm_i_tag_name (scm_t_bits tag)
return "weak vector";
case scm_tc7_vector:
return "vector";
-#ifdef CCLO
- case scm_tc7_cclo:
- return "compiled closure";
-#endif
case scm_tc7_number:
switch (tag)
{
diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c
index e73f6e1..1a66900 100644
--- a/libguile/gc-mark.c
+++ b/libguile/gc-mark.c
@@ -294,21 +294,6 @@ scm_gc_mark_dependencies (SCM p)
}
ptr = SCM_SIMPLE_VECTOR_REF (ptr, 0);
goto gc_mark_loop;
-#ifdef CCLO
- case scm_tc7_cclo:
- {
- size_t i = SCM_CCLO_LENGTH (ptr);
- size_t j;
- for (j = 1; j != i; ++j)
- {
- SCM obj = SCM_CCLO_REF (ptr, j);
- if (!SCM_IMP (obj))
- scm_gc_mark (obj);
- }
- ptr = SCM_CCLO_REF (ptr, 0);
- goto gc_mark_loop;
- }
-#endif
case scm_tc7_string:
ptr = scm_i_string_mark (ptr);
diff --git a/libguile/goops.c b/libguile/goops.c
index 4e64586..cc4e1eb 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008
+/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@@ -233,7 +233,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return scm_class_primitive_generic;
else
return scm_class_procedure;
- case scm_tc7_cclo:
+ case scm_tc7_gsubr:
return scm_class_procedure;
case scm_tc7_pws:
return scm_class_procedure_with_setter;
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index fdb70ed..91852d5 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -40,11 +40,10 @@
SCM_GLOBAL_SYMBOL (scm_sym_name, "name");
-SCM scm_f_gsubr_apply;
-
static SCM
create_gsubr (int define, const char *name,
- int req, int opt, int rst, SCM (*fcn)())
+ unsigned int req, unsigned int opt, unsigned int rst,
+ SCM (*fcn) ())
{
SCM subr;
@@ -52,53 +51,47 @@ create_gsubr (int define, const char *name,
{
case SCM_GSUBR_MAKTYPE(0, 0, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_0, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(1, 0, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_1, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(0, 1, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_1o, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(1, 1, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_2o, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(2, 0, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_2, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(3, 0, 0):
subr = scm_c_make_subr (name, scm_tc7_subr_3, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(0, 0, 1):
subr = scm_c_make_subr (name, scm_tc7_lsubr, fcn);
- goto create_subr;
+ break;
case SCM_GSUBR_MAKTYPE(2, 0, 1):
subr = scm_c_make_subr (name, scm_tc7_lsubr_2, fcn);
- create_subr:
- if (define)
- scm_define (SCM_SNAME (subr), subr);
- return subr;
+ break;
default:
{
- SCM cclo = scm_makcclo (scm_f_gsubr_apply, 3L);
- SCM subr = scm_c_make_subr (name, scm_tc7_subr_0, fcn);
- SCM sym = SCM_SNAME (subr);
- if (SCM_GSUBR_MAX < req + opt + rst)
- {
- fprintf (stderr,
- "ERROR in scm_c_make_gsubr: too many args (%d) to %s\n",
- req + opt + rst, name);
- exit (1);
- }
- SCM_SET_GSUBR_PROC (cclo, subr);
- SCM_SET_GSUBR_TYPE (cclo,
- scm_from_int (SCM_GSUBR_MAKTYPE (req, opt, rst)));
- if (SCM_REC_PROCNAMES_P)
- scm_set_procedure_property_x (cclo, scm_sym_name, sym);
- if (define)
- scm_define (sym, cclo);
- return cclo;
+ unsigned type;
+
+ type = SCM_GSUBR_MAKTYPE (req, opt, rst);
+ if (SCM_GSUBR_REQ (type) != req
+ || SCM_GSUBR_OPT (type) != opt
+ || SCM_GSUBR_REST (type) != rst)
+ scm_out_of_range ("create_gsubr", scm_from_uint (req + opt + rst));
+
+ subr = scm_c_make_subr (name, scm_tc7_gsubr | (type << 8U),
+ fcn);
}
}
+
+ if (define)
+ scm_define (SCM_SNAME (subr), subr);
+
+ return subr;
}
SCM
@@ -190,20 +183,15 @@ scm_gsubr_apply (SCM args)
#define FUNC_NAME "scm_gsubr_apply"
{
SCM self = SCM_CAR (args);
- SCM (*fcn)() = SCM_SUBRF (SCM_GSUBR_PROC (self));
+ SCM (*fcn)() = SCM_SUBRF (self);
SCM v[SCM_GSUBR_MAX];
- int typ = scm_to_int (SCM_GSUBR_TYPE (self));
+ unsigned int typ = SCM_GSUBR_TYPE (self);
long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
-#if 0
- if (n > SCM_GSUBR_MAX)
- scm_misc_error (FUNC_NAME,
- "Function ~S has illegal arity ~S.",
- scm_list_2 (self, scm_from_int (n)));
-#endif
+
args = SCM_CDR (args);
for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
if (scm_is_null (args))
- scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
+ scm_wrong_num_args (SCM_SNAME (self));
v[i] = SCM_CAR(args);
args = SCM_CDR(args);
}
@@ -218,7 +206,7 @@ scm_gsubr_apply (SCM args)
if (SCM_GSUBR_REST(typ))
v[i] = args;
else if (!scm_is_null (args))
- scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
+ scm_wrong_num_args (SCM_SNAME (self));
switch (n) {
case 2: return (*fcn)(v[0], v[1]);
case 3: return (*fcn)(v[0], v[1], v[2]);
@@ -229,6 +217,10 @@ scm_gsubr_apply (SCM args)
case 8: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7]);
case 9: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8]);
case 10: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8], v[9]);
+ default:
+ scm_misc_error ((char *) SCM_SNAME (self),
+ "gsubr invocation with more than 10 arguments not implemented",
+ SCM_EOL);
}
return SCM_BOOL_F; /* Never reached. */
}
@@ -259,8 +251,6 @@ gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst)
void
scm_init_gsubr()
{
- scm_f_gsubr_apply = scm_c_make_subr ("gsubr-apply", scm_tc7_lsubr,
- scm_gsubr_apply);
#ifdef GSUBR_TEST
scm_c_define_gsubr ("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */
#endif
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 4185649..ea48436 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -3,7 +3,7 @@
#ifndef SCM_GSUBR_H
#define SCM_GSUBR_H
-/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -26,19 +26,17 @@
\f
+/* Return an integer describing the arity of GSUBR, a subr of type
+ `scm_tc7_gsubr'. The result can be interpreted with `SCM_GSUBR_REQ ()'
+ and similar. */
+#define SCM_GSUBR_TYPE(gsubr) (SCM_CELL_TYPE (gsubr) >> 8)
+
#define SCM_GSUBR_MAKTYPE(req, opt, rst) ((req)|((opt)<<4)|((rst)<<8))
+#define SCM_GSUBR_MAX 33
#define SCM_GSUBR_REQ(x) ((long)(x)&0xf)
#define SCM_GSUBR_OPT(x) (((long)(x)&0xf0)>>4)
#define SCM_GSUBR_REST(x) ((long)(x)>>8)
-#define SCM_GSUBR_MAX 10
-#define SCM_GSUBR_TYPE(cclo) (SCM_CCLO_REF ((cclo), 1))
-#define SCM_SET_GSUBR_TYPE(cclo, type) (SCM_CCLO_SET ((cclo), 1, (type)))
-#define SCM_GSUBR_PROC(cclo) (SCM_CCLO_REF ((cclo), 2))
-#define SCM_SET_GSUBR_PROC(cclo, proc) (SCM_CCLO_SET ((cclo), 2, (proc)))
-
-SCM_API SCM scm_f_gsubr_apply;
-
SCM_API SCM scm_c_make_gsubr (const char *name,
int req, int opt, int rst, SCM (*fcn) ());
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
diff --git a/libguile/print.c b/libguile/print.c
index d218837..fa4cb1e 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -657,30 +657,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
scm_puts (scm_i_symbol_chars (SCM_SNAME (exp)), port);
scm_putc ('>', port);
break;
-#ifdef CCLO
- case scm_tc7_cclo:
- {
- SCM proc = SCM_CCLO_SUBR (exp);
- if (scm_is_eq (proc, scm_f_gsubr_apply))
- {
- /* Print gsubrs as primitives */
- SCM name = scm_procedure_name (exp);
- scm_puts ("#<primitive-procedure", port);
- if (scm_is_true (name))
- {
- scm_putc (' ', port);
- scm_puts (scm_i_symbol_chars (name), port);
- }
- }
- else
- {
- scm_puts ("#<compiled-closure ", port);
- scm_iprin1 (proc, port, pstate);
- }
- scm_putc ('>', port);
- }
- break;
-#endif
+
case scm_tc7_pws:
scm_puts ("#<procedure-with-setter", port);
{
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 88f2c22..db16834 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2003,2004, 2006, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -88,21 +88,14 @@ scm_i_procedure_arity (SCM proc)
{
return SCM_BOOL_F;
}
- case scm_tc7_cclo:
- if (scm_is_eq (SCM_CCLO_SUBR (proc), scm_f_gsubr_apply))
- {
- int type = scm_to_int (SCM_GSUBR_TYPE (proc));
- a += SCM_GSUBR_REQ (type);
- o = SCM_GSUBR_OPT (type);
- r = SCM_GSUBR_REST (type);
- break;
- }
- else
- {
- proc = SCM_CCLO_SUBR (proc);
- a -= 1;
- goto loop;
- }
+ case scm_tc7_gsubr:
+ {
+ unsigned int type = SCM_GSUBR_TYPE (proc);
+ a = SCM_GSUBR_REQ (type);
+ o = SCM_GSUBR_OPT (type);
+ r = SCM_GSUBR_REST (type);
+ break;
+ }
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
goto loop;
diff --git a/libguile/procs.c b/libguile/procs.c
index af7f071..2215147 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -90,39 +90,6 @@ scm_c_define_subr_with_generic (const char *name,
}
-#ifdef CCLO
-SCM
-scm_makcclo (SCM proc, size_t len)
-{
- scm_t_bits *base = scm_gc_malloc (len * sizeof (scm_t_bits),
- "compiled closure");
- unsigned long i;
- SCM s;
-
- for (i = 0; i < len; ++i)
- base [i] = SCM_UNPACK (SCM_UNSPECIFIED);
-
- s = scm_cell (SCM_MAKE_CCLO_TAG (len), (scm_t_bits) base);
- SCM_SET_CCLO_SUBR (s, proc);
- return s;
-}
-
-/* Undocumented debugging procedure */
-#ifdef GUILE_DEBUG
-SCM_DEFINE (scm_make_cclo, "make-cclo", 2, 0, 0,
- (SCM proc, SCM len),
- "Create a compiled closure for @var{proc}, which reserves\n"
- "@var{len} objects for its usage.")
-#define FUNC_NAME s_scm_make_cclo
-{
- return scm_makcclo (proc, scm_to_size_t (len));
-}
-#undef FUNC_NAME
-#endif
-#endif
-
-
-
SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a procedure.")
@@ -136,9 +103,6 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
break;
case scm_tcs_closures:
case scm_tcs_subrs:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
case scm_tc7_pws:
return SCM_BOOL_T;
case scm_tc7_smob:
@@ -176,10 +140,9 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
case scm_tc7_lsubr:
case scm_tc7_rpsubr:
case scm_tc7_asubr:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
return SCM_BOOL_T;
+ case scm_tc7_gsubr:
+ return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0);
case scm_tc7_pws:
obj = SCM_PROCEDURE (obj);
goto again;
@@ -230,12 +193,6 @@ SCM_DEFINE (scm_procedure_documentation, "procedure-documentation", 1, 0, 0,
return SCM_BOOL_F;
default:
return SCM_BOOL_F;
-/*
- case scm_tcs_subrs:
-#ifdef CCLO
- case scm_tc7_cclo:
-#endif
-*/
}
}
#undef FUNC_NAME
diff --git a/libguile/procs.h b/libguile/procs.h
index f0c0ee3..b7ab614 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -40,18 +40,6 @@
#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))
#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) g))
-#define SCM_CCLO_LENGTH(x) (SCM_CELL_WORD_0 (x) >> 8)
-#define SCM_MAKE_CCLO_TAG(v) (((v) << 8) + scm_tc7_cclo)
-#define SCM_SET_CCLO_LENGTH(x, v) (SCM_SET_CELL_WORD_0 ((x), SCM_MAKE_CCLO_TAG(v)))
-#define SCM_CCLO_BASE(x) ((scm_t_bits *) SCM_CELL_WORD_1 (x))
-#define SCM_SET_CCLO_BASE(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
-
-#define SCM_CCLO_REF(x, i) (SCM_PACK (SCM_CCLO_BASE (x) [i]))
-#define SCM_CCLO_SET(x, i, v) (SCM_CCLO_BASE (x) [i] = SCM_UNPACK (v))
-
-#define SCM_CCLO_SUBR(x) (SCM_CCLO_REF ((x), 0))
-#define SCM_SET_CCLO_SUBR(x, v) (SCM_CCLO_SET ((x), 0, (v)))
-
/* Closures
*/
@@ -129,7 +117,6 @@ SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type,
SCM_API SCM scm_c_define_subr (const char *name, long type, SCM (*fcn)());
SCM_API SCM scm_c_define_subr_with_generic (const char *name, long type,
SCM (*fcn)(), SCM *gf);
-SCM_API SCM scm_makcclo (SCM proc, size_t len);
SCM_API SCM scm_procedure_p (SCM obj);
SCM_API SCM scm_closure_p (SCM obj);
SCM_API SCM scm_thunk_p (SCM obj);
@@ -141,10 +128,6 @@ SCM_API SCM scm_procedure (SCM proc);
SCM_API SCM scm_setter (SCM proc);
SCM_INTERNAL void scm_init_procs (void);
-#ifdef GUILE_DEBUG
-SCM_API SCM scm_make_cclo (SCM proc, SCM len);
-#endif /*GUILE_DEBUG*/
-
#endif /* SCM_PROCS_H */
/*
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 4b97a18..86597fa 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,5 +1,5 @@
/* Representation of stack frame debug information
- * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009 Free Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -293,9 +293,6 @@ read_frames (scm_t_debug_frame *dframe, scm_t_ptrdiff offset,
NEXT_FRAME (iframe, n, quit);
}
}
- else if (scm_is_eq (iframe->proc, scm_f_gsubr_apply))
- /* Skip gsubr apply frames. */
- continue;
else
{
NEXT_FRAME (iframe, n, quit);
diff --git a/libguile/tags.h b/libguile/tags.h
index 4e0700b..2f30369 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -455,7 +455,7 @@ typedef unsigned long scm_t_bits;
#define scm_tc7_unused_9 79
#define scm_tc7_dsubr 61
-#define scm_tc7_cclo 63
+#define scm_tc7_gsubr 63
#define scm_tc7_rpsubr 69
#define scm_tc7_subr_0 85
#define scm_tc7_subr_1 87
@@ -677,7 +677,8 @@ enum scm_tc8_tags
case scm_tc7_subr_1o:\
case scm_tc7_subr_2o:\
case scm_tc7_lsubr_2:\
- case scm_tc7_lsubr
+ case scm_tc7_lsubr: \
+ case scm_tc7_gsubr
\f
--
1.6.0.4
^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: Putting an end to "compiled closures"
2009-02-16 0:22 Putting an end to "compiled closures" Ludovic Courtès
2009-02-23 22:10 ` Ludovic Courtès
@ 2009-03-01 23:34 ` Ludovic Courtès
2009-03-08 16:18 ` Ludovic Courtès
1 sibling, 1 reply; 7+ messages in thread
From: Ludovic Courtès @ 2009-03-01 23:34 UTC (permalink / raw)
To: guile-devel
Hello!
ludo@gnu.org (Ludovic Courtès) writes:
> The attached patch creates a new type tag, `scm_tc7_gsubr', whereby the
> 24 MSBs are used to store gsubr arity information as returned by
> `SCM_GSUBR_MAKTYPE ()'. This makes cclos useless, which simplifies the
> code and reduces the overhead when creating and invoking such
> procedures.
I committed it:
http://git.savannah.gnu.org/gitweb/?p=guile.git;a=commitdiff;h=e20d7001c3f7150400169fecb0bf0eefdf122fe2
http://git.savannah.gnu.org/gitweb/?p=guile.git;a=commitdiff;h=54d14084e229f90b75475a866e3f458be30fa233
I also committed a simple benchmark for subr invocation [0]. The result
is as follows (truncated for clarity):
- before patch
("subr.bm: subr invocation: simple subr" 700000 total 0.99)
("subr.bm: subr invocation: generic subr" 700000 total 1.77)
("subr.bm: subr application: simple subr" 700000 total 1.75)
("subr.bm: subr application: generic subr" 700000 total 2.31)
- after patch
("subr.bm: subr invocation: simple subr" 700000 total 0.98)
("subr.bm: subr invocation: generic subr" 700000 total 1.38)
("subr.bm: subr application: simple subr" 700000 total 1.76)
("subr.bm: subr application: generic subr" 700000 total 2.16)
That is, roughly a 20% improvement on gsubr invocation.
Thanks,
Ludo'.
[0] http://git.savannah.gnu.org/gitweb/?p=guile.git;a=commitdiff;h=b786a5bbf825f61e04ccd9a54f93cb1e40ac67d9
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: Putting an end to "compiled closures"
2009-03-01 23:34 ` Ludovic Courtès
@ 2009-03-08 16:18 ` Ludovic Courtès
2009-03-10 23:52 ` GC brokenness in `master' Ludovic Courtès
0 siblings, 1 reply; 7+ messages in thread
From: Ludovic Courtès @ 2009-03-08 16:18 UTC (permalink / raw)
To: guile-devel
Hello!
I did some more fiddling with gsubrs:
http://git.savannah.gnu.org/gitweb/?p=guile.git;a=commitdiff;h=8321ed20f69b4c56cb680563160cd30ecac8f509
The change adds a vararg function to invoke gsubrs when the number of
arguments is known, thereby eliminating consing.
The benchmark is as follows:
- before
("subr.bm: subr invocation: simple subr" 700000 total 0.98)
("subr.bm: subr invocation: generic subr" 700000 total 1.39)
("subr.bm: subr invocation: generic subr with rest arg" 700000 total 1.32)
("subr.bm: subr invocation: generic subr with rest arg and 3+ parameters" 700000 total 1.63)
- after
("subr.bm: subr invocation: simple subr" 700000 total 1.0)
("subr.bm: subr invocation: generic subr" 700000 total 1.1)
("subr.bm: subr invocation: generic subr with rest arg" 700000 total 1.19)
("subr.bm: subr invocation: generic subr with rest arg and 3+ parameters" 700000 total 1.65)
That's again a 20% improvement for gsubrs with no rest argument
(`hashq-ref', `substring', `open', `string-upcase', `gettext', etc.) and
a 10% for procedures with a rest argument called with less than 3
arguments (e.g., `(cons* 1 2)', `(run-hook h 1)', `(throw 'foo 'bar)',
`(make-regexp "foo")').
Thanks,
Ludo'.
^ permalink raw reply [flat|nested] 7+ messages in thread
* GC brokenness in `master'
2009-03-08 16:18 ` Ludovic Courtès
@ 2009-03-10 23:52 ` Ludovic Courtès
2009-03-11 0:08 ` Neil Jerram
0 siblings, 1 reply; 7+ messages in thread
From: Ludovic Courtès @ 2009-03-10 23:52 UTC (permalink / raw)
To: guile-devel
Hello,
ludo@gnu.org (Ludovic Courtès) writes:
> ("subr.bm: subr invocation: simple subr" 700000 total 0.98)
> ("subr.bm: subr invocation: generic subr" 700000 total 1.39)
> ("subr.bm: subr invocation: generic subr with rest arg" 700000 total 1.32)
> ("subr.bm: subr invocation: generic subr with rest arg and 3+ parameters" 700000 total 1.63)
"Interestingly", this is roughly twice as slow as 1.8 (!).
After some manual bisecting, I found the offending commit (dated
2008-08-16):
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=82ae1b8eb3413e6be6bd2aa032986fc7782e85ac
Right before this commit we get:
("subr.bm: subr invocation: simple subr" 700000 total 0.58)
("subr.bm: subr invocation: generic subr" 700000 total 0.96)
("subr.bm: subr invocation: generic subr with rest arg" 700000 total 0.91)
("subr.bm: subr invocation: generic subr with rest arg and 3+ parameters" 700000 total 1.05)
which is comparable with 1.8 (slightly slower).
With 1.8, we get:
("subr.bm: subr invocation: simple subr" 700000 total 0.52)
("subr.bm: subr invocation: generic subr" 700000 total 0.86)
("subr.bm: subr invocation: generic subr with rest arg" 700000 total 0.79)
("subr.bm: subr invocation: generic subr with rest arg and 3+ parameters" 700000 total 0.93)
With BDW-GC HEAD (i.e., after gsubr optimizations), we have:
("subr.bm: subr invocation: simple subr" 700000 total 0.65)
("subr.bm: subr invocation: generic subr" 700000 total 0.78)
("subr.bm: subr invocation: generic subr with rest arg" 700000 total 0.79)
("subr.bm: subr invocation: generic subr with rest arg and 3+ parameters" 700000 total 1.07)
Strangely enough, the "simple subr" case, which is not GC-intensive, is
slower with BDW-GC. This needs further investigation...
Thanks,
Ludo'.
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: GC brokenness in `master'
2009-03-10 23:52 ` GC brokenness in `master' Ludovic Courtès
@ 2009-03-11 0:08 ` Neil Jerram
2009-03-11 9:23 ` Ludovic Courtès
0 siblings, 1 reply; 7+ messages in thread
From: Neil Jerram @ 2009-03-11 0:08 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guile-devel
ludo@gnu.org (Ludovic Courtès) writes:
> Hello,
>
> ludo@gnu.org (Ludovic Courtès) writes:
>
>> ("subr.bm: subr invocation: simple subr" 700000 total 0.98)
>> ("subr.bm: subr invocation: generic subr" 700000 total 1.39)
>> ("subr.bm: subr invocation: generic subr with rest arg" 700000 total 1.32)
>> ("subr.bm: subr invocation: generic subr with rest arg and 3+ parameters" 700000 total 1.63)
>
> "Interestingly", this is roughly twice as slow as 1.8 (!).
>
> After some manual bisecting, I found the offending commit (dated
> 2008-08-16):
>
> http://git.savannah.gnu.org/cgit/guile.git/commit/?id=82ae1b8eb3413e6be6bd2aa032986fc7782e85ac
But presumably this doesn't matter much, if we are going to switch to
BDW-GC. What's your latest thinking on that?
> Strangely enough, the "simple subr" case, which is not GC-intensive, is
> slower with BDW-GC. This needs further investigation...
It's not very much slower - and IMO, not serious enough to be a
significant factor against BDW-GC.
But it's nicer to understand things fully, so I agree that
investigation would be good too.
Neil
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: GC brokenness in `master'
2009-03-11 0:08 ` Neil Jerram
@ 2009-03-11 9:23 ` Ludovic Courtès
0 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2009-03-11 9:23 UTC (permalink / raw)
To: guile-devel
Hi Neil,
Neil Jerram <neil@ossau.uklinux.net> writes:
> ludo@gnu.org (Ludovic Courtès) writes:
>> After some manual bisecting, I found the offending commit (dated
>> 2008-08-16):
>>
>> http://git.savannah.gnu.org/cgit/guile.git/commit/?id=82ae1b8eb3413e6be6bd2aa032986fc7782e85ac
>
> But presumably this doesn't matter much, if we are going to switch to
> BDW-GC. What's your latest thinking on that?
Yes, I'm still considering switching GCs anyway, but I wanted to know
what happened exactly (and whether it was really a GC issue, which
wasn't 100% obvious).
While doing this, I remembered that Valgrind can't be used with BDW-GC,
which can be annoying. I'll email the GC list about that.
>> Strangely enough, the "simple subr" case, which is not GC-intensive, is
>> slower with BDW-GC. This needs further investigation...
>
> It's not very much slower - and IMO, not serious enough to be a
> significant factor against BDW-GC.
Agreed.
> But it's nicer to understand things fully, so I agree that
> investigation would be good too.
Yes.
Thanks,
Ludo'.
^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2009-03-11 9:23 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2009-02-16 0:22 Putting an end to "compiled closures" Ludovic Courtès
2009-02-23 22:10 ` Ludovic Courtès
2009-03-01 23:34 ` Ludovic Courtès
2009-03-08 16:18 ` Ludovic Courtès
2009-03-10 23:52 ` GC brokenness in `master' Ludovic Courtès
2009-03-11 0:08 ` Neil Jerram
2009-03-11 9:23 ` Ludovic Courtès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).