[svn:mod_parrot] r644 - in mod_parrot/trunk: include languages/perl6/lib languages/perl6/lib/ModPerl6 lib lib/ModParrot/HLL src

Author: jhorwitz
Date: Mon Jun 15 17:02:37 2009
New Revision: 644

Modified:
   mod_parrot/trunk/include/mod_parrot.h
   mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm
   mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm
   mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir
   mod_parrot/trunk/lib/mod_parrot.pir
   mod_parrot/trunk/src/mod_parrot.c
   mod_parrot/trunk/src/module.c
   mod_parrot/trunk/src/parrot_util.c

Log:
fixes for HLL namespaces:
* refactor sub calling functions for metahandlers 
* new Perl 6 module: Apache::Module  
* move class registration to HLL modules (since this must be done first, it
  requires bundling LoadImmediate directives at the top or using separate
  interpreters for each HLL module)


Modified: mod_parrot/trunk/include/mod_parrot.h
==============================================================================
--- mod_parrot/trunk/include/mod_parrot.h	(original)
+++ mod_parrot/trunk/include/mod_parrot.h	Mon Jun 15 17:02:37 2009
@@ -108,6 +108,9 @@
     char *);
 char *modparrot_backtrace(Parrot_Interp);
 Parrot_PMC get_sub_pmc(Parrot_Interp , char *, char *);
+Parrot_PMC modparrot_get_meta_handler(Parrot_Interp , char *, char *);
+int modparrot_call_meta_handler_sub(Parrot_Interp, Parrot_PMC, int *,
+    Parrot_PMC);
 apr_array_header_t *mp_ctx_pool_init(apr_pool_t *, Parrot_Interp, int);
 void mp_ctx_pool_destroy(apr_array_header_t *);
 modparrot_context *reserve_ctx(apr_array_header_t *, int index);

