summaryrefslogtreecommitdiff
path: root/libguile/programs.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-08-20 14:27:38 +0200
committerAndy Wingo <wingo@pobox.com>2009-08-20 18:52:51 +0200
commit2fb924f64f6cf47a9b4d6e8a22433ac2c5739379 (patch)
treedfe2aa5484ef14797a7c659f2b0cd873d54dd37b /libguile/programs.c
parentcdde57b2f11a6c28518aebed234b98ce5bd7131f (diff)
downloadguile-2fb924f64f6cf47a9b4d6e8a22433ac2c5739379.tar.gz
programs have their own tc7 now
* libguile/tags.h (scm_tc7_program): * libguile/programs.h: Programs now have their own tc7 code. Fix up the macros appropriately. * libguile/programs.c: Remove smobby bits, leaving marking, printing, and application for other parts of Guile. * libguile/debug.c (scm_procedure_source): * libguile/eval.c (scm_trampoline_0, scm_trampoline_1) (scm_trampoline_2): Add cases for tc7_program. * libguile/eval.i.c (CEVAL, SCM_APPLY): * libguile/evalext.c (scm_self_evaluating_p): * libguile/gc-card.c (scm_i_sweep_card, scm_i_tag_name): * libguile/gc-mark.c (1): * libguile/print.c (iprin1): * libguile/procs.c (scm_procedure_p, scm_thunk_p) * libguile/vm-i-system.c (make-closure): Adapt to new procedure representation. * libguile/procprop.c (scm_i_procedure_arity): Do the right thing for programs. * test-suite/tests/procprop.test ("procedure-arity"): Arity test now succeeds. * libguile/goops.c (scm_class_of): Programs now belong to the class <procedure>, not a smob class. * libguile/vm.h (struct vm, struct vm_cont): * libguile/vm-engine.c (vm_engine): * libguile/frames.h (SCM_FRAME_BYTE_CAST, struct vm_frame): * libguile/frames.c (scm_c_make_vm_frame): Fix usages of scm_byte_t, changing them to scm_t_uint8.
Diffstat (limited to 'libguile/programs.c')
-rw-r--r--libguile/programs.c70
1 files changed, 15 insertions, 55 deletions
diff --git a/libguile/programs.c b/libguile/programs.c
index 5c43ac525..b2bf80674 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -31,8 +31,6 @@
#include "vm.h"
-scm_t_bits scm_tc16_program;
-
static SCM write_program = SCM_BOOL_F;
SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
@@ -50,49 +48,13 @@ SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
else if (free_variables != SCM_BOOL_F)
SCM_VALIDATE_VECTOR (3, free_variables);
- SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_variables);
+ return scm_double_cell (scm_tc7_program, (scm_t_bits)objcode,
+ (scm_t_bits)objtable, (scm_t_bits)free_variables);
}
#undef FUNC_NAME
-static SCM
-program_mark (SCM obj)
-{
- if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj)))
- scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj));
- if (scm_is_true (SCM_PROGRAM_FREE_VARIABLES (obj)))
- scm_gc_mark (SCM_PROGRAM_FREE_VARIABLES (obj));
- return SCM_PROGRAM_OBJCODE (obj);
-}
-
-static SCM
-program_apply (SCM program, SCM args)
-{
- return scm_vm_apply (scm_the_vm (), program, args);
-}
-
-static SCM
-program_apply_0 (SCM program)
-{
- return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
-}
-
-static SCM
-program_apply_1 (SCM program, SCM a)
-{
- return scm_c_vm_run (scm_the_vm (), program, &a, 1);
-}
-
-static SCM
-program_apply_2 (SCM program, SCM a, SCM b)
-{
- SCM args[2];
- args[0] = a;
- args[1] = b;
- return scm_c_vm_run (scm_the_vm (), program, args, 2);
-}
-
-static int
-program_print (SCM program, SCM port, scm_print_state *pstate)
+void
+scm_i_program_print (SCM program, SCM port, scm_print_state *pstate)
{
static int print_error = 0;
@@ -102,12 +64,17 @@ program_print (SCM program, SCM port, scm_print_state *pstate)
scm_from_locale_symbol ("write-program"));
if (SCM_FALSEP (write_program) || print_error)
- return scm_smob_print (program, port, pstate);
-
- print_error = 1;
- scm_call_2 (SCM_VARIABLE_REF (write_program), program, port);
- print_error = 0;
- return 1;
+ {
+ scm_puts ("#<program ", port);
+ scm_uintprint (SCM_CELL_WORD_1 (program), 16, port);
+ scm_putc ('>', port);
+ }
+ else
+ {
+ print_error = 1;
+ scm_call_2 (SCM_VARIABLE_REF (write_program), program, port);
+ print_error = 0;
+ }
}
@@ -319,13 +286,6 @@ SCM_DEFINE (scm_program_objcode, "program-objcode", 1, 0, 0,
void
scm_bootstrap_programs (void)
{
- scm_tc16_program = scm_make_smob_type ("program", 0);
- scm_set_smob_mark (scm_tc16_program, program_mark);
- scm_set_smob_apply (scm_tc16_program, program_apply, 0, 0, 1);
- scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_0 = program_apply_0;
- scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_1 = program_apply_1;
- scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_2 = program_apply_2;
- scm_set_smob_print (scm_tc16_program, program_print);
scm_c_register_extension ("libguile", "scm_init_programs",
(scm_t_extension_init_func)scm_init_programs, NULL);
}