@@ -136,9 +136,20 @@ typedef struct _jl_ast_context_t {
136
136
value_t ssavalue_sym ;
137
137
value_t slot_sym ;
138
138
jl_module_t * module ; // context module for `current-julia-module-counter`
139
- struct _jl_ast_context_t * next ; // invasive list pointer for getting free contexts
139
+ arraylist_t pinned_objects ;
140
140
} jl_ast_context_t ;
141
141
142
+ // FIXME: Ugly hack to get a pointer to the pinned objects
143
+ arraylist_t * extract_pinned_objects_from_ast_ctx (void * ctx )
144
+ {
145
+ // This is used to extract pinned objects from the context
146
+ // for the purpose of pinning them in MMTk.
147
+ if (ctx == NULL )
148
+ return NULL ;
149
+ jl_ast_context_t * jl_ctx = (jl_ast_context_t * )ctx ;
150
+ return & jl_ctx -> pinned_objects ;
151
+ }
152
+
142
153
static jl_ast_context_t jl_ast_main_ctx ;
143
154
144
155
#ifdef __clang_gcanalyzer__
@@ -153,7 +164,7 @@ struct macroctx_stack {
153
164
};
154
165
155
166
static jl_value_t * scm_to_julia (fl_context_t * fl_ctx , value_t e , jl_module_t * mod );
156
- static value_t julia_to_scm (fl_context_t * fl_ctx , jl_value_t * v );
167
+ static value_t julia_to_scm (jl_ast_context_t * ctx , jl_value_t * v );
157
168
static jl_value_t * jl_expand_macros (jl_value_t * expr , jl_module_t * inmodule , struct macroctx_stack * macroctx , int onelevel , size_t world , int throw_load_error );
158
169
159
170
static jl_sym_t * scmsym_to_julia (fl_context_t * fl_ctx , value_t s )
@@ -279,27 +290,29 @@ static void jl_init_ast_ctx(jl_ast_context_t *ctx) JL_NOTSAFEPOINT
279
290
ctx -> slot_sym = symbol (fl_ctx , "slot" );
280
291
ctx -> module = NULL ;
281
292
set (symbol (fl_ctx , "*scopewarn-opt*" ), fixnum (jl_options .warn_scope ));
293
+ arraylist_new (& ctx -> pinned_objects , 0 );
282
294
}
283
295
284
296
// There should be no GC allocation while holding this lock
285
297
static uv_mutex_t flisp_lock ;
286
- static jl_ast_context_t * jl_ast_ctx_freed = NULL ;
298
+ int flisp_initialized = 0 ;
299
+ arraylist_t jl_ast_ctx_freed ;
300
+ arraylist_t jl_ast_ctx_used ;
287
301
288
302
static jl_ast_context_t * jl_ast_ctx_enter (jl_module_t * m ) JL_GLOBALLY_ROOTED JL_NOTSAFEPOINT
289
303
{
290
304
JL_SIGATOMIC_BEGIN ();
291
305
uv_mutex_lock (& flisp_lock );
292
- jl_ast_context_t * ctx = jl_ast_ctx_freed ;
293
- if (ctx != NULL ) {
294
- jl_ast_ctx_freed = ctx -> next ;
295
- ctx -> next = NULL ;
296
- }
306
+ jl_ast_context_t * ctx = (jl_ast_context_t * )arraylist_pop (& jl_ast_ctx_freed );
297
307
uv_mutex_unlock (& flisp_lock );
298
308
if (ctx == NULL ) {
299
309
// Construct a new one if we can't find any
300
310
ctx = (jl_ast_context_t * )calloc (1 , sizeof (jl_ast_context_t ));
301
311
jl_init_ast_ctx (ctx );
302
312
}
313
+ uv_mutex_lock (& flisp_lock );
314
+ arraylist_push (& jl_ast_ctx_used , ctx );
315
+ uv_mutex_unlock (& flisp_lock );
303
316
ctx -> module = m ;
304
317
return ctx ;
305
318
}
@@ -308,16 +321,20 @@ static void jl_ast_ctx_leave(jl_ast_context_t *ctx)
308
321
{
309
322
uv_mutex_lock (& flisp_lock );
310
323
ctx -> module = NULL ;
311
- ctx -> next = jl_ast_ctx_freed ;
312
- jl_ast_ctx_freed = ctx ;
324
+ ctx -> pinned_objects .len = 0 ; // clear pinned objects
325
+ arraylist_pop (& jl_ast_ctx_used );
326
+ arraylist_push (& jl_ast_ctx_freed , ctx );
313
327
uv_mutex_unlock (& flisp_lock );
314
328
JL_SIGATOMIC_END ();
315
329
}
316
330
317
331
void jl_init_flisp (void )
318
332
{
319
- if (jl_ast_ctx_freed )
333
+ if (flisp_initialized )
320
334
return ;
335
+ flisp_initialized = 1 ;
336
+ arraylist_new (& jl_ast_ctx_freed , 0 );
337
+ arraylist_new (& jl_ast_ctx_used , 0 );
321
338
uv_mutex_init (& flisp_lock );
322
339
jl_init_ast_ctx (& jl_ast_main_ctx );
323
340
// To match the one in jl_ast_ctx_leave
@@ -674,37 +691,40 @@ static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *m
674
691
jl_error ("malformed tree" );
675
692
}
676
693
677
- static value_t julia_to_scm_ (fl_context_t * fl_ctx , jl_value_t * v , int check_valid );
694
+ static value_t julia_to_scm_ (jl_ast_context_t * ctx , jl_value_t * v , int check_valid );
678
695
679
- static value_t julia_to_scm (fl_context_t * fl_ctx , jl_value_t * v )
696
+ static value_t julia_to_scm (jl_ast_context_t * ctx , jl_value_t * v )
680
697
{
681
698
value_t temp ;
682
699
// need try/catch to reset GC handle stack in case of error
700
+ fl_context_t * fl_ctx = & ctx -> fl ;
683
701
FL_TRY_EXTERN (fl_ctx ) {
684
- temp = julia_to_scm_ (fl_ctx , v , 1 );
702
+ temp = julia_to_scm_ (ctx , v , 1 );
685
703
}
686
704
FL_CATCH_EXTERN (fl_ctx ) {
687
705
temp = fl_ctx -> lasterror ;
688
706
}
689
707
return temp ;
690
708
}
691
709
692
- static void array_to_list (fl_context_t * fl_ctx , jl_array_t * a , value_t * pv , int check_valid )
710
+ static void array_to_list (jl_ast_context_t * ctx , jl_array_t * a , value_t * pv , int check_valid )
693
711
{
694
712
value_t temp ;
713
+ fl_context_t * fl_ctx = & ctx -> fl ;
695
714
for (long i = jl_array_nrows (a ) - 1 ; i >= 0 ; i -- ) {
696
715
* pv = fl_cons (fl_ctx , fl_ctx -> NIL , * pv );
697
- temp = julia_to_scm_ (fl_ctx , jl_array_ptr_ref (a , i ), check_valid );
716
+ temp = julia_to_scm_ (ctx , jl_array_ptr_ref (a , i ), check_valid );
698
717
// note: must be separate statement
699
718
car_ (* pv ) = temp ;
700
719
}
701
720
}
702
721
703
- static value_t julia_to_list2 (fl_context_t * fl_ctx , jl_value_t * a , jl_value_t * b , int check_valid )
722
+ static value_t julia_to_list2 (jl_ast_context_t * ctx , jl_value_t * a , jl_value_t * b , int check_valid )
704
723
{
705
- value_t sa = julia_to_scm_ (fl_ctx , a , check_valid );
724
+ fl_context_t * fl_ctx = & ctx -> fl ;
725
+ value_t sa = julia_to_scm_ (ctx , a , check_valid );
706
726
fl_gc_handle (fl_ctx , & sa );
707
- value_t sb = julia_to_scm_ (fl_ctx , b , check_valid );
727
+ value_t sb = julia_to_scm_ (ctx , b , check_valid );
708
728
value_t l = fl_list2 (fl_ctx , sa , sb );
709
729
fl_free_gc_handles (fl_ctx , 1 );
710
730
return l ;
@@ -778,12 +798,13 @@ static value_t julia_to_list2_noalloc(fl_context_t *fl_ctx, jl_value_t *a, jl_va
778
798
return l ;
779
799
}
780
800
781
- static value_t julia_to_scm_ (fl_context_t * fl_ctx , jl_value_t * v , int check_valid )
801
+ static value_t julia_to_scm_ (jl_ast_context_t * ctx , jl_value_t * v , int check_valid )
782
802
{
783
803
// The following code will take internal pointers to v's fields. We need to make sure
784
804
// that v will not be moved by GC.
785
- OBJ_PIN ( v );
805
+ arraylist_push ( & ctx -> pinned_objects , v );
786
806
value_t retval ;
807
+ fl_context_t * fl_ctx = & ctx -> fl ;
787
808
if (julia_to_scm_noalloc1 (fl_ctx , v , & retval ))
788
809
return retval ;
789
810
if (jl_is_expr (v )) {
@@ -792,12 +813,12 @@ static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v, int check_vali
792
813
fl_gc_handle (fl_ctx , & args );
793
814
if (jl_expr_nargs (ex ) > 520000 && ex -> head != jl_block_sym )
794
815
lerror (fl_ctx , symbol (fl_ctx , "error" ), "expression too large" );
795
- array_to_list (fl_ctx , ex -> args , & args , check_valid );
796
- value_t hd = julia_to_scm_ (fl_ctx , (jl_value_t * )ex -> head , check_valid );
816
+ array_to_list (ctx , ex -> args , & args , check_valid );
817
+ value_t hd = julia_to_scm_ (ctx , (jl_value_t * )ex -> head , check_valid );
797
818
if (ex -> head == jl_lambda_sym && jl_expr_nargs (ex )> 0 && jl_is_array (jl_exprarg (ex ,0 ))) {
798
819
value_t llist = fl_ctx -> NIL ;
799
820
fl_gc_handle (fl_ctx , & llist );
800
- array_to_list (fl_ctx , (jl_array_t * )jl_exprarg (ex ,0 ), & llist , check_valid );
821
+ array_to_list (ctx , (jl_array_t * )jl_exprarg (ex ,0 ), & llist , check_valid );
801
822
car_ (args ) = llist ;
802
823
fl_free_gc_handles (fl_ctx , 1 );
803
824
}
@@ -813,26 +834,26 @@ static value_t julia_to_scm_(fl_context_t *fl_ctx, jl_value_t *v, int check_vali
813
834
jl_value_t * line = jl_fieldref (v ,0 );
814
835
value_t args = julia_to_list2_noalloc (fl_ctx , line , file , check_valid );
815
836
fl_gc_handle (fl_ctx , & args );
816
- value_t hd = julia_to_scm_ (fl_ctx , (jl_value_t * )jl_line_sym , check_valid );
837
+ value_t hd = julia_to_scm_ (ctx , (jl_value_t * )jl_line_sym , check_valid );
817
838
value_t scmv = fl_cons (fl_ctx , hd , args );
818
839
fl_free_gc_handles (fl_ctx , 1 );
819
840
return scmv ;
820
841
}
821
842
if (jl_typetagis (v , jl_gotonode_type ))
822
843
return julia_to_list2_noalloc (fl_ctx , (jl_value_t * )jl_goto_sym , jl_fieldref (v ,0 ), check_valid );
823
844
if (jl_typetagis (v , jl_quotenode_type ))
824
- return julia_to_list2 (fl_ctx , (jl_value_t * )jl_inert_sym , jl_fieldref_noalloc (v ,0 ), 0 );
845
+ return julia_to_list2 (ctx , (jl_value_t * )jl_inert_sym , jl_fieldref_noalloc (v ,0 ), 0 );
825
846
if (jl_typetagis (v , jl_newvarnode_type ))
826
847
return julia_to_list2_noalloc (fl_ctx , (jl_value_t * )jl_newvar_sym , jl_fieldref (v ,0 ), check_valid );
827
848
if (jl_typetagis (v , jl_globalref_type )) {
828
849
jl_module_t * m = jl_globalref_mod (v );
829
850
jl_sym_t * sym = jl_globalref_name (v );
830
851
if (m == jl_core_module )
831
- return julia_to_list2 (fl_ctx , (jl_value_t * )jl_core_sym ,
852
+ return julia_to_list2 (ctx , (jl_value_t * )jl_core_sym ,
832
853
(jl_value_t * )sym , check_valid );
833
- value_t args = julia_to_list2 (fl_ctx , (jl_value_t * )m , (jl_value_t * )sym , check_valid );
854
+ value_t args = julia_to_list2 (ctx , (jl_value_t * )m , (jl_value_t * )sym , check_valid );
834
855
fl_gc_handle (fl_ctx , & args );
835
- value_t hd = julia_to_scm_ (fl_ctx , (jl_value_t * )jl_globalref_sym , check_valid );
856
+ value_t hd = julia_to_scm_ (ctx , (jl_value_t * )jl_globalref_sym , check_valid );
836
857
value_t scmv = fl_cons (fl_ctx , hd , args );
837
858
fl_free_gc_handles (fl_ctx , 1 );
838
859
return scmv ;
@@ -900,8 +921,8 @@ JL_DLLEXPORT jl_value_t *jl_fl_parse(const char *text, size_t text_len,
900
921
static jl_value_t * jl_call_scm_on_ast (const char * funcname , jl_value_t * expr , jl_module_t * inmodule )
901
922
{
902
923
jl_ast_context_t * ctx = jl_ast_ctx_enter (inmodule );
924
+ value_t arg = julia_to_scm (ctx , expr );
903
925
fl_context_t * fl_ctx = & ctx -> fl ;
904
- value_t arg = julia_to_scm (fl_ctx , expr );
905
926
value_t e = fl_applyn (fl_ctx , 1 , symbol_value (symbol (fl_ctx , funcname )), arg );
906
927
jl_value_t * result = scm_to_julia (fl_ctx , e , inmodule );
907
928
JL_GC_PUSH1 (& result );
@@ -914,8 +935,8 @@ jl_value_t *jl_call_scm_on_ast_and_loc(const char *funcname, jl_value_t *expr,
914
935
jl_module_t * inmodule , const char * file , int line )
915
936
{
916
937
jl_ast_context_t * ctx = jl_ast_ctx_enter (inmodule );
938
+ value_t arg = julia_to_scm (ctx , expr );
917
939
fl_context_t * fl_ctx = & ctx -> fl ;
918
- value_t arg = julia_to_scm (fl_ctx , expr );
919
940
value_t e = fl_applyn (fl_ctx , 3 , symbol_value (symbol (fl_ctx , funcname )), arg ,
920
941
symbol (fl_ctx , file ), fixnum (line ));
921
942
jl_value_t * result = scm_to_julia (fl_ctx , e , inmodule );
@@ -1316,8 +1337,8 @@ JL_DLLEXPORT jl_value_t *jl_expand_with_loc_warn(jl_value_t *expr, jl_module_t *
1316
1337
expr = jl_copy_ast (expr );
1317
1338
expr = jl_expand_macros (expr , inmodule , NULL , 0 , ~(size_t )0 , 1 );
1318
1339
jl_ast_context_t * ctx = jl_ast_ctx_enter (inmodule );
1340
+ value_t arg = julia_to_scm (ctx , expr );
1319
1341
fl_context_t * fl_ctx = & ctx -> fl ;
1320
- value_t arg = julia_to_scm (fl_ctx , expr );
1321
1342
value_t e = fl_applyn (fl_ctx , 4 , symbol_value (symbol (fl_ctx , "jl-expand-to-thunk-warn" )), arg ,
1322
1343
symbol (fl_ctx , file ), fixnum (line ), fl_ctx -> F );
1323
1344
expr = scm_to_julia (fl_ctx , e , inmodule );
0 commit comments