Changeset 3930

Timestamp:

05/27/05 00:43:48 (3 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* initialise $pugs::env with tabulaRasa.

Location:

src

Files:

• Pugs/Embed.hs (modified) (1 diff)
• Pugs/Embed/Perl5.hs (modified) (3 diffs)
• Pugs/Run.hs (modified) (1 diff)
• perl5/perl5.c (modified) (1 diff)
• perl5/perl5.h (modified) (1 diff)

src/Pugs/Embed.hs

@@ -29 +29 @@
     return () -}
 evalEmbedded "Perl5" code = do
-    interp <- initPerl5 ""
+    interp <- initPerl5 "" nullSV
     evalPerl5 code nullSV 0
     freePerl5 interp

src/Pugs/Embed/Perl5.hs

@@ -11 +11 @@
 constFail = const $ fail "perl5 not embedded"
 
-initPerl5 :: String -> IO PerlInterpreter
-initPerl5 _ = return ()
+initPerl5 :: String -> PerlSV -> IO PerlInterpreter
+initPerl5 _ _ = return ()
 
 freePerl5 :: PerlInterpreter -> IO ()
@@ -98 +98 @@
 foreign import ccall "perl5.h perl5_get_sv"
     perl5_get_sv :: CString -> IO PerlSV
+foreign import ccall "perl5.h perl5_set_sv"
+    perl5_set_sv :: CString -> PerlSV -> IO PerlSV
 foreign import ccall "perl5.h perl5_call"
     perl5_call :: CString -> CInt -> Ptr PerlSV -> CInt -> IO PerlSV
@@ -112 +114 @@
     pugs_MkValRef :: PugsVal -> IO PerlSV
 
-initPerl5 :: String -> IO PerlInterpreter
-initPerl5 str = do
+initPerl5 :: String -> PerlSV -> IO PerlInterpreter
+initPerl5 str env = do
     withCString "-e" $ \prog -> withCString str $ \cstr -> do
         withArray [prog, prog, cstr] $ \argv -> do
             perl5_init 3 argv
+            withCString "pugs::env" $ \name -> do
+                perl5_set_sv name env
 
 svToVStr :: PerlSV -> IO String

src/Pugs/Run.hs

@@ -34 +34 @@
 runEvalMain :: Env -> Eval Val -> IO Val
 runEvalMain env eval = withSocketsDo $ do
-    my_perl <- initPerl5 ""
+    my_perl <- initPerl5 "" env
     val     <- runEvalIO env eval
     freePerl5 my_perl

src/perl5/perl5.c

@@ -201 +201 @@
 }
 
+void * perl5_set_sv (const char *name, SV *sv)
+{
+    sv_setsv(get_sv(name, 1), sv);
+}
+
 SV *
 perl5_eval(char *code, SV *env, int cxt)

src/perl5/perl5.h

@@ -15 +15 @@
 SV * perl5_eval(char *code, SV *env, int cxt);
 SV * perl5_get_sv ( const char *name );
+void * perl5_set_sv ( const char *name, SV *sv );