1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00

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.
This commit is contained in:
Andy Wingo 2009-08-20 14:27:38 +02:00
parent cdde57b2f1
commit 2fb924f64f
19 changed files with 91 additions and 81 deletions

View file

@ -1132,6 +1132,8 @@ dispatch:
RETURN (SCM_BOOL_T);
case scm_tc7_asubr:
RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED));
case scm_tc7_program:
RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0));
case scm_tc7_smob:
if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun;
@ -1243,6 +1245,8 @@ dispatch:
RETURN (scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)));
case scm_tc7_rpsubr:
RETURN (SCM_BOOL_T);
case scm_tc7_program:
RETURN (scm_c_vm_run (scm_the_vm (), proc, &arg1, 1));
case scm_tc7_asubr:
RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED));
case scm_tc7_lsubr:
@ -1353,6 +1357,12 @@ dispatch:
case scm_tc7_rpsubr:
case scm_tc7_asubr:
RETURN (SCM_SUBRF (proc) (arg1, arg2));
case scm_tc7_program:
{ SCM args[2];
args[0] = arg1;
args[1] = arg2;
RETURN (scm_c_vm_run (scm_the_vm (), proc, args, 2));
}
case scm_tc7_smob:
if (!SCM_SMOB_APPLICABLE_P (proc))
goto badfun;
@ -1492,6 +1502,8 @@ dispatch:
SCM_CDDR (debug.info->a.args)));
case scm_tc7_gsubr:
RETURN (scm_i_gsubr_apply_list (proc, debug.info->a.args));
case scm_tc7_program:
RETURN (scm_vm_apply (scm_the_vm (), proc, debug.info->a.args));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
debug.info->a.proc = proc;
@ -1563,6 +1575,11 @@ dispatch:
scm_cons2 (arg1, arg2,
scm_ceval_args (x, env,
proc))));
case scm_tc7_program:
RETURN (scm_vm_apply
(scm_the_vm (), proc,
scm_cons (arg1, scm_cons (arg2,
scm_ceval_args (x, env, proc)))));
case scm_tc7_pws:
proc = SCM_PROCEDURE (proc);
if (!SCM_CLOSUREP (proc))
@ -1798,6 +1815,11 @@ tail:
args = SCM_CDR (args);
}
RETURN (arg1);
case scm_tc7_program:
if (SCM_UNBNDP (arg1))
RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0));
else
RETURN (scm_vm_apply (scm_the_vm (), proc, scm_cons (arg1, args)));
case scm_tc7_rpsubr:
if (scm_is_null (args))
RETURN (SCM_BOOL_T);