~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to erts/emulator/beam/beam_bif_load.c

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
33
33
#include "erl_binary.h"
34
34
 
35
35
static Eterm check_process_code(Process* rp, Module* modp);
36
 
static void delete_code(Module* modp);
 
36
static void delete_code(Process *c_p, Uint32 c_p_locks, Module* modp);
37
37
static void delete_export_references(Eterm module);
38
38
static int purge_module(int module);
39
39
static int is_native(Eterm* code);
 
40
#if defined(HEAP_FRAG_ELIM_TEST)
 
41
static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 
42
#endif
40
43
 
41
44
Eterm
42
45
load_module_2(BIF_ALIST_2)
46
49
    int      i;
47
50
    int      sz;
48
51
    byte*    code;
49
 
    
50
 
    if (is_not_atom(BIF_ARG_1) || is_not_binary(BIF_ARG_2)) {
 
52
    int trace_pattern_is_on;
 
53
    Binary *match_spec;
 
54
    Binary *meta_match_spec;
 
55
    struct trace_pattern_flags trace_pattern_flags;
 
56
    Eterm meta_tracer_pid;
 
57
    Eterm res;
 
58
    byte* temp_alloc = NULL;
 
59
 
 
60
    if (is_not_atom(BIF_ARG_1)) {
 
61
    error:
 
62
        erts_free_aligned_binary_bytes(temp_alloc);
51
63
        BIF_ERROR(BIF_P, BADARG);
52
64
    }
53
 
    
 
65
    if ((code = erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc)) == NULL) {
 
66
        goto error;
 
67
    }
 
68
    erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
 
69
    erts_smp_block_system(0);
 
70
 
 
71
    erts_export_consolidate();
 
72
 
54
73
    hp = HAlloc(BIF_P, 3);
55
 
    GET_BINARY_BYTES(BIF_ARG_2, code);
56
74
    sz = binary_size(BIF_ARG_2);
57
 
    if ((i = erts_load_module(BIF_P->group_leader, &BIF_ARG_1, code, sz)) < 0) { 
 
75
    if ((i = erts_load_module(BIF_P, 0,
 
76
                              BIF_P->group_leader, &BIF_ARG_1, code, sz)) < 0) { 
58
77
        switch (i) {
59
78
        case -1: reason = am_badfile; break; 
60
79
        case -2: reason = am_nofile; break;
64
83
            break;
65
84
        default: reason = am_badfile; break;
66
85
        }
67
 
        BIF_RET(TUPLE2(hp, am_error, reason));
 
86
        res = TUPLE2(hp, am_error, reason);
 
87
        goto done;
68
88
    }
69
 
    if (erts_default_trace_pattern_is_on) {
 
89
 
 
90
    erts_get_default_trace_pattern(&trace_pattern_is_on,
 
91
                                   &match_spec,
 
92
                                   &meta_match_spec,
 
93
                                   &trace_pattern_flags,
 
94
                                   &meta_tracer_pid);
 
95
    if (trace_pattern_is_on) {
70
96
        Eterm mfa[1];
71
97
        mfa[0] = BIF_ARG_1;
72
98
        (void) erts_set_trace_pattern(mfa, 1, 
73
 
                                      erts_default_match_spec, 
74
 
                                      erts_default_meta_match_spec,
75
 
                                      1, erts_default_trace_pattern_flags, 
76
 
                                      erts_default_meta_tracer_pid);
 
99
                                      match_spec, 
 
100
                                      meta_match_spec,
 
101
                                      1, trace_pattern_flags, 
 
102
                                      meta_tracer_pid);
77
103
    }
78
 
    BIF_RET(TUPLE2(hp, am_module, BIF_ARG_1));
 
104
 
 
105
    res = TUPLE2(hp, am_module, BIF_ARG_1);
 
106
 
 
107
 done:
 
108
    erts_free_aligned_binary_bytes(temp_alloc);
 
109
    erts_smp_release_system();
 
110
    erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
 
111
 
 
112
    BIF_RET(res);
79
113
}
80
114
 
