Changeset 3943

Show
Ignore:
Timestamp:
05/27/05 03:15:20 (4 years ago)
Author:
autrijus
svk:copy_cache_prev:
5515
Message:

* switch to use PL_modglobal.

Location:
src
Files:
6 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Embed/Perl5.hs

    r3942 r3943  
    101101    perl5_set_svref :: CString -> PugsVal -> IO () 
    102102foreign import ccall "perl5.h perl5_apply" 
    103     perl5_apply :: PerlSV -> PerlSV -> Ptr PerlSV -> PerlSV -> CInt -> IO PerlSV 
     103    perl5_apply :: PerlSV -> PerlSV -> Ptr PerlSV -> PugsVal -> CInt -> IO PerlSV 
    104104foreign import ccall "perl5.h perl5_can" 
    105105    perl5_can :: PerlSV -> CString -> IO Bool 
    106106foreign import ccall "perl.h perl5_eval" 
    107     perl5_eval :: CString -> PerlSV -> CInt -> IO PerlSV 
     107    perl5_eval :: CString -> PugsVal -> CInt -> IO PerlSV 
    108108foreign import ccall "perl5.h perl5_init" 
    109109    perl5_init :: CInt -> Ptr CString -> IO PerlInterpreter 
     110 
     111foreign import ccall "pugsembed.h pugs_getenv" 
     112    pugs_getenv :: IO PugsVal 
     113foreign import ccall "pugsembed.h pugs_setenv" 
     114    pugs_setenv :: PugsVal -> IO () 
    110115 
    111116foreign import ccall "pugsembed.h pugs_SvToVal" 
    … …  
    120125            interp <- perl5_init 3 argv 
    121126            case env of 
    122                 Just val -> withCString "pugs::env" $ \name -> do 
     127                Just val -> do 
    123128                    ptr <- fmap castStablePtrToPtr $ newStablePtr val 
    124                     perl5_set_svref name ptr 
     129                    pugs_setenv ptr 
    125130                Nothing -> return () 
    126131            return interp 
    … …  
    157162vnumToSV int = perl5_newSVnv (realToFrac int) 
    158163 
    159 callPerl5 :: PerlSV -> PerlSV -> [PerlSV] -> PerlSV -> CInt -> IO PerlSV 
     164callPerl5 :: PerlSV -> PerlSV -> [PerlSV] -> PugsVal -> CInt -> IO PerlSV 
    160165callPerl5 sub inv args env cxt = do 
    161166    withArray0 nullPtr args $ \argv -> do 
    … …  
    165170canPerl5 sv meth = withCString meth $ \cstr -> perl5_can sv cstr 
    166171 
    167 evalPerl5 :: String -> PerlSV -> CInt -> IO PerlSV 
     172evalPerl5 :: String -> PugsVal -> CInt -> IO PerlSV 
    168173evalPerl5 str env cxt = withCString str $ \cstr -> perl5_eval cstr env cxt 
    169174 

  • src/Pugs/Run/Perl5.hs

    r3934 r3943  
    4646askPerl5Env :: IO Env 
    4747askPerl5Env = do 
    48     sv  <- withCString "pugs::env" perl5_get_sv  
    49     val <- svToVal sv 
     48    val <- deVal =<< pugs_getenv 
    5049    case val of 
    5150        VControl (ControlEnv env)   -> return env 
    52         _                           -> fail "cannot fetch $pugs::env" 
     51        _                           -> do 
     52            print val 
     53            fail "cannot fetch $pugs::env" 
    5354 
    5455pugs_eval :: CString -> IO PugsVal 
    … …  
    6162pugs_apply :: PugsVal -> PugsVal -> Ptr PugsVal -> IO PugsVal 
    6263pugs_apply subPtr invPtr argsPtr = do 
     64    print "DEREF #0" 
    6365    env     <- askPerl5Env 
    64     -- print "DEREF #1" 
     66    print "DEREF #1" 
    6567    sub     <- deVal subPtr 
    66     -- print "DEREF #2" 
     68    print "DEREF #2" 
    6769    inv     <- deValMaybe invPtr 
    68     -- print "DEREF #3" 
     70    print "DEREF #3" 
    6971    args    <- mapM deVal =<< peekArray0 nullPtr argsPtr 
    7072    let subExp = case sub of 

  • src/perl5/perl5.c

    r3941 r3943  
    199199 
    200200SV * 
    201 perl5_apply(SV *sub, SV *inv, SV** args, SV *env, int cxt) 
     201perl5_apply(SV *sub, SV *inv, SV** args, void *env, int cxt) 
    202202{ 
    203203    SV **arg; 
    … …  
    210210    SAVETMPS; 
    211211 
    212     if (env != NULL) { 
    213         sv = get_sv("pugs::env", 1); 
    214         save_item(sv); 
    215         sv_setsv(sv, env); 
    216     } 
     212    pugs_setenv(env); 
    217213 
    218214    PUSHMARK(SP); 
    … …  
    251247} 
    252248 
    253 void * perl5_set_svref (const char *name, void *val) 
     249void perl5_set_svref (const char *name, void *val) 
    254250{ 
    255251    /* fprintf(stderr, "setsvref: name: %s, mkvalref: %p\n", name, val); */ 
    … …  
    264260 
    265261SV * 
    266 perl5_eval(char *code, SV *env, int cxt) 
     262perl5_eval(char *code, void *env, int cxt) 
    267263{ 
    268264    dSP; 
    … …  
    272268    SAVETMPS; 
    273269 
    274     if (env != NULL) { 
    275         sv = get_sv("pugs::env", 1); 
    276         save_item(sv); 
    277         sv_setsv(sv, env); 
    278     } 
     270    pugs_setenv(env); 
    279271 
    280272    sv = newSVpv(code, 0); 

  • src/perl5/perl5.h

    r3938 r3943  
    1111SV * perl5_newSViv ( int iv ); 
    1212SV * perl5_newSVnv ( double iv ); 
    13 SV * perl5_apply(SV *sub, SV *inv, SV** args, SV *env, int cxt); 
     13SV * perl5_apply(SV *sub, SV *inv, SV** args, void *env, int cxt); 
    1414bool perl5_can(SV *inv, char *subname); 
    15 SV * perl5_eval(char *code, SV *env, int cxt); 
     15SV * perl5_eval(char *code, void *env, int cxt); 
    1616SV * perl5_get_sv ( const char *name ); 
    17 void * perl5_set_svref ( const char *name, void *sv ); 
     17void perl5_set_svref ( const char *name, void *sv ); 

  • src/perl5/pugsembed.c

    r3941 r3943  
    66{ 
    77    if (!sv_isa(sv, "pugs")) { 
     8        fprintf(stderr, "bad cast\n"); 
     9        sv_dump(sv); 
    810        return (pugs_MkSvRef(sv)); 
    911    } 
     12    fprintf(stderr, "good cast\n"); 
    1013    IV tmp = SvIV((SV*)SvRV(sv)); 
    1114    return ((Val *)tmp); 
    … …  
    3033    return (sv); 
    3134} 
     35 
     36Val *pugs_getenv () 
     37{ 
     38    SV** rv = hv_fetch(PL_modglobal, "PugsEnv", 7, 0); 
     39    if (*rv == NULL) 
     40        Perl_croak(aTHX_ "hate software so much"); 
     41    IV tmp = SvIV((SV*)SvRV(*rv)); 
     42    return ((Val *)tmp); 
     43} 
     44 
     45void pugs_setenv ( Val *env ) 
     46{ 
     47    if (env == NULL) { return; } 
     48 
     49    SV *sv = newSV(0); 
     50    sv_setref_pv(sv, "pugs", env); 
     51    hv_store(PL_modglobal, "PugsEnv", 7, sv, 0); 
     52} 

  • src/perl5/pugsembed.h

    r3929 r3943  
    2323SV  *pugs_MkValRef ( Val *val ); 
    2424 
     25Val *pugs_getenv (); 
     26void pugs_setenv ( Val *env ); 
     27