Changeset 3933

Timestamp:

05/27/05 01:06:48 (3 years ago)

Author:

autrijus

svk:copy_cache_prev:

5515

Message:

* still segfaulting... WIP

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 "" nullSV
+    interp <- initPerl5 "" Nothing
     evalPerl5 code nullSV 0
     freePerl5 interp

src/Pugs/Embed/Perl5.hs

@@ -11 +11 @@
 constFail = const $ fail "perl5 not embedded"
 
-initPerl5 :: String -> PerlSV -> IO PerlInterpreter
+initPerl5 :: String -> Maybe a -> IO PerlInterpreter
 initPerl5 _ _ = return ()
 
@@ -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_set_svref"
+    perl5_set_svref :: CString -> PugsVal -> IO ()
 foreign import ccall "perl5.h perl5_call"
     perl5_call :: CString -> CInt -> Ptr PerlSV -> CInt -> IO PerlSV
@@ -114 +114 @@
     pugs_MkValRef :: PugsVal -> IO PerlSV
 
-initPerl5 :: String -> PerlSV -> IO PerlInterpreter
+initPerl5 :: String -> Maybe a -> 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
+            interp <- perl5_init 3 argv
+            case env of
+                Just val -> withCString "pugs::env" $ \name -> do
+                    ptr <- fmap castStablePtrToPtr $ newStablePtr val
+                    perl5_set_svref name ptr
+                Nothing -> return ()
+            return interp
 
 svToVStr :: PerlSV -> IO String

src/Pugs/Run.hs

@@ -34 +34 @@
 runEvalMain :: Env -> Eval Val -> IO Val
 runEvalMain env eval = withSocketsDo $ do
-    my_perl <- initPerl5 "" =<< mkValRef (VControl $ ControlEnv env)
+    my_perl <- initPerl5 "" (Just . VControl $ ControlEnv env)
     val     <- runEvalIO env eval
     freePerl5 my_perl

src/perl5/perl5.c

@@ -218 +218 @@
 }
 
-void * perl5_set_sv (const char *name, SV *sv)
-{
-    sv_setsv(get_sv(name, 1), sv);
+void * perl5_set_svref (const char *name, void *val)
+{
+    SV *container = get_sv(name, TRUE);
+
+    SV *sv = newSV(0);
+    sv_setref_pv(sv, "pugs", val);
+
+    sv_setsv(container, sv);
 }
 

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 );
+void * perl5_set_svref ( const char *name, void *sv );