81
115
BIF_RETTYPE purge_module_1(BIF_ALIST_1)
82
116
{
 
117
    int purge_res;
 
118
 
83
119
    if (is_not_atom(BIF_ARG_1)) {
84
120
        BIF_ERROR(BIF_P, BADARG);
85
121
    }
86
 
    if (purge_module(atom_val(BIF_ARG_1)) < 0) {
 
122
 
 
123
    erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
 
124
    erts_smp_block_system(0);
 
125
 
 
126
    erts_export_consolidate();
 
127
    purge_res = purge_module(atom_val(BIF_ARG_1));
 
128
 
 
129
    erts_smp_release_system();
 
130
    erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
 
131
 
 
132
    if (purge_res < 0) {
87
133
        BIF_ERROR(BIF_P, BADARG);
88
134
    }
89
135
    BIF_RET(am_true);
104
150
                am_true : am_false;
105
151
}
106
152
 
 
153
BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
 
154
{
 
155
    Eterm res;
 
156
 
 
157
    erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
 
158
    erts_smp_block_system(0);
 
159
 
 
160
    erts_export_consolidate();
 
161
    res = erts_make_stub_module(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
 
162
 
 
163
    erts_smp_release_system();
 
164
    erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
 
165
    return res;
 
166
}
 
167
 
107
168
Eterm
108
169
check_process_code_2(BIF_ALIST_2)
109
170
{
114
175
        goto error;
115
176
    }
116
177
    if (is_internal_pid(BIF_ARG_1)) {
 
178
        Eterm res;
117
179
        if (internal_pid_index(BIF_ARG_1) >= erts_max_processes)
118
180
            goto error;
119
 
        rp = process_tab[internal_pid_index(BIF_ARG_1)];
120
 
        if (INVALID_PID(rp, BIF_ARG_1)) {
 
181
        rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN,
 
182
                                       BIF_ARG_1, ERTS_PROC_LOCK_MAIN);
 
183
        if (!rp) {
 
184
            ERTS_BIF_CHK_EXITED(BIF_P);
 
185
            ERTS_SMP_BIF_CHK_RESCHEDULE(BIF_P);
121
186
            BIF_RET(am_false);
122
187
        }
123
188
        modp = erts_get_module(BIF_ARG_2);
124
 
        BIF_RET(check_process_code(rp, modp));
 
189
        res = check_process_code(rp, modp);
 
190
#ifdef ERTS_SMP
 
191
        if (BIF_P != rp)
 
192
            erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
 
193
#endif
 
194
        BIF_RET(res);
125
195
    }
126
196
    else if (is_external_pid(BIF_ARG_1)
127
197
             && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) {
135
205
 
136
206
BIF_RETTYPE delete_module_1(BIF_ALIST_1)
137
207
{
138
 
    Module* modp;
139
 
 
140
 
    if (is_not_atom(BIF_ARG_1)) {
141
 
    error:
 
208
    int res;
 
209
 
 
210
    if (is_not_atom(BIF_ARG_1))
 
211
        goto badarg;
 
212
 
 
213
    erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
 
214
    erts_smp_block_system(0);
 
215
 
 
216
    {
 
217
        Module *modp = erts_get_module(BIF_ARG_1);
 
218
        if (!modp) {
 
219
            res = am_undefined;
 
220
        }
 
221
        else if (modp->old_code != 0) {
 
222
            erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
 
223
            erts_dsprintf(dsbufp, "Module %T must be purged before loading\n",
 
224
                          BIF_ARG_1);
 
225
            erts_send_error_to_logger(BIF_P->group_leader, dsbufp);
 
226
            res = am_badarg;
 
227
        }
 
228
        else {
 
229
            delete_export_references(BIF_ARG_1);
 
230
            delete_code(BIF_P, 0, modp);
 
231
            res = am_true;
 
232
        }
 
233
    }
 
234
 
 
235
    erts_smp_release_system();
 
236
    erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
 
237
 
 
238
    if (res == am_badarg) {
 
239
    badarg:
142
240
        BIF_ERROR(BIF_P, BADARG);
143
241
    }
144
 
    modp = erts_get_module(BIF_ARG_1);
145
 
    if (modp == NULL) {
146
 
        return am_undefined;
147
 
    }
148
 
    if (modp->old_code != 0) {
149
 
        cerr_pos = 0;
150
 
        erl_printf(CBUF, "Module ");
151
 
        print_atom(atom_val(BIF_ARG_1), CBUF);
152
 
        erl_printf(CBUF, " must be purged before loading\n");
153
 
        send_error_to_logger(BIF_P->group_leader);
154
 
        goto error;
155
 
    }
156
 
 
157
 
    delete_export_references(BIF_ARG_1);
158
 
    delete_code(modp);
159
 
    return am_true;
 
242
    BIF_RET(res);
160
243
}
161
244
 
162
245
BIF_RETTYPE module_loaded_1(BIF_ALIST_1)
184
267
    int i;
185
268
    int j = 0;
186
269
    
187
 
    for (i = 0; i < module_code_size; i++) {
 
270
    for (i = 0; i < module_code_size(); i++) {
188
271
        if (module_code(i) != NULL &&
189
272
            ((module_code(i)->code_length != 0) ||
190
273
             (module_code(i)->old_code_length != 0))) {
194
277
    if (j > 0) {
195
278
        hp = HAlloc(BIF_P, j*2);
196
279
 
197
 
        for (i = 0; i < module_code_size; i++) {
 
280
        for (i = 0; i < module_code_size(); i++) {
198
281
            if (module_code(i) != NULL &&
199
282
                ((module_code(i)->code_length != 0) ||
200
283
                 (module_code(i)->old_code_length != 0))) {
211
294
check_process_code(Process* rp, Module* modp)
212
295
{
213
296
    Eterm* start;
 
297
    char* mod_start;
 
298
    Uint mod_size;
214
299
    Eterm* end;
215
300
    Eterm* sp;
216
 
#ifndef SHARED_HEAP
 
301
#ifndef HYBRID /* FIND ME! */
217
302
    ErlFunThing* funp;
 
303
#endif
218
304
    int done_gc = 0;
219
 
#endif
220
305
 
221
306
#define INSIDE(a) (start <= (a) && (a) < end)
222
307
    if (modp == NULL) {         /* Doesn't exist. */
230
315
     */
231
316
    start = modp->old_code;
232
317
    end = (Eterm *)((char *)start + modp->old_code_length);
 
318
    mod_start = (char *) start;
 
319
    mod_size = modp->old_code_length;
233
320
 
234
321
    /*
235
322
     * Check if current instruction or continuation pointer points into module.
247
334
        }
248
335
    }
249
336
 
 
337
    /* 
 
338
     * Check all continuation pointers stored in stackdump
 
339
     * and clear exception stackdump if there is a pointer
 
340
     * to the module.
 
341
     */
 
342
    if (rp->ftrace != NIL) {
 
343
        struct StackTrace *s;
 
344
        ASSERT(is_list(rp->ftrace));
 
345
        s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace)));
 
346
        if ((s->pc && INSIDE(s->pc)) ||
 
347
            (s->current && INSIDE(s->current))) {
 
348
            rp->freason = EXC_NULL;
 
349
            rp->fvalue = NIL;
 
350
            rp->ftrace = NIL;
 
351
        } else {
 
352
            int i;
 
353
            for (i = 0;  i < s->depth;  i++) {
 
354
                if (INSIDE(s->trace[i])) {
 
355
                    rp->freason = EXC_NULL;
 
356
                    rp->fvalue = NIL;
 
357
                    rp->ftrace = NIL;
 
358
                    break;
 
359
                }
 
360
            }
 
361
        }
 
362
    }
 
363
 
250
364
    /*
251
365
     * See if there are funs that refer to the old version of the module.
252
366
     */
253
367
 
254
 
#ifndef SHARED_HEAP
 
368
#ifndef HYBRID /* FIND ME! */
255
369
 rescan:
256
370
    for (funp = MSO(rp).funs; funp; funp = funp->next) {
257
371
        Eterm* fun_code;
264
378
            } else {
265
379
                /*
266
380
                 * Try to get rid of this fun by garbage collecting.
 
381
                 * Clear both fvalue and ftrace to make sure they
 
382
                 * don't hold any funs.
267
383
                 */
 
384
                rp->freason = EXC_NULL;
 
385
                rp->fvalue = NIL;
 
386
                rp->ftrace = NIL;
268
387
                done_gc = 1;
269
388
                FLAGS(rp) |= F_NEED_FULLSWEEP;
270
389
                (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
273
392
        }
274
393
    }
275
394
#endif
 
395
 
 
396
#if defined(HEAP_FRAG_ELIM_TEST)
 
397
    /*
 
398
     * See if there are constants inside the module referenced by the process.
 
399
     */
 
400
    for (;;) {
 
401
        ErlMessage* mp;
 
402
 
 
403
        if (any_heap_refs(rp->stop, rp->hend, mod_start, mod_size)) {
 
404
            goto need_gc;
 
405
        }
 
406
        if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) {
 
407
            goto need_gc;
 
408
        }
 
409
 
 
410
        if (rp->dictionary != NULL) {
 
411
            Eterm* start = rp->dictionary->data;
 
412
            Eterm* end = start + rp->dictionary->used;
 
413
 
 
414
            if (any_heap_refs(start, end, mod_start, mod_size)) {
 
415
                goto need_gc;
 
416
            }
 
417
        }
 
418
 
 
419
        for (mp = rp->msg.first; mp != NULL; mp = mp->next) {
 
420
            if (any_heap_refs(mp->m, mp->m+2, mod_start, mod_size)) {
 
421
                goto need_gc;
 
422
            }
 
423
        }
 
424
        break;
 
425
 
 
426
    need_gc:
 
427
        if (done_gc) {
 
428
            return am_true;
 
429
        } else {
 
430
            /*
 
431
             * Try to get rid of constants by by garbage collecting.
 
432
             * Clear both fvalue and ftrace.
 
433
             */
 
434
            rp->freason = EXC_NULL;
 
435
            rp->fvalue = NIL;
 
436
            rp->ftrace = NIL;
 
437
            done_gc = 1;
 
438
            FLAGS(rp) |= F_NEED_FULLSWEEP;
 
439
            (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
 
440
        }
 
441
    }
 
442
#endif
276
443
    return am_false;
277
444
#undef INSIDE
278
445
}
279
446
 
 
447
#if defined(HEAP_FRAG_ELIM_TEST)
 
448
static int
 
449
any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
 
450
{
 
451
#define in_area(ptr,start,nbytes) \
 
452
    ((unsigned long)((char*)(ptr) - (char*)(start)) < (nbytes))
 
453
    Eterm* p;
 
454
    Eterm val;
 
455
 
 
456
    for (p = start; p < end; p++) {
 
457
        val = *p;
 
458
        switch (primary_tag(val)) {
 
459
        case TAG_PRIMARY_BOXED:
 
460
        case TAG_PRIMARY_LIST:
 
461
            if (in_area(val, mod_start, mod_size)) {
 
462
                return 1;
 
463
            }
 
464
            break;
 
465
        }
 
466
    }
 
467
    return 0;
 
468
#undef in_area
 
469
}
 
470
#endif
280
471
 
281
472
static int
282
473
purge_module(int module)
299
490
     */
300
491
    if (modp->old_code == 0) {
301
492
        if (display_loads) {
302
 
            erl_printf(COUT,"No code to purge for ");
303
 
            print_atom(module, COUT);
304
 
            erl_printf(COUT,"\n");
 
493
            erts_printf("No code to purge for %T\n", make_atom(module));
305
494
        }
306
495
        return -1;
307
496
    }
346
535
 */
347
536
 
348
537
static void 
349
 
delete_code(Module* modp)
 
538
delete_code(Process *c_p, Uint32 c_p_locks, Module* modp)
350
539
{
 
540
#ifdef ERTS_ENABLE_LOCK_CHECK
 
541
#ifdef ERTS_SMP
 
542
    if (c_p && c_p_locks)
 
543
        erts_proc_lc_chk_only_proc_main(c_p);
 
544
    else
 
545
#endif
 
546
        erts_lc_check_exact(NULL, 0);
 
547
#endif
 
548
 
351
549
    /*
352
550
     * Clear breakpoints if any
353
551
     */
354
552
    if (modp->code != NULL && modp->code[MI_NUM_BREAKPOINTS] > 0) {
 
553
        if (c_p && c_p_locks)
 
554
            erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
 
555
        erts_smp_block_system(0);
355
556
        erts_clear_module_break(modp);
356
557
        modp->code[MI_NUM_BREAKPOINTS] = 0;
 
558
        erts_smp_release_system();
 
559
        if (c_p && c_p_locks)
 
560
            erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
357
561
    }
358
562
    modp->old_code = modp->code;
359
563
    modp->old_code_length = modp->code_length;
374
578
 
375
579
    ASSERT(is_atom(module));
376
580
 
377
 
    for (i = 0; i < export_list_size; i++) {
378
 
        if (export_list(i) != NULL && (export_list(i)->code[0] == module)) {
379
 
            if (export_list(i)->address == beam_debug_apply+5) {
380
 
                continue;
381
 
            }
382
 
            if (export_list(i)->address == export_list(i)->code+3 &&
383
 
                (export_list(i)->code[3] == (Eterm) em_apply_bif)) {
384
 
                continue;
385
 
            }
386
 
            export_list(i)->address = export_list(i)->code+3;
387
 
            export_list(i)->code[3] = (Uint) em_call_error_handler;
388
 
            export_list(i)->code[4] = 0;
389
 
            MatchSetUnref(export_list(i)->match_prog_set);
390
 
            export_list(i)->match_prog_set = NULL;
 
581
    for (i = 0; i < export_list_size(); i++) {
 
582
        Export *ep = export_list(i);
 
583
        if (ep != NULL && (ep->code[0] == module)) {
 
584
            if (ep->address == ep->code+3 &&
 
585
                (ep->code[3] == (Eterm) em_apply_bif)) {
 
586
                continue;
 
587
            }
 
588
            ep->address = ep->code+3;
 
589
            ep->code[3] = (Uint) em_call_error_handler;
 
590
            ep->code[4] = 0;
 
591
            MatchSetUnref(ep->match_prog_set);
 
592
            ep->match_prog_set = NULL;
391
593
        }
392
594
    }
393
595
}
394
596
 
 
597
 
395
598
int
396
 
beam_make_current_old(Eterm module)
 
599
beam_make_current_old(Process *c_p, Uint32 c_p_locks, Eterm module)
397
600
{
398
601
    Module* modp = erts_put_module(module);
399
602
 
406
609
        return -3;
407
610
    } else if (modp->old_code == NULL) { /* Make the current version old. */
408
611
        if (display_loads) {
409
 
            erl_printf(COUT, "saving old code\n");
 
612
            erts_printf("saving old code\n");
410
613
        }
411
 
        delete_code(modp);
 
614
        delete_code(c_p, c_p_locks, modp);
412
615
        delete_export_references(module);
413
616
    }
414
617
    return 0;
420
623
    return ((Eterm *)code[MI_FUNCTIONS])[1] != 0;
421
624
}
422
625
 
 
626