/[guile]/guile/guile-core/libguile/eval.c
ViewVC logotype

Diff of /guile/guile-core/libguile/eval.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.337 by dirk, Sat Nov 1 10:21:15 2003 UTC revision 1.338 by dirk, Sun Nov 2 10:48:10 2003 UTC
# Line 4486  scm_i_call_closure_0 (SCM proc) Line 4486  scm_i_call_closure_0 (SCM proc)
4486  scm_t_trampoline_0  scm_t_trampoline_0
4487  scm_trampoline_0 (SCM proc)  scm_trampoline_0 (SCM proc)
4488  {  {
4489      scm_t_trampoline_0 trampoline;
4490    
4491    if (SCM_IMP (proc))    if (SCM_IMP (proc))
4492      return NULL;      return NULL;
4493    if (SCM_DEBUGGINGP)  
     return scm_call_0;  
4494    switch (SCM_TYP7 (proc))    switch (SCM_TYP7 (proc))
4495      {      {
4496      case scm_tc7_subr_0:      case scm_tc7_subr_0:
4497        return call_subr0_0;        trampoline = call_subr0_0;
4498          break;
4499      case scm_tc7_subr_1o:      case scm_tc7_subr_1o:
4500        return call_subr1o_0;        trampoline = call_subr1o_0;
4501          break;
4502      case scm_tc7_lsubr:      case scm_tc7_lsubr:
4503        return call_lsubr_0;        trampoline = call_lsubr_0;
4504          break;
4505      case scm_tcs_closures:      case scm_tcs_closures:
4506        {        {
4507          SCM formals = SCM_CLOSURE_FORMALS (proc);          SCM formals = SCM_CLOSURE_FORMALS (proc);
4508          if (SCM_NULLP (formals) || !SCM_CONSP (formals))          if (SCM_NULLP (formals) || !SCM_CONSP (formals))
4509            return scm_i_call_closure_0;            trampoline = scm_i_call_closure_0;
4510          else          else
4511            return NULL;            return NULL;
4512            break;
4513        }        }
4514      case scm_tcs_struct:      case scm_tcs_struct:
4515        if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)        if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
4516          return scm_call_generic_0;          trampoline = scm_call_generic_0;
4517        else if (SCM_I_OPERATORP (proc))        else if (SCM_I_OPERATORP (proc))
4518          return scm_call_0;          trampoline = scm_call_0;
4519        return NULL;        else
4520            return NULL;
4521          break;
4522      case scm_tc7_smob:      case scm_tc7_smob:
4523        if (SCM_SMOB_APPLICABLE_P (proc))        if (SCM_SMOB_APPLICABLE_P (proc))
4524          return SCM_SMOB_DESCRIPTOR (proc).apply_0;          trampoline = SCM_SMOB_DESCRIPTOR (proc).apply_0;
4525        else        else
4526          return NULL;          return NULL;
4527          break;
4528      case scm_tc7_asubr:      case scm_tc7_asubr:
4529      case scm_tc7_rpsubr:      case scm_tc7_rpsubr:
4530      case scm_tc7_cclo:      case scm_tc7_cclo:
4531      case scm_tc7_pws:      case scm_tc7_pws:
4532        return scm_call_0;        trampoline = scm_call_0;
4533          break;
4534      default:      default:
4535        return NULL; /* not applicable on one arg */        return NULL; /* not applicable on zero arguments */
4536      }      }
4537      /* We only reach this point if a valid trampoline was determined.  */
4538    
4539      /* If debugging is enabled, we want to see all calls to proc on the stack.
4540       * Thus, we replace the trampoline shortcut with scm_call_0.  */
4541      if (SCM_DEBUGGINGP)
4542        return scm_call_0;
4543      else
4544        return trampoline;
4545  }  }
4546    
4547  static SCM  static SCM
# Line 4589  call_closure_1 (SCM proc, SCM arg1) Line 4606  call_closure_1 (SCM proc, SCM arg1)
4606  scm_t_trampoline_1  scm_t_trampoline_1
4607  scm_trampoline_1 (SCM proc)  scm_trampoline_1 (SCM proc)
4608  {  {
4609      scm_t_trampoline_1 trampoline;
4610    
4611    if (SCM_IMP (proc))    if (SCM_IMP (proc))
4612      return NULL;      return NULL;
4613    if (SCM_DEBUGGINGP)  
     return scm_call_1;  
4614    switch (SCM_TYP7 (proc))    switch (SCM_TYP7 (proc))
4615      {      {
4616      case scm_tc7_subr_1:      case scm_tc7_subr_1:
4617      case scm_tc7_subr_1o:      case scm_tc7_subr_1o:
4618        return call_subr1_1;        trampoline = call_subr1_1;
4619          break;
4620      case scm_tc7_subr_2o:      case scm_tc7_subr_2o:
4621        return call_subr2o_1;        trampoline = call_subr2o_1;
4622          break;
4623      case scm_tc7_lsubr:      case scm_tc7_lsubr:
4624        return call_lsubr_1;        trampoline = call_lsubr_1;
4625          break;
4626      case scm_tc7_dsubr:      case scm_tc7_dsubr:
4627        return call_dsubr_1;        trampoline = call_dsubr_1;
4628          break;
4629      case scm_tc7_cxr:      case scm_tc7_cxr:
4630        return call_cxr_1;        trampoline = call_cxr_1;
4631          break;
4632      case scm_tcs_closures:      case scm_tcs_closures:
4633        {        {
4634          SCM formals = SCM_CLOSURE_FORMALS (proc);          SCM formals = SCM_CLOSURE_FORMALS (proc);
4635          if (!SCM_NULLP (formals)          if (!SCM_NULLP (formals)
4636              && (!SCM_CONSP (formals) || !SCM_CONSP (SCM_CDR (formals))))              && (!SCM_CONSP (formals) || !SCM_CONSP (SCM_CDR (formals))))
4637            return call_closure_1;            trampoline = call_closure_1;
4638          else          else
4639            return NULL;            return NULL;
4640            break;
4641        }        }
4642      case scm_tcs_struct:      case scm_tcs_struct:
4643        if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)        if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
4644          return scm_call_generic_1;          trampoline = scm_call_generic_1;
4645        else if (SCM_I_OPERATORP (proc))        else if (SCM_I_OPERATORP (proc))
4646          return scm_call_1;          trampoline = scm_call_1;
4647        return NULL;        else
4648            return NULL;
4649          break;
4650      case scm_tc7_smob:      case scm_tc7_smob:
4651        if (SCM_SMOB_APPLICABLE_P (proc))        if (SCM_SMOB_APPLICABLE_P (proc))
4652          return SCM_SMOB_DESCRIPTOR (proc).apply_1;          trampoline = SCM_SMOB_DESCRIPTOR (proc).apply_1;
4653        else        else
4654          return NULL;          return NULL;
4655          break;
4656      case scm_tc7_asubr:      case scm_tc7_asubr:
4657      case scm_tc7_rpsubr:      case scm_tc7_rpsubr:
4658      case scm_tc7_cclo:      case scm_tc7_cclo:
4659      case scm_tc7_pws:      case scm_tc7_pws:
4660        return scm_call_1;        trampoline = scm_call_1;
4661          break;
4662      default:      default:
4663        return NULL; /* not applicable on one arg */        return NULL; /* not applicable on one arg */
4664      }      }
4665      /* We only reach this point if a valid trampoline was determined.  */
4666    
4667      /* If debugging is enabled, we want to see all calls to proc on the stack.
4668       * Thus, we replace the trampoline shortcut with scm_call_1.  */
4669      if (SCM_DEBUGGINGP)
4670        return scm_call_1;
4671      else
4672        return trampoline;
4673  }  }
4674    
4675  static SCM  static SCM
# Line 4667  call_closure_2 (SCM proc, SCM arg1, SCM Line 4703  call_closure_2 (SCM proc, SCM arg1, SCM
4703  scm_t_trampoline_2  scm_t_trampoline_2
4704  scm_trampoline_2 (SCM proc)  scm_trampoline_2 (SCM proc)
4705  {  {
4706      scm_t_trampoline_2 trampoline;
4707    
4708    if (SCM_IMP (proc))    if (SCM_IMP (proc))
4709      return NULL;      return NULL;
4710    if (SCM_DEBUGGINGP)  
     return scm_call_2;  
4711    switch (SCM_TYP7 (proc))    switch (SCM_TYP7 (proc))
4712      {      {
4713      case scm_tc7_subr_2:      case scm_tc7_subr_2:
4714      case scm_tc7_subr_2o:      case scm_tc7_subr_2o:
4715      case scm_tc7_rpsubr:      case scm_tc7_rpsubr:
4716      case scm_tc7_asubr:      case scm_tc7_asubr:
4717        return call_subr2_2;        trampoline = call_subr2_2;
4718          break;
4719      case scm_tc7_lsubr_2:      case scm_tc7_lsubr_2:
4720        return call_lsubr2_2;        trampoline = call_lsubr2_2;
4721          break;
4722      case scm_tc7_lsubr:      case scm_tc7_lsubr:
4723        return call_lsubr_2;        trampoline = call_lsubr_2;
4724          break;
4725      case scm_tcs_closures:      case scm_tcs_closures:
4726        {        {
4727          SCM formals = SCM_CLOSURE_FORMALS (proc);          SCM formals = SCM_CLOSURE_FORMALS (proc);
# Line 4690  scm_trampoline_2 (SCM proc) Line 4730  scm_trampoline_2 (SCM proc)
4730                  || (!SCM_NULLP (SCM_CDR (formals))                  || (!SCM_NULLP (SCM_CDR (formals))
4731                      && (!SCM_CONSP (SCM_CDR (formals))                      && (!SCM_CONSP (SCM_CDR (formals))
4732                          || !SCM_CONSP (SCM_CDDR (formals))))))                          || !SCM_CONSP (SCM_CDDR (formals))))))
4733            return call_closure_2;            trampoline = call_closure_2;
4734          else          else
4735            return NULL;            return NULL;
4736            break;
4737        }        }
4738      case scm_tcs_struct:      case scm_tcs_struct:
4739        if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)        if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
4740          return scm_call_generic_2;          trampoline = scm_call_generic_2;
4741        else if (SCM_I_OPERATORP (proc))        else if (SCM_I_OPERATORP (proc))
4742          return scm_call_2;          trampoline = scm_call_2;
4743        return NULL;        else
4744            return NULL;
4745          break;
4746      case scm_tc7_smob:      case scm_tc7_smob:
4747        if (SCM_SMOB_APPLICABLE_P (proc))        if (SCM_SMOB_APPLICABLE_P (proc))
4748          return SCM_SMOB_DESCRIPTOR (proc).apply_2;          trampoline = SCM_SMOB_DESCRIPTOR (proc).apply_2;
4749        else        else
4750          return NULL;          return NULL;
4751          break;
4752      case scm_tc7_cclo:      case scm_tc7_cclo:
4753      case scm_tc7_pws:      case scm_tc7_pws:
4754        return scm_call_2;        trampoline = scm_call_2;
4755          break;
4756      default:      default:
4757        return NULL; /* not applicable on two args */        return NULL; /* not applicable on two args */
4758      }      }
4759      /* We only reach this point if a valid trampoline was determined.  */
4760    
4761      /* If debugging is enabled, we want to see all calls to proc on the stack.
4762       * Thus, we replace the trampoline shortcut with scm_call_2.  */
4763      if (SCM_DEBUGGINGP)
4764        return scm_call_2;
4765      else
4766        return trampoline;
4767  }  }
4768    
4769  /* Typechecking for multi-argument MAP and FOR-EACH.  /* Typechecking for multi-argument MAP and FOR-EACH.

Legend:
Removed from v.1.337  
changed lines
  Added in v.1.338

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26