Modified: mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm
==============================================================================
--- mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm	(original)
+++ mod_parrot/trunk/languages/perl6/lib/ModPerl6/Registry.pm	Mon Jun 15 17:02:37 2009
@@ -56,8 +56,8 @@
 
 sub handler($r)
 {
-    my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
-    my %dircfg = ModParrot::Apache::Module::get_config(
+    my %cfg = Apache::Module::get_config("modparrot_perl6_module");
+    my %dircfg = Apache::Module::get_config(
         "modparrot_perl6_module", $r.per_dir_config());
 
     my $script = $r.filename();

Modified: mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm
==============================================================================
--- mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm	(original)
+++ mod_parrot/trunk/languages/perl6/lib/mod_perl6.pm	Mon Jun 15 17:02:37 2009
@@ -19,6 +19,7 @@
 use v6;
 use ModParrot::Const;
 use Apache::Const;
+use Apache::Module;
 
 # for perl 6 functionality not yet supported by rakudo
 use ModPerl6::Fudge;
@@ -163,8 +164,8 @@
 sub header_parser_handler($ctx)
 {
     my $r = $ctx.request_rec();
-    my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
-    my %dircfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module",
+    my %cfg = Apache::Module::get_config("modparrot_perl6_module");
+    my %dircfg = Apache::Module::get_config("modparrot_perl6_module",
         $r.per_dir_config());
 
     # first phase that has a dir config, so register any cleanup handlers
@@ -190,8 +191,8 @@
         return $Apache::Const::DECLINED;
     }
 
-    my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
-    my %dircfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module",
+    my %cfg = Apache::Module::get_config("modparrot_perl6_module");
+    my %dircfg = Apache::Module::get_config("modparrot_perl6_module",
         $r.per_dir_config());
 
     my $handler = %dircfg<response_handler>;
@@ -216,7 +217,7 @@
     #my $s = $ctx.server_rec();
     my $s = undef;
 
-    my %cfg = ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg = Apache::Module::get_config("modparrot_perl6_module");
 
     # preload modules
     # NOTE: Perl6Module is a directory scope directive
@@ -247,49 +248,49 @@
 
 sub cmd_perl6openlogshandler($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     %cfg<open_logs_handler> = @args[0];
 }
 
 sub cmd_perl6postconfighandler($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     %cfg<post_config_handler> = @args[0];
 }
 
 sub cmd_perl6childinithandler($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     %cfg<child_init_handler> = @args[0];
 }
 
 sub cmd_perl6preconnectionhandler($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     %cfg<pre_connection_handler> = @args[0];
 }
 
 sub cmd_perl6processconnectionhandler($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     %cfg<process_connection_handler> = @args[0];
 }
 
 sub cmd_perl6postreadrequesthandler($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     %cfg<post_read_request_handler> = @args[0];
 }
 
 sub cmd_perl6maptostoragehandler($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     %cfg<map_to_storage_handler> = @args[0];
 }
 
 sub cmd_perl6transhandler($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     %cfg<trans_handler> = @args[0];
 }
 
@@ -340,7 +341,7 @@
 
 sub cmd_perl6module($parms, %mconfig, @args)
 {
-    my %cfg := ModParrot::Apache::Module::get_config("modparrot_perl6_module");
+    my %cfg := Apache::Module::get_config("modparrot_perl6_module");
     push(%cfg<preloaded_modules>, @args[0]);
 }
 
@@ -416,7 +417,7 @@
     $ModParrot::Const::MP_HOOK_RESPONSE
 );
 
-ModParrot::Apache::Module::add(
+Apache::Module::add(
     'modparrot_perl6_module',
     'perl6',
     @cmds,

Modified: mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir
==============================================================================
--- mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir	(original)
+++ mod_parrot/trunk/lib/ModParrot/HLL/perl6.pir	Mon Jun 15 17:02:37 2009
@@ -15,6 +15,24 @@
 # limitations under the License.
 
 .sub __onload :anon :load
+    $P0 = get_hll_global 'P6metaclass'
+    $P1 = get_class ['ModParrot'; 'Apache'; 'RequestRec']
+    $P0.'register'($P1, 'name' => 'Apache;RequestRec', 'perl6' :named('hll'))
+    $P1 = get_class ['ModParrot'; 'Apache'; 'ServerRec']
+    $P0.'register'($P1, 'name' => 'Apache;ServerRec', 'perl6' :named('hll'))
+    $P1 = get_class ['ModParrot'; 'Apache'; 'CmdParms']
+    $P0.'register'($P1, 'name' => 'Apache;CmdParms', 'perl6' :named('hll'))
+    $P1 = get_class ['ModParrot';'APR'; 'Pool']
+    $P0.'register'($P1, 'name' => 'APR;Pool', 'perl6' :named('hll'))
+    $P1 = get_class ['ModParrot';'APR'; 'Table']
+    $P0.'register'($P1, 'name' => 'APR;Table', 'perl6' :named('hll'))
+    $P1 = get_class ['ModParrot'; 'Interpreter']
+    $P0.'register'($P1, 'perl6' :named('hll'))
+    $P1 = get_class ['ModParrot'; 'Context']
+    $P0.'register'($P1, 'perl6' :named('hll'))
+    $P1 = get_class ['ModParrotHandle']
+    $P0.'register'($P1, 'perl6' :named('hll'))
+
     load_bytecode 'languages/rakudo/perl6.pbc'
 
     # load mod_perl6.pm, which may be precompiled

Modified: mod_parrot/trunk/lib/mod_parrot.pir
==============================================================================
--- mod_parrot/trunk/lib/mod_parrot.pir	(original)
+++ mod_parrot/trunk/lib/mod_parrot.pir	Mon Jun 15 17:02:37 2009
@@ -157,33 +157,6 @@
     load_bytecode 'ModParrot/APR/Pool.pbc'
     load_bytecode 'ModParrot/APR/Table.pbc'
 
-    # some languages make use of the Perl6 metamodel, so we register several
-    # mod_parrot classes as Perl6 meta classes so languages can access them
-    # natively.  use 'name' to register the class under a different name,
-    # letting mod_parrot provide scaffolding for functionality not yet
-    # available in the HLL layer.
-
-    # XXX this MUST be done before the mod_parrot classes are instantiated,
-    # so it can't be done in the HLL modules.  this needs to be fixed.
-
-    $P0 = get_hll_global 'P6metaclass'
-    $P1 = get_class ['ModParrot'; 'Apache'; 'RequestRec']
-    $P0.'register'($P1, 'name' => 'Apache;RequestRec')
-    $P1 = get_class ['ModParrot'; 'Apache'; 'ServerRec']
-    $P0.'register'($P1, 'name' => 'Apache;ServerRec')
-    $P1 = get_class ['ModParrot'; 'Apache'; 'CmdParms']
-    $P0.'register'($P1, 'name' => 'Apache;CmdParms')
-    $P1 = get_class ['ModParrot';'APR'; 'Pool']
-    $P0.'register'($P1, 'name' => 'APR;Pool')
-    $P1 = get_class ['ModParrot';'APR'; 'Table']
-    $P0.'register'($P1, 'name' => 'APR;Table')
-    $P1 = get_class ['ModParrot'; 'Interpreter']
-    $P0.'register'($P1)
-    $P1 = get_class ['ModParrot'; 'Context']
-    $P0.'register'($P1)
-    $P1 = get_class ['ModParrotHandle']
-    $P0.'register'($P1)
-
     # global to indicate that we're actually running
     $P0 = new 'Integer'
     $P0 = 1

Modified: mod_parrot/trunk/src/mod_parrot.c
==============================================================================
--- mod_parrot/trunk/src/mod_parrot.c	(original)
+++ mod_parrot/trunk/src/mod_parrot.c	Mon Jun 15 17:02:37 2009
@@ -348,6 +348,7 @@
     Parrot_PMC ctx_class;
     Parrot_PMC ctx_pmc;
     Parrot_PMC namespace;
+    Parrot_PMC sub;
     Parrot_Int typenum;
     int res;
 
@@ -364,7 +365,8 @@
     Parrot_register_pmc(interp, ctx_pmc);
 
     if (!hll) hll = MODPARROT_DEFAULT_HLL;
-    res = modparrot_call_sub_IP(interp, hll, hook, ret, ctx_pmc);
+    sub = modparrot_get_meta_handler(interp, hll, hook);
+    res = modparrot_call_meta_handler_sub(interp, sub, ret, ctx_pmc);
     Parrot_unregister_pmc(interp, ctx_pmc);
     return res ? 1 : 0;
 }

Modified: mod_parrot/trunk/src/module.c
==============================================================================
--- mod_parrot/trunk/src/module.c	(original)
+++ mod_parrot/trunk/src/module.c	Mon Jun 15 17:02:37 2009
@@ -582,22 +582,22 @@
     }
     modp->dynamic_load_handle = minfo;
 
-    if (sub = get_sub_pmc(interp, namespace, "server_create")) {
+    if (sub = modparrot_get_meta_handler(interp, namespace, "server_create")) {
         MP_TRACE_m(s, "registering server_create for module '%s'", name);
         modp->create_server_config = modparrot_module_srv_create;
         minfo->server_create_sub = sub;
     }
-    if (sub = get_sub_pmc(interp, namespace, "server_merge")) {
+    if (sub = modparrot_get_meta_handler(interp, namespace, "server_merge")) {
         MP_TRACE_m(s, "registering server_merge for module '%s'", name);
         modp->merge_server_config = modparrot_module_srv_merge;
         minfo->server_merge_sub = sub;
     }
-    if (sub = get_sub_pmc(interp, namespace, "dir_create")) {
+    if (sub = modparrot_get_meta_handler(interp, namespace, "dir_create")) {
         MP_TRACE_m(s, "registering dir_create for module '%s'", name);
         modp->create_dir_config = modparrot_module_dir_create;
         minfo->dir_create_sub = sub;
     }
-    if (sub = get_sub_pmc(interp, namespace, "dir_merge")) {
+    if (sub = modparrot_get_meta_handler(interp, namespace, "dir_merge")) {
         MP_TRACE_m(s, "registering dir_merge for module '%s'", name);
         modp->merge_dir_config = modparrot_module_dir_merge;
         minfo->dir_merge_sub = sub;

Modified: mod_parrot/trunk/src/parrot_util.c
==============================================================================
--- mod_parrot/trunk/src/parrot_util.c	(original)
+++ mod_parrot/trunk/src/parrot_util.c	Mon Jun 15 17:02:37 2009
@@ -130,6 +130,48 @@
     return(1);
 }
 
+Parrot_PMC modparrot_get_meta_handler(Parrot_Interp interp, char *hll,
+    char *name)
+{
+    Parrot_PMC sub;
+    Parrot_PMC namespace;
+    Parrot_PMC hllns;
+    Parrot_PMC ourns;
+    int typenum, hllid;
+
+    typenum = Parrot_PMC_typenum(interp, "ResizablePMCArray");
+    ourns = (Parrot_PMC)Parrot_PMC_new(interp, typenum);
+    Parrot_register_pmc(interp, ourns);
+    Parrot_PMC_set_intval(interp, ourns, 3);
+    Parrot_PMC_set_cstring_intkey(interp, ourns, 0, "ModParrot");
+    Parrot_PMC_set_cstring_intkey(interp, ourns, 1, "HLL");
+    Parrot_PMC_set_cstring_intkey(interp, ourns, 2, hll);
+
+    /* if PIR, use default namespace, else look in HLL namespace */
+    if (!strcmp(hll, "PIR")) {
+        namespace = ourns;
+        sub = Parrot_find_global_k(interp, namespace, MAKE_PARROT_STRING(name));
+    }
+    else {
+        /* XXX cache these during module creation */
+        hllid = Parrot_get_HLL_id(interp, MAKE_PARROT_STRING(hll));
+        hllns = Parrot_get_HLL_namespace(interp, hllid);
+        namespace = Parrot_get_namespace_keyed(interp, hllns, ourns);
+        sub = Parrot_find_global_n(interp, namespace, MAKE_PARROT_STRING(name));
+    }
+
+    Parrot_unregister_pmc(interp, namespace);
+
+    return(sub);
+}
+
+int modparrot_call_meta_handler_sub(Parrot_Interp interp, Parrot_PMC sub,
+    int *ret, Parrot_PMC ctx_pmc)
+{
+    *ret = Parrot_call_sub_ret_int(interp, sub, "IP", ctx_pmc);
+    return(1);
+}
+
 int modparrot_call_sub_Iv(Parrot_Interp interp, char *namespace, char *name,
     int *ret)
 {