aboutsummaryrefslogtreecommitdiffstats
path: root/erts
diff options
context:
space:
mode:
Diffstat (limited to 'erts')
-rw-r--r--erts/aclocal.m4224
-rw-r--r--erts/configure.in209
-rw-r--r--erts/doc/src/absform.xml1017
-rw-r--r--erts/doc/src/driver_entry.xml22
-rw-r--r--erts/doc/src/epmd.xml2
-rw-r--r--erts/doc/src/erl.xml131
-rw-r--r--erts/doc/src/erl_dist_protocol.xml4
-rw-r--r--erts/doc/src/erl_driver.xml186
-rw-r--r--erts/doc/src/erl_ext_dist.xml4
-rw-r--r--erts/doc/src/erl_nif.xml125
-rw-r--r--erts/doc/src/erl_prim_loader.xml77
-rw-r--r--erts/doc/src/erlang.xml632
-rw-r--r--erts/doc/src/erts_alloc.xml89
-rw-r--r--erts/doc/src/escript.xml6
-rw-r--r--erts/doc/src/init.xml5
-rw-r--r--erts/doc/src/notes.xml399
-rw-r--r--erts/doc/src/run_erl.xml2
-rw-r--r--erts/doc/src/time_correction.xml4
-rw-r--r--erts/emulator/Makefile.in65
-rw-r--r--erts/emulator/beam/atom.c5
-rw-r--r--erts/emulator/beam/atom.h1
-rw-r--r--erts/emulator/beam/atom.names36
-rw-r--r--erts/emulator/beam/beam_bif_load.c553
-rw-r--r--erts/emulator/beam/beam_bp.c131
-rw-r--r--erts/emulator/beam/beam_bp.h7
-rw-r--r--erts/emulator/beam/beam_catches.c6
-rw-r--r--erts/emulator/beam/beam_debug.c144
-rw-r--r--erts/emulator/beam/beam_emu.c2007
-rw-r--r--erts/emulator/beam/beam_load.c689
-rw-r--r--erts/emulator/beam/beam_load.h127
-rw-r--r--erts/emulator/beam/beam_ranges.c202
-rw-r--r--erts/emulator/beam/bif.c446
-rw-r--r--erts/emulator/beam/bif.h73
-rw-r--r--erts/emulator/beam/bif.tab21
-rw-r--r--erts/emulator/beam/big.c481
-rw-r--r--erts/emulator/beam/big.h24
-rw-r--r--erts/emulator/beam/binary.c83
-rw-r--r--erts/emulator/beam/break.c46
-rw-r--r--erts/emulator/beam/code_ix.c4
-rw-r--r--erts/emulator/beam/code_ix.h2
-rw-r--r--erts/emulator/beam/copy.c1413
-rw-r--r--erts/emulator/beam/dist.c122
-rw-r--r--erts/emulator/beam/erl_afit_alloc.c2
-rw-r--r--erts/emulator/beam/erl_alloc.c424
-rw-r--r--erts/emulator/beam/erl_alloc.h52
-rw-r--r--erts/emulator/beam/erl_alloc.types63
-rw-r--r--erts/emulator/beam/erl_alloc_util.c426
-rw-r--r--erts/emulator/beam/erl_alloc_util.h71
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.c24
-rw-r--r--erts/emulator/beam/erl_arith.c11
-rw-r--r--erts/emulator/beam/erl_async.c35
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.c2
-rw-r--r--erts/emulator/beam/erl_bif_binary.c953
-rw-r--r--erts/emulator/beam/erl_bif_ddll.c19
-rw-r--r--erts/emulator/beam/erl_bif_info.c620
-rw-r--r--erts/emulator/beam/erl_bif_lists.c8
-rw-r--r--erts/emulator/beam/erl_bif_op.c14
-rw-r--r--erts/emulator/beam/erl_bif_port.c66
-rw-r--r--erts/emulator/beam/erl_bif_re.c4
-rw-r--r--erts/emulator/beam/erl_bif_trace.c67
-rw-r--r--erts/emulator/beam/erl_bif_unique.c6
-rw-r--r--erts/emulator/beam/erl_binary.h15
-rw-r--r--erts/emulator/beam/erl_bits.c4
-rw-r--r--erts/emulator/beam/erl_cpu_topology.c10
-rw-r--r--erts/emulator/beam/erl_db.c77
-rw-r--r--erts/emulator/beam/erl_db_hash.c18
-rw-r--r--erts/emulator/beam/erl_db_tree.c240
-rw-r--r--erts/emulator/beam/erl_db_util.c395
-rw-r--r--erts/emulator/beam/erl_db_util.h20
-rw-r--r--erts/emulator/beam/erl_debug.c51
-rw-r--r--erts/emulator/beam/erl_debug.h7
-rw-r--r--erts/emulator/beam/erl_driver.h137
-rw-r--r--erts/emulator/beam/erl_drv_nif.h84
-rw-r--r--erts/emulator/beam/erl_drv_thread.c2
-rw-r--r--erts/emulator/beam/erl_fun.c5
-rw-r--r--erts/emulator/beam/erl_gc.c1453
-rw-r--r--erts/emulator/beam/erl_gc.h43
-rw-r--r--erts/emulator/beam/erl_goodfit_alloc.c4
-rw-r--r--erts/emulator/beam/erl_hl_timer.c109
-rw-r--r--erts/emulator/beam/erl_init.c125
-rw-r--r--erts/emulator/beam/erl_lock_check.c8
-rw-r--r--erts/emulator/beam/erl_map.c154
-rw-r--r--erts/emulator/beam/erl_map.h32
-rw-r--r--erts/emulator/beam/erl_message.c1692
-rw-r--r--erts/emulator/beam/erl_message.h289
-rw-r--r--erts/emulator/beam/erl_monitors.c2
-rw-r--r--erts/emulator/beam/erl_msacc.c486
-rw-r--r--erts/emulator/beam/erl_msacc.h409
-rw-r--r--erts/emulator/beam/erl_nif.c80
-rw-r--r--erts/emulator/beam/erl_nif.h91
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h8
-rw-r--r--erts/emulator/beam/erl_node_container_utils.h4
-rw-r--r--erts/emulator/beam/erl_node_tables.c251
-rw-r--r--erts/emulator/beam/erl_node_tables.h3
-rw-r--r--erts/emulator/beam/erl_port.h12
-rw-r--r--erts/emulator/beam/erl_port_task.c9
-rw-r--r--erts/emulator/beam/erl_printf_term.c31
-rw-r--r--erts/emulator/beam/erl_printf_term.h3
-rw-r--r--erts/emulator/beam/erl_process.c3732
-rw-r--r--erts/emulator/beam/erl_process.h366
-rw-r--r--erts/emulator/beam/erl_process_dict.c263
-rw-r--r--erts/emulator/beam/erl_process_dict.h11
-rw-r--r--erts/emulator/beam/erl_process_dump.c31
-rw-r--r--erts/emulator/beam/erl_process_lock.h7
-rw-r--r--erts/emulator/beam/erl_ptab.c2
-rw-r--r--erts/emulator/beam/erl_term.c39
-rw-r--r--erts/emulator/beam/erl_term.h237
-rw-r--r--erts/emulator/beam/erl_thr_progress.c12
-rw-r--r--erts/emulator/beam/erl_thr_queue.c6
-rw-r--r--erts/emulator/beam/erl_threads.h34
-rw-r--r--erts/emulator/beam/erl_time.h6
-rw-r--r--erts/emulator/beam/erl_time_sup.c217
-rw-r--r--erts/emulator/beam/erl_trace.c863
-rw-r--r--erts/emulator/beam/erl_trace.h32
-rw-r--r--erts/emulator/beam/erl_unicode.c2
-rw-r--r--erts/emulator/beam/erl_utils.h69
-rw-r--r--erts/emulator/beam/erl_vm.h15
-rw-r--r--erts/emulator/beam/export.c3
-rw-r--r--erts/emulator/beam/external.c174
-rw-r--r--erts/emulator/beam/global.h411
-rw-r--r--erts/emulator/beam/hash.c142
-rw-r--r--erts/emulator/beam/hash.h31
-rw-r--r--erts/emulator/beam/index.c4
-rw-r--r--erts/emulator/beam/index.h4
-rw-r--r--erts/emulator/beam/io.c403
-rw-r--r--erts/emulator/beam/module.c7
-rw-r--r--erts/emulator/beam/module.h3
-rw-r--r--erts/emulator/beam/ops.tab875
-rw-r--r--erts/emulator/beam/register.c5
-rw-r--r--erts/emulator/beam/sys.h157
-rw-r--r--erts/emulator/beam/time.c22
-rw-r--r--erts/emulator/beam/utils.c378
-rw-r--r--erts/emulator/drivers/common/efile_drv.c34
-rw-r--r--erts/emulator/drivers/common/inet_drv.c733
-rw-r--r--erts/emulator/drivers/ose/ose_efile.c1125
-rw-r--r--erts/emulator/drivers/ose/ose_signal_drv.c897
-rw-r--r--erts/emulator/drivers/ose/ttsl_drv.c69
-rw-r--r--erts/emulator/drivers/unix/ttsl_drv.c148
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c7
-rw-r--r--erts/emulator/drivers/win32/win_con.c4
-rw-r--r--erts/emulator/hipe/hipe_bif0.c28
-rw-r--r--erts/emulator/hipe/hipe_bif0.tab2
-rw-r--r--erts/emulator/hipe/hipe_bif_list.m41
-rw-r--r--erts/emulator/hipe/hipe_gc.c36
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.c8
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.h2
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c50
-rw-r--r--erts/emulator/hipe/hipe_native_bif.h2
-rw-r--r--erts/emulator/hipe/hipe_primops.h2
-rw-r--r--erts/emulator/hipe/hipe_x86_signal.c194
-rw-r--r--erts/emulator/sys/common/erl_check_io.c24
-rw-r--r--erts/emulator/sys/common/erl_mmap.c596
-rw-r--r--erts/emulator/sys/common/erl_mmap.h32
-rw-r--r--erts/emulator/sys/common/erl_mseg.c392
-rw-r--r--erts/emulator/sys/common/erl_mseg.h19
-rw-r--r--erts/emulator/sys/common/erl_os_monotonic_time_extender.c2
-rw-r--r--erts/emulator/sys/common/erl_poll.c36
-rw-r--r--erts/emulator/sys/common/erl_poll.h24
-rw-r--r--erts/emulator/sys/ose/beam.lmconf26
-rw-r--r--erts/emulator/sys/ose/driver_int.h42
-rw-r--r--erts/emulator/sys/ose/erl_main.c54
-rw-r--r--erts/emulator/sys/ose/erl_ose_sys.h356
-rw-r--r--erts/emulator/sys/ose/erl_ose_sys_ddll.c127
-rw-r--r--erts/emulator/sys/ose/erl_poll.c818
-rw-r--r--erts/emulator/sys/ose/erts.sig17
-rw-r--r--erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf182
-rw-r--r--erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf242
-rw-r--r--erts/emulator/sys/ose/sys.c1847
-rw-r--r--erts/emulator/sys/ose/sys_float.c845
-rw-r--r--erts/emulator/sys/ose/sys_time.c57
-rw-r--r--erts/emulator/sys/unix/erl_child_setup.c560
-rw-r--r--erts/emulator/sys/unix/erl_child_setup.h77
-rw-r--r--erts/emulator/sys/unix/erl_unix_sys.h55
-rw-r--r--erts/emulator/sys/unix/sys.c1953
-rw-r--r--erts/emulator/sys/unix/sys_drivers.c1862
-rw-r--r--erts/emulator/sys/unix/sys_float.c28
-rw-r--r--erts/emulator/sys/unix/sys_time.c138
-rw-r--r--erts/emulator/sys/unix/sys_uds.c155
-rw-r--r--erts/emulator/sys/unix/sys_uds.h57
-rw-r--r--erts/emulator/sys/win32/erl_poll.c14
-rw-r--r--erts/emulator/sys/win32/erl_win32_sys_ddll.c3
-rw-r--r--erts/emulator/sys/win32/erl_win_dyn_driver.h18
-rw-r--r--erts/emulator/sys/win32/erl_win_sys.h14
-rw-r--r--erts/emulator/sys/win32/sys.c22
-rw-r--r--erts/emulator/sys/win32/sys_interrupt.c6
-rw-r--r--erts/emulator/sys/win32/sys_time.c7
-rw-r--r--erts/emulator/test/Makefile4
-rw-r--r--erts/emulator/test/a_SUITE.erl77
-rw-r--r--erts/emulator/test/after_SUITE.erl195
-rw-r--r--erts/emulator/test/alloc_SUITE.erl355
-rw-r--r--erts/emulator/test/alloc_SUITE_data/Makefile.src3
-rw-r--r--erts/emulator/test/alloc_SUITE_data/allocator_test.h20
-rw-r--r--erts/emulator/test/alloc_SUITE_data/basic.c3
-rw-r--r--erts/emulator/test/alloc_SUITE_data/basic.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/bucket_index.c2
-rw-r--r--erts/emulator/test/alloc_SUITE_data/bucket_index.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/bucket_mask.c4
-rw-r--r--erts/emulator/test/alloc_SUITE_data/bucket_mask.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/coalesce.c3
-rw-r--r--erts/emulator/test/alloc_SUITE_data/coalesce.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/cpool.c9
-rw-r--r--erts/emulator/test/alloc_SUITE_data/cpool.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/migration.c343
-rw-r--r--erts/emulator/test/alloc_SUITE_data/migration.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c3
-rw-r--r--erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/rbtree.c14
-rw-r--r--erts/emulator/test/alloc_SUITE_data/rbtree.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/realloc_copy.c2
-rw-r--r--erts/emulator/test/alloc_SUITE_data/realloc_copy.erl10
-rw-r--r--erts/emulator/test/alloc_SUITE_data/testcase_driver.c255
-rw-r--r--erts/emulator/test/alloc_SUITE_data/testcase_driver.h15
-rw-r--r--erts/emulator/test/alloc_SUITE_data/threads.c27
-rw-r--r--erts/emulator/test/alloc_SUITE_data/threads.erl10
-rw-r--r--erts/emulator/test/async_ports_SUITE.erl39
-rw-r--r--erts/emulator/test/beam_SUITE.erl15
-rw-r--r--erts/emulator/test/beam_literals_SUITE.erl188
-rw-r--r--erts/emulator/test/bif_SUITE.erl379
-rw-r--r--erts/emulator/test/big_SUITE.erl150
-rw-r--r--erts/emulator/test/binary_SUITE.erl845
-rw-r--r--erts/emulator/test/bs_bincomp_SUITE.erl2
-rw-r--r--erts/emulator/test/bs_bit_binaries_SUITE.erl90
-rw-r--r--erts/emulator/test/bs_construct_SUITE.erl351
-rw-r--r--erts/emulator/test/bs_match_bin_SUITE.erl56
-rw-r--r--erts/emulator/test/bs_match_int_SUITE.erl96
-rw-r--r--erts/emulator/test/bs_match_misc_SUITE.erl232
-rw-r--r--erts/emulator/test/bs_match_tail_SUITE.erl77
-rw-r--r--erts/emulator/test/bs_utf_SUITE.erl110
-rw-r--r--erts/emulator/test/busy_port_SUITE.erl637
-rw-r--r--erts/emulator/test/call_trace_SUITE.erl1582
-rw-r--r--erts/emulator/test/code_SUITE.erl767
-rw-r--r--erts/emulator/test/code_SUITE_data/literals.erl7
-rw-r--r--erts/emulator/test/code_parallel_load_SUITE.erl49
-rw-r--r--erts/emulator/test/crypto_SUITE.erl399
-rw-r--r--erts/emulator/test/ddll_SUITE.erl1609
-rw-r--r--erts/emulator/test/decode_packet_SUITE.erl551
-rw-r--r--erts/emulator/test/distribution_SUITE.erl2685
-rw-r--r--erts/emulator/test/distribution_SUITE_data/run.erl47
-rw-r--r--erts/emulator/test/driver_SUITE.erl3136
-rw-r--r--erts/emulator/test/efile_SUITE.erl144
-rw-r--r--erts/emulator/test/emulator.spec.ose2
-rw-r--r--erts/emulator/test/erl_drv_thread_SUITE.erl120
-rw-r--r--erts/emulator/test/erl_link_SUITE.erl1523
-rw-r--r--erts/emulator/test/erts_debug_SUITE.erl81
-rw-r--r--erts/emulator/test/estone_SUITE.erl61
-rw-r--r--erts/emulator/test/evil_SUITE.erl466
-rw-r--r--erts/emulator/test/exception_SUITE.erl631
-rw-r--r--erts/emulator/test/float_SUITE.erl394
-rw-r--r--erts/emulator/test/float_SUITE_data/fp_drv.c1
-rw-r--r--erts/emulator/test/fun_SUITE.erl798
-rw-r--r--erts/emulator/test/fun_r13_SUITE.erl92
-rw-r--r--erts/emulator/test/gc_SUITE.erl49
-rw-r--r--erts/emulator/test/guard_SUITE.erl324
-rw-r--r--erts/emulator/test/hash_SUITE.erl88
-rw-r--r--erts/emulator/test/hibernate_SUITE.erl256
-rw-r--r--erts/emulator/test/ignore_cores.erl14
-rw-r--r--erts/emulator/test/list_bif_SUITE.erl169
-rw-r--r--erts/emulator/test/map_SUITE.erl504
-rw-r--r--erts/emulator/test/match_spec_SUITE.erl1171
-rw-r--r--erts/emulator/test/message_queue_data_SUITE.erl213
-rw-r--r--erts/emulator/test/module_info_SUITE.erl45
-rw-r--r--erts/emulator/test/monitor_SUITE.erl1092
-rw-r--r--erts/emulator/test/mtx_SUITE.erl404
-rw-r--r--erts/emulator/test/multi_load_SUITE.erl196
-rw-r--r--erts/emulator/test/nested_SUITE.erl96
-rw-r--r--erts/emulator/test/nif_SUITE.erl1297
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c100
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.c2
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.erl4
-rw-r--r--erts/emulator/test/nif_SUITE_data/tester.erl5
-rw-r--r--erts/emulator/test/node_container_SUITE.erl1671
-rw-r--r--erts/emulator/test/nofrag_SUITE.erl106
-rw-r--r--erts/emulator/test/num_bif_SUITE.erl101
-rw-r--r--erts/emulator/test/old_mod.erl34
-rw-r--r--erts/emulator/test/old_scheduler_SUITE.erl349
-rw-r--r--erts/emulator/test/op_SUITE.erl294
-rw-r--r--erts/emulator/test/port_SUITE.erl2067
-rw-r--r--erts/emulator/test/port_SUITE_data/port_test.c35
-rw-r--r--erts/emulator/test/port_bif_SUITE.erl96
-rw-r--r--erts/emulator/test/process_SUITE.erl251
-rw-r--r--erts/emulator/test/random_iolist.erl16
-rw-r--r--erts/emulator/test/receive_SUITE.erl35
-rw-r--r--erts/emulator/test/ref_SUITE.erl51
-rw-r--r--erts/emulator/test/register_SUITE.erl62
-rw-r--r--erts/emulator/test/save_calls_SUITE.erl264
-rw-r--r--erts/emulator/test/scheduler_SUITE.erl1906
-rw-r--r--erts/emulator/test/scheduler_SUITE_data/Makefile.src8
-rw-r--r--erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c31
-rw-r--r--erts/emulator/test/send_term_SUITE.erl180
-rw-r--r--erts/emulator/test/sensitive_SUITE.erl505
-rw-r--r--erts/emulator/test/signal_SUITE.erl438
-rw-r--r--erts/emulator/test/smoke_test_SUITE.erl48
-rw-r--r--erts/emulator/test/statistics_SUITE.erl578
-rw-r--r--erts/emulator/test/system_info_SUITE.erl239
-rw-r--r--erts/emulator/test/system_profile_SUITE.erl229
-rw-r--r--erts/emulator/test/time_SUITE.erl285
-rw-r--r--erts/emulator/test/timer_bif_SUITE.erl714
-rw-r--r--erts/emulator/test/trace_SUITE.erl2123
-rw-r--r--erts/emulator/test/trace_bif_SUITE.erl454
-rw-r--r--erts/emulator/test/trace_call_count_SUITE.erl314
-rw-r--r--erts/emulator/test/trace_call_time_SUITE.erl657
-rw-r--r--erts/emulator/test/trace_local_SUITE.erl1472
-rw-r--r--erts/emulator/test/trace_meta_SUITE.erl74
-rw-r--r--erts/emulator/test/trace_nif_SUITE.erl335
-rw-r--r--erts/emulator/test/trace_port_SUITE.erl819
-rw-r--r--erts/emulator/test/tuple_SUITE.erl10
-rw-r--r--erts/emulator/test/unique_SUITE.erl254
-rw-r--r--erts/emulator/test/z_SUITE.erl338
-rwxr-xr-xerts/emulator/utils/beam_makeops89
-rw-r--r--erts/emulator/valgrind/suppress.halfword56
-rw-r--r--erts/emulator/valgrind/suppress.patched.3.6.02
-rw-r--r--erts/emulator/valgrind/suppress.standard2
-rw-r--r--erts/epmd/src/Makefile.in37
-rw-r--r--erts/epmd/src/epmd.c6
-rw-r--r--erts/epmd/src/epmd_cli.c30
-rw-r--r--erts/epmd/src/epmd_int.h81
-rw-r--r--erts/epmd/src/epmd_srv.c215
-rw-r--r--erts/epmd/test/epmd_SUITE.erl93
-rw-r--r--erts/etc/common/Makefile.in83
-rw-r--r--erts/etc/common/erlexec.c27
-rw-r--r--erts/etc/common/heart.c6
-rw-r--r--erts/etc/common/run_erl_common.c696
-rw-r--r--erts/etc/common/run_erl_common.h97
-rw-r--r--erts/etc/common/to_erl_common.c717
-rw-r--r--erts/etc/common/to_erl_common.h29
-rw-r--r--erts/etc/ose/etc.lmconf20
-rw-r--r--erts/etc/ose/run_erl.c664
-rw-r--r--erts/etc/ose/run_erl.h30
-rw-r--r--erts/etc/ose/run_erl_main.c80
-rw-r--r--erts/etc/unix/etp-commands.in16
-rw-r--r--erts/etc/unix/run_erl.c621
-rw-r--r--erts/etc/unix/run_erl.h (renamed from erts/etc/common/run_erl_vsn.h)7
-rw-r--r--erts/etc/unix/safe_string.c (renamed from erts/etc/common/safe_string.c)11
-rw-r--r--erts/etc/unix/safe_string.h (renamed from erts/etc/common/safe_string.h)11
-rw-r--r--erts/etc/unix/to_erl.c591
-rwxr-xr-xerts/etc/win32/cygwin_tools/vc/cc.sh2
-rw-r--r--erts/etc/win32/msys_tools/vc/cc.sh2
-rw-r--r--erts/include/erl_int_sizes_config.h.in3
-rw-r--r--erts/include/internal/erl_printf_format.h11
-rw-r--r--erts/include/internal/ethr_internal.h1
-rw-r--r--erts/include/internal/ethr_mutex.h8
-rw-r--r--erts/include/internal/ethread.h146
-rw-r--r--erts/include/internal/ethread_header_config.h.in4
-rw-r--r--erts/include/internal/i386/ethr_dw_atomic.h73
-rw-r--r--erts/include/internal/ose/ethr_event.h114
-rw-r--r--erts/lib_src/common/erl_misc_utils.c6
-rw-r--r--erts/lib_src/common/erl_printf_format.c25
-rw-r--r--erts/lib_src/common/ethr_aux.c47
-rw-r--r--erts/lib_src/common/ethr_mutex.c2
-rw-r--r--erts/lib_src/ose/ethr_event.c220
-rw-r--r--erts/lib_src/ose/ethread.c833
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin56328 -> 55528 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin101840 -> 102200 bytes
-rw-r--r--erts/preloaded/ebin/erts_code_purger.beambin0 -> 8704 bytes
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin5964 -> 9976 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin48768 -> 44608 bytes
-rw-r--r--erts/preloaded/ebin/otp_ring0.beambin1468 -> 1448 bytes
-rw-r--r--erts/preloaded/ebin/prim_eval.beambin1340 -> 1320 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin44904 -> 44800 bytes
-rw-r--r--erts/preloaded/ebin/prim_inet.beambin72712 -> 72608 bytes
-rw-r--r--erts/preloaded/ebin/prim_zip.beambin23416 -> 23156 bytes
-rw-r--r--erts/preloaded/ebin/zlib.beambin14176 -> 14156 bytes
-rw-r--r--erts/preloaded/src/Makefile1
-rw-r--r--erts/preloaded/src/erl_prim_loader.erl539
-rw-r--r--erts/preloaded/src/erlang.erl173
-rw-r--r--erts/preloaded/src/erts.app.src1
-rw-r--r--erts/preloaded/src/erts_code_purger.erl299
-rw-r--r--erts/preloaded/src/erts_internal.erl170
-rw-r--r--erts/preloaded/src/init.erl405
-rw-r--r--erts/preloaded/src/prim_file.erl3
-rw-r--r--erts/preloaded/src/prim_inet.erl4
-rw-r--r--erts/test/Makefile2
-rw-r--r--erts/test/erl_print_SUITE.erl2
-rw-r--r--erts/test/erlc_SUITE.erl2
-rw-r--r--erts/test/erlexec_SUITE.erl2
-rw-r--r--erts/test/ethread_SUITE.erl34
-rw-r--r--erts/test/ethread_SUITE_data/ethread_tests.c6
-rw-r--r--erts/test/ignore_cores.erl2
-rw-r--r--erts/test/install_SUITE.erl2
-rw-r--r--erts/test/nt_SUITE.erl2
-rw-r--r--erts/test/otp_SUITE.erl59
-rw-r--r--erts/test/run_erl_SUITE.erl20
-rw-r--r--erts/vsn.mk4
383 files changed, 44500 insertions, 48032 deletions
diff --git a/erts/aclocal.m4 b/erts/aclocal.m4
index 390d6cfc4d..017fdbd589 100644
--- a/erts/aclocal.m4
+++ b/erts/aclocal.m4
@@ -74,21 +74,6 @@ AC_ARG_VAR(erl_xcomp_clock_gettime_cpu_time, [clock_gettime() can be used for re
AC_ARG_VAR(erl_xcomp_after_morecore_hook, [__after_morecore_hook can track malloc()s core memory usage: yes|no (only used when cross compiling)])
AC_ARG_VAR(erl_xcomp_dlsym_brk_wrappers, [dlsym(RTLD_NEXT, _) brk wrappers can track malloc()s core memory usage: yes|no (only used when cross compiling)])
-dnl Cross compilation variables for OSE
-AC_ARG_VAR(erl_xcomp_ose_ldflags_pass1, [Linker flags for the OSE module (pass 1) (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_ldflags_pass2, [Linker flags for the OSE module (pass 2) (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_OSEROOT, [OSE installation root directory (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_STRIP, [Strip utility shipped with the OSE distribution(only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_LM_POST_LINK, [OSE postlink tool (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_LM_SET_CONF, [Sets the configuration for an OSE load module (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_LM_ELF_SIZE, [Prints the section size information for an OSE load module (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_LM_LCF, [OSE load module linker configuration file (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_BEAM_LM_CONF, [BEAM OSE load module default configuration file (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_EPMD_LM_CONF, [EPMD OSE load module default configuration file (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_RUN_ERL_LM_CONF, [run_erl_lm OSE load module default configuration file (only used when cross compiling for OSE)])
-AC_ARG_VAR(erl_xcomp_ose_CONFD, [OSE confd source file])
-AC_ARG_VAR(erl_xcomp_ose_CRT0_LM, [OSE crt0 lm source file])
-
])
AC_DEFUN(ERL_XCOMP_SYSROOT_INIT,
@@ -142,18 +127,18 @@ MIXED_MSYS=no
AC_MSG_CHECKING(for mixed cygwin or msys and native VC++ environment)
if test "X$host" = "Xwin32" -a "x$GCC" != "xyes"; then
- if test -x /usr/bin/cygpath; then
- CFLAGS="-O2"
- MIXED_CYGWIN=yes
- AC_MSG_RESULT([Cygwin and VC])
- MIXED_CYGWIN_VC=yes
- CPPFLAGS="$CPPFLAGS -DERTS_MIXED_CYGWIN_VC"
- elif test -x /usr/bin/msysinfo; then
+ if test -x /usr/bin/msys-?.0.dll; then
CFLAGS="-O2"
MIXED_MSYS=yes
AC_MSG_RESULT([MSYS and VC])
MIXED_MSYS_VC=yes
CPPFLAGS="$CPPFLAGS -DERTS_MIXED_MSYS_VC"
+ elif test -x /usr/bin/cygpath; then
+ CFLAGS="-O2"
+ MIXED_CYGWIN=yes
+ AC_MSG_RESULT([Cygwin and VC])
+ MIXED_CYGWIN_VC=yes
+ CPPFLAGS="$CPPFLAGS -DERTS_MIXED_CYGWIN_VC"
else
AC_MSG_RESULT([undeterminable])
AC_MSG_ERROR(Seems to be mixed windows but not with cygwin, cannot handle this!)
@@ -503,8 +488,6 @@ AC_CACHE_VAL(ac_cv_sys_ipv6_support,
#ifdef __WIN32__
#include <winsock2.h>
#include <ws2tcpip.h>
-#elif __OSE__
-#error "no ipv6"
#else
#include <netinet/in.h>
#endif],
@@ -517,8 +500,6 @@ else
#ifdef __WIN32__
#include <winsock2.h>
#include <ws2tcpip.h>
-#elif __OSE__
-#error "no ipv6"
#else
#include <netinet/in.h>
#endif],
@@ -991,12 +972,6 @@ if test "X$host_os" = "Xwin32"; then
THR_LIBS=
THR_LIB_NAME=win32_threads
THR_LIB_TYPE=win32_threads
-elif test "X$host_os" = "Xose"; then
- AC_MSG_RESULT(yes)
- THR_DEFS="-DOSE_THREADS"
- THR_LIBS=
- THR_LIB_NAME=ose_threads
- THR_LIB_TYPE=ose_threads
else
AC_MSG_RESULT(no)
THR_DEFS=
@@ -1583,22 +1558,9 @@ case "$THR_LIB_NAME" in
fi
;;
- pthread|ose_threads)
- case "$THR_LIB_NAME" in
- pthread)
- ETHR_THR_LIB_BASE_DIR=pthread
- AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads])
- ;;
- ose_threads)
- AC_DEFINE(ETHR_OSE_THREADS, 1,
- [Define if you have OSE style threads])
- ETHR_THR_LIB_BASE_DIR=ose
- AC_CHECK_HEADER(ose_spi/ose_spi.h,
- AC_DEFINE(HAVE_OSE_SPI_H, 1,
- [Define if you have the "ose_spi/ose_spi.h" header file.]))
- ;;
- esac
- if test "x$THR_LIB_NAME" = "xpthread"; then
+ pthread)
+ ETHR_THR_LIB_BASE_DIR=pthread
+ AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads])
case $host_os in
openbsd*)
# The default stack size is insufficient for our needs
@@ -1657,7 +1619,6 @@ case "$THR_LIB_NAME" in
*) ;;
esac
- fi
dnl We sometimes need ETHR_DEFS in order to find certain headers
dnl (at least for pthread.h on osf1).
saved_cppflags="$CPPFLAGS"
@@ -1702,7 +1663,6 @@ case "$THR_LIB_NAME" in
dnl
dnl Check for functions
dnl
- if test "x$THR_LIB_NAME" = "xpthread"; then
AC_CHECK_FUNC(pthread_spin_lock, \
[ethr_have_native_spinlock=yes \
AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \
@@ -1922,8 +1882,6 @@ case "$THR_LIB_NAME" in
esac
CFLAGS=$old_CFLAGS
- fi ## test "x$THR_LIB_NAME" = "xpthread"
-
if test "X$disable_native_ethr_impls" = "Xyes"; then
ethr_have_native_atomics=no
else
@@ -2117,63 +2075,159 @@ esac
case "$GCC-$host_cpu" in
yes-i86pc | yes-i*86 | yes-x86_64 | yes-amd64)
+
+ if test $ac_cv_sizeof_void_p = 4; then
+ dw_cmpxchg="cmpxchg8b"
+ else
+ dw_cmpxchg="cmpxchg16b"
+ fi
+
gcc_dw_cmpxchg_asm=no
- AC_MSG_CHECKING([for gcc double word cmpxchg asm support])
- AC_TRY_COMPILE([],
+ gcc_pic_dw_cmpxchg_asm=no
+ gcc_cflags_pic=no
+ gcc_cmpxchg8b_pic_no_clobber_ebx=no
+ gcc_cmpxchg8b_pic_no_clobber_ebx_register_shortage=no
+
+ save_CFLAGS="$CFLAGS"
+
+ # Check if it works out of the box using passed CFLAGS
+ # and with -fPIC added to CFLAGS if the passed CFLAGS
+ # doesn't trigger position independent code
+ pic_cmpxchg=unknown
+ while true; do
+
+ case $pic_cmpxchg in
+ yes) pic_text="pic ";;
+ *) pic_text="";;
+ esac
+
+ AC_MSG_CHECKING([for gcc $pic_text$dw_cmpxchg plain asm support])
+
+ plain_cmpxchg=no
+ AC_TRY_COMPILE([],
[
char xchgd;
long new[2], xchg[2], *p;
__asm__ __volatile__(
-#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__
- "pushl %%ebx\n\t"
- "movl %8, %%ebx\n\t"
-#endif
#if ETHR_SIZEOF_PTR == 4
"lock; cmpxchg8b %0\n\t"
#else
"lock; cmpxchg16b %0\n\t"
#endif
"setz %3\n\t"
-#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__
- "popl %%ebx\n\t"
-#endif
- : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd)
- : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "3"(new[1]),
-#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__
- "r"(new[0])
-#else
- "b"(new[0])
-#endif
+ : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=q"(xchgd)
+ : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "c"(new[1]), "b"(new[0])
: "cc", "memory");
+ ],
+ [plain_cmpxchg=yes])
+
+ AC_MSG_RESULT([$plain_cmpxchg])
+
+ if test $pic_cmpxchg = yes; then
+ gcc_pic_dw_cmpxchg_asm=$plain_cmpxchg
+ break
+ fi
+
+ gcc_dw_cmpxchg_asm=$plain_cmpxchg
+ # If not already compiling to position independent
+ # code add -fPIC to CFLAGS and do it again. This
+ # since we want also want to know how to compile
+ # to position independent code since this might
+ # cause problems with the use of the EBX register
+ # as input to the asm on 32-bit x86 and old gcc
+ # compilers (gcc vsn < 5).
+
+ AC_TRY_COMPILE([],
+ [
+#if !defined(__PIC__) || !__PIC__
+# error no pic
+#endif
],
- [gcc_dw_cmpxchg_asm=yes])
- if test $gcc_dw_cmpxchg_asm = no && test $ac_cv_sizeof_void_p = 4; then
+ [pic_cmpxchg=yes
+ gcc_cflags_pic=yes],
+ [pic_cmpxchg=no])
+
+ if test $pic_cmpxchg = yes; then
+ gcc_pic_dw_cmpxchg_asm=$gcc_dw_cmpxchg_asm
+ break
+ fi
+
+ CFLAGS="$save_CFLAGS -fPIC"
+ pic_cmpxchg=yes
+
+ done
+
+ if test $gcc_pic_dw_cmpxchg_asm = no && test $ac_cv_sizeof_void_p = 4; then
+
+ AC_MSG_CHECKING([for gcc pic cmpxchg8b asm support with EBX workaround])
+
+ # Check if we can work around it by managing the ebx
+ # register explicitly in the asm...
+
AC_TRY_COMPILE([],
+ [
+ char xchgd;
+ long new[2], xchg[2], *p;
+ __asm__ __volatile__(
+ "pushl %%ebx\n\t"
+ "movl %8, %%ebx\n\t"
+ "lock; cmpxchg8b %0\n\t"
+ "setz %3\n\t"
+ "popl %%ebx\n\t"
+ : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=q"(xchgd)
+ : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "c"(new[1]), "r"(new[0])
+ : "cc", "memory");
+ ],
+ [gcc_pic_dw_cmpxchg_asm=yes
+ gcc_cmpxchg8b_pic_no_clobber_ebx=yes])
+
+ AC_MSG_RESULT([$gcc_pic_dw_cmpxchg_asm])
+
+ if test $gcc_pic_dw_cmpxchg_asm = no; then
+
+ AC_MSG_CHECKING([for gcc pic cmpxchg8b asm support with EBX and register shortage workarounds])
+ # If no optimization is enabled we sometimes get a
+ # register shortage. Check if we can work around
+ # this...
+
+ AC_TRY_COMPILE([],
[
char xchgd;
long new[2], xchg[2], *p;
-#if !defined(__PIC__) || !__PIC__
-# error nope
-#endif
__asm__ __volatile__(
- "pushl %%ebx\n\t"
- "movl (%7), %%ebx\n\t"
- "movl 4(%7), %%ecx\n\t"
- "lock; cmpxchg8b %0\n\t"
- "setz %3\n\t"
- "popl %%ebx\n\t"
- : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd)
- : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "3"(new)
+ "pushl %%ebx\n\t"
+ "movl (%7), %%ebx\n\t"
+ "movl 4(%7), %%ecx\n\t"
+ "lock; cmpxchg8b %0\n\t"
+ "setz %3\n\t"
+ "popl %%ebx\n\t"
+ : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd)
+ : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "r"(new)
: "cc", "memory");
],
- [gcc_dw_cmpxchg_asm=yes])
- if test "$gcc_dw_cmpxchg_asm" = "yes"; then
- AC_DEFINE(ETHR_CMPXCHG8B_REGISTER_SHORTAGE, 1, [Define if you get a register shortage with cmpxchg8b and position independent code])
+ [gcc_pic_dw_cmpxchg_asm=yes
+ gcc_cmpxchg8b_pic_no_clobber_ebx=yes
+ gcc_cmpxchg8b_pic_no_clobber_ebx_register_shortage=yes])
+
+ AC_MSG_RESULT([$gcc_pic_dw_cmpxchg_asm])
fi
+
+ if test $gcc_cflags_pic = yes; then
+ gcc_dw_cmpxchg_asm=$gcc_pic_dw_cmpxchg_asm
+ fi
+
+ fi
+
+ CFLAGS="$save_CFLAGS"
+
+ if test "$gcc_cmpxchg8b_pic_no_clobber_ebx" = "yes"; then
+ AC_DEFINE(ETHR_CMPXCHG8B_PIC_NO_CLOBBER_EBX, 1, [Define if gcc wont let you clobber ebx with cmpxchg8b and position independent code])
+ fi
+ if test "$gcc_cmpxchg8b_pic_no_clobber_ebx_register_shortage" = "yes"; then
+ AC_DEFINE(ETHR_CMPXCHG8B_REGISTER_SHORTAGE, 1, [Define if you get a register shortage with cmpxchg8b and position independent code])
fi
- AC_MSG_RESULT([$gcc_dw_cmpxchg_asm])
if test "$gcc_dw_cmpxchg_asm" = "yes"; then
AC_DEFINE(ETHR_GCC_HAVE_DW_CMPXCHG_ASM_SUPPORT, 1, [Define if you use a gcc that supports the double word cmpxchg instruction])
fi;;
diff --git a/erts/configure.in b/erts/configure.in
index 4fb725ff00..cae3843465 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -106,7 +106,6 @@ AC_CONFIG_HEADER($host/config.h:config.h.in include/internal/$host/ethread_heade
dnl ----------------------------------------------------------------------
dnl Optional features.
dnl ----------------------------------------------------------------------
-enable_child_waiter_thread=no
ENABLE_ALLOC_TYPE_VARS=
AC_SUBST(ENABLE_ALLOC_TYPE_VARS)
@@ -143,14 +142,6 @@ AS_HELP_STRING([--enable-dirty-schedulers], [enable dirty scheduler support]),
*) enable_dirty_schedulers=yes ;;
esac ], enable_dirty_schedulers=no)
-AC_ARG_ENABLE(halfword-emulator,
-AS_HELP_STRING([--enable-halfword-emulator],
- [enable halfword emulator (only for 64bit builds). Note: Halfword emulator is marked as deprecated and scheduled for removal in future major release.]),
-[ case "$enableval" in
- no) enable_halfword_emualtor=no ;;
- *) enable_halfword_emulator=yes ;;
- esac ], enable_halfword_emulator=unknown)
-
AC_ARG_ENABLE(smp-support,
AS_HELP_STRING([--enable-smp-support], [enable smp support])
AS_HELP_STRING([--disable-smp-support], [disable smp support]),
@@ -351,6 +342,21 @@ AS_HELP_STRING([--disable-saved-compile-time], [disable saved compile time]),
AC_DEFINE_UNQUOTED(ERTS_SAVED_COMPILE_TIME, $save_compile_time, [Save compile time?])
+AC_ARG_WITH(microstate-accounting,
+AS_HELP_STRING([--with-microstate-accounting={yes|extra}],
+ [enable microstate account, possibly with extra detailed states])
+AS_HELP_STRING([--without-microstate-accounting],
+ [don't enable microstate accounting]),
+[],[with_microstate_accounting=yes])
+
+case "$with_microstate_accounting" in
+ yes) AC_DEFINE(ERTS_ENABLE_MSACC,[1],
+ [Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;;
+ extra) AC_DEFINE(ERTS_ENABLE_MSACC,[2],
+ [Define as 1 if you want to enable microstate accounting, 2 if you want extra states]) ;;
+ *) ;;
+esac
+
dnl Magic test for clearcase.
OTP_RELEASE=
if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then
@@ -468,11 +474,8 @@ case $host_os in
win32)
# The ethread library requires _WIN32_WINNT of at least 0x0403.
# -D_WIN32_WINNT=* from CPPFLAGS is saved in ETHR_DEFS.
- CPPFLAGS="$CPPFLAGS -D_WIN32_WINNT=0x0501 -DWINVER=0x0501"
+ CPPFLAGS="$CPPFLAGS -D_WIN32_WINNT=0x0600 -DWINVER=0x0600"
;;
- darwin*)
- CPPFLAGS="$CPPFLAGS -D_XOPEN_SOURCE"
- ;;
*)
;;
esac
@@ -578,6 +581,7 @@ fi
if test "x$GCC" = xyes; then
# Treat certain GCC warnings as errors
LM_TRY_ENABLE_CFLAG([-Werror=return-type], [WERRORFLAGS])
+ LM_TRY_ENABLE_CFLAG([-Werror=implicit], [WERRORFLAGS])
# until the emulator can handle this, I suggest we turn it off!
#WFLAGS="-Wall -Wshadow -Wcast-qual -Wmissing-declarations"
@@ -796,36 +800,18 @@ esac
AC_SUBST(LIBCARBON)
-dnl Check if we should/can build a halfword emulator
-
-AC_MSG_CHECKING(if we are building a halfword emulator (32bit heap on 64bit machine))
-if test "$enable_halfword_emulator" = "yes"; then
- if test "$ARCH" = "amd64"; then
- AC_DEFINE(HALFWORD_HEAP_EMULATOR, [1],
- [Define if building a halfword-heap 64bit emulator])
- ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS halfword"
- AC_MSG_RESULT([yes])
-
- test -f "$ERL_TOP/erts/CONF_INFO" ||
- echo "" > "$ERL_TOP/erts/CONF_INFO"
- cat >> $ERL_TOP/erts/CONF_INFO <<EOF
-
- The HALFWORD emulator has been enabled.
- This is a DEPRECATED feature scheduled for removal
- in a future major release.
+dnl Check if we should/can build a sharing-preserving emulator
-EOF
- else
- AC_MSG_ERROR(no; halfword emulator not supported on this architecture)
- fi
+AC_MSG_CHECKING(if we are building a sharing-preserving emulator)
+if test "$enable_sharing_preserving" = "yes"; then
+ AC_DEFINE(SHCOPY, [1],
+ [Define if building a sharing-preserving emulator])
+ AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
fi
-
-
-
dnl some tests below will call this if we haven't already - and autoconf
dnl can't handle those tests being done conditionally at runtime
AC_PROG_CPP
@@ -944,10 +930,7 @@ dnl what the user say. This might not be the right way to do it, but
dnl for now that is the way we do it.
USER_LD=$LD
USER_LDFLAGS="$LDFLAGS"
-case $host in
- *ose) ;;
- *) LD='$(CC)' ;;
-esac
+LD='$(CC)'
AC_SUBST(LD)
LDFLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH"
@@ -962,8 +945,6 @@ dnl This is the os flavour, should be unix, ose, vxworks or win32
case $host in
win32)
ERLANG_OSTYPE=win32 ;;
- *ose)
- ERLANG_OSTYPE=ose ;;
*)
ERLANG_OSTYPE=unix ;;
esac
@@ -1272,7 +1253,7 @@ case "$enable_threads"-"$found_threads" in
AC_MSG_RESULT(yes; enabled by user) ;;
unknown-yes)
case $host_os in
- solaris*|linux*|darwin*|win32|ose)
+ solaris*|linux*|darwin*|win32)
emu_threads=yes
AC_MSG_RESULT(yes; default on this platform)
;;
@@ -1334,11 +1315,7 @@ else
AC_MSG_RESULT(no)
fi
- disable_child_waiter_thread=no
case $host_os in
- solaris*)
- enable_child_waiter_thread=yes
- ;;
linux*)
AC_MSG_CHECKING([whether dlopen() needs to be called before first call to dlerror()])
if test "x$ETHR_THR_LIB_BASE_TYPE" != "xposix_nptl"; then
@@ -1348,16 +1325,6 @@ else
else
AC_MSG_RESULT(no)
fi
- if test "x$ETHR_THR_LIB_BASE_TYPE" != "xposix_nptl"; then
- # Child waiter thread cannot be enabled
- disable_child_waiter_thread=yes
- enable_child_waiter_thread=no
- fi
- ;;
- win32|ose)
- # Child waiter thread cannot be enabled
- disable_child_waiter_thread=yes
- enable_child_waiter_thread=no
;;
*)
;;
@@ -1377,24 +1344,6 @@ else
esac
done
EMU_THR_DEFS=$new_emu_thr_defs
-
- AC_MSG_CHECKING(whether the child waiter thread should be enabled)
- if test $enable_child_waiter_thread = yes; then
- AC_DEFINE(ENABLE_CHILD_WAITER_THREAD,[1],
- [Define if you want to enable child waiter thread])
- AC_MSG_RESULT(yes)
- else
- case $ERTS_BUILD_SMP_EMU-$disable_child_waiter_thread in
- yes-no)
- AC_MSG_RESULT([yes on SMP build, but not on non-SMP build]);;
- *-yes)
- AC_DEFINE(DISABLE_CHILD_WAITER_THREAD,[1],
- [Define if you want to disable child waiter thread])
- AC_MSG_RESULT(no);;
- *)
- AC_MSG_RESULT(no);;
- esac
- fi
fi
AC_SUBST(EMU_THR_LIB_NAME)
@@ -1526,19 +1475,27 @@ dnl
# if -lsocket doesn't work by itself.
#--------------------------------------------------------------------
+tk_oldLibs=$LIBS
erl_checkBoth=0
+SOCKET_LIBS=""
AC_CHECK_FUNC(connect, erl_checkSocket=0, erl_checkSocket=1)
if test "$erl_checkSocket" = 1; then
- AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", erl_checkBoth=1)
+ AC_CHECK_LIB(socket, main, SOCKET_LIBS="-lsocket", erl_checkBoth=1)
fi
+
if test "$erl_checkBoth" = 1; then
- tk_oldLibs=$LIBS
LIBS="$LIBS -lsocket -lnsl"
- AC_CHECK_FUNC(accept, erl_checkNsl=0, [LIBS=$tk_oldLibs])
+ AC_CHECK_FUNC(accept, SOCKET_LIBS="-lsocket -lnsl")
fi
-AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))
+
+LIBS="$tk_oldLibs $SOCKET_LIBS"
+AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [SOCKET_LIBS="$SOCKET_LIBS -lnsl"]))
AC_CHECK_FUNC(gethostbyname_r,have_gethostbyname_r=yes)
+LIBS="$tk_oldLibs $SOCKET_LIBS"
+
+AC_SUBST(SOCKET_LIBS)
+
dnl
dnl These gethostbyname thingies use old style AC_DEFINE for BC with ancient
dnl autoconf...
@@ -2118,7 +2075,7 @@ AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2])
AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \
pread pwrite memmove strerror strerror_r strncasecmp \
gethrtime localtime_r gmtime_r inet_pton \
- memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \
+ mmap mremap memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \
flockfile fstat strlcpy strlcat setsid posix2time time2posix \
setlocale nl_langinfo poll mlockall ppoll])
@@ -2136,8 +2093,7 @@ fi
case X$erl_xcomp_posix_memalign in
Xno) ;;
- Xyes) AC_DEFINE(HAVE_POSIX_MEMALIGN,[1],
- [Define to 1 if you have the `posix_memalign' function.]) ;;
+ Xyes) have_posix_memalign=yes ;;
*)
AC_CHECK_FUNC(
[posix_memalign],
@@ -2152,15 +2108,19 @@ int main(void) {
return error;
return 0;
}
-],AC_DEFINE(HAVE_POSIX_MEMALIGN,[1],
- [Define to 1 if you have the `posix_memalign' function.])
+],have_posix_memalign=yes
)
else
- AC_DEFINE(HAVE_POSIX_MEMALIGN,[1],
- [Define to 1 if you have the `posix_memalign' function.])
+ have_posix_memalign=yes
fi]);;
esac
+if test $have_posix_memalign = yes; then
+ AC_DEFINE(HAVE_POSIX_MEMALIGN,[1],
+ [Define to 1 if you have the `posix_memalign' function.])
+fi
+
+
dnl writev on OS X snow leopard is broken for files > 4GB
case $host_os in
darwin10.8.0)
@@ -2170,17 +2130,6 @@ case $host_os in
AC_CHECK_FUNCS([writev]) ;;
esac
-case $host_os in
- *ose)
- AC_MSG_CHECKING([for mmap])
- AC_MSG_RESULT(not using for OSE)
- AC_MSG_CHECKING([for mremap])
- AC_MSG_RESULT(not using for OSE) ;;
- *)
- AC_CHECK_FUNCS([mmap mremap]) ;;
-esac
-
-
AC_CHECK_DECLS([posix2time, time2posix],,,[#include <time.h>])
disable_vfork=false
@@ -2829,17 +2778,26 @@ LM_SYS_IPV6
LM_SYS_MULTICAST
ERL_TIME_CORRECTION
AC_CHECK_PROG(M4, m4, m4)
+
+
+dnl HiPE cannot run on 64-bit without MAP_FIXED and MAP_NORESERVE
+if test X${enable_hipe} != Xno && test X$ac_cv_sizeof_void_p != X4; then
+ AC_CHECK_DECLS([MAP_FIXED, MAP_NORESERVE], [], [], [#include <sys/mman.h>])
+ if test X$ac_cv_have_decl_MAP_FIXED != Xyes || test X$ac_cv_have_decl_MAP_NORESERVE != Xyes; then
+ if test X${enable_hipe} = Xyes; then
+ AC_MSG_ERROR([HiPE on 64-bit needs MAP_FIXED and MAP_NORESERVE flags for mmap()])
+ else
+ enable_hipe=no
+ AC_MSG_WARN([Disable HiPE due to lack of MAP_FIXED and MAP_NORESERVE flags for mmap()])
+ fi
+ fi
+fi
+
dnl check to auto-enable hipe here...
if test "$cross_compiling" != "yes" && test X${enable_hipe} != Xno; then
if test -z "$M4"; then
enable_hipe=no
AC_MSG_NOTICE([HiPE disabled as no valid m4 is found in PATH])
- elif test "$enable_halfword_emulator" = "yes"; then
- if test X${enable_hipe} = Xyes; then
- AC_MSG_ERROR([HiPE can not be combined with halfword emulator (yet)])
- else
- AC_MSG_NOTICE([HiPE auto-disabled on halfword emulator])
- fi
else
case "$ARCH-$OPSYS" in
x86-linux|amd64-linux|x86-darwin*|amd64-darwin*|ppc-linux|ppc64-linux|ppc-darwin|arm-linux|amd64-freebsd|x86-freebsd|x86-sol2|amd64-sol2|ultrasparc-linux)
@@ -2849,44 +2807,6 @@ if test "$cross_compiling" != "yes" && test X${enable_hipe} != Xno; then
fi
fi
-case $ARCH-$OPSYS in
- amd64-darwin*|x86-darwin*)
- AC_MSG_CHECKING([For modern (leopard) style mcontext_t])
- AC_TRY_COMPILE([
- #include <stdlib.h>
- #include <sys/types.h>
- #include <unistd.h>
- #include <mach/mach.h>
- #include <pthread.h>
- #include <machine/signal.h>
- #include <ucontext.h>
- ],[
- #if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
- #define __DARWIN__ 1
- #endif
-
- #ifndef __DARWIN__
- #error inpossible
- #else
-
- mcontext_t mc = NULL;
- int x = mc->__fs.__fpu_mxcsr;
-
- #endif
- ],darwin_mcontext_leopard=yes,
- darwin_mcontext_leopard=no)
- if test X"$darwin_mcontext_leopard" = X"yes"; then
- AC_DEFINE(DARWIN_MODERN_MCONTEXT,[],[Modern style mcontext_t in MacOSX])
- AC_MSG_RESULT(yes)
- else
- AC_MSG_RESULT(no)
- fi
- ;;
- *)
- darwin_mcontext_leopard=no
- ;;
-esac
-
if test X${enable_fp_exceptions} = Xauto ; then
case $host_os in
*linux*)
@@ -3768,7 +3688,7 @@ dnl crypto
#
#--------------------------------------------------------------------
-DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE"
+DED_SYS_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host -I${ERL_TOP}/erts/include/internal -I${ERL_TOP}/erts/include/internal/$host -I${ERL_TOP}/erts/emulator/sys/$ERLANG_OSTYPE -I${ERL_TOP}/erts/emulator/sys/common"
if test "X$ETHR_DEFS" = "X"; then
DED_THR_DEFS="-D_THREAD_SAFE -D_REENTRANT"
@@ -4111,7 +4031,7 @@ AC_ARG_WITH(ssl-rpath,
AS_HELP_STRING([--with-ssl-rpath=yes|no|PATHS],
[runtime library path for OpenSSL. Default is "yes", which equates to a
number of standard locations. If "no", then no runtime
- library paths wil be used. Anything else should be a
+ library paths will be used. Anything else should be a
comma separated list of paths.]),
[
case X$with_ssl in
@@ -4940,7 +4860,6 @@ AC_OUTPUT(
Makefile:Makefile.in
../make/$host/otp.mk:../make/otp.mk.in
../make/$host/otp_ded.mk:../make/otp_ded.mk.in
- ../make/$host/ose_lm.mk:../make/ose_lm.mk.in
dnl
dnl The ones below should be moved to their respective lib
dnl
diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml
index df2553ced3..13756ddfdc 100644
--- a/erts/doc/src/absform.xml
+++ b/erts/doc/src/absform.xml
@@ -4,14 +4,14 @@
<chapter>
<header>
<copyright>
- <year>2001</year><year>2015</year>
+ <year>2001</year><year>2016</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
-
+
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
@@ -19,7 +19,7 @@
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-
+
</legalnotice>
<title>The Abstract Format</title>
@@ -35,24 +35,24 @@
<p></p>
<p>This document describes the standard representation of parse trees for Erlang
programs as Erlang terms. This representation is known as the <em>abstract format</em>.
- Functions dealing with such parse trees are <c><![CDATA[compile:forms/[1,2]]]></c>
+ Functions dealing with such parse trees are <c>compile:forms/[1,2]</c>
and functions in the modules
- <c><![CDATA[epp]]></c>,
- <c><![CDATA[erl_eval]]></c>,
- <c><![CDATA[erl_lint]]></c>,
- <c><![CDATA[erl_pp]]></c>,
- <c><![CDATA[erl_parse]]></c>,
+ <c>epp</c>,
+ <c>erl_eval</c>,
+ <c>erl_lint</c>,
+ <c>erl_pp</c>,
+ <c>erl_parse</c>,
and
- <c><![CDATA[io]]></c>.
+ <c>io</c>.
They are also used as input and output for parse transforms (see the module
- <c><![CDATA[compile]]></c>).</p>
- <p>We use the function <c><![CDATA[Rep]]></c> to denote the mapping from an Erlang source
- construct <c><![CDATA[C]]></c> to its abstract format representation <c><![CDATA[R]]></c>, and write
- <c><![CDATA[R = Rep(C)]]></c>.
+ <c>compile</c>).</p>
+ <p>We use the function <c>Rep</c> to denote the mapping from an Erlang source
+ construct <c>C</c> to its abstract format representation <c>R</c>, and write
+ <c>R = Rep(C)</c>.
</p>
- <p>The word <c><![CDATA[LINE]]></c> below represents an integer, and denotes the
+ <p>The word <c>LINE</c> below represents an integer, and denotes the
number of the line in the source file where the construction occurred.
- Several instances of <c><![CDATA[LINE]]></c> in the same construction may denote
+ Several instances of <c>LINE</c> in the same construction may denote
different lines.</p>
<p>Since operators are not terms in their own right, when operators are
mentioned below, the representation of an operator should be taken to
@@ -61,233 +61,114 @@
</p>
<section>
- <title>Module declarations and forms</title>
+ <title>Module Declarations and Forms</title>
<p>A module declaration consists of a sequence of forms that are either
function declarations or attributes.</p>
<list type="bulleted">
<item>If D is a module declaration consisting of the forms
- <c><![CDATA[F_1]]></c>, ..., <c><![CDATA[F_k]]></c>, then
- Rep(D) = <c><![CDATA[[Rep(F_1), ..., Rep(F_k)]]]></c>.</item>
- <item>If F is an attribute <c><![CDATA[-module(Mod)]]></c>, then
- Rep(F) = <c><![CDATA[{attribute,LINE,module,Mod}]]></c>.</item>
- <item>If F is an attribute <c><![CDATA[-behavior(Behavior)]]></c>, then
- Rep(F) = <c><![CDATA[{attribute,LINE,behavior,Behavior}]]></c>.</item>
- <item>If F is an attribute <c><![CDATA[-behaviour(Behaviour)]]></c>, then
- Rep(F) = <c><![CDATA[{attribute,LINE,behaviour,Behaviour}]]></c>.</item>
- <item>If F is an attribute <c><![CDATA[-export([Fun_1/A_1, ..., Fun_k/A_k])]]></c>, then
- Rep(F) = <c><![CDATA[{attribute,LINE,export,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}]]></c>.</item>
- <item>If F is an attribute <c><![CDATA[-import(Mod,[Fun_1/A_1, ..., Fun_k/A_k])]]></c>, then
- Rep(F) = <c><![CDATA[{attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}]]></c>.</item>
- <item>If F is an attribute <c><![CDATA[-compile(Options)]]></c>, then
- Rep(F) = <c><![CDATA[{attribute,LINE,compile,Options}]]></c>.</item>
- <item>If F is an attribute <c><![CDATA[-file(File,Line)]]></c>, then
- Rep(F) = <c><![CDATA[{attribute,LINE,file,{File,Line}}]]></c>.</item>
- <item>If F is a record declaration <c><![CDATA[-record(Name,{V_1, ..., V_k})]]></c>, then
- Rep(F) =
- <c><![CDATA[{attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}]]></c>. For Rep(V), see below.</item>
- <item>If F is a type attribute (i.e. <c><![CDATA[opaque]]></c> or
- <c><![CDATA[type]]></c>)
- <c><![CDATA[-Attr Name(A_1, ..., A_k) :: T]]></c> where each
- <c><![CDATA[A_i]]></c> is a variable, then Rep(F) =
- <c><![CDATA[{attribute,LINE,Attr,{Name,Rep(T),[Rep(A_1), ..., Rep(A_k)]}}]]></c>.
- For Rep(T), see below.</item>
- <item>If F is a type spec (i.e. <c><![CDATA[callback]]></c> or
- <c><![CDATA[spec]]></c>)
- <c><![CDATA[-Attr F Tc_1; ...; Tc_k]]></c>,
- where each <c><![CDATA[Tc_i]]></c> is a fun type clause with an
- argument sequence of the same length <c><![CDATA[Arity]]></c>, then
- Rep(F) =
- <c><![CDATA[{Attr,LINE,{{F,Arity},[Rep(Tc_1), ..., Rep(Tc_k)]}}]]></c>.
- For Rep(Tc_i), see below.</item>
- <item>If F is a type spec (i.e. <c><![CDATA[callback]]></c> or
- <c><![CDATA[spec]]></c>)
- <c><![CDATA[-Attr Mod:F Tc_1; ...; Tc_k]]></c>,
- where each <c><![CDATA[Tc_i]]></c> is a fun type clause with an
- argument sequence of the same length <c><![CDATA[Arity]]></c>, then
- Rep(F) =
- <c><![CDATA[{Attr,LINE,{{Mod,F,Arity},[Rep(Tc_1), ..., Rep(Tc_k)]}}]]></c>.
- For Rep(Tc_i), see below.</item>
- <item>If F is a wild attribute <c><![CDATA[-A(T)]]></c>, then
- Rep(F) = <c><![CDATA[{attribute,LINE,A,T}]]></c>.
+ <c>F_1</c>, ..., <c>F_k</c>, then
+ Rep(D) = <c>[Rep(F_1), ..., Rep(F_k)]</c>.</item>
+ <item>If F is an attribute <c>-behavior(Behavior)</c>, then
+ Rep(F) = <c>{attribute,LINE,behavior,Behavior}</c>.</item>
+ <item>If F is an attribute <c>-behaviour(Behaviour)</c>, then
+ Rep(F) = <c>{attribute,LINE,behaviour,Behaviour}</c>.</item>
+ <item>If F is an attribute <c>-compile(Options)</c>, then
+ Rep(F) = <c>{attribute,LINE,compile,Options}</c>.</item>
+ <item>If F is an attribute <c>-export([Fun_1/A_1, ..., Fun_k/A_k])</c>, then
+ Rep(F) = <c>{attribute,LINE,export,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}</c>.</item>
+ <item>If F is an attribute <c>-export_type([Type_1/A_1, ..., Type_k/A_k])</c>, then
+ Rep(F) = <c>{attribute,LINE,export_type,[{Type_1,A_1}, ..., {Type_k,A_k}]}</c>.</item>
+ <item>If F is an attribute <c>-import(Mod,[Fun_1/A_1, ..., Fun_k/A_k])</c>, then
+ Rep(F) = <c>{attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}</c>.</item>
+ <item>If F is an attribute <c>-module(Mod)</c>, then
+ Rep(F) = <c>{attribute,LINE,module,Mod}</c>.</item>
+ <item>If F is an attribute <c>-optional_callbacks([Fun_1/A_1, ..., Fun_k/A_k])</c>, then
+ Rep(F) = <c>{attribute,LINE,optional_callbacks,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}</c>.</item>
+ <item>If F is an attribute <c>-file(File,Line)</c>, then
+ Rep(F) = <c>{attribute,LINE,file,{File,Line}}</c>.</item>
+ <item>If F is a function declaration
+ <c>Name Fc_1 ; ... ; Name Fc_k</c>,
+ where each <c>Fc_i</c> is a function clause with a
+ pattern sequence of the same length <c>Arity</c>, then
+ Rep(F) = <c>{function,LINE,Name,Arity,[Rep(Fc_1), ...,Rep(Fc_k)]}</c>.
+ </item>
+ <item>If F is a function specification
+ <c>-Spec Name Ft_1; ...; Ft_k</c>,
+ where <c>Spec</c> is either the atom <c>spec</c> or the atom
+ <c>callback</c>, and each <c>Ft_i</c> is a possibly constrained
+ function type with an argument sequence of the same length
+ <c>Arity</c>, then Rep(F) =
+ <c>{attribute,Line,Spec,{{Name,Arity},[Rep(Ft_1), ..., Rep(Ft_k)]}}</c>.
+ </item>
+ <item>If F is a function specification
+ <c>-spec Mod:Name Ft_1; ...; Ft_k</c>,
+ where each <c>Ft_i</c> is a possibly constrained
+ function type with an argument sequence of the same length
+ <c>Arity</c>, then Rep(F) =
+ <c>{attribute,Line,spec,{{Mod,Name,Arity},[Rep(Ft_1), ..., Rep(Ft_k)]}}</c>.
+ </item>
+ <item>If F is a record declaration
+ <c>-record(Name,{V_1, ..., V_k})</c>,
+ where each <c>V_i</c> is a record field, then Rep(F) =
+ <c>{attribute,LINE,record,{Name,[Rep(V_1), ..., Rep(V_k)]}}</c>.
+ For Rep(V), see below.</item>
+ <item>If F is a type declaration
+ <c>-Type Name(V_1, ..., V_k) :: T</c>, where
+ <c>Type</c> is either the atom <c>type</c> or the atom <c>opaque</c>,
+ each <c>V_i</c> is a variable, and <c>T</c> is a type, then Rep(F) =
+ <c>{attribute,LINE,Type,{Name,Rep(T),[Rep(V_1), ..., Rep(V_k)]}}</c>.
+ </item>
+ <item>If F is a wild attribute <c>-A(T)</c>, then
+ Rep(F) = <c>{attribute,LINE,A,T}</c>.
<br></br></item>
- <item>If F is a function declaration <c><![CDATA[Name Fc_1 ; ... ; Name Fc_k]]></c>,
- where each <c><![CDATA[Fc_i]]></c> is a function clause with a
- pattern sequence of the same length <c><![CDATA[Arity]]></c>, then
- Rep(F) = <c><![CDATA[{function,LINE,Name,Arity,[Rep(Fc_1), ...,Rep(Fc_k)]}]]></c>.</item>
</list>
<section>
- <title>Type clauses</title>
- <list type="bulleted">
- <item>If T is a fun type clause
- <c><![CDATA[(A_1, ..., A_n) -> Ret]]></c>, where each
- <c><![CDATA[A_i]]></c> and <c><![CDATA[Ret]]></c> are types, then
- Rep(T) =
- <c><![CDATA[{type,LINE,'fun',[{type,LINE,product,[Rep(A_1), ..., Rep(A_n)]},Rep(Ret)]}]]></c>.
- </item>
- <item>If T is a bounded fun type clause <c><![CDATA[Tc when Tg]]></c>,
- where <c><![CDATA[Tc]]></c> is an unbounded fun type clause and
- <c><![CDATA[Tg]]></c> is a type guard sequence, then Rep(T) =
- <c><![CDATA[{type,LINE,bounded_fun,[Rep(Tc),Rep(Tg)]}]]></c>.</item>
- </list>
- </section>
-
- <section>
- <title>Type guards</title>
- <list type="bulleted">
- <item>If G is a constraint <c><![CDATA[F(A_1, ..., A_k)]]></c>, where
- <c><![CDATA[F]]></c> is an atom and each <c><![CDATA[A_i]]></c> is a
- type, then Rep(G) =
- <c><![CDATA[{type,LINE,constraint,[Rep(F),[Rep(A_1), ..., Rep(A_k)]]}]]></c>.
- </item>
- <item>If G is a type definition <c><![CDATA[Name :: Type]]></c>,
- where <c><![CDATA[Name]]></c> is a variable and
- <c><![CDATA[Type]]></c> is a type, then Rep(G) =
- <c><![CDATA[{type,LINE,constraint,[{atom,LINE,is_subtype},[Rep(Name),Rep(Type)]]}]]></c>.</item>
- </list>
- </section>
-
- <section>
- <title>Types</title>
- <list type="bulleted">
- <item>If T is a type definition <c><![CDATA[Name :: Type]]></c>,
- where <c><![CDATA[Name]]></c> is a variable and
- <c><![CDATA[Type]]></c> is a type, then Rep(T) =
- <c><![CDATA[{ann_type,LINE,[Rep(Name),Rep(Type)]}]]></c>.</item>
- <item>If T is a type union <c><![CDATA[A_1 | ... | A_k]]></c>,
- where each <c><![CDATA[A_i]]></c> is a type, then Rep(T) =
- <c><![CDATA[{type,LINE,union,[Rep(A_1), ..., Rep(A_k)]}]]></c>.</item>
- <item>If T is a type range <c><![CDATA[L .. R]]></c>,
- where <c><![CDATA[L]]></c> and <c><![CDATA[R]]></c> are types, then
- Rep(T) = <c><![CDATA[{type,LINE,range,[Rep(L), Rep(R)]}]]></c>.</item>
- <item>If T is a binary operation <c><![CDATA[L Op R]]></c>,
- where <c><![CDATA[Op]]></c> is an arithmetic or bitwise binary operator
- and <c><![CDATA[L]]></c> and <c><![CDATA[R]]></c> are types, then
- Rep(T) = <c><![CDATA[{op,LINE,Op,Rep(L),Rep(R)}]]></c>.</item>
- <item>If T is <c><![CDATA[Op A]]></c>, where <c><![CDATA[Op]]></c> is an
- arithmetic or bitwise unary operator and <c><![CDATA[A]]></c> is a
- type, then Rep(T) = <c><![CDATA[{op,LINE,Op,Rep(A)}]]></c>.</item>
- <item>If T is a fun type <c><![CDATA[fun()]]></c>, then Rep(T) =
- <c><![CDATA[{type,LINE,'fun',[]}]]></c>.</item>
- <item>If T is a variable <c><![CDATA[V]]></c>, then Rep(T) =
- <c><![CDATA[{var,LINE,A}]]></c>, where <c><![CDATA[A]]></c> is an atom
- with a printname consisting of the same characters as
- <c><![CDATA[V]]></c>.</item>
- <item>If T is an atomic literal L and L is not a string literal, then
- Rep(T) = Rep(L).</item>
- <item>If T is a tuple or map type <c><![CDATA[F()]]></c> (i.e.
- <c><![CDATA[tuple]]></c> or <c><![CDATA[map]]></c>), then Rep(T) =
- <c><![CDATA[{type,LINE,F,any}]]></c>.</item>
- <item>If T is a type <c><![CDATA[F(A_1, ..., A_k)]]></c>, where each
- <c><![CDATA[A_i]]></c> is a type, then Rep(T) =
- <c><![CDATA[{user_type,LINE,F,[Rep(A_1), ..., Rep(A_k)]}]]></c>.</item>
- <item>If T is a remote type <c><![CDATA[M:F(A_1, ..., A_k)]]></c>, where
- each <c><![CDATA[A_i]]></c> is a type and <c><![CDATA[M]]></c> and
- <c><![CDATA[F]]></c>, then Rep(T) =
- <c><![CDATA[{remote_type,LINE,[Rep(M),Rep(F),[Rep(A_1), ..., Rep(A_k)]]}]]></c>.
- </item>
- <item>If T is the nil type <c><![CDATA[[]]]></c>, then Rep(T) =
- <c><![CDATA[{type,LINE,nil,[]}]]></c>.</item>
- <item>If T is a list type <c><![CDATA[[A]]]></c>, where
- <c><![CDATA[A]]></c> is a type, then Rep(T) =
- <c><![CDATA[{type,LINE,list,[Rep(A)]}]]></c>.</item>
- <item>If T is a non-empty list type <c><![CDATA[[A, ...]]]></c>, where
- <c><![CDATA[A]]></c> is a type, then Rep(T) =
- <c><![CDATA[{type,LINE,nonempty_list,[Rep(A)]}]]></c>.</item>
- <item>If T is a map type <c><![CDATA[#{P_1, ..., P_k}]]></c>, where each
- <c><![CDATA[P_i]]></c> is a map pair type, then Rep(T) =
- <c><![CDATA[{type,LINE,map,[Rep(P_1), ..., Rep(P_k)]}]]></c>.</item>
- <item>If T is a map pair type <c><![CDATA[K => V]]></c>, where
- <c><![CDATA[K]]></c> and <c><![CDATA[V]]></c> are types,
- then Rep(T) =
- <c><![CDATA[{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}]]></c>.</item>
- <item>If T is a tuple type <c><![CDATA[{A_1, ..., A_k}]]></c>, where
- each <c><![CDATA[A_i]]></c> is a type, then Rep(T) =
- <c><![CDATA[{type,LINE,tuple,[Rep(A_1), ..., Rep(A_k)]}]]></c>.</item>
- <item>If T is a record type <c><![CDATA[#Name{}]]></c>, where
- <c><![CDATA[Name]]></c> is an atom, then Rep(T) =
- <c><![CDATA[{type,LINE,record,[Rep(Name)]}]]></c>.</item>
- <item>If T is a record type <c><![CDATA[#Name{F_1, ..., F_k}]]></c>,
- where <c><![CDATA[Name]]></c> is an atom, then Rep(T) =
- <c><![CDATA[{type,LINE,record,[Rep(Name),[Rep(F_1), ..., Rep(F_k)]]}]]></c>.
- </item>
- <item>If T is a record field type <c><![CDATA[Name :: Type]]></c>,
- where <c><![CDATA[Name]]></c> is an atom, then Rep(T) =
- <c><![CDATA[{type,LINE,field_type,[Rep(Name),Rep(Type)]}]]></c>.</item>
- <item>If T is a record field type <c><![CDATA[<<>>]]></c>, then Rep(T) =
- <c><![CDATA[{type,LINE,binary,[{integer,LINE,0},{integer,LINE,0}]}]]></c>.
- </item>
- <item>If T is a binary type <c><![CDATA[<< _ : B >>]]></c>, where
- <c><![CDATA[B]]></c> is a type, then Rep(T) =
- <c><![CDATA[{type,LINE,binary,[Rep(B),{integer,LINE,0}]}]]></c>.</item>
- <item>If T is a binary type <c><![CDATA[<< _ : _ * U >>]]></c>,
- where <c><![CDATA[U]]></c> is a type, then Rep(T) =
- <c><![CDATA[{type,LINE,binary,[{integer,LINE,0},Rep(U)]}]]></c>.</item>
- <item>If T is a binary type <c><![CDATA[<< _ : B , _ : _ * U >>]]></c>,
- where <c><![CDATA[B]]></c> and <c><![CDATA[U]]></c> is a type, then
- Rep(T) =
- <c><![CDATA[{type,LINE,binary,[Rep(B),Rep(U)]}]]></c>.</item>
-
- <item>If T is a fun type <c><![CDATA[fun((...) -> Ret)]]></c>, then
- Rep(T) = <c><![CDATA[{type,LINE,'fun',[{type,LINE,product,[]},Rep(Ret)]}]]></c>.
- </item>
- <item>If T is a fun type <c><![CDATA[fun(Tc)]]></c>, where
- <c><![CDATA[Tc]]></c> is an unbounded fun type clause,
- then Rep(T) = <c><![CDATA[Rep(Tc)]]></c>.</item>
- </list>
- </section>
-
- <section>
- <title>Record fields</title>
+ <title>Record Fields</title>
<p>Each field in a record declaration may have an optional
- explicit default initializer expression</p>
+ explicit default initializer expression, as well as an
+ optional type.</p>
<list type="bulleted">
- <item>If V is <c><![CDATA[A]]></c>, then
- Rep(V) = <c><![CDATA[{record_field,LINE,Rep(A)}]]></c>.</item>
- <item>If V is <c><![CDATA[A = E]]></c>, then
- Rep(V) = <c><![CDATA[{record_field,LINE,Rep(A),Rep(E)}]]></c>.</item>
- <item>If V is <c><![CDATA[A :: T]]></c>, where <c><![CDATA[A]]></c> is
- an atom and <c><![CDATA[T]]></c> is a type and it does not contain
- <c><![CDATA[undefined]]></c> syntactically, then Rep(V) =
- <c><![CDATA[{typed_record_field,{record_field,LINE,Rep(A)},Rep(undefined | T)}]]></c>.
- Note that if <![CDATA[T]]> is an annotated type, it will be wrapped in
- parentheses.</item>
- <item>If V is <c><![CDATA[A :: T]]></c>, where <c><![CDATA[A]]></c> is
- an atom and <c><![CDATA[T]]></c> is a type, then Rep(V) =
- <c><![CDATA[{typed_record_field,{record_field,LINE,Rep(A)},Rep(T)}]]></c>.
- </item>
- <item>If V is <c><![CDATA[A = E :: T]]></c>, where <c><![CDATA[A]]></c>
- is an atom, <c><![CDATA[E]]></c> is an expression and
- <c><![CDATA[T]]></c> is a type, then Rep(V) =
- <c><![CDATA[{typed_record_field,{record_field,LINE,Rep(A),Rep(E)},Rep(T)}]]></c>.
- </item>
+ <item>If V is <c>A</c>, then
+ Rep(V) = <c>{record_field,LINE,Rep(A)}</c>.</item>
+ <item>If V is <c>A = E</c>,
+ where <c>E</c> is an expression, then
+ Rep(V) = <c>{record_field,LINE,Rep(A),Rep(E)}</c>.</item>
+ <item>If V is <c>A :: T</c>, where <c>T</c> is a type, then Rep(V) =
+ <c>{typed_record_field,{record_field,LINE,Rep(A)},Rep(T)}</c>.
+ </item>
+ <item>If V is <c>A = E :: T</c>, where
+ <c>E</c> is an expression and <c>T</c> is a type, then Rep(V) =
+ <c>{typed_record_field,{record_field,LINE,Rep(A),Rep(E)},Rep(T)}</c>.
+ </item>
</list>
</section>
<section>
- <title>Representation of parse errors and end of file</title>
+ <title>Representation of Parse Errors and End-of-file</title>
<p>In addition to the representations of forms, the list that represents
- a module declaration (as returned by functions in <c><![CDATA[erl_parse]]></c> and
- <c><![CDATA[epp]]></c>) may contain tuples <c><![CDATA[{error,E}]]></c> and <c><![CDATA[{warning,W}]]></c>, denoting
- syntactically incorrect forms and warnings, and <c><![CDATA[{eof,LINE}]]></c>, denoting an end
- of stream encountered before a complete form had been parsed.</p>
+ a module declaration (as returned by functions in <c>erl_parse</c> and
+ <c>epp</c>) may contain tuples <c>{error,E}</c> and
+ <c>{warning,W}</c>, denoting syntactically incorrect forms and
+ warnings, and <c>{eof,LINE}</c>, denoting an end-of-stream
+ encountered before a complete form had been parsed.</p>
</section>
</section>
<section>
- <title>Atomic literals</title>
+ <title>Atomic Literals</title>
<p>There are five kinds of atomic literals, which are represented in the
same way in patterns, expressions and guards:</p>
<list type="bulleted">
- <item>If L is an integer or character literal, then
- Rep(L) = <c><![CDATA[{integer,LINE,L}]]></c>.</item>
+ <item>If L is an atom literal, then
+ Rep(L) = <c>{atom,LINE,L}</c>.</item>
<item>If L is a float literal, then
- Rep(L) = <c><![CDATA[{float,LINE,L}]]></c>.</item>
+ Rep(L) = <c>{float,LINE,L}</c>.</item>
+ <item>If L is an integer or character literal, then
+ Rep(L) = <c>{integer,LINE,L}</c>.</item>
<item>If L is a string literal consisting of the characters
- <c><![CDATA[C_1]]></c>, ..., <c><![CDATA[C_k]]></c>, then
- Rep(L) = <c><![CDATA[{string,LINE,[C_1, ..., C_k]}]]></c>.</item>
- <item>If L is an atom literal, then
- Rep(L) = <c><![CDATA[{atom,LINE,L}]]></c>.</item>
+ <c>C_1</c>, ..., <c>C_k</c>, then
+ Rep(L) = <c>{string,LINE,[C_1, ..., C_k]}</c>.</item>
</list>
<p>Note that negative integer and float literals do not occur as such; they are
parsed as an application of the unary negation operator.</p>
@@ -295,47 +176,59 @@
<section>
<title>Patterns</title>
- <p>If <c><![CDATA[Ps]]></c> is a sequence of patterns <c><![CDATA[P_1, ..., P_k]]></c>, then
- Rep(Ps) = <c><![CDATA[[Rep(P_1), ..., Rep(P_k)]]]></c>. Such sequences occur as the
+ <p>If Ps is a sequence of patterns <c>P_1, ..., P_k</c>, then
+ Rep(Ps) = <c>[Rep(P_1), ..., Rep(P_k)]</c>. Such sequences occur as the
list of arguments to a function or fun.</p>
<p>Individual patterns are represented as follows:</p>
<list type="bulleted">
- <item>If P is an atomic literal L, then Rep(P) = Rep(L).</item>
- <item>If P is a compound pattern <c><![CDATA[P_1 = P_2]]></c>, then
- Rep(P) = <c><![CDATA[{match,LINE,Rep(P_1),Rep(P_2)}]]></c>.</item>
- <item>If P is a variable pattern <c><![CDATA[V]]></c>, then
- Rep(P) = <c><![CDATA[{var,LINE,A}]]></c>,
- where A is an atom with a printname consisting of the same characters as
- <c><![CDATA[V]]></c>.</item>
- <item>If P is a universal pattern <c><![CDATA[_]]></c>, then
- Rep(P) = <c><![CDATA[{var,LINE,'_'}]]></c>.</item>
- <item>If P is a tuple pattern <c><![CDATA[{P_1, ..., P_k}]]></c>, then
- Rep(P) = <c><![CDATA[{tuple,LINE,[Rep(P_1), ..., Rep(P_k)]}]]></c>.</item>
- <item>If P is a nil pattern <c><![CDATA[[]]]></c>, then
- Rep(P) = <c><![CDATA[{nil,LINE}]]></c>.</item>
- <item>If P is a cons pattern <c><![CDATA[[P_h | P_t]]]></c>, then
- Rep(P) = <c><![CDATA[{cons,LINE,Rep(P_h),Rep(P_t)}]]></c>.</item>
- <item>If E is a binary pattern <c><![CDATA[<<P_1:Size_1/TSL_1, ..., P_k:Size_k/TSL_k>>]]></c>, then
- Rep(E) = <c><![CDATA[{bin,LINE,[{bin_element,LINE,Rep(P_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(P_k),Rep(Size_k),Rep(TSL_k)}]}]]></c>.
+ <item>If P is an atomic literal <c>L</c>, then Rep(P) = Rep(L).</item>
+ <item>If P is a bit string pattern
+ <c>&lt;&lt;P_1:Size_1/TSL_1, ..., P_k:Size_k/TSL_k>></c>, where each
+ <c>Size_i</c> is an expression that can be evaluated to an integer
+ and each <c>TSL_i</c> is a type specificer list, then
+ Rep(P) = <c>{bin,LINE,[{bin_element,LINE,Rep(P_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(P_k),Rep(Size_k),Rep(TSL_k)}]}</c>.
For Rep(TSL), see below.
- An omitted <c><![CDATA[Size]]></c> is represented by <c><![CDATA[default]]></c>. An omitted <c><![CDATA[TSL]]></c>
- (type specifier list) is represented by <c><![CDATA[default]]></c>.</item>
- <item>If P is <c><![CDATA[P_1 Op P_2]]></c>, where <c><![CDATA[Op]]></c> is a binary operator (this
- is either an occurrence of <c><![CDATA[++]]></c> applied to a literal string or character
+ An omitted <c>Size_i</c> is represented by <c>default</c>.
+ An omitted <c>TSL_i</c> is represented by <c>default</c>.</item>
+ <item>If P is a compound pattern <c>P_1 = P_2</c>, then
+ Rep(P) = <c>{match,LINE,Rep(P_1),Rep(P_2)}</c>.</item>
+ <item>If P is a cons pattern <c>[P_h | P_t]</c>, then
+ Rep(P) = <c>{cons,LINE,Rep(P_h),Rep(P_t)}</c>.</item>
+ <item>If P is a map pattern <c>#{A_1, ..., A_k}</c>, where each
+ <c>A_i</c> is an association <c>P_i_1 := P_i_2</c>, then Rep(P) =
+ <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see
+ below.</item>
+ <item>If P is a nil pattern <c>[]</c>, then
+ Rep(P) = <c>{nil,LINE}</c>.</item>
+ <item>If P is an operator pattern <c>P_1 Op P_2</c>,
+ where <c>Op</c> is a binary operator (this is either an occurrence
+ of <c>++</c> applied to a literal string or character
list, or an occurrence of an expression that can be evaluated to a number
at compile time),
- then Rep(P) = <c><![CDATA[{op,LINE,Op,Rep(P_1),Rep(P_2)}]]></c>.</item>
- <item>If P is <c><![CDATA[Op P_0]]></c>, where <c><![CDATA[Op]]></c> is a unary operator (this is an
- occurrence of an expression that can be evaluated to a number at compile
- time), then Rep(P) = <c><![CDATA[{op,LINE,Op,Rep(P_0)}]]></c>.</item>
- <item>If P is a record pattern <c><![CDATA[#Name{Field_1=P_1, ..., Field_k=P_k}]]></c>,
- then Rep(P) =
- <c><![CDATA[{record,LINE,Name, [{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}]]></c>.</item>
- <item>If P is <c><![CDATA[#Name.Field]]></c>, then
- Rep(P) = <c><![CDATA[{record_index,LINE,Name,Rep(Field)}]]></c>.</item>
- <item>If P is <c><![CDATA[( P_0 )]]></c>, then
- Rep(P) = <c><![CDATA[Rep(P_0)]]></c>,
- i.e., patterns cannot be distinguished from their bodies.</item>
+ then Rep(P) = <c>{op,LINE,Op,Rep(P_1),Rep(P_2)}</c>.</item>
+ <item>If P is an operator pattern <c>Op P_0</c>,
+ where <c>Op</c> is a unary operator (this is an occurrence of
+ an expression that can be evaluated to a number at compile
+ time), then Rep(P) = <c>{op,LINE,Op,Rep(P_0)}</c>.</item>
+ <item>If P is a parenthesized pattern <c>( P_0 )</c>, then
+ Rep(P) = <c>Rep(P_0)</c>,
+ that is, parenthesized patterns cannot be distinguished from their
+ bodies.</item>
+ <item>If P is a record field index pattern <c>#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(P) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
+ <item>If P is a record pattern
+ <c>#Name{Field_1=P_1, ..., Field_k=P_k}</c>,
+ where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(P) =
+ <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(P_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(P_k)}]}</c>.</item>
+ <item>If P is a tuple pattern <c>{P_1, ..., P_k}</c>, then
+ Rep(P) = <c>{tuple,LINE,[Rep(P_1), ..., Rep(P_k)]}</c>.</item>
+ <item>If P is a universal pattern <c>_</c>, then
+ Rep(P) = <c>{var,LINE,'_'}</c>.</item>
+ <item>If P is a variable pattern <c>V</c>, then
+ Rep(P) = <c>{var,LINE,A}</c>,
+ where A is an atom with a printname consisting of the same characters as
+ <c>V</c>.</item>
</list>
<p>Note that every pattern has the same source form as some expression, and is
represented the same way as the corresponding expression.</p>
@@ -343,180 +236,187 @@
<section>
<title>Expressions</title>
- <p>A body B is a sequence of expressions <c><![CDATA[E_1, ..., E_k]]></c>, and
- Rep(B) = <c><![CDATA[[Rep(E_1), ..., Rep(E_k)]]]></c>.</p>
+ <p>A body B is a nonempty sequence of expressions <c>E_1, ..., E_k</c>,
+ and Rep(B) = <c>[Rep(E_1), ..., Rep(E_k)]</c>.</p>
<p>An expression E is one of the following alternatives:</p>
<list type="bulleted">
- <item>If P is an atomic literal <c><![CDATA[L]]></c>, then
- Rep(P) = Rep(L).</item>
- <item>If E is <c><![CDATA[P = E_0]]></c>, then
- Rep(E) = <c><![CDATA[{match,LINE,Rep(P),Rep(E_0)}]]></c>.</item>
- <item>If E is a variable <c><![CDATA[V]]></c>, then
- Rep(E) = <c><![CDATA[{var,LINE,A}]]></c>,
- where <c><![CDATA[A]]></c> is an atom with a printname consisting of the same
- characters as <c><![CDATA[V]]></c>.</item>
- <item>If E is a tuple skeleton <c><![CDATA[{E_1, ..., E_k}]]></c>, then
- Rep(E) = <c><![CDATA[{tuple,LINE,[Rep(E_1), ..., Rep(E_k)]}]]></c>.</item>
- <item>If E is <c><![CDATA[[]]]></c>, then
- Rep(E) = <c><![CDATA[{nil,LINE}]]></c>.</item>
- <item>If E is a cons skeleton <c><![CDATA[[E_h | E_t]]]></c>, then
- Rep(E) = <c><![CDATA[{cons,LINE,Rep(E_h),Rep(E_t)}]]></c>.</item>
- <item>If E is a binary constructor <c><![CDATA[<<V_1:Size_1/TSL_1, ..., V_k:Size_k/TSL_k>>]]></c>, then
- Rep(E) = <c><![CDATA[{bin,LINE,[{bin_element,LINE,Rep(V_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(V_k),Rep(Size_k),Rep(TSL_k)}]}]]></c>.
+ <item>If E is an atomic literal <c>L</c>, then Rep(E) = Rep(L).</item>
+ <item>If E is a bit string comprehension
+ <c>&lt;&lt;E_0 || Q_1, ..., Q_k>></c>,
+ where each <c>Q_i</c> is a qualifier, then
+ Rep(E) = <c>{bc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}</c>.
+ For Rep(Q), see below.</item>
+ <item>If E is a bit string constructor
+ <c>&lt;&lt;E_1:Size_1/TSL_1, ..., E_k:Size_k/TSL_k>></c>,
+ where each <c>Size_i</c> is an expression and each
+ <c>TSL_i</c> is a type specificer list, then Rep(E) =
+ <c>{bin,LINE,[{bin_element,LINE,Rep(E_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(E_k),Rep(Size_k),Rep(TSL_k)}]}</c>.
For Rep(TSL), see below.
- An omitted <c><![CDATA[Size]]></c> is represented by <c><![CDATA[default]]></c>. An omitted <c><![CDATA[TSL]]></c>
- (type specifier list) is represented by <c><![CDATA[default]]></c>.</item>
- <item>If E is <c><![CDATA[E_1 Op E_2]]></c>, where <c><![CDATA[Op]]></c> is a binary operator,
- then Rep(E) = <c><![CDATA[{op,LINE,Op,Rep(E_1),Rep(E_2)}]]></c>.</item>
- <item>If E is <c><![CDATA[Op E_0]]></c>, where <c><![CDATA[Op]]></c> is a unary operator, then
- Rep(E) = <c><![CDATA[{op,LINE,Op,Rep(E_0)}]]></c>.</item>
- <item>If E is <c><![CDATA[#Name{Field_1=E_1, ..., Field_k=E_k}]]></c>, then
- Rep(E) =
- <c><![CDATA[{record,LINE,Name, [{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}]]></c>.</item>
- <item>If E is <c><![CDATA[E_0#Name{Field_1=E_1, ..., Field_k=E_k}]]></c>, then
- Rep(E) =
- <c><![CDATA[{record,LINE,Rep(E_0),Name, [{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}]]></c>.</item>
- <item>If E is <c><![CDATA[#Name.Field]]></c>, then
- Rep(E) = <c><![CDATA[{record_index,LINE,Name,Rep(Field)}]]></c>.</item>
- <item>If E is <c><![CDATA[E_0#Name.Field]]></c>, then
- Rep(E) = <c><![CDATA[{record_field,LINE,Rep(E_0),Name,Rep(Field)}]]></c>.</item>
- <item>If E is <c><![CDATA[#{W_1, ..., W_k}]]></c> where each
- <c><![CDATA[W_i]]></c> is a map assoc or exact field, then Rep(E) =
- <c><![CDATA[{map,LINE,[Rep(W_1), ..., Rep(W_k)]}]]></c>. For Rep(W), see
- below.</item>
- <item>If E is <c><![CDATA[E_0#{W_1, ..., W_k}]]></c> where
- <c><![CDATA[W_i]]></c> is a map assoc or exact field, then Rep(E) =
- <c><![CDATA[{map,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}]]></c>. For
- Rep(W), see below.</item>
- <item>If E is <c><![CDATA[catch E_0]]></c>, then
- Rep(E) = <c><![CDATA[{'catch',LINE,Rep(E_0)}]]></c>.</item>
- <item>If E is <c><![CDATA[E_0(E_1, ..., E_k)]]></c>, then
- Rep(E) = <c><![CDATA[{call,LINE,Rep(E_0),[Rep(E_1), ..., Rep(E_k)]}]]></c>.</item>
- <item>If E is <c><![CDATA[E_m:E_0(E_1, ..., E_k)]]></c>, then
- Rep(E) =
- <c><![CDATA[{call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ..., Rep(E_k)]}]]></c>.</item>
- <item>If E is a list comprehension <c><![CDATA[[E_0 || W_1, ..., W_k]]]></c>,
- where each <c><![CDATA[W_i]]></c> is a generator or a filter, then
- Rep(E) = <c><![CDATA[{lc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}]]></c>. For Rep(W), see
+ An omitted <c>Size_i</c> is represented by <c>default</c>.
+ An omitted <c>TSL_i</c> is represented by <c>default</c>.</item>
+ <item>If E is a block expression <c>begin B end</c>,
+ where <c>B</c> is a body, then
+ Rep(E) = <c>{block,LINE,Rep(B)}</c>.</item>
+ <item>If E is a case expression <c>case E_0 of Cc_1 ; ... ; Cc_k end</c>,
+ where <c>E_0</c> is an expression and each <c>Cc_i</c> is a
+ case clause then Rep(E) =
+ <c>{'case',LINE,Rep(E_0),[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item>
+ <item>If E is a catch expression <c>catch E_0</c>, then
+ Rep(E) = <c>{'catch',LINE,Rep(E_0)}</c>.</item>
+ <item>If E is a cons skeleton <c>[E_h | E_t]</c>, then
+ Rep(E) = <c>{cons,LINE,Rep(E_h),Rep(E_t)}</c>.</item>
+ <item>If E is a fun expression <c>fun Name/Arity</c>, then
+ Rep(E) = <c>{'fun',LINE,{function,Name,Arity}}</c>.</item>
+ <item>If E is a fun expression
+ <c>fun Module:Name/Arity</c>, then Rep(E) =
+ <c>{'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}</c>.
+ (Before the R15 release: Rep(E) =
+ <c>{'fun',LINE,{function,Module,Name,Arity}}</c>.)</item>
+ <item>If E is a fun expression <c>fun Fc_1 ; ... ; Fc_k end</c>,
+ where each <c>Fc_i</c> is a function clause then Rep(E) =
+ <c>{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}</c>.</item>
+ <item>If E is a fun expression
+ <c>fun Name Fc_1 ; ... ; Name Fc_k end</c>,
+ where <c>Name</c> is a variable and each
+ <c>Fc_i</c> is a function clause then Rep(E) =
+ <c>{named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}</c>.
+ </item>
+ <item>If E is a function call <c>E_0(E_1, ..., E_k)</c>, then
+ Rep(E) = <c>{call,LINE,Rep(E_0),[Rep(E_1), ..., Rep(E_k)]}</c>.</item>
+ <item>If E is a function call <c>E_m:E_0(E_1, ..., E_k)</c>,
+ then Rep(E) =
+ <c>{call,LINE,{remote,LINE,Rep(E_m),Rep(E_0)},[Rep(E_1), ..., Rep(E_k)]}</c>.
+ </item>
+ <item>If E is an if expression <c>if Ic_1 ; ... ; Ic_k end</c>,
+ where each <c>Ic_i</c> is an if clause then Rep(E) =
+ <c>{'if',LINE,[Rep(Ic_1), ..., Rep(Ic_k)]}</c>.</item>
+ <item>If E is a list comprehension <c>[E_0 || Q_1, ..., Q_k]</c>,
+ where each <c>Q_i</c> is a qualifier, then Rep(E) =
+ <c>{lc,LINE,Rep(E_0),[Rep(Q_1), ..., Rep(Q_k)]}</c>. For Rep(Q), see
below.</item>
- <item>If E is a binary comprehension <c><![CDATA[<<E_0 || W_1, ..., W_k>>]]></c>,
- where each <c><![CDATA[W_i]]></c> is a generator or a filter, then
- Rep(E) = <c><![CDATA[{bc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}]]></c>. For Rep(W), see
+ <item>If E is a map creation <c>#{A_1, ..., A_k}</c>,
+ where each <c>A_i</c> is an association <c>E_i_1 => E_i_2</c>
+ or <c>E_i_1 := E_i_2</c>, then Rep(E) =
+ <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see
below.</item>
- <item>If E is <c><![CDATA[begin B end]]></c>, where <c><![CDATA[B]]></c> is a body, then
- Rep(E) = <c><![CDATA[{block,LINE,Rep(B)}]]></c>.</item>
- <item>If E is <c><![CDATA[if Ic_1 ; ... ; Ic_k end]]></c>,
- where each <c><![CDATA[Ic_i]]></c> is an if clause then
+ <item>If E is a map update <c>E_0#{A_1, ..., A_k}</c>,
+ where each <c>A_i</c> is an association <c>E_i_1 => E_i_2</c>
+ or <c>E_i_1 := E_i_2</c>, then Rep(E) =
+ <c>{map,LINE,Rep(E_0),[Rep(A_1), ..., Rep(A_k)]}</c>.
+ For Rep(A), see below.</item>
+ <item>If E is a match operator expression <c>P = E_0</c>,
+ where <c>P</c> is a pattern, then
+ Rep(E) = <c>{match,LINE,Rep(P),Rep(E_0)}</c>.</item>
+ <item>If E is nil, <c>[]</c>, then
+ Rep(E) = <c>{nil,LINE}</c>.</item>
+ <item>If E is an operator expression <c>E_1 Op E_2</c>,
+ where <c>Op</c> is a binary operator other than the match
+ operator <c>=</c>, then
+ Rep(E) = <c>{op,LINE,Op,Rep(E_1),Rep(E_2)}</c>.</item>
+ <item>If E is an operator expression <c>Op E_0</c>,
+ where <c>Op</c> is a unary operator, then
+ Rep(E) = <c>{op,LINE,Op,Rep(E_0)}</c>.</item>
+ <item>If E is a parenthesized expression <c>( E_0 )</c>, then
+ Rep(E) = <c>Rep(E_0)</c>, that is, parenthesized
+ expressions cannot be distinguished from their bodies.</item>
+ <item>If E is a receive expression <c>receive Cc_1 ; ... ; Cc_k end</c>,
+ where each <c>Cc_i</c> is a case clause then Rep(E) =
+ <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)]}</c>.</item>
+ <item>If E is a receive expression
+ <c>receive Cc_1 ; ... ; Cc_k after E_0 -> B_t end</c>,
+ where each <c>Cc_i</c> is a case clause,
+ <c>E_0</c> is an expression and <c>B_t</c> is a body, then Rep(E) =
+ <c>{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)],Rep(E_0),Rep(B_t)}</c>.</item>
+ <item>If E is a record creation
+ <c>#Name{Field_1=E_1, ..., Field_k=E_k}</c>,
+ where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(E) =
+ <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item>
+ <item>If E is a record field access <c>E_0#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(E) = <c>{record_field,LINE,Rep(E_0),Name,Rep(Field)}</c>.</item>
+ <item>If E is a record field index <c>#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(E) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
+ <item>If E is a record update
+ <c>E_0#Name{Field_1=E_1, ..., Field_k=E_k}</c>,
+ where each <c>Field_i</c> is an atom, then Rep(E) =
+ <c>{record,LINE,Rep(E_0),Name,[{record_field,LINE,Rep(Field_1),Rep(E_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(E_k)}]}</c>.</item>
+ <item>If E is a tuple skeleton <c>{E_1, ..., E_k}</c>, then
+ Rep(E) = <c>{tuple,LINE,[Rep(E_1), ..., Rep(E_k)]}</c>.</item>
+ <item>If E is a try expression <c>try B catch Tc_1 ; ... ; Tc_k end</c>,
+ where <c>B</c> is a body and each <c>Tc_i</c> is a catch clause then
Rep(E) =
- <c><![CDATA[{'if',LINE,[Rep(Ic_1), ..., Rep(Ic_k)]}]]></c>.</item>
- <item>If E is <c><![CDATA[case E_0 of Cc_1 ; ... ; Cc_k end]]></c>,
- where <c><![CDATA[E_0]]></c> is an expression and each <c><![CDATA[Cc_i]]></c> is a
- case clause then
+ <c>{'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],[]}</c>.</item>
+ <item>If E is a try expression
+ <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n end</c>,
+ where <c>B</c> is a body,
+ each <c>Cc_i</c> is a case clause and
+ each <c>Tc_j</c> is a catch clause then Rep(E) =
+ <c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],[]}</c>.</item>
+ <item>If E is a try expression <c>try B after A end</c>,
+ where <c>B</c> and <c>A</c> are bodies then Rep(E) =
+ <c>{'try',LINE,Rep(B),[],[],Rep(A)}</c>.</item>
+ <item>If E is a try expression
+ <c>try B of Cc_1 ; ... ; Cc_k after A end</c>,
+ where <c>B</c> and <c>A</c> are a bodies and
+ each <c>Cc_i</c> is a case clause then Rep(E) =
+ <c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[],Rep(A)}</c>.</item>
+ <item>If E is a try expression
+ <c>try B catch Tc_1 ; ... ; Tc_k after A end</c>,
+ where <c>B</c> and <c>A</c> are bodies and
+ each <c>Tc_i</c> is a catch clause then Rep(E) =
+ <c>{'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],Rep(A)}</c>.</item>
+ <item>If E is a try expression
+ <c>try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n after A end</c>,
+ where <c>B</c> and <c>A</c> are a bodies,
+ each <c>Cc_i</c> is a case clause, and
+ each <c>Tc_j</c> is a catch clause then
Rep(E) =
- <c><![CDATA[{'case',LINE,Rep(E_0),[Rep(Cc_1), ..., Rep(Cc_k)]}]]></c>.</item>
- <item>If E is <c><![CDATA[try B catch Tc_1 ; ... ; Tc_k end]]></c>,
- where <c><![CDATA[B]]></c> is a body and each <c><![CDATA[Tc_i]]></c> is a catch clause then
- Rep(E) =
- <c><![CDATA[{'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],[]}]]></c>.</item>
- <item>If E is <c><![CDATA[try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n end]]></c>,
- where <c><![CDATA[B]]></c> is a body,
- each <c><![CDATA[Cc_i]]></c> is a case clause and
- each <c><![CDATA[Tc_j]]></c> is a catch clause then
- Rep(E) =
- <c><![CDATA[{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],[]}]]></c>.</item>
- <item>If E is <c><![CDATA[try B after A end]]></c>,
- where <c><![CDATA[B]]></c> and <c><![CDATA[A]]></c> are bodies then
- Rep(E) =
- <c><![CDATA[{'try',LINE,Rep(B),[],[],Rep(A)}]]></c>.</item>
- <item>If E is <c><![CDATA[try B of Cc_1 ; ... ; Cc_k after A end]]></c>,
- where <c><![CDATA[B]]></c> and <c><![CDATA[A]]></c> are a bodies and
- each <c><![CDATA[Cc_i]]></c> is a case clause then
- Rep(E) =
- <c><![CDATA[{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[],Rep(A)}]]></c>.</item>
- <item>If E is <c><![CDATA[try B catch Tc_1 ; ... ; Tc_k after A end]]></c>,
- where <c><![CDATA[B]]></c> and <c><![CDATA[A]]></c> are bodies and
- each <c><![CDATA[Tc_i]]></c> is a catch clause then
- Rep(E) =
- <c><![CDATA[{'try',LINE,Rep(B),[],[Rep(Tc_1), ..., Rep(Tc_k)],Rep(A)}]]></c>.</item>
- <item>If E is <c><![CDATA[try B of Cc_1 ; ... ; Cc_k catch Tc_1 ; ... ; Tc_n after A end]]></c>,
- where <c><![CDATA[B]]></c> and <c><![CDATA[A]]></c> are a bodies,
- each <c><![CDATA[Cc_i]]></c> is a case clause and
- each <c><![CDATA[Tc_j]]></c> is a catch clause then
- Rep(E) =
- <c><![CDATA[{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],Rep(A)}]]></c>.</item>
- <item>If E is <c><![CDATA[receive Cc_1 ; ... ; Cc_k end]]></c>,
- where each <c><![CDATA[Cc_i]]></c> is a case clause then
- Rep(E) =
- <c><![CDATA[{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)]}]]></c>.</item>
- <item>If E is <c><![CDATA[receive Cc_1 ; ... ; Cc_k after E_0 -> B_t end]]></c>,
- where each <c><![CDATA[Cc_i]]></c> is a case clause,
- <c><![CDATA[E_0]]></c> is an expression and <c><![CDATA[B_t]]></c> is a body, then
- Rep(E) =
- <c><![CDATA[{'receive',LINE,[Rep(Cc_1), ..., Rep(Cc_k)],Rep(E_0),Rep(B_t)}]]></c>.</item>
- <item>If E is <c><![CDATA[fun Name / Arity]]></c>, then
- Rep(E) = <c><![CDATA[{'fun',LINE,{function,Name,Arity}}]]></c>.</item>
- <item>If E is <c><![CDATA[fun Module:Name/Arity]]></c>, then
- Rep(E) = <c><![CDATA[{'fun',LINE,{function,Rep(Module),Rep(Name),Rep(Arity)}}]]></c>.
- (Before the R15 release: Rep(E) = <c><![CDATA[{'fun',LINE,{function,Module,Name,Arity}}]]></c>.)</item>
- <item>If E is <c><![CDATA[fun Fc_1 ; ... ; Fc_k end]]></c>
- where each <c><![CDATA[Fc_i]]></c> is a function clause then Rep(E) =
- <c><![CDATA[{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}]]></c>.</item>
- <item>If E is <c><![CDATA[fun Name Fc_1 ; ... ; Name Fc_k end]]></c>
- where <c><![CDATA[Name]]></c> is a variable and each
- <c><![CDATA[Fc_i]]></c> is a function clause then Rep(E) =
- <c><![CDATA[{named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}]]></c>.
- </item>
- <item>If E is <c><![CDATA[query [E_0 || W_1, ..., W_k] end]]></c>,
- where each <c><![CDATA[W_i]]></c> is a generator or a filter, then
- Rep(E) = <c><![CDATA[{'query',LINE,{lc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}}]]></c>.
- For Rep(W), see below.</item>
- <item>If E is <c><![CDATA[E_0.Field]]></c>, a Mnesia record access
- inside a query, then
- Rep(E) = <c><![CDATA[{record_field,LINE,Rep(E_0),Rep(Field)}]]></c>.</item>
- <item>If E is <c><![CDATA[( E_0 )]]></c>, then
- Rep(E) = <c><![CDATA[Rep(E_0)]]></c>,
- i.e., parenthesized expressions cannot be distinguished from their bodies.</item>
+ <c>{'try',LINE,Rep(B),[Rep(Cc_1), ..., Rep(Cc_k)],[Rep(Tc_1), ..., Rep(Tc_n)],Rep(A)}</c>.</item>
+ <item>If E is a variable <c>V</c>, then Rep(E) = <c>{var,LINE,A}</c>,
+ where <c>A</c> is an atom with a printname consisting of the same
+ characters as <c>V</c>.</item>
</list>
<section>
- <title>Generators and filters</title>
- <p>When W is a generator or a filter (in the body of a list or binary comprehension), then:</p>
+ <title>Qualifiers</title>
+ <p>A qualifier Q is one of the following alternatives:</p>
<list type="bulleted">
- <item>If W is a generator <c><![CDATA[P <- E]]></c>, where <c><![CDATA[P]]></c> is a pattern and <c><![CDATA[E]]></c>
- is an expression, then
- Rep(W) = <c><![CDATA[{generate,LINE,Rep(P),Rep(E)}]]></c>.</item>
- <item>If W is a generator <c><![CDATA[P <= E]]></c>, where <c><![CDATA[P]]></c> is a pattern and <c><![CDATA[E]]></c>
- is an expression, then
- Rep(W) = <c><![CDATA[{b_generate,LINE,Rep(P),Rep(E)}]]></c>.</item>
- <item>If W is a filter <c><![CDATA[E]]></c>, which is an expression, then
- Rep(W) = <c><![CDATA[Rep(E)]]></c>.</item>
+ <item>If Q is a filter <c>E</c>, where <c>E</c> is an expression, then
+ Rep(Q) = <c>Rep(E)</c>.</item>
+ <item>If Q is a generator <c>P &lt;- E</c>, where <c>P</c> is
+ a pattern and <c>E</c> is an expression, then
+ Rep(Q) = <c>{generate,LINE,Rep(P),Rep(E)}</c>.</item>
+ <item>If Q is a bit string generator
+ <c>P &lt;= E</c>, where <c>P</c> is
+ a pattern and <c>E</c> is an expression, then
+ Rep(Q) = <c>{b_generate,LINE,Rep(P),Rep(E)}</c>.</item>
</list>
</section>
<section>
- <title>Binary element type specifiers</title>
- <p>A type specifier list TSL for a binary element is a sequence of type
- specifiers <c><![CDATA[TS_1 - ... - TS_k]]></c>.
- Rep(TSL) = <c><![CDATA[[Rep(TS_1), ..., Rep(TS_k)]]]></c>.</p>
- <p>When TS is a type specifier for a binary element, then:</p>
+ <title>Bit String Element Type Specifiers</title>
+ <p>A type specifier list TSL for a bit string element is a sequence
+ of type specifiers <c>TS_1 - ... - TS_k</c>, and
+ Rep(TSL) = <c>[Rep(TS_1), ..., Rep(TS_k)]</c>.</p>
<list type="bulleted">
- <item>If TS is an atom <c><![CDATA[A]]></c>, Rep(TS) = <c><![CDATA[A]]></c>.</item>
- <item>If TS is a couple <c><![CDATA[A:Value]]></c> where <c><![CDATA[A]]></c> is an atom and <c><![CDATA[Value]]></c>
- is an integer, Rep(TS) = <c><![CDATA[{A, Value}]]></c>.</item>
+ <item>If TS is a type specifier <c>A</c>, where <c>A</c> is an atom,
+ then Rep(TS) = <c>A</c>.</item>
+ <item>If TS is a type specifier <c>A:Value</c>,
+ where <c>A</c> is an atom and <c>Value</c> is an integer,
+ then Rep(TS) = <c>{A,Value}</c>.</item>
</list>
</section>
<section>
- <title>Map assoc and exact fields</title>
- <p>When W is an assoc or exact field (in the body of a map), then:</p>
+ <title>Associations</title>
+ <p>An association A is one of the following alternatives:</p>
<list type="bulleted">
- <item>If W is an assoc field <c><![CDATA[K => V]]></c>, where
- <c><![CDATA[K]]></c> and <c><![CDATA[V]]></c> are both expressions,
- then Rep(W) = <c><![CDATA[{map_field_assoc,LINE,Rep(K),Rep(V)}]]></c>.
+ <item>If A is an association <c>K => V</c>,
+ then Rep(A) = <c>{map_field_assoc,LINE,Rep(K),Rep(V)}</c>.
</item>
- <item>If W is an exact field <c><![CDATA[K := V]]></c>, where
- <c><![CDATA[K]]></c> and <c><![CDATA[V]]></c> are both expressions,
- then Rep(W) = <c><![CDATA[{map_field_exact,LINE,Rep(K),Rep(V)}]]></c>.
+ <item>If A is an association <c>K := V</c>,
+ then Rep(A) = <c>{map_field_exact,LINE,Rep(K),Rep(V)}</c>.
</item>
</list>
</section>
@@ -524,112 +424,245 @@
<section>
<title>Clauses</title>
- <p>There are function clauses, if clauses, case clauses
+ <p>There are function clauses, if clauses, case clauses
and catch clauses.</p>
- <p>A clause <c><![CDATA[C]]></c> is one of the following alternatives:</p>
+ <p>A clause <c>C</c> is one of the following alternatives:</p>
<list type="bulleted">
- <item>If C is a function clause <c><![CDATA[( Ps ) -> B]]></c>
- where <c><![CDATA[Ps]]></c> is a pattern sequence and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,Rep(Ps),[],Rep(B)}]]></c>.</item>
- <item>If C is a function clause <c><![CDATA[( Ps ) when Gs -> B]]></c>
- where <c><![CDATA[Ps]]></c> is a pattern sequence,
- <c><![CDATA[Gs]]></c> is a guard sequence and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}]]></c>.</item>
- <item>If C is an if clause <c><![CDATA[Gs -> B]]></c>
- where <c><![CDATA[Gs]]></c> is a guard sequence and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,[],Rep(Gs),Rep(B)}]]></c>.</item>
- <item>If C is a case clause <c><![CDATA[P -> B]]></c>
- where <c><![CDATA[P]]></c> is a pattern and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,[Rep(P)],[],Rep(B)}]]></c>.</item>
- <item>If C is a case clause <c><![CDATA[P when Gs -> B]]></c>
- where <c><![CDATA[P]]></c> is a pattern,
- <c><![CDATA[Gs]]></c> is a guard sequence and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,[Rep(P)],Rep(Gs),Rep(B)}]]></c>.</item>
- <item>If C is a catch clause <c><![CDATA[P -> B]]></c>
- where <c><![CDATA[P]]></c> is a pattern and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,[Rep({throw,P,_})],[],Rep(B)}]]></c>.</item>
- <item>If C is a catch clause <c><![CDATA[X : P -> B]]></c>
- where <c><![CDATA[X]]></c> is an atomic literal or a variable pattern,
- <c><![CDATA[P]]></c> is a pattern and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,[Rep({X,P,_})],[],Rep(B)}]]></c>.</item>
- <item>If C is a catch clause <c><![CDATA[P when Gs -> B]]></c>
- where <c><![CDATA[P]]></c> is a pattern, <c><![CDATA[Gs]]></c> is a guard sequence
- and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,[Rep({throw,P,_})],Rep(Gs),Rep(B)}]]></c>.</item>
- <item>If C is a catch clause <c><![CDATA[X : P when Gs -> B]]></c>
- where <c><![CDATA[X]]></c> is an atomic literal or a variable pattern,
- <c><![CDATA[P]]></c> is a pattern, <c><![CDATA[Gs]]></c> is a guard sequence
- and <c><![CDATA[B]]></c> is a body, then
- Rep(C) = <c><![CDATA[{clause,LINE,[Rep({X,P,_})],Rep(Gs),Rep(B)}]]></c>.</item>
+ <item>If C is a case clause <c>P -> B</c>,
+ where <c>P</c> is a pattern and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[Rep(P)],[],Rep(B)}</c>.</item>
+ <item>If C is a case clause <c>P when Gs -> B</c>,
+ where <c>P</c> is a pattern,
+ <c>Gs</c> is a guard sequence and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[Rep(P)],Rep(Gs),Rep(B)}</c>.</item>
+ <item>If C is a catch clause <c>P -> B</c>,
+ where <c>P</c> is a pattern and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[Rep({throw,P,_})],[],Rep(B)}</c>.</item>
+ <item>If C is a catch clause <c>X : P -> B</c>,
+ where <c>X</c> is an atomic literal or a variable pattern,
+ <c>P</c> is a pattern, and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],[],Rep(B)}</c>.</item>
+ <item>If C is a catch clause <c>P when Gs -> B</c>,
+ where <c>P</c> is a pattern, <c>Gs</c> is a guard sequence,
+ and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[Rep({throw,P,_})],Rep(Gs),Rep(B)}</c>.</item>
+ <item>If C is a catch clause <c>X : P when Gs -> B</c>,
+ where <c>X</c> is an atomic literal or a variable pattern,
+ <c>P</c> is a pattern, <c>Gs</c> is a guard sequence,
+ and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[Rep({X,P,_})],Rep(Gs),Rep(B)}</c>.</item>
+ <item>If C is a function clause <c>( Ps ) -> B</c>,
+ where <c>Ps</c> is a pattern sequence and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,Rep(Ps),[],Rep(B)}</c>.</item>
+ <item>If C is a function clause <c>( Ps ) when Gs -> B</c>,
+ where <c>Ps</c> is a pattern sequence,
+ <c>Gs</c> is a guard sequence and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,Rep(Ps),Rep(Gs),Rep(B)}</c>.</item>
+ <item>If C is an if clause <c>Gs -> B</c>,
+ where <c>Gs</c> is a guard sequence and <c>B</c> is a body, then
+ Rep(C) = <c>{clause,LINE,[],Rep(Gs),Rep(B)}</c>.</item>
</list>
</section>
<section>
<title>Guards</title>
- <p>A guard sequence Gs is a sequence of guards <c><![CDATA[G_1; ...; G_k]]></c>, and
- Rep(Gs) = <c><![CDATA[[Rep(G_1), ..., Rep(G_k)]]]></c>. If the guard sequence is
- empty, Rep(Gs) = <c><![CDATA[[]]]></c>.</p>
- <p>A guard G is a nonempty sequence of guard tests <c><![CDATA[Gt_1, ..., Gt_k]]></c>, and
- Rep(G) = <c><![CDATA[[Rep(Gt_1), ..., Rep(Gt_k)]]]></c>.</p>
- <p>A guard test <c><![CDATA[Gt]]></c> is one of the following alternatives:</p>
+ <p>A guard sequence Gs is a sequence of guards <c>G_1; ...; G_k</c>, and
+ Rep(Gs) = <c>[Rep(G_1), ..., Rep(G_k)]</c>. If the guard sequence is
+ empty, Rep(Gs) = <c>[]</c>.</p>
+ <p>A guard G is a nonempty sequence of guard tests
+ <c>Gt_1, ..., Gt_k</c>, and Rep(G) =
+ <c>[Rep(Gt_1), ..., Rep(Gt_k)]</c>.</p>
+ <p>A guard test <c>Gt</c> is one of the following alternatives:</p>
<list type="bulleted">
- <item>If Gt is an atomic literal L, then Rep(Gt) = Rep(L).</item>
- <item>If Gt is a variable pattern <c><![CDATA[V]]></c>, then
- Rep(Gt) = <c><![CDATA[{var,LINE,A}]]></c>,
- where A is an atom with a printname consisting of the same characters as
- <c><![CDATA[V]]></c>.</item>
- <item>If Gt is a tuple skeleton <c><![CDATA[{Gt_1, ..., Gt_k}]]></c>, then
- Rep(Gt) = <c><![CDATA[{tuple,LINE,[Rep(Gt_1), ..., Rep(Gt_k)]}]]></c>.</item>
- <item>If Gt is <c><![CDATA[[]]]></c>, then
- Rep(Gt) = <c><![CDATA[{nil,LINE}]]></c>.</item>
- <item>If Gt is a cons skeleton <c><![CDATA[[Gt_h | Gt_t]]]></c>, then
- Rep(Gt) = <c><![CDATA[{cons,LINE,Rep(Gt_h),Rep(Gt_t)}]]></c>.</item>
- <item>If Gt is a binary constructor <c><![CDATA[<<Gt_1:Size_1/TSL_1, ..., Gt_k:Size_k/TSL_k>>]]></c>, then
- Rep(Gt) = <c><![CDATA[{bin,LINE,[{bin_element,LINE,Rep(Gt_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(Gt_k),Rep(Size_k),Rep(TSL_k)}]}]]></c>.
+ <item>If Gt is an atomic literal <c>L</c>, then Rep(Gt) = Rep(L).</item>
+ <item>If Gt is a bit string constructor
+ <c>&lt;&lt;Gt_1:Size_1/TSL_1, ..., Gt_k:Size_k/TSL_k>></c>,
+ where each <c>Size_i</c> is a guard test and each
+ <c>TSL_i</c> is a type specificer list, then
+ Rep(Gt) = <c>{bin,LINE,[{bin_element,LINE,Rep(Gt_1),Rep(Size_1),Rep(TSL_1)}, ..., {bin_element,LINE,Rep(Gt_k),Rep(Size_k),Rep(TSL_k)}]}</c>.
For Rep(TSL), see above.
- An omitted <c><![CDATA[Size]]></c> is represented by <c><![CDATA[default]]></c>. An omitted <c><![CDATA[TSL]]></c>
- (type specifier list) is represented by <c><![CDATA[default]]></c>.</item>
- <item>If Gt is <c><![CDATA[Gt_1 Op Gt_2]]></c>, where <c><![CDATA[Op]]></c>
- is a binary operator, then Rep(Gt) = <c><![CDATA[{op,LINE,Op,Rep(Gt_1),Rep(Gt_2)}]]></c>.</item>
- <item>If Gt is <c><![CDATA[Op Gt_0]]></c>, where <c><![CDATA[Op]]></c> is a unary operator, then
- Rep(Gt) = <c><![CDATA[{op,LINE,Op,Rep(Gt_0)}]]></c>.</item>
- <item>If Gt is <c><![CDATA[#Name{Field_1=Gt_1, ..., Field_k=Gt_k}]]></c>, then
- Rep(E) =
- <c><![CDATA[{record,LINE,Name, [{record_field,LINE,Rep(Field_1),Rep(Gt_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(Gt_k)}]}]]></c>.</item>
- <item>If Gt is <c><![CDATA[#Name.Field]]></c>, then
- Rep(Gt) = <c><![CDATA[{record_index,LINE,Name,Rep(Field)}]]></c>.</item>
- <item>If Gt is <c><![CDATA[Gt_0#Name.Field]]></c>, then
- Rep(Gt) = <c><![CDATA[{record_field,LINE,Rep(Gt_0),Name,Rep(Field)}]]></c>.</item>
- <item>If Gt is <c><![CDATA[A(Gt_1, ..., Gt_k)]]></c>, where <c><![CDATA[A]]></c> is an atom, then
- Rep(Gt) = <c><![CDATA[{call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}]]></c>.</item>
- <item>If Gt is <c><![CDATA[A_m:A(Gt_1, ..., Gt_k)]]></c>, where <c><![CDATA[A_m]]></c> is
- the atom <c><![CDATA[erlang]]></c> and <c><![CDATA[A]]></c> is an atom or an operator, then
- Rep(Gt) = <c><![CDATA[{call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}]]></c>.</item>
- <item>If Gt is <c><![CDATA[{A_m,A}(Gt_1, ..., Gt_k)]]></c>, where <c><![CDATA[A_m]]></c> is
- the atom <c><![CDATA[erlang]]></c> and <c><![CDATA[A]]></c> is an atom or an operator, then
- Rep(Gt) = <c><![CDATA[{call,LINE,Rep({A_m,A}),[Rep(Gt_1), ..., Rep(Gt_k)]}]]></c>.</item>
- <item>If Gt is <c><![CDATA[( Gt_0 )]]></c>, then
- Rep(Gt) = <c><![CDATA[Rep(Gt_0)]]></c>,
- i.e., parenthesized guard tests cannot be distinguished from their bodies.</item>
+ An omitted <c>Size_i</c> is represented by <c>default</c>.
+ An omitted <c>TSL_i</c> is represented by <c>default</c>.</item>
+ <item>If Gt is a cons skeleton <c>[Gt_h | Gt_t]</c>, then
+ Rep(Gt) = <c>{cons,LINE,Rep(Gt_h),Rep(Gt_t)}</c>.</item>
+ <item>If Gt is a function call <c>A(Gt_1, ..., Gt_k)</c>,
+ where <c>A</c> is an atom, then Rep(Gt) =
+ <c>{call,LINE,Rep(A),[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
+ <item>If Gt is a function call <c>A_m:A(Gt_1, ..., Gt_k)</c>,
+ where <c>A_m</c> is the atom <c>erlang</c> and <c>A</c> is
+ an atom or an operator, then Rep(Gt) =
+ <c>{call,LINE,{remote,LINE,Rep(A_m),Rep(A)},[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
+ <item>If Gt is a map creation <c>#{A_1, ..., A_k}</c>,
+ where each <c>A_i</c> is an association <c>Gt_i_1 => Gt_i_2</c>
+ or <c>Gt_i_1 := Gt_i_2</c>, then Rep(Gt) =
+ <c>{map,LINE,[Rep(A_1), ..., Rep(A_k)]}</c>. For Rep(A), see
+ above.</item>
+ <item>If Gt is a map update <c>Gt_0#{A_1, ..., A_k}</c>, where each
+ <c>A_i</c> is an association <c>Gt_i_1 => Gt_i_2</c>
+ or <c>Gt_i_1 := Gt_i_2</c>, then Rep(Gt) =
+ <c>{map,LINE,Rep(Gt_0),[Rep(A_1), ..., Rep(A_k)]}</c>.
+ For Rep(A), see above.</item>
+ <item>If Gt is nil, <c>[]</c>,
+ then Rep(Gt) = <c>{nil,LINE}</c>.</item>
+ <item>If Gt is an operator guard test <c>Gt_1 Op Gt_2</c>,
+ where <c>Op</c> is a binary operator other than the match
+ operator <c>=</c>, then
+ Rep(Gt) = <c>{op,LINE,Op,Rep(Gt_1),Rep(Gt_2)}</c>.</item>
+ <item>If Gt is an operator guard test <c>Op Gt_0</c>,
+ where <c>Op</c> is a unary operator, then
+ Rep(Gt) = <c>{op,LINE,Op,Rep(Gt_0)}</c>.</item>
+ <item>If Gt is a parenthesized guard test <c>( Gt_0 )</c>, then
+ Rep(Gt) = <c>Rep(Gt_0)</c>, that is, parenthesized
+ guard tests cannot be distinguished from their bodies.</item>
+ <item>If Gt is a record creation
+ <c>#Name{Field_1=Gt_1, ..., Field_k=Gt_k}</c>,
+ where each <c>Field_i</c> is an atom or <c>_</c>, then Rep(Gt) =
+ <c>{record,LINE,Name,[{record_field,LINE,Rep(Field_1),Rep(Gt_1)}, ..., {record_field,LINE,Rep(Field_k),Rep(Gt_k)}]}</c>.</item>
+ <item>If Gt is a record field access <c>Gt_0#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(Gt) = <c>{record_field,LINE,Rep(Gt_0),Name,Rep(Field)}</c>.</item>
+ <item>If Gt is a record field index <c>#Name.Field</c>,
+ where <c>Field</c> is an atom, then
+ Rep(Gt) = <c>{record_index,LINE,Name,Rep(Field)}</c>.</item>
+ <item>If Gt is a tuple skeleton <c>{Gt_1, ..., Gt_k}</c>, then
+ Rep(Gt) = <c>{tuple,LINE,[Rep(Gt_1), ..., Rep(Gt_k)]}</c>.</item>
+ <item>If Gt is a variable pattern <c>V</c>, then
+ Rep(Gt) = <c>{var,LINE,A}</c>, where A is an atom with
+ a printname consisting of the same characters as <c>V</c>.</item>
</list>
<p>Note that every guard test has the same source form as some expression,
and is represented the same way as the corresponding expression.</p>
</section>
<section>
- <title>The abstract format after preprocessing</title>
- <p>The compilation option <c><![CDATA[debug_info]]></c> can be given to the
- compiler to have the abstract code stored in
- the <c><![CDATA[abstract_code]]></c> chunk in the BEAM file
+ <title>Types</title>
+ <list type="bulleted">
+ <item>If T is an annotated type <c>A :: T_0</c>,
+ where <c>A</c> is a variable, then Rep(T) =
+ <c>{ann_type,LINE,[Rep(A),Rep(T_0)]}</c>.</item>
+ <item>If T is an atom or integer literal L, then Rep(T) = Rep(L).
+ </item>
+ <item>If T is a bit string type <c>&lt;&lt;_:M,_:_*N>></c>,
+ where <c>M</c> and <c>N</c> are singleton integer types, then Rep(T) =
+ <c>{type,LINE,binary,[Rep(M),Rep(N)]}</c>.</item>
+ <item>If T is the empty list type <c>[]</c>, then Rep(T) =
+ <c>{type,Line,nil,[]}</c>.</item>
+ <item>If T is a fun type <c>fun()</c>, then Rep(T) =
+ <c>{type,LINE,'fun',[]}</c>.</item>
+ <item>If T is a fun type <c>fun((...) -> T_0)</c>, then
+ Rep(T) = <c>{type,LINE,'fun',[{type,LINE,any},Rep(T_0)]}</c>.
+ </item>
+ <item>If T is a fun type <c>fun(Ft)</c>, where
+ <c>Ft</c> is a function type,
+ then Rep(T) = <c>Rep(Ft)</c>. For Rep(Ft), see below.</item>
+ <item>If T is an integer range type <c>L .. H</c>,
+ where <c>L</c> and <c>H</c> are singleton integer types, then
+ Rep(T) = <c>{type,LINE,range,[Rep(L),Rep(H)]}</c>.</item>
+ <item>If T is a map type <c>map()</c>, then Rep(T) =
+ <c>{type,LINE,map,any}</c>.</item>
+ <item>If T is a map type <c>#{A_1, ..., A_k}</c>, where each
+ <c>A_i</c> is an association type, then Rep(T) =
+ <c>{type,LINE,map,[Rep(A_1), ..., Rep(A_k)]}</c>.
+ For Rep(A), see below.</item>
+ <item>If T is an operator type <c>T_1 Op T_2</c>,
+ where <c>Op</c> is a binary operator (this is an occurrence of
+ an expression that can be evaluated to an integer at compile
+ time), then
+ Rep(T) = <c>{op,LINE,Op,Rep(T_1),Rep(T_2)}</c>.</item>
+ <item>If T is an operator type <c>Op T_0</c>, where <c>Op</c> is a
+ unary operator (this is an occurrence of
+ an expression that can be evaluated to an integer at compile time),
+ then Rep(T) = <c>{op,LINE,Op,Rep(T_0)}</c>.</item>
+ <item>If T is <c>( T_0 )</c>, then Rep(T) = <c>Rep(T_0)</c>,
+ that is, parenthesized types cannot be distinguished from their
+ bodies.</item>
+ <item>If T is a predefined (or built-in) type <c>N(T_1, ..., T_k)</c>,
+ then Rep(T) =
+ <c>{type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}</c>.</item>
+ <item>If T is a record type <c>#Name{F_1, ..., F_k}</c>,
+ where each <c>F_i</c> is a record field type, then Rep(T) =
+ <c>{type,LINE,record,[Rep(Name),Rep(F_1), ..., Rep(F_k)]}</c>.
+ For Rep(F), see below.</item>
+ <item>If T is a remote type <c>M:N(T_1, ..., T_k)</c>, then Rep(T) =
+ <c>{remote_type,LINE,[Rep(M),Rep(N),[Rep(T_1), ..., Rep(T_k)]]}</c>.
+ </item>
+ <item>If T is a tuple type <c>tuple()</c>, then Rep(T) =
+ <c>{type,LINE,tuple,any}</c>.</item>
+ <item>If T is a tuple type <c>{T_1, ..., T_k}</c>, then Rep(T) =
+ <c>{type,LINE,tuple,[Rep(T_1), ..., Rep(T_k)]}</c>.</item>
+ <item>If T is a type union <c>T_1 | ... | T_k</c>, then Rep(T) =
+ <c>{type,LINE,union,[Rep(T_1), ..., Rep(T_k)]}</c>.</item>
+ <item>If T is a type variable <c>V</c>, then Rep(T) =
+ <c>{var,LINE,A}</c>, where <c>A</c> is an atom with a printname
+ consisting of the same characters as <c>V</c>. A type variable
+ is any variable except underscore (<c>_</c>).</item>
+ <item>If T is a user-defined type <c>N(T_1, ..., T_k)</c>,
+ then Rep(T) =
+ <c>{user_type,LINE,N,[Rep(T_1), ..., Rep(T_k)]}</c>.</item>
+ </list>
+
+ <section>
+ <title>Function Types</title>
+ <p>A function type Ft is one of the following alternatives:</p>
+ <list type="bulleted">
+ <item>If Ft is a constrained function type <c>Ft_1 when Fc</c>,
+ where <c>Ft_1</c> is a function type and
+ <c>Fc</c> is a function constraint, then Rep(T) =
+ <c>{type,LINE,bounded_fun,[Rep(Ft_1),Rep(Fc)]}</c>.
+ For Rep(Fc), see below.</item>
+ <item>If Ft is a function type <c>(T_1, ..., T_n) -> T_0</c>,
+ where each <c>T_i</c> is a type, then
+ Rep(Ft) = <c>{type,LINE,'fun',[{type,LINE,product,[Rep(T_1),
+ ..., Rep(T_n)]},Rep(T_0)]}</c>.</item>
+ </list>
+ </section>
+
+ <section>
+ <title>Function Constraints</title>
+ <p>A function constraint Fc is a nonempty sequence of constraints
+ <c>C_1, ..., C_k</c>, and
+ Rep(Fc) = <c>[Rep(C_1), ..., Rep(C_k)]</c>.</p>
+ <list type="bulleted">
+ <item>If C is a constraint <c>is_subtype(V, T)</c> or <c>V :: T</c>,
+ where <c>V</c> is a type variable and <c>T</c> is a type, then
+ Rep(C) = <c>{type,LINE,constraint,[{atom,LINE,is_subtype},[Rep(V),Rep(T)]]}</c>.
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Association Types</title>
+ <list type="bulleted">
+ <item>If A is an association type <c>K => V</c>, where
+ <c>K</c> and <c>V</c> are types, then Rep(A) =
+ <c>{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}</c>.</item>
+ </list>
+ </section>
+
+ <section>
+ <title>Record Field Types</title>
+ <list type="bulleted">
+ <item>If F is a record field type <c>Name :: Type</c>,
+ where <c>Type</c> is a type, then Rep(F) =
+ <c>{type,LINE,field_type,[Rep(Name),Rep(Type)]}</c>.</item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>The Abstract Format After Preprocessing</title>
+ <p>The compilation option <c>debug_info</c> can be given to the
+ compiler to have the abstract code stored in
+ the <c>abstract_code</c> chunk in the BEAM file
(for debugging purposes).</p>
- <p>In OTP R9C and later, the <c><![CDATA[abstract_code]]></c> chunk will
+ <p>In OTP R9C and later, the <c>abstract_code</c> chunk will
contain</p>
- <p><c><![CDATA[{raw_abstract_v1,AbstractCode}]]></c></p>
- <p>where <c><![CDATA[AbstractCode]]></c> is the abstract code as described
+ <p><c>{raw_abstract_v1,AbstractCode}</c></p>
+ <p>where <c>AbstractCode</c> is the abstract code as described
in this document.</p>
<p>In releases of OTP prior to R9C, the abstract code after some more
processing was stored in the BEAM file. The first element of the
- tuple would be either <c><![CDATA[abstract_v1]]></c> (R7B) or <c><![CDATA[abstract_v2]]></c>
+ tuple would be either <c>abstract_v1</c> (R7B) or <c>abstract_v2</c>
(R8B).</p>
</section>
</chapter>
diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml
index 30772c68fe..ae7f264d0c 100644
--- a/erts/doc/src/driver_entry.xml
+++ b/erts/doc/src/driver_entry.xml
@@ -4,7 +4,7 @@
<cref>
<header>
<copyright>
- <year>2001</year><year>2013</year>
+ <year>2001</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -126,7 +126,7 @@
<section>
<title>DATA TYPES</title>
<taglist>
- <tag><b>ErlDrvEntry</b></tag>
+ <tag><em>ErlDrvEntry</em></tag>
<item>
<p/>
<code type="none">
@@ -235,6 +235,7 @@ typedef struct erl_drv_entry {
</item>
<tag><marker id="ready_input"/>void (*ready_input)(ErlDrvData drv_data, ErlDrvEvent event)</tag>
+ <item/>
<tag><marker id="ready_output"/>void (*ready_output)(ErlDrvData drv_data, ErlDrvEvent event)</tag>
<item>
<p>This is called when a driver event (given in the
@@ -246,14 +247,10 @@ typedef struct erl_drv_entry {
something that the <c>WaitForMultipleObjects</c> API
function understands). (Some trickery in the emulator allows
more than the built-in limit of 64 <c>Events</c> to be used.)</p>
- <p>On Enea OSE the <c>event</c> is one or more signals that can
- be retrieved using <seealso marker="ose:ose_erl_driver#erl_drv_ose_get_signal">erl_drv_ose_get_signal</seealso>.</p>
<p>To use this with threads and asynchronous routines, create a
- pipe on unix, an Event on Windows or a unique signal number on
- Enea OSE. When the routine
+ pipe on unix and an Event on Windows. When the routine
completes, write to the pipe (use <c>SetEvent</c> on
- Windows or send a message to the emulator process on Enea OSE),
- this will make the emulator call
+ Windows), this will make the emulator call
<c>ready_input</c> or <c>ready_output</c>.</p>
<p>Spurious events may happen. That is, calls to <c>ready_input</c>
or <c>ready_output</c> even though no real events are signaled. In
@@ -440,7 +437,14 @@ typedef struct erl_drv_entry {
<seealso marker="erl_driver#erl_drv_busy_msgq_limits">erl_drv_busy_msgq_limits()</seealso>
function.
</item>
- </taglist>
+ <tag><c>ERL_DRV_FLAG_USE_INIT_ACK</c></tag>
+ <item>When this flag is given the linked-in driver has to manually
+ acknowledge that the port has been successfully started using
+ <seealso marker="erl_driver#erl_drv_init_ack">erl_drv_init_ack()</seealso>.
+ This allows the implementor to make the erlang:open_port exit with
+ badarg after some initial asynchronous initialization has been done.
+ </item>
+ </taglist>
</item>
<tag>void *handle2</tag>
<item>
diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml
index 28fcc8f7af..7f61804bea 100644
--- a/erts/doc/src/epmd.xml
+++ b/erts/doc/src/epmd.xml
@@ -37,7 +37,7 @@
<comsummary>
<p>Erlang Port Mapper Daemon</p>
<taglist>
- <tag><c><![CDATA[epmd [-d|-debug] [DbgExtra...] [-port No] [-daemon] [-relaxed_command_check]]]></c></tag>
+ <tag><c><![CDATA[epmd [-d|-debug] [DbgExtra...] [-address Addresses] [-port No] [-daemon] [-relaxed_command_check]]]></c></tag>
<item>
<p>Starts the port mapper daemon</p>
</item>
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index b0322b7d43..096af096dc 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -4,7 +4,7 @@
<comref>
<header>
<copyright>
- <year>1996</year><year>2013</year>
+ <year>1996</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -138,7 +138,7 @@
see <seealso marker="kernel:app">app(4)</seealso> and
<seealso marker="kernel:application">application(3)</seealso>.</p>
</item>
- <tag><marker id="args_file"><c><![CDATA[-args_file FileName]]></c></marker></tag>
+ <tag><marker id="args_file"/><c><![CDATA[-args_file FileName]]></c></tag>
<item>
<p>Command line arguments are read from the file <c><![CDATA[FileName]]></c>.
The arguments read from the file replace the
@@ -203,7 +203,7 @@
<seealso marker="kernel:app">app(4)</seealso> and
<seealso marker="kernel:application">application(3)</seealso>.</p>
</item>
- <tag><marker id="connect_all"><c><![CDATA[-connect_all false]]></c></marker></tag>
+ <tag><marker id="connect_all"/><c><![CDATA[-connect_all false]]></c></tag>
<item>
<p>If this flag is present, <c><![CDATA[global]]></c> will not maintain a
fully connected network of distributed Erlang nodes, and then
@@ -288,7 +288,7 @@
<p>Makes <c><![CDATA[init]]></c> write some debug information while
interpreting the boot script.</p>
</item>
- <tag><marker id="instr"><c><![CDATA[-instr]]></c>(emulator flag)</marker></tag>
+ <tag><marker id="instr"/><c><![CDATA[-instr]]></c>(emulator flag)</tag>
<item>
<p>Selects an instrumented Erlang runtime system (virtual
machine) to run, instead of the ordinary one. When running an
@@ -371,7 +371,7 @@
path, similar to <c><![CDATA[code:add_pathsa/1]]></c>. See
<seealso marker="kernel:code">code(3)</seealso>.
As an alternative to <c>-pa</c>, if several directories are
- to be prepended to the code and the directories have a
+ to be prepended to the code path and the directories have a
common parent directory, that parent directory could be
specified in the <c>ERL_LIBS</c> environment variable.
See <seealso marker="kernel:code">code(3)</seealso>.</p>
@@ -382,6 +382,33 @@
similar to <c><![CDATA[code:add_pathsz/1]]></c>. See
<seealso marker="kernel:code">code(3)</seealso>.</p>
</item>
+ <tag><c><![CDATA[-path Dir1 Dir2 ...]]></c></tag>
+ <item>
+ <p>Replaces the path specified in the boot script. See
+ <seealso marker="sasl:script">script(4)</seealso>.</p>
+ </item>
+ <tag><c><![CDATA[-proto_dist Proto]]></c></tag>
+ <item>
+ <p>Specify a protocol for Erlang distribution.</p>
+ <taglist>
+ <tag><c>inet_tcp</c></tag>
+ <item>
+ <p>TCP over IPv4 (the default)</p>
+ </item>
+ <tag><c>inet_tls</c></tag>
+ <item>
+ <p>distribution over TLS/SSL</p>
+ </item>
+ <tag><c>inet6_tcp</c></tag>
+ <item>
+ <p>TCP over IPv6</p>
+ </item>
+ </taglist>
+ <p>For example, to start up IPv6 distributed nodes:</p>
+<pre>
+% <input>erl -name [email protected] -proto_dist inet6_tcp</input>
+</pre>
+ </item>
<tag><c><![CDATA[-remsh Node]]></c></tag>
<item>
<p>Starts Erlang with a remote shell connected to <c><![CDATA[Node]]></c>.</p>
@@ -436,7 +463,7 @@
flag and those running with the <c><![CDATA[-name]]></c> flag, as node
names must be unique in distributed Erlang systems.</p>
</item>
- <tag><marker id="smp"><c><![CDATA[-smp [enable|auto|disable]]]></c></marker></tag>
+ <tag><marker id="smp"/><c><![CDATA[-smp [enable|auto|disable]]]></c></tag>
<item>
<p><c>-smp enable</c> and <c>-smp</c> starts the Erlang runtime
system with SMP support enabled. This may fail if no runtime
@@ -462,7 +489,7 @@
<p><c><![CDATA[erl]]></c> invokes the code for the Erlang emulator (virtual
machine), which supports the following flags:</p>
<taglist>
- <tag><marker id="async_thread_stack_size"><c><![CDATA[+a size]]></c></marker></tag>
+ <tag><marker id="async_thread_stack_size"/><c><![CDATA[+a size]]></c></tag>
<item>
<p>Suggested stack size, in kilowords, for threads in the
async-thread pool. Valid range is 16-8192 kilowords. The
@@ -477,7 +504,7 @@
suggestion, and it might even be ignored on some
platforms.</p>
</item>
- <tag><marker id="async_thread_pool_size"><c><![CDATA[+A size]]></c></marker></tag>
+ <tag><marker id="async_thread_pool_size"/><c><![CDATA[+A size]]></c></tag>
<item>
<p>Sets the number of threads in async thread pool, valid range
is 0-1024. If thread support is available, the default is 10.</p>
@@ -496,7 +523,7 @@
<c><![CDATA[werl]]></c>, not <c><![CDATA[erl]]></c> (<c><![CDATA[oldshell]]></c>). Note also that
<c><![CDATA[Ctrl-Break]]></c> is used instead of <c><![CDATA[Ctrl-C]]></c> on Windows.</p>
</item>
- <tag><marker id="+c"><c><![CDATA[+c true | false]]></c></marker></tag>
+ <tag><marker id="+c"/><c><![CDATA[+c true | false]]></c></tag>
<item>
<p>Enable or disable
<seealso marker="time_correction#Time_Correction">time correction</seealso>:</p>
@@ -512,7 +539,7 @@
This is interpreted as <c>+c false</c>.
</p>
</item>
- <tag><marker id="+C_"><c><![CDATA[+C no_time_warp | single_time_warp | multi_time_warp]]></c></marker></tag>
+ <tag><marker id="+C_"/><c><![CDATA[+C no_time_warp | single_time_warp | multi_time_warp]]></c></tag>
<item>
<p>Set
<seealso marker="time_correction#Time_Warp_Modes">time warp mode</seealso>:
@@ -540,7 +567,7 @@
produce a crash dump. On Unix systems, sending an emulator process
a SIGUSR1 signal will also force a crash dump.</p>
</item>
- <tag><marker id="+e"><c><![CDATA[+e Number]]></c></marker></tag>
+ <tag><marker id="+e"/><c><![CDATA[+e Number]]></c></tag>
<item>
<p>Set max number of ETS tables.</p>
</item>
@@ -625,7 +652,7 @@
information about the file names and line numbers.
</p>
</item>
- <tag><marker id="erts_alloc"><c><![CDATA[+MFlag Value]]></c></marker></tag>
+ <tag><marker id="erts_alloc"/><c><![CDATA[+MFlag Value]]></c></tag>
<item>
<p>Memory allocator specific flags, see
<seealso marker="erts_alloc">erts_alloc(3)</seealso> for
@@ -664,10 +691,10 @@
debugging.</item>
</taglist>
</item>
- <tag><marker id="+pc"/><marker id="printable_character_range"><c><![CDATA[+pc Range]]></c></marker></tag>
+ <tag><marker id="+pc"/><marker id="printable_character_range"/><c><![CDATA[+pc Range]]></c></tag>
<item>
<p>Sets the range of characters that the system will consider printable in heuristic detection of strings. This typically affects the shell, debugger and io:format functions (when ~tp is used in the format string).</p>
- <p>Currently two values for the <c>Range</c> are supported:
+ <p>Currently two values for the <c>Range</c> are supported:</p>
<taglist>
<tag><c>latin1</c></tag> <item>The default. Only characters
in the ISO-latin-1 range can be considered printable, which means
@@ -682,11 +709,10 @@
example your font does not cover all Unicode
characters.</item>
</taglist>
- </p>
<p>Se also <seealso marker="stdlib:io#printable_range/0">
io:printable_range/0</seealso>.</p>
</item>
- <tag><marker id="+P"/><marker id="max_processes"><c><![CDATA[+P Number|legacy]]></c></marker></tag>
+ <tag><marker id="+P"/><marker id="max_processes"/><c><![CDATA[+P Number|legacy]]></c></tag>
<item>
<p>Sets the maximum number of simultaneously existing processes for this
system if a <c>Number</c> is passed as value. Valid range for
@@ -706,7 +732,7 @@
circumstances be extremely expensive. The legacy algoritm is deprecated,
and the <c>legacy</c> option is scheduled for removal in OTP-R18.</p>
</item>
- <tag><marker id="+Q"/><marker id="max_ports"><c><![CDATA[+Q Number|legacy]]></c></marker></tag>
+ <tag><marker id="+Q"/><marker id="max_ports"/><c><![CDATA[+Q Number|legacy]]></c></tag>
<item>
<p>Sets the maximum number of simultaneously existing ports for this
system if a Number is passed as value. Valid range for <c>Number</c>
@@ -737,7 +763,7 @@
circumstances be extremely expensive. The legacy algoritm is deprecated,
and the <c>legacy</c> option is scheduled for removal in OTP-R18.</p>
</item>
- <tag><marker id="compat_rel"><c><![CDATA[+R ReleaseNumber]]></c></marker></tag>
+ <tag><marker id="compat_rel"/><c><![CDATA[+R ReleaseNumber]]></c></tag>
<item>
<p>Sets the compatibility mode.</p>
<p>The distribution mechanism is not backwards compatible by
@@ -757,7 +783,7 @@
<item>
<p>Force ets memory block to be moved on realloc.</p>
</item>
- <tag><marker id="+rg"><c><![CDATA[+rg ReaderGroupsLimit]]></c></marker></tag>
+ <tag><marker id="+rg"/><c><![CDATA[+rg ReaderGroupsLimit]]></c></tag>
<item>
<p>Limits the amount of reader groups used by read/write locks
optimized for read operations in the Erlang runtime system. By
@@ -775,7 +801,7 @@
schedulers to logical processors</seealso>, since the reader groups
are distributed better between schedulers.</p>
</item>
- <tag><marker id="+S"><c><![CDATA[+S Schedulers:SchedulerOnline]]></c></marker></tag>
+ <tag><marker id="+S"/><c><![CDATA[+S Schedulers:SchedulerOnline]]></c></tag>
<item>
<p>Sets the number of scheduler threads to create and scheduler
threads to set online when SMP support has been enabled. The maximum for
@@ -800,7 +826,7 @@
SMP support enabled (see the <seealso marker="#smp">-smp</seealso>
flag).</p>
</item>
- <tag><marker id="+SP"><c><![CDATA[+SP SchedulersPercentage:SchedulersOnlinePercentage]]></c></marker></tag>
+ <tag><marker id="+SP"/><c><![CDATA[+SP SchedulersPercentage:SchedulersOnlinePercentage]]></c></tag>
<item>
<p>Similar to <seealso marker="#+S">+S</seealso> but uses percentages to set the
number of scheduler threads to create, based on logical processors configured,
@@ -821,7 +847,7 @@
SMP support enabled (see the <seealso marker="#smp">-smp</seealso>
flag).</p>
</item>
- <tag><marker id="+SDcpu"><c><![CDATA[+SDcpu DirtyCPUSchedulers:DirtyCPUSchedulersOnline]]></c></marker></tag>
+ <tag><marker id="+SDcpu"/><c><![CDATA[+SDcpu DirtyCPUSchedulers:DirtyCPUSchedulersOnline]]></c></tag>
<item>
<p>Sets the number of dirty CPU scheduler threads to create and dirty
CPU scheduler threads to set online when threading support has been
@@ -845,7 +871,7 @@
enabled (it's disabled by default).
</p>
</item>
- <tag><marker id="+SDPcpu"><c><![CDATA[+SDPcpu DirtyCPUSchedulersPercentage:DirtyCPUSchedulersOnlinePercentage]]></c></marker></tag>
+ <tag><marker id="+SDPcpu"/><c><![CDATA[+SDPcpu DirtyCPUSchedulersPercentage:DirtyCPUSchedulersOnlinePercentage]]></c></tag>
<item>
<p>Similar to <seealso marker="#+SDcpu">+SDcpu</seealso> but uses percentages to set the
number of dirty CPU scheduler threads to create and number of dirty CPU scheduler threads
@@ -868,7 +894,7 @@
enabled (it's disabled by default).
</p>
</item>
- <tag><marker id="+SDio"><c><![CDATA[+SDio IOSchedulers]]></c></marker></tag>
+ <tag><marker id="+SDio"/><c><![CDATA[+SDio IOSchedulers]]></c></tag>
<item>
<p>Sets the number of dirty I/O scheduler threads to create when threading
support has been enabled. The valid range is 0-1024. By default, the number
@@ -886,7 +912,7 @@
<item>
<p>Scheduling specific flags.</p>
<taglist>
- <tag><marker id="+sbt"><c>+sbt BindType</c></marker></tag>
+ <tag><marker id="+sbt"/><c>+sbt BindType</c></tag>
<item>
<p>Set scheduler bind type.</p>
<p>Schedulers can also be bound using the
@@ -1010,7 +1036,7 @@
<seealso marker="erlang#system_info_scheduler_bindings">erlang:system_info(scheduler_bindings)</seealso>.
</p>
</item>
- <tag><marker id="+sbwt"><c>+sbwt none|very_short|short|medium|long|very_long</c></marker></tag>
+ <tag><marker id="+sbwt"/><c>+sbwt none|very_short|short|medium|long|very_long</c></tag>
<item>
<p>Set scheduler busy wait threshold. Default is <c>medium</c>.
The threshold determines how long schedulers should busy
@@ -1020,7 +1046,7 @@
without prior notice.
</p>
</item>
- <tag><marker id="+scl"><c>+scl true|false</c></marker></tag>
+ <tag><marker id="+scl"/><c>+scl true|false</c></tag>
<item>
<p>Enable or disable scheduler compaction of load. By default
scheduler compaction of load is enabled. When enabled, load
@@ -1037,7 +1063,7 @@
between schedulers.
</p>
</item>
- <tag><marker id="+sct"><c>+sct CpuTopology</c></marker></tag>
+ <tag><marker id="+sct"/><c>+sct CpuTopology</c></tag>
<item>
<list type="bulleted">
<item><c><![CDATA[<Id> = integer(); when 0 =< <Id> =< 65535]]></c></item>
@@ -1159,7 +1185,7 @@
<p>For more information, see
<seealso marker="erlang#system_info_cpu_topology">erlang:system_info(cpu_topology)</seealso>.</p>
</item>
- <tag><marker id="+secio"><c>+secio true|false</c></marker></tag>
+ <tag><marker id="+secio"/><c>+secio true|false</c></tag>
<item>
<p>Enable or disable eager check I/O scheduling. The default
is currently <c>true</c>. The default was changed from <c>false</c>
@@ -1176,7 +1202,7 @@
<p><seealso marker="erlang#system_info_eager_check_io"><c>erlang:system_info(eager_check_io)</c></seealso>
returns the value of this parameter used when starting the VM.</p>
</item>
- <tag><marker id="+sfwi"><c>+sfwi Interval</c></marker></tag>
+ <tag><marker id="+sfwi"/><c>+sfwi Interval</c></tag>
<item>
<p>Set scheduler forced wakeup interval. All run queues will
be scanned each <c>Interval</c> milliseconds. While there are
@@ -1185,12 +1211,12 @@
disables this feature, which also is the default.
</p>
<p>This feature has been introduced as a temporary workaround
- for lengthy executing native code, and native code that do not
+ for long-executing native code, and native code that does not
bump reductions properly in OTP. When these bugs have be fixed
the <c>+sfwi</c> flag will be removed.
</p>
</item>
- <tag><marker id="+stbt"><c>+stbt BindType</c></marker></tag>
+ <tag><marker id="+stbt"/><c>+stbt BindType</c></tag>
<item>
<p>Try to set scheduler bind type. The same as the
<seealso marker="#+sbt">+sbt</seealso> flag with the exception of
@@ -1198,7 +1224,7 @@
documentation of the <seealso marker="#+sbt">+sbt</seealso> flag.
</p>
</item>
- <tag><marker id="+sub"><c>+sub true|false</c></marker></tag>
+ <tag><marker id="+sub"/><c>+sub true|false</c></tag>
<item>
<p>Enable or disable
<seealso marker="erts:erlang#statistics_scheduler_wall_time">scheduler
@@ -1211,7 +1237,7 @@
balance scheduler utilization between schedulers. That is,
strive for equal scheduler utilization on all schedulers.
<br/>&nbsp;&nbsp;&nbsp;<c>+sub true</c> is only supported on
- systems where the runtime system detects and use a monotonically
+ systems where the runtime system detects and uses a monotonically
increasing high resolution clock. On other systems, the runtime
system will fail to start.
<br/>&nbsp;&nbsp;&nbsp;<c>+sub true</c> implies
@@ -1221,7 +1247,7 @@
utilization.
</p>
</item>
- <tag><marker id="+swct"><c>+swct very_eager|eager|medium|lazy|very_lazy</c></marker></tag>
+ <tag><marker id="+swct"/><c>+swct very_eager|eager|medium|lazy|very_lazy</c></tag>
<item>
<p>
Set scheduler wake cleanup threshold. Default is <c>medium</c>.
@@ -1235,7 +1261,7 @@
<p><em>NOTE:</em> This flag may be removed or changed at any time without prior notice.
</p>
</item>
- <tag><marker id="+sws"><c>+sws default|legacy</c></marker></tag>
+ <tag><marker id="+sws"/><c>+sws default|legacy</c></tag>
<item>
<p>
Set scheduler wakeup strategy. Default strategy changed in erts-5.10/OTP-R16A. This strategy was previously known as <c>proposal</c> in OTP-R15. The <c>legacy</c> strategy was used as default from R13 up to and including R15.
@@ -1243,7 +1269,7 @@
<p><em>NOTE:</em> This flag may be removed or changed at any time without prior notice.
</p>
</item>
- <tag><marker id="+swt"><c>+swt very_low|low|medium|high|very_high</c></marker></tag>
+ <tag><marker id="+swt"/><c>+swt very_low|low|medium|high|very_high</c></tag>
<item>
<p>Set scheduler wakeup threshold. Default is <c>medium</c>.
The threshold determines when to wake up sleeping schedulers
@@ -1257,7 +1283,7 @@
without prior notice.
</p>
</item>
- <tag><marker id="+spp"><c>+spp Bool</c></marker></tag>
+ <tag><marker id="+spp"/><c>+spp Bool</c></tag>
<item>
<p>Set default scheduler hint for port parallelism. If set to
<c>true</c>, the VM will schedule port tasks when doing so will
@@ -1273,7 +1299,7 @@
option to <seealso
marker="erlang#open_port/2">open_port/2</seealso></p>.
</item>
- <tag><marker id="sched_thread_stack_size"><c><![CDATA[+sss size]]></c></marker></tag>
+ <tag><marker id="sched_thread_stack_size"/><c><![CDATA[+sss size]]></c></tag>
<item>
<p>Suggested stack size, in kilowords, for scheduler threads.
Valid range is 4-8192 kilowords. The default stack size
@@ -1281,11 +1307,11 @@
</item>
</taglist>
</item>
- <tag><marker id="+t"><c><![CDATA[+t size]]></c></marker></tag>
+ <tag><marker id="+t"/><c><![CDATA[+t size]]></c></tag>
<item>
<p>Set the maximum number of atoms the VM can handle. Default is 1048576.</p>
</item>
- <tag><marker id="+T"><c><![CDATA[+T Level]]></c></marker></tag>
+ <tag><marker id="+T"/><c><![CDATA[+T Level]]></c></tag>
<item>
<p>Enables modified timing and sets the modified timing level.
Currently valid range is 0-9. The timing of the runtime system
@@ -1335,11 +1361,26 @@
<seealso marker="kernel:error_logger#warning_map/0">error_logger(3)</seealso>
for further information.</p>
</item>
+ <tag><c><![CDATA[+xFlag Value]]></c></tag>
+ <item>
+ <p>Default process flag settings.</p>
+ <taglist>
+ <tag><marker id="+xmqd"><c>+xmqd off_heap|on_heap|mixed</c></marker></tag>
+ <item><p>
+ Sets the default value for the process flag
+ <c>message_queue_data</c>. If <c>+xmqd</c> is not
+ passed, <c>mixed</c> will be the default. For more information,
+ see the documentation of
+ <seealso marker="erlang#process_flag_message_queue_data"><c>process_flag(message_queue_data,
+ MQD)</c></seealso>.
+ </p></item>
+ </taglist>
+ </item>
<tag><c><![CDATA[+zFlag Value]]></c></tag>
<item>
<p>Miscellaneous flags.</p>
<taglist>
- <tag><marker id="+zdbbl"><c>+zdbbl size</c></marker></tag>
+ <tag><marker id="+zdbbl"/><c>+zdbbl size</c></tag>
<item>
<p>Set the distribution buffer busy limit
(<seealso marker="erlang#system_info_dist_buf_busy_limit">dist_buf_busy_limit</seealso>)
@@ -1352,7 +1393,7 @@
give lower latency and higher throughput at the expense
of higher memory usage.</p>
</item>
- <tag><marker id="+zdntgc"><c>+zdntgc time</c></marker></tag>
+ <tag><marker id="+zdntgc"/><c>+zdntgc time</c></tag>
<item>
<p>Set the delayed node table garbage collection time
(<seealso marker="erlang#system_info_delayed_node_table_gc">delayed_node_table_gc</seealso>)
@@ -1426,7 +1467,7 @@
</item>
</taglist>
</item>
- <tag><marker id="ERL_AFLAGS"><c><![CDATA[ERL_AFLAGS]]></c></marker></tag>
+ <tag><marker id="ERL_AFLAGS"/><c><![CDATA[ERL_AFLAGS]]></c></tag>
<item>
<p>The content of this environment variable will be added to the
beginning of the command line for <c><![CDATA[erl]]></c>.</p>
@@ -1436,7 +1477,7 @@
the <c><![CDATA[-extra]]></c> section, i.e. the end of the command line
following after an <c><![CDATA[-extra]]></c> flag.</p>
</item>
- <tag><marker id="ERL_ZFLAGS"><c><![CDATA[ERL_ZFLAGS]]></c></marker> and <marker id="ERL_FLAGS"><c><![CDATA[ERL_FLAGS]]></c></marker></tag>
+ <tag><marker id="ERL_ZFLAGS"/><c><![CDATA[ERL_ZFLAGS]]></c> and <marker id="ERL_FLAGS"/><c><![CDATA[ERL_FLAGS]]></c></tag>
<item>
<p>The content of these environment variables will be added to the
end of the command line for <c><![CDATA[erl]]></c>.</p>
diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml
index e1a58856f3..b435d5c9b4 100644
--- a/erts/doc/src/erl_dist_protocol.xml
+++ b/erts/doc/src/erl_dist_protocol.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2007</year>
- <year>2013</year>
+ <year>2015</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -549,10 +549,10 @@ If Result > 0, the packet only consists of [119, Result].
-->
</section>
- <marker id="distribution_handshake"/>
<section>
<title>Distribution Handshake</title>
<p>
+ <marker id="distribution_handshake"/>
This section describes the distribution handshake protocol
introduced in the OTP-R6 release of Erlang/OTP. This
description was previously located in
diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml
index 1f7fe0f961..241d4131d5 100644
--- a/erts/doc/src/erl_driver.xml
+++ b/erts/doc/src/erl_driver.xml
@@ -4,7 +4,7 @@
<cref>
<header>
<copyright>
- <year>2001</year><year>2014</year>
+ <year>2001</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -223,7 +223,7 @@
asynchronous function calls, using a thread pool provided by
Erlang. There is also a select call, that can be used for
asynchronous drivers.</item>
- <tag><marker id="multi_threading">Multi-threading</marker></tag>
+ <tag><marker id="multi_threading"/>Multi-threading</tag>
<item>
<p>A POSIX thread like API for multi-threading is provided. The
Erlang driver thread API only provide a subset of the functionality
@@ -297,7 +297,7 @@
<item><p>A driver can add and later remove drivers.</p></item>
<tag>Monitoring processes</tag>
<item><p>A driver can monitor a process that does not own a port.</p></item>
- <tag><marker id="version_management">Version management</marker></tag>
+ <tag><marker id="version_management"/>Version management</tag>
<item>
<p>Version management is enabled for drivers that have set the
<seealso marker="driver_entry#extended_marker">extended_marker</seealso>
@@ -347,6 +347,16 @@
the driver does not handle sizes that overflow an <c>int</c>
all will work as before.</p>
</item>
+ <tag><marker id="time_measurement"/>Time Measurement</tag>
+ <item><p>Support for time measurement in drivers:
+ <list>
+ <item><seealso marker="#ErlDrvTime"><c>ErlDrvTime</c></seealso></item>
+ <item><seealso marker="#ErlDrvTimeUnit"><c>ErlDrvTimeUnit</c></seealso></item>
+ <item><seealso marker="#erl_drv_monotonic_time"><c>erl_drv_monotonic_time()</c></seealso></item>
+ <item><seealso marker="#erl_drv_time_offset"><c>erl_drv_time_offset()</c></seealso></item>
+ <item><seealso marker="#erl_drv_convert_time_unit"><c>erl_drv_convert_time_unit()</c></seealso></item>
+ </list></p>
+ </item>
</taglist>
</section>
@@ -384,12 +394,12 @@
<item>
<p>
Rewrite driver callback
- <c><seealso marker="driver_entry#control">control</seealso></c>
+ <seealso marker="driver_entry#control"><c>control</c></seealso>
to use return type <c>ErlDrvSSizeT</c> instead of <c>int</c>.
</p>
<p>
Rewrite driver callback
- <c><seealso marker="driver_entry#call">call</seealso></c>
+ <seealso marker="driver_entry#call"><c>call</c></seealso>
to use return type <c>ErlDrvSSizeT</c> instead of <c>int</c>.
</p>
<note>
@@ -407,19 +417,19 @@
<item>
<p>
Driver callback
- <c><seealso marker="driver_entry#output">output</seealso></c>
+ <seealso marker="driver_entry#output"><c>output</c></seealso>
now gets <c>ErlDrvSizeT</c> as 3rd argument instead
of previously <c>int</c>.
</p>
<p>
Driver callback
- <c><seealso marker="driver_entry#control">control</seealso></c>
+ <seealso marker="driver_entry#control"><c>control</c></seealso>
now gets <c>ErlDrvSizeT</c> as 4th and 6th arguments instead
of previously <c>int</c>.
</p>
<p>
Driver callback
- <c><seealso marker="driver_entry#call">call</seealso></c>
+ <seealso marker="driver_entry#call"><c>call</c></seealso>
now gets <c>ErlDrvSizeT</c> as 4th and 6th arguments instead
of previously <c>int</c>.
</p>
@@ -860,6 +870,24 @@ typedef struct ErlIOVec {
<seealso marker="#erl_drv_tsd_get">erl_drv_tsd_get()</seealso>.
</p>
</item>
+ <tag><marker id="ErlDrvTime"/>ErlDrvTime</tag>
+ <item>
+ <p>A signed 64-bit integer type for representation of time.</p>
+ </item>
+ <tag><marker id="ErlDrvTimeUnit"/>ErlDrvTimeUnit</tag>
+ <item>
+ <p>An enumeration of time units supported by the driver API:</p>
+ <taglist>
+ <tag><c>ERL_DRV_SEC</c></tag>
+ <item><p>Seconds</p></item>
+ <tag><c>ERL_DRV_MSEC</c></tag>
+ <item><p>Milliseconds</p></item>
+ <tag><c>ERL_DRV_USEC</c></tag>
+ <item><p>Microseconds</p></item>
+ <tag><c>ERL_DRV_NSEC</c></tag>
+ <item><p>Nanoseconds</p></item>
+ </taglist>
+ </item>
</taglist>
</section>
@@ -1023,6 +1051,11 @@ typedef struct ErlIOVec {
<fsummary>Read a system timestamp</fsummary>
<desc>
<marker id="driver_get_now"></marker>
+ <warning><p><em>This function is deprecated! Do not use it!</em>
+ Use <seealso marker="#erl_drv_monotonic_time"><c>erl_drv_monotonic_time()</c></seealso>
+ (perhaps in combination with
+ <seealso marker="#erl_drv_time_offset"><c>erl_drv_time_offset()</c></seealso>)
+ instead.</p></warning>
<p>This function reads a timestamp into the memory pointed to by
the parameter <c>now</c>. See the description of <seealso marker="#ErlDrvNowData">ErlDrvNowData</seealso> for
specification of its fields. </p>
@@ -1044,9 +1077,7 @@ typedef struct ErlIOVec {
<c>select</c>/<c>poll</c> can use).
On windows, the Win32 API function <c>WaitForMultipleObjects</c>
is used. This places other restrictions on the event object.
- Refer to the Win32 SDK documentation.
- On Enea OSE, the receive function is used. See the <seealso
- marker="ose:ose_erl_driver"></seealso> for more details.</p>
+ Refer to the Win32 SDK documentation.</p>
<p>The <c>on</c> parameter should be <c>1</c> for setting events
and <c>0</c> for clearing them.</p>
<p>The <c>mode</c> argument is a bitwise-or combination of
@@ -1058,7 +1089,7 @@ typedef struct ErlIOVec {
<seealso marker="driver_entry#ready_output">ready_output</seealso>.
</p>
<note>
- <p>Some OS (Windows and Enea OSE) do not differentiate between read and write events.
+ <p>Some OS (Windows) do not differentiate between read and write events.
The call-back for a fired event then only depends on the value of <c>mode</c>.</p>
</note>
<p><c>ERL_DRV_USE</c> specifies if we are using the event object or if we want to close it.
@@ -2133,6 +2164,53 @@ ERL_DRV_MAP int sz
</func>
<func>
+ <name><ret>void</ret><nametext>erl_drv_init_ack(ErlDrvPort port, ErlDrvData res)</nametext></name>
+ <fsummary>Acknowledge the start of the port</fsummary>
+ <desc>
+ <marker id="erl_drv_init_ack"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>port</c></tag>
+ <item>The port handle of the port (driver instance) creating
+ doing the acknowledgment.
+ </item>
+ <tag><c>res</c></tag>
+ <item>The result of the port initialization. This can be the same values
+ as the return value of <seealso marker="driver_entry#start">start</seealso>,
+ i.e any of the error codes or the ErlDrvData that is to be used for this
+ port.
+ </item>
+ </taglist>
+ <p>
+ When this function is called the initiating erlang:open_port call is
+ returned as if the <seealso marker="driver_entry#start">start</seealso>
+ function had just been called. It can only be used when the
+ <seealso marker="driver_entry#driver_flags">ERL_DRV_FLAG_USE_INIT_ACK</seealso>
+ flag has been set on the linked-in driver.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name><ret>void</ret><nametext>erl_drv_set_os_pid(ErlDrvPort port, ErlDrvSInt pid)</nametext></name>
+ <fsummary>Set the os_pid for the port</fsummary>
+ <desc>
+ <marker id="erl_drv_set_os_pid"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>port</c></tag>
+ <item>The port handle of the port (driver instance) to set the pid on.
+ </item>
+ <tag><c>pid</c></tag>
+ <item>The pid to set.</item>
+ </taglist>
+ <p>
+ Set the os_pid seen when doing erlang:port_info/2 on this port.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>int</ret><nametext>erl_drv_thread_create(char *name,
ErlDrvTid *tid,
void * (*func)(void *),
@@ -2811,7 +2889,7 @@ ERL_DRV_MAP int sz
</func>
<func>
- <name><ret>int</ret><nametext>erl_drv_putenv(char *key, char *value)</nametext></name>
+ <name><ret>int</ret><nametext>erl_drv_putenv(const char *key, char *value)</nametext></name>
<fsummary>Set the value of an environment variable</fsummary>
<desc>
<marker id="erl_drv_putenv"></marker>
@@ -2840,7 +2918,7 @@ ERL_DRV_MAP int sz
</desc>
</func>
<func>
- <name><ret>int</ret><nametext>erl_drv_getenv(char *key, char *value, size_t *value_size)</nametext></name>
+ <name><ret>int</ret><nametext>erl_drv_getenv(const char *key, char *value, size_t *value_size)</nametext></name>
<fsummary>Get the value of an environment variable</fsummary>
<desc>
<marker id="erl_drv_getenv"></marker>
@@ -2997,6 +3075,86 @@ ERL_DRV_MAP int sz
</desc>
</func>
+ <func>
+ <name><ret>ErlDrvTime</ret><nametext>erl_drv_monotonic_time(ErlDrvTimeUnit time_unit)</nametext></name>
+ <fsummary>Get Erlang Monotonic Time</fsummary>
+ <desc>
+ <marker id="erl_drv_monotonic_time"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>time_unit</c></tag>
+ <item>Time unit of returned value.</item>
+ </taglist>
+ <p>
+ Returns
+ <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang
+ monotonic time</seealso>. Note that it is not uncommon with
+ negative values.
+ </p>
+ <p>Returns <c>ERL_DRV_TIME_ERROR</c> if called with an invalid
+ time unit argument, or if called from a thread that is not a
+ scheduler thread.</p>
+ <p>See also:</p>
+ <list>
+ <item><seealso marker="#ErlDrvTime"><c>ErlDrvTime</c></seealso></item>
+ <item><seealso marker="#ErlDrvTimeUnit"><c>ErlDrvTimeUnit</c></seealso></item>
+ </list>
+ </desc>
+ </func>
+
+ <func>
+ <name><ret>ErlDrvTime</ret><nametext>erl_drv_time_offset(ErlDrvTimeUnit time_unit)</nametext></name>
+ <fsummary>Get current Time Offset</fsummary>
+ <desc>
+ <marker id="erl_drv_time_offset"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>time_unit</c></tag>
+ <item>Time unit of returned value.</item>
+ </taglist>
+ <p>Returns the current time offset between
+ <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang monotonic time</seealso>
+ and
+ <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso>
+ converted into the <c>time_unit</c> passed as argument.</p>
+ <p>Returns <c>ERL_DRV_TIME_ERROR</c> if called with an invalid
+ time unit argument, or if called from a thread that is not a
+ scheduler thread.</p>
+ <p>See also:</p>
+ <list>
+ <item><seealso marker="#ErlDrvTime"><c>ErlDrvTime</c></seealso></item>
+ <item><seealso marker="#ErlDrvTimeUnit"><c>ErlDrvTimeUnit</c></seealso></item>
+ </list>
+ </desc>
+ </func>
+
+ <func>
+ <name><ret>ErlDrvTime</ret><nametext>erl_drv_convert_time_unit(ErlDrvTime val, ErlDrvTimeUnit from, ErlDrvTimeUnit to)</nametext></name>
+ <fsummary>Convert time unit of a time value</fsummary>
+ <desc>
+ <marker id="erl_drv_convert_time_unit"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>val</c></tag>
+ <item>Value to convert time unit for.</item>
+ <tag><c>from</c></tag>
+ <item>Time unit of <c>val</c>.</item>
+ <tag><c>to</c></tag>
+ <item>Time unit of returned value.</item>
+ </taglist>
+ <p>Converts the <c>val</c> value of time unit <c>from</c> to
+ the corresponding value of time unit <c>to</c>. The result is
+ rounded using the floor function.</p>
+ <p>Returns <c>ERL_DRV_TIME_ERROR</c> if called with an invalid
+ time unit argument.</p>
+ <p>See also:</p>
+ <list>
+ <item><seealso marker="#ErlDrvTime"><c>ErlDrvTime</c></seealso></item>
+ <item><seealso marker="#ErlDrvTimeUnit"><c>ErlDrvTimeUnit</c></seealso></item>
+ </list>
+ </desc>
+ </func>
+
</funcs>
<section>
<title>SEE ALSO</title>
diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml
index caf1e812c4..2ac974f497 100644
--- a/erts/doc/src/erl_ext_dist.xml
+++ b/erts/doc/src/erl_ext_dist.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2007</year>
- <year>2014</year>
+ <year>2015</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -150,10 +150,10 @@
</note>
</section>
- <marker id="distribution_header"/>
<section>
<title>Distribution header</title>
<p>
+ <marker id="distribution_header"/>
As of erts version 5.7.2 the old atom cache protocol was
dropped and a new one was introduced. This atom cache protocol
introduced the distribution header. Nodes with erts versions
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index 23c3d5fcee..be0e406b9c 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -4,7 +4,7 @@
<cref>
<header>
<copyright>
- <year>2001</year><year>2013</year>
+ <year>2001</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -317,6 +317,17 @@ ok
libraries might however fail if deprecated features are used.
</p></item>
+ <tag><marker id="time_measurement"/>Time Measurement</tag>
+ <item><p>Support for time measurement in NIF libraries:
+ <list>
+ <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item>
+ <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item>
+ <item><seealso marker="#enif_monotonic_time"><c>enif_monotonic_time()</c></seealso></item>
+ <item><seealso marker="#enif_time_offset"><c>enif_time_offset()</c></seealso></item>
+ <item><seealso marker="#enif_convert_time_unit"><c>enif_convert_time_unit()</c></seealso></item>
+ </list></p>
+ </item>
+
<tag>Long-running NIFs</tag>
<item><p><marker id="dirty_nifs"/>Native functions
<seealso marker="#lengthy_work">
@@ -560,6 +571,25 @@ typedef enum {
<item><p>A native signed 64-bit integer type.</p></item>
<tag><marker id="ErlNifUInt64"/>ErlNifUInt64</tag>
<item><p>A native unsigned 64-bit integer type.</p></item>
+
+ <tag><marker id="ErlNifTime"/>ErlNifTime</tag>
+ <item>
+ <p>A signed 64-bit integer type for representation of time.</p>
+ </item>
+ <tag><marker id="ErlNifTimeUnit"/>ErlNifTimeUnit</tag>
+ <item>
+ <p>An enumeration of time units supported by the NIF API:</p>
+ <taglist>
+ <tag><c>ERL_NIF_SEC</c></tag>
+ <item><p>Seconds</p></item>
+ <tag><c>ERL_NIF_MSEC</c></tag>
+ <item><p>Milliseconds</p></item>
+ <tag><c>ERL_NIF_USEC</c></tag>
+ <item><p>Microseconds</p></item>
+ <tag><c>ERL_NIF_NSEC</c></tag>
+ <item><p>Nanoseconds</p></item>
+ </taglist>
+ </item>
</taglist>
</section>
@@ -723,7 +753,7 @@ typedef enum {
<func><name><ret>int</ret><nametext>enif_get_list_length(ErlNifEnv* env, ERL_NIF_TERM term, unsigned* len)</nametext></name>
<fsummary>Get the length of list <c>term</c></fsummary>
<desc><p>Set <c>*len</c> to the length of list <c>term</c> and return true,
- or return false if <c>term</c> is not a list.</p></desc>
+ or return false if <c>term</c> is not a proper list.</p></desc>
</func>
<func><name><ret>int</ret><nametext>enif_get_long(ErlNifEnv* env, ERL_NIF_TERM term, long int* ip)</nametext></name>
<fsummary>Read an long integer term</fsummary>
@@ -791,6 +821,10 @@ typedef enum {
and return true, or return false if <c>term</c> is not an unsigned integer or is
outside the bounds of type <c>unsigned long</c>.</p></desc>
</func>
+ <func><name><ret>int</ret><nametext>enif_getenv(const char* key, char* value, size_t *value_size)</nametext></name>
+ <fsummary>Get the value of an environment variable</fsummary>
+ <desc><p>Same as <seealso marker="erl_driver#erl_drv_getenv">erl_drv_getenv</seealso>.</p></desc>
+ </func>
<func><name><ret>int</ret><nametext>enif_has_pending_exception(ErlNifEnv* env, ERL_NIF_TERM* reason)</nametext></name>
<fsummary>Check if an exception has been raised</fsummary>
<desc><p>Return true if a pending exception is associated
@@ -833,9 +867,10 @@ typedef enum {
<fsummary>Determine if a term is an empty list</fsummary>
<desc><p>Return true if <c>term</c> is an empty list.</p></desc>
</func>
- <marker id="enif_is_exception"/><func><name><ret>int</ret><nametext>enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name>
+ <func><name><ret>int</ret><nametext>enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name>
<fsummary>Determine if a term is an exception</fsummary>
- <desc><p>Return true if <c>term</c> is an exception.</p></desc>
+ <desc><marker id="enif_is_exception"/>
+ <p>Return true if <c>term</c> is an exception.</p></desc>
</func>
<func><name><ret>int</ret><nametext>enif_is_map(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name>
<fsummary>Determine if a term is a map</fsummary>
@@ -1481,6 +1516,88 @@ enif_map_iterator_destroy(env, &amp;iter);
<desc><p>Same as <seealso marker="erl_driver#erl_drv_tsd_set">erl_drv_tsd_set</seealso>.
</p></desc>
</func>
+
+
+ <func>
+ <name><ret>ErlNifTime</ret><nametext>enif_monotonic_time(ErlNifTimeUnit time_unit)</nametext></name>
+ <fsummary>Get Erlang Monotonic Time</fsummary>
+ <desc>
+ <marker id="enif_monotonic_time"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>time_unit</c></tag>
+ <item>Time unit of returned value.</item>
+ </taglist>
+ <p>
+ Returns
+ <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang
+ monotonic time</seealso>. Note that it is not uncommon with
+ negative values.
+ </p>
+ <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid
+ time unit argument, or if called from a thread that is not a
+ scheduler thread.</p>
+ <p>See also:</p>
+ <list>
+ <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item>
+ <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item>
+ </list>
+ </desc>
+ </func>
+
+ <func>
+ <name><ret>ErlNifTime</ret><nametext>enif_time_offset(ErlNifTimeUnit time_unit)</nametext></name>
+ <fsummary>Get current Time Offset</fsummary>
+ <desc>
+ <marker id="enif_time_offset"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>time_unit</c></tag>
+ <item>Time unit of returned value.</item>
+ </taglist>
+ <p>Returns the current time offset between
+ <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang monotonic time</seealso>
+ and
+ <seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso>
+ converted into the <c>time_unit</c> passed as argument.</p>
+ <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid
+ time unit argument, or if called from a thread that is not a
+ scheduler thread.</p>
+ <p>See also:</p>
+ <list>
+ <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item>
+ <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item>
+ </list>
+ </desc>
+ </func>
+
+ <func>
+ <name><ret>ErlNifTime</ret><nametext>enif_convert_time_unit(ErlNifTime val, ErlNifTimeUnit from, ErlNifTimeUnit to)</nametext></name>
+ <fsummary>Convert time unit of a time value</fsummary>
+ <desc>
+ <marker id="enif_convert_time_unit"></marker>
+ <p>Arguments:</p>
+ <taglist>
+ <tag><c>val</c></tag>
+ <item>Value to convert time unit for.</item>
+ <tag><c>from</c></tag>
+ <item>Time unit of <c>val</c>.</item>
+ <tag><c>to</c></tag>
+ <item>Time unit of returned value.</item>
+ </taglist>
+ <p>Converts the <c>val</c> value of time unit <c>from</c> to
+ the corresponding value of time unit <c>to</c>. The result is
+ rounded using the floor function.</p>
+ <p>Returns <c>ERL_NIF_TIME_ERROR</c> if called with an invalid
+ time unit argument.</p>
+ <p>See also:</p>
+ <list>
+ <item><seealso marker="#ErlNifTime"><c>ErlNifTime</c></seealso></item>
+ <item><seealso marker="#ErlNifTimeUnit"><c>ErlNifTimeUnit</c></seealso></item>
+ </list>
+ </desc>
+ </func>
+
</funcs>
<section>
<title>SEE ALSO</title>
diff --git a/erts/doc/src/erl_prim_loader.xml b/erts/doc/src/erl_prim_loader.xml
index d05f0d9aea..8f66e07ae1 100644
--- a/erts/doc/src/erl_prim_loader.xml
+++ b/erts/doc/src/erl_prim_loader.xml
@@ -36,17 +36,11 @@
the system. The start script is also fetched with this low level
loader.</p>
<p><c>erl_prim_loader</c> knows about the environment and how to
- fetch modules. The loader could, for example, fetch files using
- the file system (with absolute file names as input), or a
- database (where the binary format of a module is stored).</p>
+ fetch modules.</p>
<p>The <c>-loader Loader</c> command line flag can be used to
choose the method used by the <c>erl_prim_loader</c>. Two
<c>Loader</c> methods are supported by the Erlang runtime system:
- <c>efile</c> and <c>inet</c>. If another loader is required, then
- it has to be implemented by the user. The <c>Loader</c> provided
- by the user must fulfill the protocol defined below, and it is
- started with the <c>erl_prim_loader</c> by evaluating
- <c>open_port({spawn,Loader},[binary])</c>.</p>
+ <c>efile</c> and <c>inet</c>.</p>
<warning><p>The support for loading of code from archive files is
experimental. The sole purpose of releasing it before it is ready
@@ -56,39 +50,9 @@
<c>-loader_debug</c> are also experimental</p></warning>
</description>
- <datatypes>
- <datatype>
- <name name="host"/>
- </datatype>
- </datatypes>
<funcs>
<func>
- <name name="start" arity="3"/>
- <fsummary>Start the Erlang low level loader</fsummary>
- <desc>
- <p>Starts the Erlang low level loader. This function is called
- by the <c>init</c> process (and module). The <c>init</c>
- process reads the command line flags <c>-id <anno>Id</anno></c>,
- <c>-loader <anno>Loader</anno></c>, and <c>-hosts <anno>Hosts</anno></c>. These are
- the arguments supplied to the <c>start/3</c> function.</p>
- <p>If <c>-loader</c> is not given, the default loader is
- <c>efile</c> which tells the system to read from the file
- system.</p>
- <p>If <c>-loader</c> is <c>inet</c>, the <c>-id <anno>Id</anno></c>,
- <c>-hosts <anno>Hosts</anno></c>, and <c>-setcookie Cookie</c> flags must
- also be supplied. <c><anno>Hosts</anno></c> identifies hosts which this
- node can contact in order to load modules. One Erlang
- runtime system with a <c>erl_boot_server</c> process must be
- started on each of hosts given in <c><anno>Hosts</anno></c> in order to
- answer the requests. See <seealso
- marker="kernel:erl_boot_server">erl_boot_server(3)</seealso>.</p>
- <p>If <c>-loader</c> is something else, the given port program
- is started. The port program is supposed to follow
- the protocol specified below.</p>
- </desc>
- </func>
- <func>
<name name="get_file" arity="1"/>
<fsummary>Get a file</fsummary>
<desc>
@@ -96,8 +60,6 @@
<c><anno>Filename</anno></c> is either an absolute file name or just the name
of the file, for example <c>"lists.beam"</c>. If an internal
path is set to the loader, this path is used to find the file.
- If a user supplied loader is used, the path can be stripped
- off if it is obsolete, and the loader does not use a path.
<c><anno>FullName</anno></c> is the complete name of the fetched file.
<c><anno>Bin</anno></c> is the contents of the file as a binary.</p>
@@ -175,22 +137,6 @@
</funcs>
<section>
- <title>Protocol</title>
- <p>The following protocol must be followed if a user provided
- loader port program is used. The <c>Loader</c> port program is
- started with the command
- <c>open_port({spawn,Loader},[binary])</c>. The protocol is as
- follows:</p>
- <pre>
-Function Send Receive
--------------------------------------------------------------
-get_file [102 | FileName] [121 | BinaryFile] (on success)
- [122] (failure)
-
-stop eof terminate</pre>
- </section>
-
- <section>
<title>Command Line Flags</title>
<p>The <c>erl_prim_loader</c> module interprets the following
command line flags:</p>
@@ -199,10 +145,8 @@ stop eof terminate</pre>
<item>
<p>Specifies the name of the loader used by
<c>erl_prim_loader</c>. <c>Loader</c> can be <c>efile</c>
- (use the local file system), or <c>inet</c> (load using
- the <c>boot_server</c> on another Erlang node). If
- <c>Loader</c> is user defined, the defined <c>Loader</c> port
- program is started.</p>
+ (use the local file system) or <c>inet</c> (load using
+ the <c>boot_server</c> on another Erlang node).</p>
<p>If the <c>-loader</c> flag is omitted, it defaults to
<c>efile</c>.</p>
</item>
@@ -216,17 +160,12 @@ stop eof terminate</pre>
<p>Specifies which other Erlang nodes the <c>inet</c> loader
can use. This flag is mandatory if the <c>-loader inet</c>
flag is present. On each host, there must be on Erlang node
- with the <c>erl_boot_server</c> which handles the load
- requests. <c>Hosts</c> is a list of IP addresses (hostnames
+ with the <seealso
+ marker="kernel:erl_boot_server">erl_boot_server(3)</seealso>
+ which handles the load requests.
+ <c>Hosts</c> is a list of IP addresses (hostnames
are not acceptable).</p>
</item>
- <tag><c>-id Id</c></tag>
- <item>
- <p>Specifies the identity of the Erlang runtime system. If
- the system runs as a distributed node, <c>Id</c> must be
- identical to the name supplied with the <c>-sname</c> or
- <c>-name</c> distribution flags.</p>
- </item>
<tag><c>-setcookie Cookie</c></tag>
<item>
<p>Specifies the cookie of the Erlang runtime system. This flag
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 70d000f763..350a8506f5 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2013</year>
+ <year>1996</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -59,14 +59,20 @@
</datatype>
<datatype>
+ <name name="message_queue_data"></name>
+ <desc><p>See <seealso marker="#process_flag_message_queue_data"><c>erlang:process_flag(message_queue_data, MQD)</c></seealso>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
<name name="timestamp"></name>
<desc><p>See <seealso marker="#timestamp/0">erlang:timestamp/0</seealso>.</p>
</desc>
</datatype>
- <marker id="type_time_unit"/>
<datatype>
<name name="time_unit"></name>
- <desc><p>Supported time unit representations:</p>
+ <desc><p><marker id="type_time_unit"/>
+ Supported time unit representations:</p>
<taglist>
<tag><c>PartsPerSecond :: integer() >= 1</c></tag>
<item><p>Time unit expressed in parts per second. That is,
@@ -125,6 +131,17 @@
</note>
</item>
+ <tag><c>perf_counter</c></tag>
+ <item><p>Symbolic representation of the performance counter
+ time unit used by the Erlang runtime system.</p>
+
+ <p>The <c>perf_counter</c> time unit behaves much in the same way
+ as the <c>native</c> time unit. That is it might differ inbetween
+ run-time restarts. You get values of this type by calling
+ <seealso marker="kernel:os#perf_counter/0"><c>os:perf_counter()</c></seealso>
+ </p>
+ </item>
+
</taglist>
<p>The <c>time_unit/0</c> type may be extended. Use
@@ -439,7 +456,7 @@
<func>
<name name="binary_to_list" arity="3"/>
<fsummary>Converts part of a binary to a list.</fsummary>
- <type_desc variable="Start">1..byte_size(<anno>Binary</anno>)</type_desc>
+ <type_desc variable="Start">1..byte_size(<c><anno>Binary</anno></c>)</type_desc>
<desc>
<p>As <c>binary_to_list/1</c>, but returns a list of integers
corresponding to the bytes from position <c><anno>Start</anno></c> to
@@ -997,19 +1014,19 @@
the call, though. It is therefore usually advisable
to remove such a <c>'DOWN'</c> message from the message queue
after monitoring has been stopped.
- <seealso marker="#demonitor/2">demonitor(<anno>MonitorRef</anno>, [flush])</seealso>
+ <seealso marker="#demonitor/2"><c>demonitor(<anno>MonitorRef</anno>, [flush])</c></seealso>
can be used instead of
<c>demonitor(<anno>MonitorRef</anno>)</c> if this cleanup is wanted.</p>
<note>
- <p>Before OTP R11B (<c>ERTS</c> 5.5), <c>demonitor/1</c>
- behaved asynchronous, that is, the monitor was active
- until the "demonitor signal" reached the monitored entity.
- This had an undesirable effect, as you could never know when
- you were guaranteed <em>not</em> to receive a <c>DOWN</c>
- message because of the monitor.</p>
- <p>The current behavior can be viewed as two combined operations:
- asynchronously send a "demonitor signal" to the monitored
- entity and ignore any future results of the monitor.</p>
+ <p>Prior to OTP release R11B (ERTS version 5.5) <c>demonitor/1</c>
+ behaved completely asynchronously, i.e., the monitor was active
+ until the "demonitor signal" reached the monitored entity. This
+ had one undesirable effect. You could never know when
+ you were guaranteed <em>not</em> to receive a <c>DOWN</c> message
+ due to the monitor.</p>
+ <p>Current behavior can be viewed as two combined operations:
+ asynchronously send a "demonitor signal" to the monitored entity
+ and ignore any future results of the monitor. </p>
</note>
<p>Failure: It is an error if <c><anno>MonitorRef</anno></c> refers to a
monitoring started by another process. Not all such cases are
@@ -1026,7 +1043,7 @@
<p>The returned value is <c>true</c> unless <c>info</c> is part
of <c><anno>OptionList</anno></c>.</p>
<p><c>demonitor(<anno>MonitorRef</anno>, [])</c> is equivalent to
- <seealso marker="#demonitor/1">demonitor(<anno>MonitorRef</anno>)</seealso>.</p>
+ <seealso marker="#demonitor/1"><c>demonitor(<anno>MonitorRef</anno>)</c></seealso>.</p>
<p>The available <c><anno>Option</anno></c>s are as follows:</p>
<taglist>
<tag><c>flush</c></tag>
@@ -1105,7 +1122,7 @@
<fsummary>Prints a term on standard output.</fsummary>
<desc>
<p>Prints a text representation of <c><anno>Term</anno></c> on the
- standard output. On OSE, the term is printed to the ramlog.</p>
+ standard output.</p>
<warning>
<p>This BIF is intended for debugging only.</p>
</warning>
@@ -1114,8 +1131,8 @@
<func>
<name name="element" arity="2"/>
- <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<fsummary>Returns the Nth element of a tuple.</fsummary>
+ <type_desc variable="N">1..tuple_size(<anno>Tuple</anno>)</type_desc>
<desc>
<p>Returns the <c><anno>N</anno></c>th element (numbering from 1) of
<c><anno>Tuple</anno></c>, for example:</p>
@@ -1794,7 +1811,8 @@ os_prompt% </pre>
</item>
</taglist>
<note><p>On many platforms, the OS supports only status
- codes 0-255.</p></note>
+ codes 0-255. A too large status code will be truncated by clearing
+ the high bits.</p></note>
<p>For integer <c><anno>Status</anno></c>, the Erlang runtime system
closes all ports and allows async threads to finish their
operations before exiting. To exit without such flushing, use
@@ -2855,10 +2873,10 @@ os_prompt% </pre>
<func>
<name name="monitor" arity="2" clause_i="1"/>
<name name="monitor" arity="2" clause_i="2"/>
+ <fsummary>Starts monitoring.</fsummary>
<type name="registered_name"/>
<type name="registered_process_identifier"/>
<type name="monitor_process_identifier"/>
- <fsummary>Starts monitoring.</fsummary>
<desc>
<p>Send a monitor request of type <c><anno>Type</anno></c> to the
entity identified by <c><anno>Item</anno></c>. The caller of
@@ -3581,8 +3599,8 @@ os_prompt% </pre>
<func>
<name name="phash" arity="2"/>
- <type_desc variable="Range">Range = 1..2^32, Hash = 1..Range</type_desc>
<fsummary>Portable hash function.</fsummary>
+ <type_desc variable="Range">Range = 1..2^32, Hash = 1..Range</type_desc>
<desc>
<p>Portable hash function that gives the same hash for
the same Erlang term regardless of machine architecture and
@@ -3600,9 +3618,9 @@ os_prompt% </pre>
<func>
<name name="phash2" arity="1"/>
<name name="phash2" arity="2"/>
+ <fsummary>Portable hash function.</fsummary>
<type_desc variable="Range">1..2^32</type_desc>
<type_desc variable="Hash">0..Range-1</type_desc>
- <fsummary>Portable hash function.</fsummary>
<desc>
<p>Portable hash function that gives the same hash for
the same Erlang term regardless of machine architecture and
@@ -4280,9 +4298,59 @@ os_prompt% </pre>
<p>Returns the old value of the flag.</p>
</desc>
</func>
-
+ <marker id="process_flag_message_queue_data"/>
<func>
<name name="process_flag" arity="2" clause_i="5"/>
+ <fsummary>Set process flag <c>message_queue_data</c> for the calling process</fsummary>
+ <type name="message_queue_data"/>
+ <desc>
+ <p>This flag determines how messages in the message queue
+ are stored. When the flag is:</p>
+ <taglist>
+ <tag><c>off_heap</c></tag>
+ <item><p>
+ <em>All</em> messages in the message queue will be stored
+ outside of the process heap. This implies that <em>no</em>
+ messages in the message queue will be part of a garbage
+ collection of the process.
+ </p></item>
+ <tag><c>on_heap</c></tag>
+ <item><p>
+ All messages in the message queue will eventually be
+ placed on heap. They may however temporarily be stored
+ off heap. This is how messages always have been stored
+ up until ERTS version 8.0.
+ </p></item>
+ <tag><c>mixed</c></tag>
+ <item><p>
+ Messages may be placed either on the heap or outside
+ of the heap.
+ </p></item>
+ </taglist>
+ <p>
+ The default <c>message_queue_data</c> process flag is determined
+ by the <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso>
+ <c>erl</c> command line argument.
+ </p>
+ <p>
+ If the process potentially may get a hugh amount of messages,
+ you are recommended to set the flag to <c>off_heap</c>. This
+ since a garbage collection with lots of messages placed on
+ the heap may become extremly expensive and the process may
+ consume large amounts of memory. Performance of the
+ actual message passing is however generally better when not
+ using the <c>off_heap</c> flag.
+ </p>
+ <p>
+ When changing this flag messages will be moved. This work
+ has been initiated but not completed when this function
+ call returns.
+ </p>
+ <p>Returns the old value of the flag.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="process_flag" arity="2" clause_i="6"/>
<fsummary>Sets process flag <c>priority</c> for the calling process.</fsummary>
<type name="priority_level"/>
<desc>
@@ -4356,7 +4424,7 @@ os_prompt% </pre>
</func>
<func>
- <name name="process_flag" arity="2" clause_i="6"/>
+ <name name="process_flag" arity="2" clause_i="7"/>
<fsummary>Sets process flag <c>save_calls</c> for the calling process.</fsummary>
<desc>
<p><c><anno>N</anno></c> must be an integer in the interval 0..10000.
@@ -4387,7 +4455,7 @@ os_prompt% </pre>
</func>
<func>
- <name name="process_flag" arity="2" clause_i="7"/>
+ <name name="process_flag" arity="2" clause_i="8"/>
<fsummary>Sets process flag <c>sensitive</c> for the calling process.</fsummary>
<desc>
<p>Sets or clears flag <c>sensitive</c> for the current process.
@@ -4441,6 +4509,7 @@ os_prompt% </pre>
<type name="process_info_result_item"/>
<type name="priority_level"/>
<type name="stack_item"/>
+ <type name="message_queue_data" />
<desc>
<p>Returns a list containing <c><anno>InfoTuple</anno></c>s with
miscellaneous information about the process identified by
@@ -4493,6 +4562,7 @@ os_prompt% </pre>
<type name="process_info_result_item"/>
<type name="stack_item"/>
<type name="priority_level"/>
+ <type name="message_queue_data" />
<desc>
<p>Returns information about the process identified by
<c><anno>Pid</anno></c>, as specified by
@@ -4584,6 +4654,17 @@ os_prompt% </pre>
The content of <c><anno>GCInfo</anno></c> can be changed without
prior notice.</p>
</item>
+ <tag><c>{garbage_collection_info, <anno>GCInfo</anno>}</c></tag>
+ <item>
+ <p><c><anno>GCInfo</anno></c> is a list containing miscellaneous
+ detailed information about garbage collection for this process.
+ The content of <c><anno>GCInfo</anno></c> can be changed without
+ prior notice.
+ See <seealso marker="#gc_start">gc_start</seealso> in
+ <seealso marker="#trace/3">erlang:trace/3</seealso> for details about
+ what each item means.
+ </p>
+ </item>
<tag><c>{group_leader, <anno>GroupLeader</anno>}</c></tag>
<item>
<p><c><anno>GroupLeader</anno></c> is group leader for the I/O of
@@ -4661,6 +4742,15 @@ os_prompt% </pre>
monitor by name, the list item is
<c>{process, {<anno>RegName</anno>, <anno>Node</anno>}}</c>.</p>
</item>
+ <tag><c>{message_queue_data, <anno>MQD</anno>}</c></tag>
+ <item>
+ <p>Returns the current state of the <c>message_queue_data</c>
+ process flag. <c><anno>MQD</anno></c> is either <c>off_heap</c>,
+ <c>on_heap</c>, or <c>mixed</c>. For more information, see the
+ documentation of
+ <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data,
+ MQD)</c></seealso>.</p>
+ </item>
<tag><c>{priority, <anno>Level</anno>}</c></tag>
<item>
<p><c><anno>Level</anno></c> is the current priority level for
@@ -4803,6 +4893,12 @@ os_prompt% </pre>
<seealso marker="kernel:code">code(3)</seealso>)
and is not to be used elsewhere.</p>
</warning>
+ <note>
+ <p>As from <c>ERTS</c> 8.0 (OTP 19), any lingering processes
+ that still execute the old code will be killed by this function.
+ In earlier versions, such incorrect use could cause much
+ more fatal failures, like emulator crash.</p>
+ </note>
<p>Failure: <c>badarg</c> if there is no old code for
<c><anno>Module</anno></c>.</p>
</desc>
@@ -5240,8 +5336,8 @@ true</pre>
<func>
<name name="setelement" arity="3"/>
- <type_desc variable="Index">1..tuple_size(<anno>Tuple1</anno></type_desc>
<fsummary>Sets the Nth element of a tuple.</fsummary>
+ <type_desc variable="Index">1..tuple_size(<anno>Tuple1</anno></type_desc>
<desc>
<p>Returns a tuple that is a copy of argument
<c><anno>Tuple1</anno></c>
@@ -5429,6 +5525,8 @@ true</pre>
<name name="spawn_opt" arity="2"/>
<fsummary>Creates a new process with a fun as entry point.</fsummary>
<type name="priority_level"/>
+ <type name="message_queue_data" />
+ <type name="spawn_opt_option" />
<desc>
<p>Returns the process identifier (pid) of a new process
started by the application of <c><anno>Fun</anno></c>
@@ -5444,6 +5542,8 @@ true</pre>
<name name="spawn_opt" arity="3"/>
<fsummary>Creates a new process with a fun as entry point on a given node.</fsummary>
<type name="priority_level"/>
+ <type name="message_queue_data" />
+ <type name="spawn_opt_option" />
<desc>
<p>Returns the process identifier (pid) of a new process started
by the application of <c><anno>Fun</anno></c> to the
@@ -5458,6 +5558,8 @@ true</pre>
<name name="spawn_opt" arity="4"/>
<fsummary>Creates a new process with a function as entry point.</fsummary>
<type name="priority_level"/>
+ <type name="message_queue_data" />
+ <type name="spawn_opt_option" />
<desc>
<p>Works as
<seealso marker="#spawn/3">spawn/3</seealso>, except that an
@@ -5559,6 +5661,18 @@ true</pre>
fine-tuning an application and to measure the execution
time with various <c><anno>VSize</anno></c> values.</p>
</item>
+ <tag><c>{message_queue_data, <anno>MQD</anno>}</c></tag>
+ <item>
+ <p>Sets the state of the <c>message_queue_data</c> process
+ flag. <c><anno>MQD</anno></c> should be either <c>off_heap</c>,
+ <c>on_heap</c>, or <c>mixed</c>. The default
+ <c>message_queue_data</c> process flag is determined by the
+ <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso> <c>erl</c>
+ command line argument. For more information, see the
+ documentation of
+ <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data,
+ <anno>MQD</anno>)</c></seealso>.</p>
+ </item>
</taglist>
</desc>
</func>
@@ -5567,6 +5681,8 @@ true</pre>
<name name="spawn_opt" arity="5"/>
<fsummary>Creates a new process with a function as entry point on a given node.</fsummary>
<type name="priority_level"/>
+ <type name="message_queue_data" />
+ <type name="spawn_opt_option" />
<desc>
<p>Returns the process identifier (pid) of a new process started
by the application
@@ -5582,8 +5698,8 @@ true</pre>
<func>
<name name="split_binary" arity="2"/>
- <type_desc variable="Pos">0..byte_size(Bin)</type_desc>
<fsummary>Splits a binary into two.</fsummary>
+ <type_desc variable="Pos">0..byte_size(Bin)</type_desc>
<desc>
<p>Returns a tuple containing the binaries that are the result
of splitting <c><anno>Bin</anno></c> into two parts at
@@ -5684,8 +5800,31 @@ true</pre>
<anno>Dest</anno>, <anno>Msg</anno>, [])</c></seealso>.</p>
</desc>
</func>
+
<func>
<name name="statistics" arity="1" clause_i="1"/>
+ <fsummary>Information about active processes and ports.</fsummary>
+ <desc><marker id="statistics_active_tasks"></marker>
+ <p>
+ Returns a list where each element represents the amount
+ of active processes and ports on each run queue and its
+ associated scheduler. That is, the number of processes and
+ ports that are ready to run, or are currently running. The
+ element location in the list corresponds to the scheduler
+ and its run queue. The first element corresponds to scheduler
+ number 1 and so on. The information is <em>not</em> gathered
+ atomically. That is, the result is not necessarily a
+ consistent snapshot of the state, but instead quite
+ efficiently gathered. See also,
+ <seealso marker="#statistics_total_active_tasks"><c>statistics(total_active_tasks)</c></seealso>,
+ <seealso marker="#statistics_run_queue_lengths"><c>statistics(run_queue_lengths)</c></seealso>, and
+ <seealso marker="#statistics_total_run_queue_lengths"><c>statistics(total_run_queue_lengths)</c></seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="statistics" arity="1" clause_i="2"/>
<fsummary>Information about context switches.</fsummary>
<desc>
<p>Returns the total number of context switches since the
@@ -5694,7 +5833,7 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="2"/>
+ <name name="statistics" arity="1" clause_i="3"/>
<fsummary>Information about exact reductions.</fsummary>
<desc>
<marker id="statistics_exact_reductions"></marker>
@@ -5708,7 +5847,7 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="3"/>
+ <name name="statistics" arity="1" clause_i="4"/>
<fsummary>Information about garbage collection.</fsummary>
<desc>
<p>Returns information about garbage collection, for example:</p>
@@ -5720,7 +5859,7 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="4"/>
+ <name name="statistics" arity="1" clause_i="5"/>
<fsummary>Information about I/O.</fsummary>
<desc>
<p>Returns <c><anno>Input</anno></c>,
@@ -5731,7 +5870,147 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="5"/>
+ <name name="statistics" arity="1" clause_i="6"/>
+ <fsummary>Information about microstate accounting.</fsummary>
+ <desc>
+ <marker id="statistics_microstate_accounting"></marker>
+ <p>
+ Microstate accounting can be used to measure how much time the Erlang
+ runtime system spends doing various tasks. It is designed to be as
+ lightweight as possible, but there will be some overhead when this
+ is enabled. Microstate accounting is meant to be a profiling tool
+ to help figure out performance bottlenecks.
+ To <c>start</c>/<c>stop</c>/<c>reset</c> microstate_accounting you use
+ the system_flag
+ <seealso marker="#system_flag_microstate_accounting">
+ <c>microstate_accounting</c></seealso>.
+ </p>
+ <p>
+ <c>erlang:statistics(microstate_accounting)</c> returns a list of maps
+ representing some of the OS threads within ERTS. Each map contains
+ <c>type</c> and <c>id</c> fields that can be used to identify what
+ thread it is, and also a counters field that contains data about how
+ much time has been spent in the various states.</p>
+ <pre>
+> <input>erlang:statistics(microstate_accounting).</input>
+[#{counters => #{aux => 1899182914,
+ check_io => 2605863602,
+ emulator => 45731880463,
+ gc => 1512206910,
+ other => 5421338456,
+ port => 221631,
+ sleep => 5150294100},
+ id => 1,
+ type => scheduler}|...]
+ </pre>
+ <p>The time unit is the same as returned by
+ <seealso marker="kernel:os#perf_counter/0">
+ <c>os:perf_counter/0</c></seealso>.
+ So to convert it to milliseconds you could do something like this:</p>
+ <pre>
+lists:map(
+ fun(#{ counters := Cnt } = M) ->
+ MsCnt = maps:map(fun(_K, PerfCount) ->
+ erlang:convert_time_unit(PerfCount, perf_counter, 1000)
+ end, Cnt),
+ M#{ counters := MsCnt }
+ end, erlang:statistics(microstate_accounting)).
+ </pre>
+ <p>
+ It is important to note that these values are not guaranteed to be
+ the exact time spent in each state. This is because of various
+ optimisation done in order to keep the overhead as small as possible.
+ </p>
+
+ <p>Currently the following <c><anno>MSAcc_Thread_Type</anno></c> are available:</p>
+ <taglist>
+ <tag><c>scheduler</c></tag>
+ <item>The main execution threads that do most of the work.</item>
+ <tag><c>async</c></tag><item>Async threads are used by various
+ linked-in drivers (mainly the file drivers) do offload non-cpu
+ intensive work.</item>
+ <tag><c>aux</c></tag><item>Takes care of any work that is not
+ specifically assigned to a scheduler.</item>
+ </taglist>
+ <p>Currently the following <c><anno>MSAcc_Thread_State</anno></c>s are available.
+ All states are exclusive, meaning that a thread cannot be in two states
+ at once. So if you add the numbers of all counters in a thread
+ you will get the total run-time for that thread.</p>
+ <taglist>
+ <tag><c>aux</c></tag>
+ <item>Time spent handling auxiliary jobs.</item>
+ <tag><c>check_io</c></tag>
+ <item>Time spent checking for new I/O events.</item>
+ <tag><c>emulator</c></tag>
+ <item>Time spent executing erlang processes.</item>
+ <tag><c>gc</c></tag>
+ <item>Time spent doing garbage collection. When extra states are
+ enabled this is the time spent doing non-fullsweep garbage
+ collections.</item>
+ <tag><c>other</c></tag>
+ <item>Time spent doing unaccounted things.</item>
+ <tag><c>port</c></tag>
+ <item>Time spent executing ports.</item>
+ <tag><c>sleep</c></tag>
+ <item>Time spent sleeping.</item>
+ </taglist>
+ <p>It is possible to add more fine grained <c><anno>MSAcc_Thread_State</anno></c>s
+ through configure.
+ (e.g. <c>./configure --with-microstate-accounting=extra</c>).
+ Enabling these states will cause a performance degradation when
+ microstate accounting is turned off and increase the overhead when
+ it is turned on.</p>
+ <taglist>
+ <tag><c>alloc</c></tag>
+ <item>Time spent managing memory. Without extra states this time is
+ spread out over all other states.</item>
+ <tag><c>bif</c></tag>
+ <item>Time spent in bifs. Without extra states this time is part of
+ the <c>emulator</c> state.</item>
+ <tag><c>busy_wait</c></tag>
+ <item>Time spent busy waiting. This is also the state where a
+ scheduler no longer reports that it is active when using
+ <seealso marker="#statistics_scheduler_wall_time">
+ <c>erlang:statistics(scheduler_wall_time)</c></seealso>.
+ So if you add all other states but this and sleep and then divide that
+ by all time in the thread you should get something very similar to the
+ scheduler_wall_time fraction. Without extra states this time is part
+ of the <c>other</c> state.</item>
+ <tag><c>ets</c></tag>
+ <item>Time spent executing ETS bifs. Without extra states this time is
+ part of the <c>emulator</c> state.</item>
+ <tag><c>gc_full</c></tag>
+ <item>Time spent doing fullsweep garbage collection. Without extra
+ states this time is part of the <c>gc</c> state.</item>
+ <tag><c>nif</c></tag>
+ <item>Time spent in nifs. Without extra states this time is part of
+ the <c>emulator</c> state.</item>
+ <tag><c>send</c></tag>
+ <item>Time spent sending messages (processes only). Without extra
+ states this time is part of the <c>emulator</c> state.</item>
+ <tag><c>timers</c></tag>
+ <item>Time spent managing timers. Without extra states this time is
+ part of the <c>other</c> state.</item>
+ </taglist>
+ <p>There is a utility module called
+ <seealso marker="runtime_tools:msacc"><c>msacc</c></seealso> in
+ runtime_tools that can be used to more easily analyse these
+ statistics.</p>
+
+ <p>
+ Returns <c>undefined</c> if the system flag
+ <seealso marker="#system_flag_microstate_accounting">
+ <c>microstate_accounting</c></seealso>
+ is turned off.
+ </p>
+ <p>The list of thread information is unsorted and may appear in
+ different order between calls.</p>
+ <note><p>The threads and states are subject to change without any
+ prior notice.</p></note>
+ </desc>
+ </func>
+ <func>
+ <name name="statistics" arity="1" clause_i="7"/>
<fsummary>Information about reductions.</fsummary>
<desc>
<marker id="statistics_reductions"></marker>
@@ -5749,16 +6028,43 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="6"/>
- <fsummary>Information about the run-queue.</fsummary>
- <desc>
- <p>Returns the total length of run-queues, that is, the number
- of processes that are ready to run on all available run-queues.</p>
+ <name name="statistics" arity="1" clause_i="8"/>
+ <fsummary>Information about the run-queues.</fsummary>
+ <desc><marker id="statistics_run_queue"></marker>
+ <p>
+ Returns the total length of the run-queues. That is, the number
+ of processes and ports that are ready to run on all available
+ run-queues. The information is gathered atomically. That
+ is, the result is a consistent snapshot of the state, but
+ this operation is much more expensive compared to
+ <seealso marker="#statistics_total_run_queue_lengths"><c>statistics(total_run_queue_lengths)</c></seealso>.
+ This especially when a large amount of schedulers is used.
+ </p>
</desc>
</func>
<func>
- <name name="statistics" arity="1" clause_i="7"/>
+ <name name="statistics" arity="1" clause_i="9"/>
+ <fsummary>Information about the run-queue lengths.</fsummary>
+ <desc><marker id="statistics_run_queue_lengths"></marker>
+ <p>
+ Returns a list where each element represents the amount
+ of processes and ports ready to run for each run queue. The
+ element location in the list corresponds to the run queue
+ of a scheduler. The first element corresponds to the run
+ queue of scheduler number 1 and so on. The information is
+ <em>not</em> gathered atomically. That is, the result is
+ not necessarily a consistent snapshot of the state, but
+ instead quite efficiently gathered. See also,
+ <seealso marker="#statistics_total_run_queue_lengths"><c>statistics(total_run_queue_lengths)</c></seealso>,
+ <seealso marker="#statistics_active_tasks"><c>statistics(active_tasks)</c></seealso>, and
+ <seealso marker="#statistics_total_active_tasks"><c>statistics(total_active_tasks)</c></seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="statistics" arity="1" clause_i="10"/>
<fsummary>Information about runtime.</fsummary>
<desc>
<p>Returns information about runtime, in milliseconds.</p>
@@ -5773,7 +6079,7 @@ true</pre>
</func>
<func>
- <name name="statistics" arity="1" clause_i="8"/>
+ <name name="statistics" arity="1" clause_i="11"/>
<fsummary>Information about each schedulers work time.</fsummary>
<desc>
<marker id="statistics_scheduler_wall_time"></marker>
@@ -5844,7 +6150,44 @@ ok
</func>
<func>
- <name name="statistics" arity="1" clause_i="9"/>
+ <name name="statistics" arity="1" clause_i="12"/>
+ <fsummary>Information about active processes and ports.</fsummary>
+ <desc><marker id="statistics_total_active_tasks"></marker>
+ <p>
+ Returns the total amount of active processes and ports in
+ the system. That is, the number of processes and ports that
+ are ready to run, or are currently running. The information
+ is <em>not</em> gathered atomically. That is, the result
+ is not necessarily a consistent snapshot of the state, but
+ instead quite efficiently gathered. See also,
+ <seealso marker="#statistics_active_tasks"><c>statistics(active_tasks)</c></seealso>,
+ <seealso marker="#statistics_run_queue_lengths"><c>statistics(run_queue_lengths)</c></seealso>, and
+ <seealso marker="#statistics_total_run_queue_lengths"><c>statistics(total_run_queue_lengths)</c></seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="statistics" arity="1" clause_i="13"/>
+ <fsummary>Information about the run-queue lengths.</fsummary>
+ <desc><marker id="statistics_total_run_queue_lengths"></marker>
+ <p>
+ Returns the total length of the run-queues. That is, the number
+ of processes and ports that are ready to run on all available
+ run-queues. The information is <em>not</em> gathered atomically.
+ That is, the result is not necessarily a consistent snapshot of
+ the state, but much more efficiently gathered compared to
+ <seealso marker="#statistics_run_queue"><c>statistics(run_queue)</c></seealso>.
+ See also,
+ <seealso marker="#statistics_run_queue_lengths"><c>statistics(run_queue_lengths)</c></seealso>,
+ <seealso marker="#statistics_total_active_tasks"><c>statistics(total_active_tasks)</c></seealso>, and
+ <seealso marker="#statistics_active_tasks"><c>statistics(active_tasks)</c></seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="statistics" arity="1" clause_i="14"/>
<fsummary>Information about wall clock.</fsummary>
<desc>
<p>Returns information about wall clock. <c>wall_clock</c> can
@@ -6078,6 +6421,17 @@ ok
<func>
<name name="system_flag" arity="2" clause_i="5"/>
+ <fsummary>Set system flag microstate_accounting</fsummary>
+ <desc><p><marker id="system_flag_microstate_accounting"></marker>
+ Turns on/off microstate accounting measurements. By passing reset it is possible to reset
+ all counters to 0.</p>
+ <p>For more information see,
+ <seealso marker="#statistics_microstate_accounting">erlang:statistics(microstate_accounting)</seealso>.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name name="system_flag" arity="2" clause_i="6"/>
<fsummary>Sets system flag <c>min_heap_size</c>.</fsummary>
<desc>
<p>Sets the default minimum heap size for processes. The size
@@ -6092,7 +6446,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="6"/>
+ <name name="system_flag" arity="2" clause_i="7"/>
<fsummary>Sets system flag <c>min_bin_vheap_size</c>.</fsummary>
<desc>
<p>Sets the default minimum binary virtual heap size for
@@ -6109,45 +6463,57 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="7"/>
+ <name name="system_flag" arity="2" clause_i="8"/>
<fsummary>Sets system flag <c>multi_scheduling</c>.</fsummary>
<desc>
<p><marker id="system_flag_multi_scheduling"></marker>
If multi-scheduling is enabled, more than one scheduler
thread is used by the emulator. Multi-scheduling can be
- blocked. When multi-scheduling is blocked, only
- one scheduler thread schedules Erlang processes.</p>
+ blocked in two different ways. Either all schedulers but
+ one is blocked, or all <em>normal</em> schedulers but
+ one is blocked. When only normal schedulers are blocked
+ dirty schedulers are free to continue to schedule
+ processes.</p>
<p>If <c><anno>BlockState</anno> =:= block</c>, multi-scheduling is
- blocked. If <c><anno>BlockState</anno> =:= unblock</c> and no one
+ blocked. That is, one and only one scheduler thread will
+ execute. If <c><anno>BlockState</anno> =:= unblock</c> and no one
else blocks multi-scheduling, and this process has
blocked only once, multi-scheduling is unblocked.</p>
- <p>One process can block multi-scheduling multiple times.
- If a process has blocked multiple times, it must
- unblock exactly as many times as it has blocked before it
- has released its multi-scheduling block. If a process that
- has blocked multi-scheduling exits, it releases its
- blocking of multi-scheduling.</p>
+ <p>If <c><anno>BlockState</anno> =:= block_normal</c>, normal
+ multi-scheduling is blocked. That is, only one normal scheduler
+ thread will execute, but multiple dirty schedulers may execute.
+ If <c><anno>BlockState</anno> =:= unblock_normal</c> and no one
+ else blocks normal multi-scheduling, and this process has
+ blocked only once, normal multi-scheduling is unblocked.</p>
+ <p>One process can block multi-scheduling as well as normal
+ multi-scheduling multiple times. If a process has blocked
+ multiple times, it must unblock exactly as many times as it
+ has blocked before it has released its multi-scheduling
+ block. If a process that has blocked multi-scheduling or normal
+ multi scheduling exits, it automatically releases its blocking
+ of multi-scheduling and normal multi-scheduling.</p>
<p>The return values are <c>disabled</c>, <c>blocked</c>,
- or <c>enabled</c>. The returned value describes the
- state just after the call to
+ <c>blocked_normal</c>, or <c>enabled</c>. The returned value
+ describes the state just after the call to
<c>erlang:system_flag(multi_scheduling, <anno>BlockState</anno>)</c>
has been made. For information about the return values, see
<seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>.</p>
- <note><p>Blocking of multi-scheduling is normally not needed.
- If you feel that you need to block multi-scheduling,
- consider it a few more times again. Blocking multi-scheduling
- is only to be used as a last resort, as it is most likely
- a <em>very inefficient</em> way to solve the problem.</p>
+ <note><p>Blocking of multi-scheduling and normal multi-scheduling
+ is normally not needed. If you feel that you need to use these
+ features, consider it a few more times again. Blocking
+ multi-scheduling is only to be used as a last resort, as it is
+ most likely a <em>very inefficient</em> way to solve the problem.</p>
</note>
<p>See also
<seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>,
+ <seealso marker="#system_info_normal_multi_scheduling_blockers">erlang:system_info(normal_multi_scheduling_blockers)</seealso>,
<seealso marker="#system_info_multi_scheduling_blockers">erlang:system_info(multi_scheduling_blockers)</seealso>, and
<seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p>
</desc>
</func>
<func>
- <name name="system_flag" arity="2" clause_i="8"/>
+ <name name="system_flag" arity="2" clause_i="9"/>
<fsummary>Sets system flag <c>scheduler_bind_type</c>.</fsummary>
<type name="scheduler_bind_type"/>
<desc>
@@ -6265,7 +6631,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="9"/>
+ <name name="system_flag" arity="2" clause_i="10"/>
<fsummary>Sets system flag <c>scheduler_wall_time</c>.</fsummary>
<desc><p><marker id="system_flag_scheduler_wall_time"></marker>
Turns on or off scheduler wall time measurements.</p>
@@ -6275,7 +6641,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="10"/>
+ <name name="system_flag" arity="2" clause_i="11"/>
<fsummary>Sets system flag <c>schedulers_online</c>.</fsummary>
<desc>
<p><marker id="system_flag_schedulers_online"></marker>
@@ -6300,7 +6666,7 @@ ok
</func>
<func>
- <name name="system_flag" arity="2" clause_i="11"/>
+ <name name="system_flag" arity="2" clause_i="12"/>
<fsummary>Sets system flag <c>trace_control_word</c>.</fsummary>
<desc>
<p>Sets the value of the node trace control word to
@@ -6475,7 +6841,7 @@ ok
<p>Returns various size information for the specified
allocator. The information returned is a subset of the
information returned by
- <seealso marker="#system_info_allocator_tuple">erlang:system_info({allocator, <anno>Alloc</anno>})</seealso>.
+ <seealso marker="#system_info_allocator_tuple"><c>erlang:system_info({allocator, <anno>Alloc</anno>})</c></seealso>.
</p>
</item>
</taglist>
@@ -6639,6 +7005,7 @@ ok
<name name="system_info" arity="1" clause_i="65"/>
<name name="system_info" arity="1" clause_i="66"/>
<name name="system_info" arity="1" clause_i="67"/>
+ <name name="system_info" arity="1" clause_i="68"/>
<fsummary>Information about the system.</fsummary>
<desc>
<p>Returns various information about the current system
@@ -6855,7 +7222,7 @@ ok
The return value will always be <c>false</c>, as the
<c>elib_malloc</c> allocator has been removed.</p>
</item>
- <tag><marker id="system_info_eager_check_io"><c>eager_check_io</c></marker></tag>
+ <tag><marker id="system_info_eager_check_io"/><c>eager_check_io</c></tag>
<item>
<p>
Returns the value of the <c>erl</c> command line flag
@@ -6974,6 +7341,16 @@ ok
where <c><anno>MinHeapSize</anno></c> is the current
system-wide minimum heap size for spawned processes.</p>
</item>
+ <tag><marker id="system_info_message_queue_data"><c>message_queue_data</c></marker></tag>
+ <item>
+ <p>Returns the default value of the <c>message_queue_data</c>
+ process flag which is either <c>off_heap</c>, <c>on_heap</c>, or <c>mixed</c>.
+ This default is set by the <c>erl</c> command line argument
+ <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso>. For more information on the
+ <c>message_queue_data</c> process flag, see documentation of
+ <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data,
+ MQD)</c></seealso>.</p>
+ </item>
<tag><c>min_bin_vheap_size</c></tag>
<item>
<p>Returns <c>{min_bin_vheap_size,
@@ -6993,7 +7370,8 @@ ok
<tag><c>multi_scheduling</c></tag>
<item>
<marker id="system_info_multi_scheduling"></marker>
- <p>Returns <c>disabled</c>, <c>blocked</c>, or <c>enabled</c>:</p>
+ <p>Returns <c>disabled</c>, <c>blocked</c>, <c>blocked_normal</c>,
+ or <c>enabled</c>:</p>
<taglist>
<tag><c>disabled</c></tag>
<item>
@@ -7004,14 +7382,22 @@ ok
<tag><c>blocked</c></tag>
<item>
<p>The emulator has more than one scheduler thread,
- but all scheduler threads except one are blocked,
- that is, only one scheduler thread schedules
+ but all scheduler threads except one are blocked.
+ That is, only one scheduler thread schedules
Erlang processes and executes Erlang code.</p>
</item>
+ <tag><c>blocked_normal</c></tag>
+ <item>
+ <p>The emulator has more than one scheduler thread,
+ but all normal scheduler threads except one are
+ blocked. Note that dirty schedulers are not
+ blocked, and may schedule Erlang processes and
+ execute native code.</p>
+ </item>
<tag><c>enabled</c></tag>
<item>
<p>The emulator has more than one scheduler thread,
- and no scheduler threads are blocked, that is,
+ and no scheduler threads are blocked. That is,
all available scheduler threads schedule
Erlang processes and execute Erlang code.</p>
</item>
@@ -7019,6 +7405,7 @@ ok
<p>See also
<seealso marker="#system_flag_multi_scheduling">erlang:system_flag(multi_scheduling, BlockState)</seealso>,
<seealso marker="#system_info_multi_scheduling_blockers">erlang:system_info(multi_scheduling_blockers)</seealso>,
+ <seealso marker="#system_info_normal_multi_scheduling_blockers">erlang:system_info(normal_multi_scheduling_blockers)</seealso>,
and
<seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p>
</item>
@@ -7035,6 +7422,8 @@ ok
<p>See also
<seealso marker="#system_flag_multi_scheduling">erlang:system_flag(multi_scheduling, BlockState)</seealso>,
<seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>,
+ <seealso marker="#system_info_normal_multi_scheduling_blockers">erlang:system_info(normal_multi_scheduling_blockers)</seealso>,
+
and
<seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p>
</item>
@@ -7044,7 +7433,25 @@ ok
used by the runtime system. It is on the form
"&lt;major ver&gt;.&lt;minor ver&gt;".</p>
</item>
- <tag><c>otp_release</c></tag>
+ <tag><c>normal_multi_scheduling_blockers</c></tag>
+ <item>
+ <marker id="system_info_normal_multi_scheduling_blockers"></marker>
+ <p>Returns a list of <c><anno>Pid</anno></c>s when
+ normal multi-scheduling is blocked (i.e. all normal schedulers
+ but one is blocked), otherwise the empty list is returned.
+ The <c><anno>Pid</anno></c>s in the list represent all the
+ processes currently blocking normal multi-scheduling.
+ A <c><anno>Pid</anno></c> occurs only once in the list, even if
+ the corresponding process has blocked multiple times.</p>
+ <p>See also
+ <seealso marker="#system_flag_multi_scheduling">erlang:system_flag(multi_scheduling, BlockState)</seealso>,
+ <seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>,
+ <seealso marker="#system_info_multi_scheduling_blockers">erlang:system_info(multi_scheduling_blockers)</seealso>,
+
+ and
+ <seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>.</p>
+ </item>
+ <tag><marker id="system_info_otp_release"><c>otp_release</c></marker></tag>
<item>
<marker id="system_info_otp_release"></marker>
<p>Returns a string containing the OTP release number of the
@@ -7058,7 +7465,7 @@ ok
of versions in <seealso marker="doc/system_principles:versions">
System principles</seealso> in System Documentation.</p>
</item>
- <tag><marker id="system_info_os_monotonic_time_source"><c>os_monotonic_time_source</c></marker></tag>
+ <tag><marker id="system_info_os_monotonic_time_source"/><c>os_monotonic_time_source</c></tag>
<item>
<p>Returns a list containing information about the source of
<seealso marker="erts:time_correction#OS_Monotonic_Time">OS
@@ -7121,7 +7528,7 @@ ok
<seealso marker="#type_time_unit">time unit</seealso>.</p></item>
</taglist>
</item>
- <tag><marker id="system_info_os_system_time_source"><c>os_system_time_source</c></marker></tag>
+ <tag><marker id="system_info_os_system_time_source"/><c>os_system_time_source</c></tag>
<item>
<p>Returns a list containing information about the source of
<seealso marker="erts:time_correction#OS_System_Time">OS
@@ -7285,6 +7692,7 @@ ok
<seealso marker="#system_info_scheduler_id">erlang:system_info(scheduler_id)</seealso>,
<seealso marker="#system_flag_multi_scheduling">erlang:system_flag(multi_scheduling, BlockState)</seealso>,
<seealso marker="#system_info_multi_scheduling">erlang:system_info(multi_scheduling)</seealso>,
+ <seealso marker="#system_info_normal_multi_scheduling_blockers">erlang:system_info(normal_multi_scheduling_blockers)</seealso>
and
<seealso marker="#system_info_multi_scheduling_blockers">erlang:system_info(multi_scheduling_blockers)</seealso>.</p>
</item>
@@ -7298,7 +7706,6 @@ ok
<seealso marker="#system_info_schedulers">erlang:system_info(schedulers)</seealso>
and
<seealso marker="#system_flag_schedulers_online">erlang:system_flag(schedulers_online, SchedulersOnline)</seealso>.</p>
- <name name="system_info" arity="1" clause_i="49"/>
</item>
<tag><c>smp_support</c></tag>
<item>
@@ -7486,7 +7893,7 @@ ok
system performance monitoring settings are cleared.</p>
<p>Calling the function with <c>{<anno>MonitorPid</anno>,
<anno>Options</anno>}</c> as argument is the same as calling
- <seealso marker="#system_monitor/2">erlang:system_monitor(<anno>MonitorPid</anno>, <anno>Options</anno>)</seealso>.</p>
+ <seealso marker="#system_monitor/2"><c>erlang:system_monitor(<anno>MonitorPid</anno>, <anno>Options</anno>)</c></seealso>.</p>
<p>Returns the previous system monitor settings just like
<seealso marker="#system_monitor/0">erlang:system_monitor/0</seealso>.</p>
</desc>
@@ -7653,6 +8060,14 @@ ok
<c>inactive</c>, and later <c>active</c> when the port
callback returns.</p>
</item>
+ <tag><c>monotonic_timestamp</c></tag>
+ <item>
+ <p>Timestamps in profile messages will use
+ <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang
+ monotonic time</seealso>. The time-stamp (Ts) has the same
+ format and value as produced by
+ <c>erlang:monotonic_time(nano_seconds)</c>.</p>
+ </item>
<tag><c>runnable_procs</c></tag>
<item>
<p>If a process is put into or removed from the run queue, a
@@ -7673,6 +8088,25 @@ ok
<c>{profile, scheduler, Id, State, NoScheds, Ts}</c>, is
sent to <c><anno>ProfilerPid</anno></c>.</p>
</item>
+ <tag><c>strict_monotonic_timestamp</c></tag>
+ <item>
+ <p>Timestamps in profile messages will consisting of
+ <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang
+ monotonic time</seealso> and a monotonically increasing
+ integer. The time-stamp (Ts) has the same format and value
+ as produced by <c>{erlang:monotonic_time(nano_seconds),
+ erlang:unique_integer([monotonic])}</c>.</p>
+ </item>
+ <tag><c>timestamp</c></tag>
+ <item>
+ <p>Timestamps in profile messages will include a
+ time-stamp (Ts) that has the same form as returned by
+ <c>erlang:now()</c>. This is also the default if no
+ timestamp flag is given. If <c>cpu_timestamp</c> has
+ been enabled via <c>erlang:trace/3</c>, this will also
+ effect the timestamp produced in profiling messages
+ when <c>timestamp</c> flag is enabled.</p>
+ </item>
</taglist>
<note><p><c>erlang:system_profile</c> is considered experimental
and its behavior can change in a future release.</p>
@@ -7857,8 +8291,8 @@ ok
</func>
<func>
<name name="timestamp" arity="0"/>
- <type name="timestamp"/>
<fsummary>Current Erlang System time</fsummary>
+ <type name="timestamp"/>
<desc>
<p>Returns current
<seealso marker="time_correction#Erlang_System_Time">Erlang system time</seealso>
@@ -7878,9 +8312,9 @@ timestamp() ->
Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000,
MicroSecs = ErlangSystemTime rem 1000000,
{MegaSecs, Secs, MicroSecs}.</code>
- <p>The BIF uses a native implementation which does
- not build garbage on the heap and with slightly better
- performance.</p>
+ <p>It, however, uses a native implementation which does
+ not build garbage on the heap and with slightly better
+ performance.</p>
<note><p>This time is <em>not</em> a monotonically increasing time
in the general case. For more information, see the documentation of
@@ -8032,7 +8466,10 @@ timestamp() ->
<tag><c>cpu_timestamp</c></tag>
<item>
<p>A global trace flag for the Erlang node that makes all
- trace time-stamps to be in CPU time, not wall clock time.
+ trace time-stamps using the <c>timestamp</c> flag to be
+ in CPU time, not wall clock time. That is, <c>cpu_timestamp</c>
+ will not be used if <c>monotonic_timestamp</c>, or
+ <c>strict_monotonic_timestamp</c> is enabled.
Only allowed with <c>PidSpec==all</c>. If the host
machine OS does not support high-resolution
CPU time measurements, <c>trace/3</c> exits with
@@ -8040,6 +8477,26 @@ timestamp() ->
not synchronize this value across cores, so be prepared
that time might seem to go backwards when using this option.</p>
</item>
+ <tag><c>monotonic_timestamp</c></tag>
+ <item>
+ <p>Includes an
+ <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang
+ monotonic time</seealso> time-stamp in all trace messages. The
+ time-stamp (Ts) has the same format and value as produced by
+ <c>erlang:monotonic_time(nano_seconds)</c>. This flag overrides
+ the <c>cpu_timestamp</c> flag.</p>
+ </item>
+ <tag><c>strict_monotonic_timestamp</c></tag>
+ <item>
+ <p>Includes an timestamp consisting of
+ <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang
+ monotonic time</seealso> and a monotonically increasing
+ integer in all trace messages. The time-stamp (Ts) has the
+ same format and value as produced by
+ <c>{erlang:monotonic_time(nano_seconds),
+ erlang:unique_integer([monotonic])}</c>. This flag overrides
+ the <c>cpu_timestamp</c> flag.</p>
+ </item>
<tag><c>arity</c></tag>
<item>
<p>Used with the <c>call</c> trace flag.
@@ -8086,9 +8543,16 @@ timestamp() ->
in the following list. <c>Pid</c> is the process identifier of the
traced process in which the traced event has occurred. The
third tuple element is the message tag.</p>
- <p>If flag <c>timestamp</c> is given, the first tuple
- element is <c>trace_ts</c> instead, and the time-stamp
- is added last in the message tuple.</p>
+ <p>If flag <c>timestamp</c>, <c>strict_monotonic_timestamp</c>, or
+ <c>monotonic_timestamp</c> is given, the first tuple
+ element is <c>trace_ts</c> instead, and the time-stamp
+ is added as an extra element last in the message tuple. If
+ multiple timestamp flags are passed, <c>timestamp</c> has
+ precedence over <c>strict_monotonic_timestamp</c> which
+ in turn has precedence over <c>monotonic_timestamp</c>. All
+ timestamp flags are remembered, so if two are passed
+ and the one with highest precedence later is disabled
+ the other one will become active.</p>
<marker id="trace_3_trace_messages"></marker>
<taglist>
<tag><c>{trace, Pid, 'receive', Msg}</c></tag>
@@ -8183,14 +8647,14 @@ timestamp() ->
<p>When <c>Pid</c> is scheduled to run. The process
runs in function <c>{M, F, Arity}</c>. On some rare
occasions, the current function cannot be determined,
- then the last element <c>Arity</c> is <c>0</c>.</p>
+ then the last element is <c>0</c>.</p>
</item>
<tag><c>{trace, Pid, out, {M, F, Arity} | 0}</c></tag>
<item>
<p>When <c>Pid</c> is scheduled out. The process was
running in function {M, F, Arity}. On some rare occasions,
the current function cannot be determined, then the last
- element <c>Arity</c> is <c>0</c>.</p>
+ element is <c>0</c>.</p>
</item>
<tag><c>{trace, Pid, gc_start, Info}</c></tag>
<item>
@@ -8228,7 +8692,7 @@ timestamp() ->
<tag><c>bin_old_vheap_size</c></tag>
<item>The total size of unique off-heap binaries referenced
from the process old heap.</item>
- <tag><c>bin_vheap_block_size</c></tag>
+ <tag><c>bin_old_vheap_block_size</c></tag>
<item>The total size of binaries allowed in the virtual
old heap in the process before doing a garbage collection.</item>
</taglist>
@@ -8813,8 +9277,8 @@ timestamp() ->
true
end</code>
<note>
- <p>Before OTP R11B (<c>ERTS</c> 5.5) <c>unlink/1</c>
- behaved asynchronous, that is, the link was active
+ <p>Prior to OTP release R11B (ERTS version 5.5) <c>unlink/1</c>
+ behaved completely asynchronously, i.e., the link was active
until the "unlink signal" reached the linked entity. This
had an undesirable effect, as you could never know when
you were guaranteed <em>not</em> to be effected by the link.</p>
diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml
index 376cae4a95..0965f9b49c 100644
--- a/erts/doc/src/erts_alloc.xml
+++ b/erts/doc/src/erts_alloc.xml
@@ -4,7 +4,7 @@
<cref>
<header>
<copyright>
- <year>2002</year><year>2014</year>
+ <year>2002</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -52,6 +52,8 @@
<item>Allocator used for ETS data.</item>
<tag><c>driver_alloc</c></tag>
<item>Allocator used for driver data.</item>
+ <tag><c>literal_alloc</c></tag>
+ <item>Allocator used for constant terms in Erlang code.</item>
<tag><c>sl_alloc</c></tag>
<item>Allocator used for memory blocks that are expected to be
short-lived.</item>
@@ -77,7 +79,7 @@
instead of creating new segments. This in order to reduce
the number of system calls made.</item>
</taglist>
- <p><c>sys_alloc</c> is always enabled and
+ <p><c>sys_alloc</c> and <c>literal_alloc</c> are always enabled and
cannot be disabled. <c>mseg_alloc</c> is always enabled if it is
available and an allocator that uses it is enabled. All other
allocators can be <seealso marker="#M_e">enabled or disabled</seealso>.
@@ -246,6 +248,7 @@
the currently present allocators:</p>
<list type="bulleted">
<item><c>B: binary_alloc</c></item>
+ <item><c>I: literal_alloc</c></item>
<item><c>D: std_alloc</c></item>
<item><c>E: ets_alloc</c></item>
<item><c>F: fix_alloc</c></item>
@@ -260,19 +263,19 @@
<p>The following flags are available for configuration of
<c>mseg_alloc</c>:</p>
<taglist>
- <tag><marker id="MMamcbf"><c><![CDATA[+MMamcbf <size>]]></c></marker></tag>
+ <tag><marker id="MMamcbf"/><c><![CDATA[+MMamcbf <size>]]></c></tag>
<item>
Absolute max cache bad fit (in kilobytes). A segment in the
memory segment cache is not reused if its size exceeds the
requested size with more than the value of this
parameter. Default value is 4096. </item>
- <tag><marker id="MMrmcbf"><c><![CDATA[+MMrmcbf <ratio>]]></c></marker></tag>
+ <tag><marker id="MMrmcbf"/><c><![CDATA[+MMrmcbf <ratio>]]></c></tag>
<item>
Relative max cache bad fit (in percent). A segment in the
memory segment cache is not reused if its size exceeds the
requested size with more than relative max cache bad fit
percent of the requested size. Default value is 20.</item>
- <tag><marker id="MMsco"><c><![CDATA[+MMsco true|false]]></c></marker></tag>
+ <tag><marker id="MMsco"/><c><![CDATA[+MMsco true|false]]></c></tag>
<item>
Set <seealso marker="#MMscs">super carrier</seealso> only flag. This
flag defaults to <c>true</c>. When a super carrier is used and this
@@ -292,7 +295,7 @@
disabled on halfword heap systems. This flag will be
ignored on halfword heap systems.
</item>
- <tag><marker id="MMscrfsd"><c><![CDATA[+MMscrfsd <amount>]]></c></marker></tag>
+ <tag><marker id="MMscrfsd"/><c><![CDATA[+MMscrfsd <amount>]]></c></tag>
<item>
Set <seealso marker="#MMscs">super carrier</seealso> reserved
free segment descriptors. This parameter defaults to <c>65536</c>.
@@ -305,7 +308,7 @@
<c>erts_mmap</c> tuple part of the result from calling
<seealso marker="erts:erlang#system_info_allocator_tuple">erlang:system_info({allocator, mseg_alloc})</seealso>.
</item>
- <tag><marker id="MMscrpm"><c><![CDATA[+MMscrpm true|false]]></c></marker></tag>
+ <tag><marker id="MMscrpm"/><c><![CDATA[+MMscrpm true|false]]></c></tag>
<item>
Set <seealso marker="#MMscs">super carrier</seealso> reserve physical
memory flag. This flag defaults to <c>true</c>. When this flag is
@@ -328,7 +331,7 @@
disabled on halfword heap systems. This flag will be
ignored on halfword heap systems.
</item>
- <tag><marker id="MMscs"><c><![CDATA[+MMscs <size in MB>]]></c></marker></tag>
+ <tag><marker id="MMscs"/><c><![CDATA[+MMscs <size in MB>]]></c></tag>
<item>
Set super carrier size (in MB). The super carrier size defaults to
zero; i.e, the super carrier is by default disabled. The super
@@ -343,7 +346,7 @@
disabled on halfword heap systems. This flag will be
ignored on halfword heap systems.
</item>
- <tag><marker id="MMmcs"><c><![CDATA[+MMmcs <amount>]]></c></marker></tag>
+ <tag><marker id="MMmcs"/><c><![CDATA[+MMmcs <amount>]]></c></tag>
<item>
Max cached segments. The maximum number of memory segments
stored in the memory segment cache. Valid range is
@@ -352,15 +355,15 @@
<p>The following flags are available for configuration of
<c>sys_alloc</c>:</p>
<taglist>
- <tag><marker id="MYe"><c>+MYe true</c></marker></tag>
+ <tag><marker id="MYe"/><c>+MYe true</c></tag>
<item>
Enable <c>sys_alloc</c>. Note: <c>sys_alloc</c> cannot be disabled.</item>
- <tag><marker id="MYm"><c>+MYm libc</c></marker></tag>
+ <tag><marker id="MYm"/><c>+MYm libc</c></tag>
<item>
<c>malloc</c> library to use. Currently only
<c>libc</c> is available. <c>libc</c> enables the standard
<c>libc</c> malloc implementation. By default <c>libc</c> is used.</item>
- <tag><marker id="MYtt"><c><![CDATA[+MYtt <size>]]></c></marker></tag>
+ <tag><marker id="MYtt"/><c><![CDATA[+MYtt <size>]]></c></tag>
<item>
Trim threshold size (in kilobytes). This is the maximum amount
of free memory at the top of the heap (allocated by
@@ -372,7 +375,7 @@
trim threshold is 128. <em>Note:</em> This flag will
only have any effect when the emulator has been linked with
the GNU C library, and uses its <c>malloc</c> implementation.</item>
- <tag><marker id="MYtp"><c><![CDATA[+MYtp <size>]]></c></marker></tag>
+ <tag><marker id="MYtp"/><c><![CDATA[+MYtp <size>]]></c></tag>
<item>
Top pad size (in kilobytes). This is the amount of extra
memory that will be allocated by <c>malloc</c> when
@@ -390,7 +393,7 @@
subsystem identifier, only the specific allocator identified will be
effected:</p>
<taglist>
- <tag><marker id="M_acul"><c><![CDATA[+M<S>acul <utilization>|de]]></c></marker></tag>
+ <tag><marker id="M_acul"/><c><![CDATA[+M<S>acul <utilization>|de]]></c></tag>
<item>
Abandon carrier utilization limit. A valid
<c><![CDATA[<utilization>]]></c> is an integer in the range
@@ -422,7 +425,7 @@
allocators based on the <c>alloc_util</c> framework with the
exception of <c>temp_alloc</c> (which would be pointless).
</item>
- <tag><marker id="M_as"><c><![CDATA[+M<S>as bf|aobf|aoff|aoffcbf|aoffcaobf|gf|af]]></c></marker></tag>
+ <tag><marker id="M_as"/><c><![CDATA[+M<S>as bf|aobf|aoff|aoffcbf|aoffcaobf|gf|af]]></c></tag>
<item>
Allocation strategy. Valid strategies are <c>bf</c> (best fit),
<c>aobf</c> (address order best fit), <c>aoff</c> (address order first fit),
@@ -430,7 +433,7 @@
<c>aoffcaobf</c> (address order first fit carrier address order best fit),
<c>gf</c> (good fit), and <c>af</c> (a fit). See
<seealso marker="#strategy">the description of allocation strategies</seealso> in "the <c>alloc_util</c> framework" section.</item>
- <tag><marker id="M_asbcst"><c><![CDATA[+M<S>asbcst <size>]]></c></marker></tag>
+ <tag><marker id="M_asbcst"/><c><![CDATA[+M<S>asbcst <size>]]></c></tag>
<item>
Absolute singleblock carrier shrink threshold (in
kilobytes). When a block located in an
@@ -438,23 +441,23 @@
will be left unchanged if the amount of unused memory is less
than this threshold; otherwise, the carrier will be shrunk.
See also <seealso marker="#M_rsbcst">rsbcst</seealso>.</item>
- <tag><marker id="M_e"><c><![CDATA[+M<S>e true|false]]></c></marker></tag>
+ <tag><marker id="M_e"/><c><![CDATA[+M<S>e true|false]]></c></tag>
<item>
Enable allocator <c><![CDATA[<S>]]></c>.</item>
- <tag><marker id="M_lmbcs"><c><![CDATA[+M<S>lmbcs <size>]]></c></marker></tag>
+ <tag><marker id="M_lmbcs"/><c><![CDATA[+M<S>lmbcs <size>]]></c></tag>
<item>
Largest (<c>mseg_alloc</c>) multiblock carrier size (in
kilobytes). See <seealso marker="#mseg_mbc_sizes">the description
on how sizes for mseg_alloc multiblock carriers are decided</seealso>
in "the <c>alloc_util</c> framework" section. On 32-bit Unix style OS
this limit can not be set higher than 128 megabyte.</item>
- <tag><marker id="M_mbcgs"><c><![CDATA[+M<S>mbcgs <ratio>]]></c></marker></tag>
+ <tag><marker id="M_mbcgs"/><c><![CDATA[+M<S>mbcgs <ratio>]]></c></tag>
<item>
(<c>mseg_alloc</c>) multiblock carrier growth stages. See
<seealso marker="#mseg_mbc_sizes">the description on how sizes for
mseg_alloc multiblock carriers are decided</seealso>
in "the <c>alloc_util</c> framework" section.</item>
- <tag><marker id="M_mbsd"><c><![CDATA[+M<S>mbsd <depth>]]></c></marker></tag>
+ <tag><marker id="M_mbsd"/><c><![CDATA[+M<S>mbsd <depth>]]></c></tag>
<item>
Max block search depth. This flag has effect only if the
good fit strategy has been selected for allocator
@@ -464,40 +467,40 @@
search depth sets a limit on the maximum number of blocks to
inspect in a free list during a search for suitable block
satisfying the request.</item>
- <tag><marker id="M_mmbcs"><c><![CDATA[+M<S>mmbcs <size>]]></c></marker></tag>
+ <tag><marker id="M_mmbcs"/><c><![CDATA[+M<S>mmbcs <size>]]></c></tag>
<item>
Main multiblock carrier size. Sets the size of the main
multiblock carrier for allocator <c><![CDATA[<S>]]></c>. The main
multiblock carrier is allocated via <c><![CDATA[sys_alloc]]></c> and is
never deallocated.</item>
- <tag><marker id="M_mmmbc"><c><![CDATA[+M<S>mmmbc <amount>]]></c></marker></tag>
+ <tag><marker id="M_mmmbc"/><c><![CDATA[+M<S>mmmbc <amount>]]></c></tag>
<item>
Max <c>mseg_alloc</c> multiblock carriers. Maximum number of
multiblock carriers allocated via <c>mseg_alloc</c> by
allocator <c><![CDATA[<S>]]></c>. When this limit has been reached,
new multiblock carriers will be allocated via
<c>sys_alloc</c>.</item>
- <tag><marker id="M_mmsbc"><c><![CDATA[+M<S>mmsbc <amount>]]></c></marker></tag>
+ <tag><marker id="M_mmsbc"/><c><![CDATA[+M<S>mmsbc <amount>]]></c></tag>
<item>
Max <c>mseg_alloc</c> singleblock carriers. Maximum number of
singleblock carriers allocated via <c>mseg_alloc</c> by
allocator <c><![CDATA[<S>]]></c>. When this limit has been reached,
new singleblock carriers will be allocated via
<c>sys_alloc</c>.</item>
- <tag><marker id="M_ramv"><c><![CDATA[+M<S>ramv <bool>]]></c></marker></tag>
+ <tag><marker id="M_ramv"/><c><![CDATA[+M<S>ramv <bool>]]></c></tag>
<item>
Realloc always moves. When enabled, reallocate operations will
more or less be translated into an allocate, copy, free sequence.
This often reduce memory fragmentation, but costs performance.
</item>
- <tag><marker id="M_rmbcmt"><c><![CDATA[+M<S>rmbcmt <ratio>]]></c></marker></tag>
+ <tag><marker id="M_rmbcmt"/><c><![CDATA[+M<S>rmbcmt <ratio>]]></c></tag>
<item>
Relative multiblock carrier move threshold (in percent). When
a block located in a multiblock carrier is shrunk,
the block will be moved if the ratio of the size of the returned
memory compared to the previous size is more than this threshold;
otherwise, the block will be shrunk at current location.</item>
- <tag><marker id="M_rsbcmt"><c><![CDATA[+M<S>rsbcmt <ratio>]]></c></marker></tag>
+ <tag><marker id="M_rsbcmt"/><c><![CDATA[+M<S>rsbcmt <ratio>]]></c></tag>
<item>
Relative singleblock carrier move threshold (in percent). When
a block located in a singleblock carrier is shrunk to
@@ -506,7 +509,7 @@
the block will be left unchanged in the singleblock carrier if
the ratio of unused memory is less than this threshold;
otherwise, it will be moved into a multiblock carrier. </item>
- <tag><marker id="M_rsbcst"><c><![CDATA[+M<S>rsbcst <ratio>]]></c></marker></tag>
+ <tag><marker id="M_rsbcst"/><c><![CDATA[+M<S>rsbcst <ratio>]]></c></tag>
<item>
Relative singleblock carrier shrink threshold (in
percent). When a block located in an <c>mseg_alloc</c>
@@ -514,20 +517,20 @@
unchanged if the ratio of unused memory is less than this
threshold; otherwise, the carrier will be shrunk.
See also <seealso marker="#M_asbcst">asbcst</seealso>.</item>
- <tag><marker id="M_sbct"><c><![CDATA[+M<S>sbct <size>]]></c></marker></tag>
+ <tag><marker id="M_sbct"/><c><![CDATA[+M<S>sbct <size>]]></c></tag>
<item>
Singleblock carrier threshold. Blocks larger than this
threshold will be placed in singleblock carriers. Blocks
smaller than this threshold will be placed in multiblock
carriers. On 32-bit Unix style OS this threshold can not be set higher
than 8 megabytes.</item>
- <tag><marker id="M_smbcs"><c><![CDATA[+M<S>smbcs <size>]]></c></marker></tag>
+ <tag><marker id="M_smbcs"/><c><![CDATA[+M<S>smbcs <size>]]></c></tag>
<item>
Smallest (<c>mseg_alloc</c>) multiblock carrier size (in
kilobytes). See <seealso marker="#mseg_mbc_sizes">the description
on how sizes for mseg_alloc multiblock carriers are decided</seealso>
in "the <c>alloc_util</c> framework" section.</item>
- <tag><marker id="M_t"><c><![CDATA[+M<S>t true|false]]></c></marker></tag>
+ <tag><marker id="M_t"/><c><![CDATA[+M<S>t true|false]]></c></tag>
<item>
<p>Multiple, thread specific instances of the allocator.
This option will only have any effect on the runtime system
@@ -544,40 +547,50 @@
<c>alloc_util</c>, i.e. all allocators based on <c>alloc_util</c>
will be effected:</p>
<taglist>
- <tag><marker id="Muycs"><c><![CDATA[+Muycs <size>]]></c></marker></tag>
+ <tag><marker id="Muycs"/><c><![CDATA[+Muycs <size>]]></c></tag>
<item>
<c>sys_alloc</c> carrier size. Carriers allocated via
<c>sys_alloc</c> will be allocated in sizes which are
multiples of the <c>sys_alloc</c> carrier size. This is not
true for main multiblock carriers and carriers allocated
during a memory shortage, though.</item>
- <tag><marker id="Mummc"><c><![CDATA[+Mummc <amount>]]></c></marker></tag>
+ <tag><marker id="Mummc"/><c><![CDATA[+Mummc <amount>]]></c></tag>
<item>
Max <c>mseg_alloc</c> carriers. Maximum number of carriers
placed in separate memory segments. When this limit has been
reached, new carriers will be placed in memory retrieved from
<c>sys_alloc</c>.</item>
- <tag><marker id="Musac"><c><![CDATA[+Musac <bool>]]></c></marker></tag>
+ <tag><marker id="Musac"/><c><![CDATA[+Musac <bool>]]></c></tag>
<item>
Allow <c>sys_alloc</c> carriers. By default <c>true</c>. If
set to <c>false</c>, <c>sys_alloc</c> carriers will never be
created by allocators using the <c>alloc_util</c> framework.</item>
</taglist>
+ <p>The following flag is special for <c>literal_alloc</c>:</p>
+ <taglist>
+ <tag><marker id="MIscs"/><c><![CDATA[+MIscs <size in MB>]]></c></tag>
+ <item>
+ <c>literal_alloc</c> super carrier size (in MB). The amount of
+ <em>virtual</em> address space reserved for literal terms in
+ Erlang code on 64-bit architectures. The default is 1024 (1GB)
+ and is usually sufficient. The flag is ignored on 32-bit
+ architectures.</item>
+ </taglist>
<p>Instrumentation flags:</p>
<taglist>
- <tag><marker id="Mim"><c>+Mim true|false</c></marker></tag>
+ <tag><marker id="Mim"/><c>+Mim true|false</c></tag>
<item>
A map over current allocations is kept by the emulator. The
allocation map can be retrieved via the <c>instrument</c>
module. <c>+Mim true</c> implies <c>+Mis true</c>.
<c>+Mim true</c> is the same as
<seealso marker="erl#instr">-instr</seealso>.</item>
- <tag><marker id="Mis"><c>+Mis true|false</c></marker></tag>
+ <tag><marker id="Mis"/><c>+Mis true|false</c></tag>
<item>
Status over allocated memory is kept by the emulator. The
allocation status can be retrieved via the <c>instrument</c>
module.</item>
- <tag><marker id="Mit"><c>+Mit X</c></marker></tag>
+ <tag><marker id="Mit"/><c>+Mit X</c></tag>
<item>
Reserved for future use. Do <em>not</em> use this flag.</item>
</taglist>
@@ -587,7 +600,7 @@
</note>
<p>Other flags:</p>
<taglist>
- <tag><marker id="Mea"><c>+Mea min|max|r9c|r10b|r11b|config</c></marker></tag>
+ <tag><marker id="Mea"/><c>+Mea min|max|r9c|r10b|r11b|config</c></tag>
<item>
<taglist>
<tag><c>min</c></tag>
@@ -617,7 +630,7 @@
</item>
</taglist>
</item>
- <tag><marker id="Mlpm"><c>+Mlpm all|no</c></marker></tag>
+ <tag><marker id="Mlpm"/><c>+Mlpm all|no</c></tag>
<item>Lock physical memory. The default value is <c>no</c>, i.e.,
no physical memory will be locked. If set to <c>all</c>, all
memory mappings made by the runtime system, will be locked into
diff --git a/erts/doc/src/escript.xml b/erts/doc/src/escript.xml
index 46110333f9..f12f76890c 100644
--- a/erts/doc/src/escript.xml
+++ b/erts/doc/src/escript.xml
@@ -4,7 +4,7 @@
<comref>
<header>
<copyright>
- <year>2007</year><year>2014</year>
+ <year>2007</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -96,8 +96,8 @@ $ <input>escript factorial 5</input> </pre>
<note><p>
The encoding specified by the above mentioned comment
applies to the script itself. The encoding of the
- I/O-server, however, has to be set explicitly like this:
-<code>io:setopts([{encoding, unicode}])</code></p>
+ I/O-server, however, has to be set explicitly like this:</p>
+<code>io:setopts([{encoding, unicode}])</code>
<p>The default encoding of the I/O-server for <c>standard_io</c>
is <c>latin1</c>
since the script runs in a non-interactive terminal
diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml
index fe26df61f7..2a33096d04 100644
--- a/erts/doc/src/init.xml
+++ b/erts/doc/src/init.xml
@@ -247,10 +247,7 @@
<c>Expr</c> during system initialization. If any of these
steps fail (syntax error, parse error or exception during
evaluation), Erlang stops with an error message. Here is an
- example that seeds the random number generator:</p>
- <pre>
-% <input>erl -eval '{X,Y,Z} = now(), random:seed(X,Y,Z).'</input></pre>
- <p>This example uses Erlang as a hexadecimal calculator:</p>
+ example that uses Erlang as a hexadecimal calculator:</p>
<pre>
% <input>erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\</input>
<input>-s erlang halt</input>
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index 3f6d5b1d89..acd816a81c 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2004</year><year>2013</year>
+ <year>2004</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -31,8 +31,320 @@
</header>
<p>This document describes the changes made to the ERTS application.</p>
-<section><title>Erts 7.1</title>
+<section><title>Erts 7.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The '-path' flag to 'erl' has been documented. This flag
+ replaces the path specified in the boot script. It has
+ always existed, but was earlier only documented in SASL
+ (script).</p>
+ <p>
+ Own Id: OTP-13060</p>
+ </item>
+ <item>
+ <p>
+ The <c>call_time</c> tracing functionality internally
+ used a time based on OS system time in order to measure
+ call time which could cause erroneous results if OS
+ system time was changed during tracing.</p>
+ <p>
+ This functionality now use Erlang monotonic time in order
+ to measure time. Besides fixing the erroneous results due
+ to OS system time being used, the results are often also
+ better since Erlang monotonic time often has better
+ accuracy and precision.</p>
+ <p>
+ Own Id: OTP-13216</p>
+ </item>
+ <item>
+ <p>
+ Fix behaviour of -delay_write command line switch of
+ epmd, which is used for debugging - in some cases epmd
+ was sleeping twice the requested amount of time.</p>
+ <p>
+ Own Id: OTP-13220</p>
+ </item>
+ <item>
+ <p>
+ Fix race between timeout and exit signal that could cause
+ a process to ignore the exit signal and continue
+ execution. Bug exist since OTP 18.0.</p>
+ <p>
+ Own Id: OTP-13245</p>
+ </item>
+ <item>
+ <p>
+ Fix bug in <c>erlang:halt/1,2</c> for large exit status
+ values, causing either <c>badarg</c> (on 32-bit) or exit
+ with a crash dump and/or core dump (on 64-bit). Make
+ <c>erlang:halt/1,2</c> tolerate any non negative integer
+ as exit status and truncate high order bits if the OS
+ does not support it.</p>
+ <p>
+ Own Id: OTP-13251 Aux Id: ERL-49 </p>
+ </item>
+ <item>
+ <p>
+ <seealso
+ marker="kernel:gen_tcp#accept/2"><c>gen_tcp:accept/2</c></seealso>
+ was not <seealso
+ marker="erts:time_correction#Time_Warp_Safe_Code">time
+ warp safe</seealso>. This since it used the same time as
+ returned by <seealso
+ marker="erts:erlang#now/0"><c>erlang:now/0</c></seealso>
+ when calculating timeout. This has now been fixed.</p>
+ <p>
+ Own Id: OTP-13254 Aux Id: OTP-11997, OTP-13222 </p>
+ </item>
+ <item>
+ <p>
+ Fix faulty error handling when writing to a compressed
+ file.</p>
+ <p>
+ Own Id: OTP-13270</p>
+ </item>
+ <item>
+ <p>
+ Fix sendfile usage for large files on FreeBSD</p>
+ <p>
+ Own Id: OTP-13271</p>
+ </item>
+ <item>
+ <p>
+ Fix bug that could cause
+ <c>process_info(P,current_location)</c> to crash emulator
+ for hipe compiled modules.</p>
+ <p>
+ Own Id: OTP-13282 Aux Id: ERL-79 </p>
+ </item>
+ <item>
+ <p>
+ Out of memory errors have been changed to cause an exit
+ instead of abort.</p>
+ <p>
+ Own Id: OTP-13292</p>
+ </item>
+ <item>
+ <p>
+ When calling <c>garbage_collect/[1,2]</c> or
+ <c>check_process_code/[2,3]</c> from a process with a
+ higher priority than the priority of the process operated
+ on, the run queues could end up in an inconsistent state.
+ This bug has now been fixed.</p>
+ <p>
+ Own Id: OTP-13298 Aux Id: OTP-11388 </p>
+ </item>
+ <item>
+ <p>
+ A workaround for an issue with older gcc versions (less
+ than 5) and inline assembly on 32-bit x86 caused an
+ emulator crash when it had been compiled with a newer gcc
+ version. An improved <c>configure</c> test, run when
+ building OTP, now detects whether the workaround should
+ be used or not.</p>
+ <p>
+ Own Id: OTP-13326 Aux Id: ERL-80 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>Introduced new statistics functionality in order to
+ more efficiently retrieve information about run able and
+ active processes and ports. For more information see:</p>
+ <list> <item><seealso
+ marker="erlang#statistics_total_run_queue_lengths"><c>statistics(total_run_queue_lengths)</c></seealso></item>
+ <item><seealso
+ marker="erlang#statistics_run_queue_lengths"><c>statistics(run_queue_lengths)</c></seealso></item>
+ <item><seealso
+ marker="erlang#statistics_total_active_tasks"><c>statistics(total_active_tasks)</c></seealso></item>
+ <item><seealso
+ marker="erlang#statistics_active_tasks"><c>statistics(active_tasks)</c></seealso></item>
+ </list>
+ <p>
+ Own Id: OTP-13201</p>
+ </item>
+ <item>
+ <p>
+ Time warp safety improvements.</p>
+ <p>
+ Introduced the options <c>monotonic_timestamp</c>, and
+ <c>strict_monotonic_timestamp</c> to the trace,
+ sequential trace, and system profile functionality. This
+ since the already existing <c>timestamp</c> option is not
+ time warp safe.</p>
+ <p>
+ Introduced the option <c>safe_fixed_monotonic_time</c> to
+ <c>ets:info/2</c> and <c>dets:info/2</c>. This since the
+ already existing <c>safe_fixed</c> option is not time
+ warp safe.</p>
+ <p>
+ Own Id: OTP-13222 Aux Id: OTP-11997 </p>
+ </item>
+ <item>
+ <p>
+ Fix a register race where down nodes goes undetected in
+ epmd</p>
+ <p>
+ Own Id: OTP-13301</p>
+ </item>
+ <item>
+ <p>
+ Improved the gcc inline assembly implementing double word
+ atomic compare and exchange on x86/x86_64 so that it also
+ can be used when compiling with clang.</p>
+ <p>
+ Own Id: OTP-13336</p>
+ </item>
+ <item>
+ <p>
+ An optimization preventing a long wait for a scheduler
+ thread looking up information about a process executing
+ on another scheduler thread had unintentionally been lost
+ in erts-5.10 (OTP R16A). This optimization has now been
+ reintroduced.</p>
+ <p>
+ Own Id: OTP-13365 Aux Id: OTP-9892 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 7.2.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Revert "Fix erroneous splitting of emulator path"</p>
+ <p>
+ Own Id: OTP-13202</p>
+ </item>
+ <item>
+ <p>
+ Fix HiPE enabled emulator for FreeBSD.</p>
+ <p>
+ Own Id: OTP-13204 Aux Id: pr926 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 7.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Small documentation fixes</p>
+ <p>
+ Own Id: OTP-13017</p>
+ </item>
+ <item>
+ <p>
+ Fix memory corruption bug caused by disabling
+ distribution and then re-enable distribution with a node
+ name that has previously been used by a remote node.</p>
+ <p>
+ Own Id: OTP-13076 Aux Id: seq12959 </p>
+ </item>
+ <item>
+ <p>
+ Renamed variables with name bool as Visual Studio 2015
+ now treats this is a keyword.</p>
+ <p>
+ Own Id: OTP-13079</p>
+ </item>
+ <item>
+ <p><c>erl_prim_loader</c> has not supported custom
+ loaders for several releases. In the documentation for
+ <c>erl_prim_loader</c>, all references to custom loaders
+ have now been removed.</p>
+ <p>
+ Own Id: OTP-13102</p>
+ </item>
+ <item>
+ <p>
+ Fixed compilation of erts together with libc versions
+ that do not define __uint32_t.</p>
+ <p>
+ Own Id: OTP-13105</p>
+ </item>
+ <item>
+ <p>
+ erl -make now returns non-zero exit codes on failure</p>
+ <p>
+ Own Id: OTP-13107</p>
+ </item>
+ <item>
+ <p>
+ Fix crash on init:restart in embedded mode caused by
+ on_load handler process not being relaunched leading to
+ load failure for modules such as crypto and asn1rt_nif
+ that need it to be present for correct NIF loading.</p>
+ <p>
+ Own Id: OTP-13115</p>
+ </item>
+ <item>
+ <p>
+ Fix maps decode in erlang:binary_to_term/1</p>
+ <p>Decoding a term with a large (HAMT) map in an small
+ (FLAT) map could cause a critical error if the external
+ format was not produced by beam.</p>
+ <p>
+ Own Id: OTP-13125</p>
+ </item>
+ <item>
+ <p>
+ Fix very rare bug in GC when big maps with a lot of hash
+ collisions from a remote node are waiting in inner
+ message queue.</p>
+ <p>
+ Own Id: OTP-13146</p>
+ </item>
+ <item>
+ <p>
+ Fixed a bug that could cause a crash dump to become
+ almost empty.</p>
+ <p>
+ Own Id: OTP-13150</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> Updated the xmllint target to just check the xml
+ files with real documentation content.<br/> Corrected
+ some errors and added some missing target in the DTD's.
+ </p>
+ <p>
+ Own Id: OTP-13026</p>
+ </item>
+ <item>
+ <p>
+ Add function enif_getenv to read OS environment variables
+ in a portable way from NIFs.</p>
+ <p>
+ Own Id: OTP-13147</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 7.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
<item>
@@ -708,19 +1020,20 @@
</item>
<item>
<p>
- Use persistent hashmaps for large Maps <p>Maps will use a
+ Use persistent hashmaps for large Maps</p>
+ <p>Maps will use a
persistent hashmap implementation when the number of
pairs in a Map becomes sufficiently large. The change
will occur when a Map reaches 33 pairs in size but this
- limit might change in the future.</p></p>
- <p>The most significant impact for the user by this
+ limit might change in the future.</p>
+ <p>The most significant impact for the user by this
change is speed, and to a lesser degree memory
consumption and introspection of Maps. Memory consumption
size is probalistic but lesser than <c>gb_trees</c> or
<c>dict</c> for instance. Any other impacts will be
transparent for the user except for the following
changes.</p>
- <p>Semantics of Maps have changed in two incompatible
+ <p>Semantics of Maps have changed in two incompatible
ways compared to the experimental implementation in OTP
17:</p> <list> <item>Hashing of maps is done different by
<c>erlang:phash2/1,2</c>, <c>erlang:phash/1</c> and
@@ -980,6 +1293,42 @@
</section>
+<section><title>Erts 6.4.1.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed a bug that could cause a crash dump to become
+ almost empty.</p>
+ <p>
+ Own Id: OTP-13150</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 6.4.1.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The 'raw' socket option could not be used multiple times
+ in one call to any e.g gen_tcp function because only one
+ of the occurrences were used. This bug has been fixed,
+ and also a small bug concerning propagating error codes
+ from within inet:setopts/2.</p>
+ <p>
+ Own Id: OTP-11482 Aux Id: seq12872 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+
<section><title>Erts 6.4.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -1368,7 +1717,7 @@
<p>
Improved support for atomic memory operations provided by
the <url
- href="https://github.com/ivmai/libatomic_ops/"><c>libatomic_ops</c></url>
+ href="https://github.com/ivmai/libatomic_ops/">libatomic_ops</url>
library. Most importantly support for use of native
double word atomics when implemented by
<c>libatomic_ops</c> (for example, implemented for ARM).</p>
@@ -2335,22 +2684,28 @@
<p>
EEP43: New data type - Maps</p>
<p>
- With Maps you may for instance: <taglist> <item><c>M0 =
- #{ a =&gt; 1, b =&gt; 2}, % create
- associations</c></item> <item><c>M1 = M0#{ a := 10 }, %
- update values</c></item> <item><c>M2 = M1#{ "hi" =&gt;
- "hello"}, % add new associations</c></item> <item><c>#{
- "hi" := V1, a := V2, b := V3} = M2. % match keys with
- values</c></item> </taglist></p>
+ With Maps you may for instance:</p>
+ <taglist>
+ <tag/> <item><c>M0 = #{ a =&gt; 1, b =&gt; 2}, % create
+ associations</c></item>
+ <tag/><item><c>M1 = M0#{ a := 10 }, % update values</c></item>
+ <tag/><item><c>M2 = M1#{ "hi" =&gt;
+ "hello"}, % add new associations</c></item>
+ <tag/><item><c>#{ "hi" := V1, a := V2, b := V3} = M2.
+ % match keys with values</c></item>
+ </taglist>
<p>
For information on how to use Maps please see Map Expressions in the
<seealso marker="doc/reference_manual:expressions#map_expressions">
Reference Manual</seealso>.</p>
<p>
The current implementation is without the following
- features: <taglist> <item>No variable keys</item>
- <item>No single value access</item> <item>No map
- comprehensions</item> </taglist></p>
+ features:</p>
+ <taglist>
+ <tag/><item>No variable keys</item>
+ <tag/><item>No single value access</item>
+ <tag/><item>No map comprehensions</item>
+ </taglist>
<p>
Note that Maps is <em>experimental</em> during OTP 17.0.</p>
<p>
@@ -4510,8 +4865,7 @@
<p>
Fix erl_prim_loader errors in handling of primary
archive. The following errors have been corrected:</p>
- <p>
- <list> <item> If primary archive was named "xxx", then a
+ <list> <item> If primary archive was named "xxx", then a
file in the same directory named "xxxyyy" would be
interpreted as a file named "yyy" inside the archive.
</item> <item> erl_prim_loader did not correctly create
@@ -4526,7 +4880,8 @@
erl_prim_loader:list_dir/1 would sometimes return an
empty string inside the file list. This was a virtual
element representing the top directory of the archive.
- This has been removed. </item> </list></p>
+ This has been removed. </item>
+ </list>
<p>
Thanks to Tuncer Ayaz and Shunichi Shinohara for
reporting and co-authoring corrections.</p>
@@ -6969,12 +7324,12 @@
Own Id: OTP-8726 Aux Id: seq11617 </p>
</item>
<item>
- <p>Fix libm linking with --as-needed flag
+ <p>Fix libm linking with --as-needed flag</p>
<p>
When building with "--as-needed" linker flags on Linux
the build will fail. This has now been fixed.</p>
<p>
- (Thanks to Christian Faulhammer)</p></p>
+ (Thanks to Christian Faulhammer)</p>
<p>
Own Id: OTP-8728</p>
</item>
diff --git a/erts/doc/src/run_erl.xml b/erts/doc/src/run_erl.xml
index 0a5b2c6136..faec3c68c1 100644
--- a/erts/doc/src/run_erl.xml
+++ b/erts/doc/src/run_erl.xml
@@ -59,7 +59,7 @@
first argument to run_erl on the command line.</item>
<tag>pipe_dir</tag>
<item>This is where to put the named pipe, usually
- <c><![CDATA[/tmp/]]></c> on Unix or <c><![CDATA[/pipe/]]></c> on OSE. It shall be suffixed by a <c><![CDATA[/]]></c> (slash),
+ <c><![CDATA[/tmp/]]></c>. It shall be suffixed by a <c><![CDATA[/]]></c> (slash),
i.e. not <c><![CDATA[/tmp/epipies]]></c>, but <c><![CDATA[/tmp/epipes/]]></c>. </item>
<tag>log_dir</tag>
<item>This is where the log files are written. There will be one
diff --git a/erts/doc/src/time_correction.xml b/erts/doc/src/time_correction.xml
index 4de3739a36..236fe679cb 100644
--- a/erts/doc/src/time_correction.xml
+++ b/erts/doc/src/time_correction.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>1999</year><year>2014</year>
+ <year>1999</year><year>2015</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -897,6 +897,6 @@ EventTag = {Time, UMI}</code>
and using these wrappers instead of using the API directly,
the problem is solved. These wrappers can, for example,
be implemented as in
- <url href="time_compat.erl"><c>$ERL_TOP/erts/example/time_compat.erl</c></url>.</p>
+ <url href="time_compat.erl">$ERL_TOP/erts/example/time_compat.erl</url>.</p>
</section>
</chapter>
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index a919f0e3ac..12148ad9c7 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -23,10 +23,6 @@ include ../vsn.mk
include $(ERL_TOP)/make/$(TARGET)/otp.mk
-include $(TARGET)/gen_git_version.mk
-ifeq ($(findstring ose,$(TARGET)),ose)
-include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk
-endif
-
ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@
HIPE_ENABLED=@HIPE_ENABLED@
DTRACE_ENABLED=@DTRACE_ENABLED@
@@ -245,9 +241,7 @@ HCC = @HCC@
LD = @LD@
DEXPORT = @DEXPORT@
RANLIB = @RANLIB@
-ifneq ($(findstring ose,$(TARGET)),ose)
STRIP = strip
-endif
PERL = @PERL@
RM = @RM@
MKDIR = @MKDIR@
@@ -323,7 +317,7 @@ else
CS_CFLAGS = $(CS_CFLAGS_)
endif
CS_LDFLAGS = $(LDFLAGS)
-CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal$(TYPEMARKER) @ERTS_INTERNAL_X_LIBS@
+CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal$(TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ @SOCKET_LIBS@
LIBS += @TERMCAP_LIB@ -L../lib/internal/$(TARGET) @ERTS_INTERNAL_X_LIBS@
@@ -404,7 +398,7 @@ EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll
else
EMULATOR_EXECUTABLE = beam$(TF_MARKER)
endif
-CS_EXECUTABLE = child_setup$(TYPEMARKER)
+CS_EXECUTABLE = erl_child_setup$(TYPEMARKER)
# ----------------------------------------------------------------------
@@ -597,6 +591,7 @@ ifeq ($(TARGET),win32)
PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT)
PRELOAD_SRC = $(TARGET)/beams.rc
$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
@@ -606,11 +601,13 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
$(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \
$(ERL_TOP)/erts/preloaded/ebin/erlang.beam \
$(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam
+
$(gen_verbose)LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@
else
PRELOAD_OBJ = $(OBJDIR)/preload.o
PRELOAD_SRC = $(TARGET)/preload.c
$(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \
$(ERL_TOP)/erts/preloaded/ebin/init.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
@@ -684,14 +681,6 @@ $(OBJDIR)/%.o: $(TTF_DIR)/%.c
$(OBJDIR)/%.o: sys/$(ERLANG_OSTYPE)/%.c
$(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(OBJDIR)/ose_confd.o: $(OSE_CONFD)
- $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
-
-$(OBJDIR)/crt0_lm.o: $(CRT0_LM)
- $(V_CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
-endif
-
$(OBJDIR)/%.o: sys/common/%.c
$(V_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
@@ -704,11 +693,11 @@ $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c
# ----------------------------------------------------------------------
# Specials
#
-CS_SRC = sys/$(ERLANG_OSTYPE)/erl_child_setup.c
+CS_OBJ = $(OBJDIR)/erl_child_setup.o $(OBJDIR)/sys_uds.o $(OBJDIR)/hash.o
-$(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_SRC) $(ERTS_LIB)
- $(ld_verbose)$(CS_PURIFY) $(CC) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \
- $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_SRC) $(CS_LIBS)
+$(BINDIR)/$(CS_EXECUTABLE): $(TTF_DIR)/GENERATED $(PRELOAD_SRC) $(CS_OBJ) $(ERTS_LIB)
+ $(ld_verbose)$(CS_PURIFY) $(LD) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \
+ $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_OBJ) $(CS_LIBS)
$(OBJDIR)/%.kp.o: sys/common/%.c
$(V_CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@
@@ -787,7 +776,8 @@ RUN_OBJS = \
$(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o \
$(OBJDIR)/erl_bif_binary.o $(OBJDIR)/erl_ao_firstfit_alloc.o \
$(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o \
- $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o
+ $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \
+ $(OBJDIR)/erl_msacc.o
ifeq ($(TARGET),win32)
DRV_OBJS = \
@@ -810,31 +800,10 @@ OS_OBJS = \
$(OBJDIR)/dosmap.o
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-OS_OBJS = \
- $(OBJDIR)/sys.o \
- $(OBJDIR)/driver_tab.o \
- $(OBJDIR)/ose_efile.o \
- $(OBJDIR)/gzio.o \
- $(OBJDIR)/elib_memmove.o
-
-OS_OBJS += $(OBJDIR)/ose_confd.o \
- $(OBJDIR)/crt0_lm.o
-
-OS_OBJS += $(OBJDIR)/sys_float.o \
- $(OBJDIR)/sys_time.o
-
-DRV_OBJS = \
- $(OBJDIR)/efile_drv.o \
- $(OBJDIR)/ose_signal_drv.o \
- $(OBJDIR)/inet_drv.o \
- $(OBJDIR)/zlib_drv.o \
- $(OBJDIR)/ram_file_drv.o \
- $(OBJDIR)/ttsl_drv.o
-
-else
OS_OBJS = \
$(OBJDIR)/sys.o \
+ $(OBJDIR)/sys_drivers.o \
+ $(OBJDIR)/sys_uds.o \
$(OBJDIR)/driver_tab.o \
$(OBJDIR)/unix_efile.o \
$(OBJDIR)/gzio.o \
@@ -849,7 +818,6 @@ DRV_OBJS = \
$(OBJDIR)/ram_file_drv.o \
$(OBJDIR)/ttsl_drv.o
endif
-endif
ifneq ($(STATIC_NIFS),no)
STATIC_NIF_LIBS = $(STATIC_NIFS)
@@ -1022,19 +990,12 @@ $(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS)
$(STATIC_DRIVER_LIBS) $(LIBS)
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) $(LCF)
- $(call build-ose-load-module, $@, $(INIT_OBJS) $(OBJS), $(STATIC_NIF_LIBS) \
- $(STATIC_DRIVER_LIBS) $(LIBS), $(BEAM_LMCONF))
-
-else
$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS)
$(ld_verbose)$(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \
$(HIPEBEAMLDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) \
$(STATIC_NIF_LIBS) $(STATIC_DRIVER_LIBS) $(LIBS)
endif
-endif
# ----------------------------------------------------------------------
# Dependencies
diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c
index fe91134ef4..099c00bcf6 100644
--- a/erts/emulator/beam/atom.c
+++ b/erts/emulator/beam/atom.c
@@ -176,7 +176,7 @@ atom_alloc(Atom* tmpl)
/*
* Precompute ordinal value of first 3 bytes + 7 bits.
- * This is used by utils.c:cmp_atoms().
+ * This is used by utils.c:erts_cmp_atoms().
* We cannot use the full 32 bits of the first 4 bytes,
* since we use the sign of the difference between two
* ordinal values to represent their relative order.
@@ -435,6 +435,9 @@ init_atom_table(void)
f.cmp = (HCMP_FUN) atom_cmp;
f.alloc = (HALLOC_FUN) atom_alloc;
f.free = (HFREE_FUN) atom_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
atom_text_pos = NULL;
atom_text_end = NULL;
diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h
index ead56c83d8..2c002ca92f 100644
--- a/erts/emulator/beam/atom.h
+++ b/erts/emulator/beam/atom.h
@@ -129,6 +129,7 @@ typedef enum {
(erts_is_atom_utf8_bytes((byte *) LSTR, sizeof(LSTR) - 1, (TERM)))
#define ERTS_DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
#define ERTS_INIT_AM(S) AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
+#define ERTS_MAKE_AM(Str) am_atom_put(Str, sizeof(Str) - 1)
int atom_table_size(void); /* number of elements */
int atom_table_sz(void); /* table size in bytes, excluding stored objects */
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 190e7817dc..169b071cd7 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -71,6 +71,7 @@ atom absoluteURI
atom ac
atom accessor
atom active
+atom active_tasks
atom all
atom all_but_first
atom all_names
@@ -101,6 +102,7 @@ atom asynchronous
atom atom
atom atom_used
atom attributes
+atom await_microstate_accounting_modifications
atom await_port_send_result
atom await_proc_exit
atom await_result
@@ -117,14 +119,15 @@ atom bif_timer_server
atom binary
atom binary_bin_to_list_trap
atom binary_copy_trap
+atom binary_find_trap
atom binary_longest_prefix_trap
atom binary_longest_suffix_trap
-atom binary_match_trap
-atom binary_matches_trap
atom binary_to_list_continue
atom binary_to_term_trap
atom block
+atom block_normal
atom blocked
+atom blocked_normal
atom bm
atom bnot
atom bor
@@ -172,6 +175,7 @@ atom const
atom context_switches
atom control
atom copy
+atom counters
atom cpu
atom cpu_timestamp
atom cr
@@ -188,7 +192,9 @@ atom dexit
atom depth
atom dgroup_leader
atom dictionary
+atom dirty_cpu
atom dirty_cpu_schedulers_online
+atom dirty_io
atom disable_trace
atom disabled
atom display_items
@@ -209,7 +215,9 @@ atom dsend
atom dsend_continue_trap
atom dunlink
atom duplicate_bag
+atom duplicated
atom dupnames
+atom einval
atom elib_malloc
atom emulator
atom enable_trace
@@ -257,6 +265,7 @@ atom functions
atom function_clause
atom garbage_collecting
atom garbage_collection
+atom garbage_collection_info
atom gc_end
atom gc_start
atom Ge='>='
@@ -267,7 +276,9 @@ atom get_tcw
atom getenv
atom gather_gc_info_result
atom gather_io_bytes
+atom gather_microstate_accounting_result
atom gather_sched_wall_time_result
+atom gather_system_check_result
atom getting_linked
atom getting_unlinked
atom global
@@ -298,6 +309,7 @@ atom index
atom infinity
atom info
atom info_msg
+atom init
atom initial_call
atom input
atom internal
@@ -351,17 +363,20 @@ atom memory_internal
atom memory_types
atom message
atom message_binary
+atom message_queue_data
atom message_queue_len
atom messages
atom merge_trap
atom meta
atom meta_match_spec
atom micro_seconds
+atom microstate_accounting
atom milli_seconds
atom min_heap_size
atom min_bin_vheap_size
atom minor_version
atom Minus='-'
+atom mixed
atom module
atom module_info
atom monitored_by
@@ -369,6 +384,7 @@ atom monitor
atom monitor_nodes
atom monitors
atom monotonic
+atom monotonic_timestamp
atom more
atom multi_scheduling
atom multiline
@@ -424,10 +440,12 @@ atom notify
atom notsup
atom nouse_stdio
atom objects
+atom off_heap
atom offset
atom ok
atom old_heap_block_size
atom old_heap_size
+atom on_heap
atom on_load
atom open
atom open_error
@@ -438,13 +456,6 @@ atom orelse
atom os_pid
atom os_type
atom os_version
-atom ose_bg_proc
-atom ose_int_proc
-atom ose_phantom
-atom ose_pri_proc
-atom ose_process_prio
-atom ose_process_type
-atom ose_ti_proc
atom out
atom out_exited
atom out_exiting
@@ -512,6 +523,7 @@ atom return_from
atom return_to
atom return_trace
atom run_queue
+atom run_queue_lengths
atom runnable
atom runnable_ports
atom runnable_procs
@@ -557,6 +569,7 @@ atom static
atom stderr_to_stdout
atom stop
atom stream
+atom strict_monotonic_timestamp
atom sunrm
atom suspend
atom suspended
@@ -579,12 +592,16 @@ atom timeout_value
atom Times='*'
atom timestamp
atom total
+atom total_active_tasks
atom total_heap_size
+atom total_run_queue_lengths
atom tpkt
atom trace trace_ts traced
atom trace_control_word
atom tracer
atom trap_exit
+atom trim
+atom trim_all
atom try_clause
atom true
atom tuple
@@ -600,6 +617,7 @@ atom use_stdio
atom used
atom utf8
atom unblock
+atom unblock_normal
atom uniq
atom unless_suspending
atom unloaded
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 0e192b1ebd..0b47fc3586 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -38,9 +38,9 @@
#include "erl_thr_progress.h"
static void set_default_trace_pattern(Eterm module);
-static Eterm check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp);
+static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp);
static void delete_code(Module* modp);
-static void decrement_refc(BeamInstr* code);
+static void decrement_refc(BeamCodeHeader*);
static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
@@ -58,8 +58,8 @@ BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1)
return am_undefined;
}
erts_rlock_old_code(code_ix);
- res = (erts_is_module_native(modp->curr.code) ||
- erts_is_module_native(modp->old.code)) ?
+ res = (erts_is_module_native(modp->curr.code_hdr) ||
+ erts_is_module_native(modp->old.code_hdr)) ?
am_true : am_false;
erts_runlock_old_code(code_ix);
return res;
@@ -81,12 +81,12 @@ BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3)
modp = erts_get_module(BIF_ARG_1, erts_active_code_ix());
if (modp && modp->curr.num_breakpoints > 0) {
- ASSERT(modp->curr.code != NULL);
+ ASSERT(modp->curr.code_hdr != NULL);
erts_clear_module_break(modp);
ASSERT(modp->curr.num_breakpoints == 0);
}
- erts_start_staging_code_ix();
+ erts_start_staging_code_ix(1);
res = erts_make_stub_module(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
@@ -139,6 +139,25 @@ prepare_loading_2(BIF_ALIST_2)
BIF_RET(res);
}
+BIF_RETTYPE
+has_prepared_code_on_load_1(BIF_ALIST_1)
+{
+ Eterm res;
+ ProcBin* pb;
+
+ if (!ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_1)) {
+ error:
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ pb = (ProcBin*) binary_val(BIF_ARG_1);
+ res = erts_has_code_on_load(pb->val);
+ if (res == NIL) {
+ goto error;
+ }
+ BIF_RET(res);
+}
+
struct m {
Binary* code;
Eterm module;
@@ -154,7 +173,7 @@ static struct /* Protected by code_write_permission */
{
Process* stager;
ErtsThrPrgrLaterOp lop;
-}commiter_state;
+} committer_state;
#endif
static Eterm
@@ -163,14 +182,13 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions)
Eterm* hp = HAlloc(p, 3 + 2*exceptions);
Eterm res = NIL;
- mp += exceptions - 1;
while (exceptions > 0) {
if (mp->exception) {
res = CONS(hp, mp->module, res);
hp += 2;
exceptions--;
}
- mp--;
+ mp++;
}
return TUPLE2(hp, tag, res);
}
@@ -179,8 +197,8 @@ exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions)
BIF_RETTYPE
finish_loading_1(BIF_ALIST_1)
{
- int i;
- int n;
+ Sint i;
+ Sint n;
struct m* p = NULL;
Uint exceptions;
Eterm res;
@@ -201,9 +219,13 @@ finish_loading_1(BIF_ALIST_1)
*/
n = erts_list_length(BIF_ARG_1);
- if (n == -1) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
- goto done;
+ if (n < 0) {
+ badarg:
+ if (p) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, p);
+ }
+ erts_release_code_write_permission();
+ BIF_ERROR(BIF_P, BADARG);
}
p = erts_alloc(ERTS_ALC_T_LOADER_TMP, n*sizeof(struct m));
@@ -218,29 +240,32 @@ finish_loading_1(BIF_ALIST_1)
ProcBin* pb;
if (!ERTS_TERM_IS_MAGIC_BINARY(term)) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
- goto done;
+ goto badarg;
}
pb = (ProcBin*) binary_val(term);
p[i].code = pb->val;
p[i].module = erts_module_for_prepared_code(p[i].code);
if (p[i].module == NIL) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG);
- goto done;
+ goto badarg;
}
BIF_ARG_1 = CDR(cons);
}
/*
* Since we cannot handle atomic loading of a group of modules
- * if one or more of them uses on_load, we will only allow one
- * element in the list. This limitation is intended to be
- * lifted in the future.
+ * if one or more of them uses on_load, we will only allow
+ * more than one element in the list if none of the modules
+ * have an on_load function.
*/
if (n > 1) {
- ERTS_BIF_PREP_ERROR(res, BIF_P, SYSTEM_LIMIT);
- goto done;
+ for (i = 0; i < n; i++) {
+ if (erts_has_code_on_load(p[i].code) == am_true) {
+ erts_free(ERTS_ALC_T_LOADER_TMP, p);
+ erts_release_code_write_permission();
+ BIF_ERROR(BIF_P, SYSTEM_LIMIT);
+ }
+ }
}
/*
@@ -252,11 +277,27 @@ finish_loading_1(BIF_ALIST_1)
*/
res = am_ok;
- erts_start_staging_code_ix();
+ erts_start_staging_code_ix(n);
for (i = 0; i < n; i++) {
p[i].modp = erts_put_module(p[i].module);
+ p[i].modp->seen = 0;
}
+
+ exceptions = 0;
+ for (i = 0; i < n; i++) {
+ p[i].exception = 0;
+ if (p[i].modp->seen) {
+ p[i].exception = 1;
+ exceptions++;
+ }
+ p[i].modp->seen = 1;
+ }
+ if (exceptions) {
+ res = exception_list(BIF_P, am_duplicated, p, exceptions);
+ goto done;
+ }
+
for (i = 0; i < n; i++) {
if (p[i].modp->curr.num_breakpoints > 0 ||
p[i].modp->curr.num_traced_exports > 0 ||
@@ -281,7 +322,7 @@ finish_loading_1(BIF_ALIST_1)
exceptions = 0;
for (i = 0; i < n; i++) {
p[i].exception = 0;
- if (p[i].modp->curr.code && p[i].modp->old.code) {
+ if (p[i].modp->curr.code_hdr && p[i].modp->old.code_hdr) {
p[i].exception = 1;
exceptions++;
}
@@ -367,9 +408,9 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
* schedulers to read active code_ix in a safe way while executing
* without any memory barriers at all.
*/
- ASSERT(commiter_state.stager == NULL);
- commiter_state.stager = c_p;
- erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &commiter_state.lop);
+ ASSERT(committer_state.stager == NULL);
+ committer_state.stager = c_p;
+ erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &committer_state.lop);
erts_proc_inc_refc(c_p);
erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL);
/*
@@ -385,11 +426,11 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking,
#ifdef ERTS_SMP
static void smp_code_ix_commiter(void* null)
{
- Process* p = commiter_state.stager;
+ Process* p = committer_state.stager;
erts_commit_staging_code_ix();
#ifdef DEBUG
- commiter_state.stager = NULL;
+ committer_state.stager = NULL;
#endif
erts_release_code_write_permission();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
@@ -417,7 +458,7 @@ check_old_code_1(BIF_ALIST_1)
modp = erts_get_module(BIF_ARG_1, code_ix);
if (modp != NULL) {
erts_rlock_old_code(code_ix);
- if (modp->old.code != NULL) {
+ if (modp->old.code_hdr) {
res = am_true;
}
erts_runlock_old_code(code_ix);
@@ -426,7 +467,7 @@ check_old_code_1(BIF_ALIST_1)
}
Eterm
-erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
+erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp)
{
Module* modp;
Eterm res;
@@ -441,7 +482,8 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
if (!modp)
return am_false;
erts_rlock_old_code(code_ix);
- res = modp->old.code ? check_process_code(c_p, modp, allow_gc, redsp) : am_false;
+ res = (!modp->old.code_hdr ? am_false :
+ check_process_code(c_p, modp, flags, redsp));
erts_runlock_old_code(code_ix);
return res;
@@ -450,49 +492,21 @@ erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp)
BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2)
{
int reds = 0;
+ Uint flags;
Eterm res;
- Eterm olist = BIF_ARG_2;
- int allow_gc = 1;
if (is_not_atom(BIF_ARG_1))
goto badarg;
- while (is_list(olist)) {
- Eterm *lp = list_val(olist);
- Eterm opt = CAR(lp);
- if (is_tuple(opt)) {
- Eterm* tp = tuple_val(opt);
- switch (arityval(tp[0])) {
- case 2:
- switch (tp[1]) {
- case am_allow_gc:
- switch (tp[2]) {
- case am_false:
- allow_gc = 0;
- break;
- case am_true:
- allow_gc = 1;
- break;
- default:
- goto badarg;
- }
- break;
- default:
- goto badarg;
- }
- break;
- default:
- goto badarg;
- }
- }
- else
- goto badarg;
- olist = CDR(lp);
+ if (is_not_small(BIF_ARG_2))
+ goto badarg;
+
+ flags = unsigned_val(BIF_ARG_2);
+ if (flags & ~ERTS_CPC_ALL) {
+ goto badarg;
}
- if (is_not_nil(olist))
- goto badarg;
- res = erts_check_process_code(BIF_P, BIF_ARG_1, allow_gc, &reds);
+ res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds);
ASSERT(is_value(res));
@@ -519,13 +533,13 @@ BIF_RETTYPE delete_module_1(BIF_ALIST_1)
}
{
- erts_start_staging_code_ix();
+ erts_start_staging_code_ix(0);
code_ix = erts_staging_code_ix();
modp = erts_get_module(BIF_ARG_1, code_ix);
if (!modp) {
res = am_undefined;
}
- else if (modp->old.code != 0) {
+ else if (modp->old.code_hdr) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
erts_dsprintf(dsbufp, "Module %T must be purged before loading\n",
BIF_ARG_1);
@@ -563,8 +577,8 @@ BIF_RETTYPE module_loaded_1(BIF_ALIST_1)
}
code_ix = erts_active_code_ix();
if ((modp = erts_get_module(BIF_ARG_1, code_ix)) != NULL) {
- if (modp->curr.code != NULL
- && modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] == 0) {
+ if (modp->curr.code_hdr
+ && modp->curr.code_hdr->on_load_function_ptr == NULL) {
res = am_true;
}
}
@@ -611,8 +625,8 @@ BIF_RETTYPE call_on_load_function_1(BIF_ALIST_1)
{
Module* modp = erts_get_module(BIF_ARG_1, erts_active_code_ix());
- if (modp && modp->curr.code) {
- BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]);
+ if (modp && modp->curr.code_hdr) {
+ BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code_hdr->on_load_function_ptr);
}
else {
BIF_ERROR(BIF_P, BADARG);
@@ -623,7 +637,6 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
{
ErtsCodeIndex code_ix;
Module* modp;
- Eterm on_load;
if (!erts_try_seize_code_write_permission(BIF_P)) {
ERTS_BIF_YIELD2(bif_export[BIF_finish_after_on_load_2],
@@ -638,14 +651,14 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
code_ix = erts_active_code_ix();
modp = erts_get_module(BIF_ARG_1, code_ix);
- if (!modp || modp->curr.code == 0) {
+ if (!modp || !modp->curr.code_hdr) {
error:
erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_release_code_write_permission();
BIF_ERROR(BIF_P, BADARG);
}
- if ((on_load = modp->curr.code[MI_ON_LOAD_FUNCTION_PTR]) == 0) {
+ if (modp->curr.code_hdr->on_load_function_ptr == NULL) {
goto error;
}
if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) {
@@ -667,7 +680,7 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
ep->code[4] = 0;
}
}
- modp->curr.code[MI_ON_LOAD_FUNCTION_PTR] = 0;
+ modp->curr.code_hdr->on_load_function_ptr = NULL;
set_default_trace_pattern(BIF_ARG_1);
} else if (BIF_ARG_2 == am_false) {
BeamInstr* code;
@@ -679,13 +692,16 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2)
* the current code; the old code is not touched.
*/
erts_total_code_size -= modp->curr.code_length;
- code = modp->curr.code;
- end = (BeamInstr *)((char *)code + modp->curr.code_length);
+ code = (BeamInstr*) modp->curr.code_hdr;
+ end = (BeamInstr *) ((char *)code + modp->curr.code_length);
erts_cleanup_funs_on_purge(code, end);
beam_catches_delmod(modp->curr.catches, code, modp->curr.code_length,
erts_active_code_ix());
- erts_free(ERTS_ALC_T_CODE, (void *) code);
- modp->curr.code = NULL;
+ if (modp->curr.code_hdr->literals_start) {
+ erts_free(ERTS_ALC_T_LITERAL, modp->curr.code_hdr->literals_start);
+ }
+ erts_free(ERTS_ALC_T_CODE, modp->curr.code_hdr);
+ modp->curr.code_hdr = NULL;
modp->curr.code_length = 0;
modp->curr.catches = BEAM_CATCHES_NIL;
erts_remove_from_ranges(code);
@@ -721,31 +737,50 @@ set_default_trace_pattern(Eterm module)
}
}
+static ERTS_INLINE int
+check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size)
+{
+ struct erl_off_heap_header* oh;
+ for (oh = off_heap->first; oh; oh = oh->next) {
+ if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
+ ErlFunThing* funp = (ErlFunThing*) oh;
+ if (ErtsInArea(funp->fe->address, area, area_size))
+ return !0;
+ }
+ }
+ return 0;
+}
+
+
static Eterm
-check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
+check_process_code(Process* rp, Module* modp, Uint flags, int *redsp)
{
BeamInstr* start;
+ char* literals;
+ Uint lit_bsize;
char* mod_start;
Uint mod_size;
- BeamInstr* end;
Eterm* sp;
- struct erl_off_heap_header* oh;
int done_gc = 0;
+ int need_gc = 0;
+ ErtsMessage *msgp;
+ ErlHeapFragment *hfrag;
-#define INSIDE(a) (start <= (a) && (a) < end)
+#define ERTS_ORDINARY_GC__ (1 << 0)
+#define ERTS_LITERAL_GC__ (1 << 1)
/*
* Pick up limits for the module.
*/
- start = modp->old.code;
- end = (BeamInstr *)((char *)start + modp->old.code_length);
+ start = (BeamInstr*) modp->old.code_hdr;
mod_start = (char *) start;
mod_size = modp->old.code_length;
/*
* Check if current instruction or continuation pointer points into module.
*/
- if (INSIDE(rp->i) || INSIDE(rp->cp)) {
+ if (ErtsInArea(rp->i, mod_start, mod_size)
+ || ErtsInArea(rp->cp, mod_start, mod_size)) {
return am_true;
}
@@ -753,7 +788,7 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
* Check all continuation pointers stored on the stack.
*/
for (sp = rp->stop; sp < STACK_START(rp); sp++) {
- if (is_CP(*sp) && INSIDE(cp_val(*sp))) {
+ if (is_CP(*sp) && ErtsInArea(cp_val(*sp), mod_start, mod_size)) {
return am_true;
}
}
@@ -767,15 +802,15 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
struct StackTrace *s;
ASSERT(is_list(rp->ftrace));
s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace)));
- if ((s->pc && INSIDE(s->pc)) ||
- (s->current && INSIDE(s->current))) {
+ if ((s->pc && ErtsInArea(s->pc, mod_start, mod_size)) ||
+ (s->current && ErtsInArea(s->current, mod_start, mod_size))) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
} else {
int i;
for (i = 0; i < s->depth; i++) {
- if (INSIDE(s->trace[i])) {
+ if (ErtsInArea(s->trace[i], mod_start, mod_size)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
@@ -796,111 +831,147 @@ check_process_code(Process* rp, Module* modp, int allow_gc, int *redsp)
}
/*
- * See if there are funs that refer to the old version of the module.
+ * Message queue can contains funs, but (at least currently) no
+ * constants. If we got references to this module from the message
+ * queue, a GC cannot remove these...
*/
- rescan:
- for (oh = MSO(rp).first; oh; oh = oh->next) {
- if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
- ErlFunThing* funp = (ErlFunThing*) oh;
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ);
- if (INSIDE((BeamInstr *) funp->fe->address)) {
- if (done_gc) {
- return am_true;
- } else {
- if (!allow_gc)
- return am_aborted;
- /*
- * Try to get rid of this fun by garbage collecting.
- * Clear both fvalue and ftrace to make sure they
- * don't hold any funs.
- */
- rp->freason = EXC_NULL;
- rp->fvalue = NIL;
- rp->ftrace = NIL;
- done_gc = 1;
- FLAGS(rp) |= F_NEED_FULLSWEEP;
- *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
- goto rescan;
- }
- }
+ literals = (char*) modp->old.code_hdr->literals_start;
+ lit_bsize = (char*) modp->old.code_hdr->literals_end - literals;
+
+ for (msgp = rp->msg.first; msgp; msgp = msgp->next) {
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ hfrag = &msgp->hfrag;
+ else if (is_value(ERL_MESSAGE_TERM(msgp)) && msgp->data.heap_frag)
+ hfrag = msgp->data.heap_frag;
+ else
+ continue;
+ for (; hfrag; hfrag = hfrag->next) {
+ if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size))
+ return am_true;
+ /* Should not contain any constants... */
+ ASSERT(!any_heap_refs(&hfrag->mem[0],
+ &hfrag->mem[hfrag->used_size],
+ literals,
+ lit_bsize));
}
}
- /*
- * See if there are constants inside the module referenced by the process.
- */
- done_gc = 0;
- for (;;) {
- ErlMessage* mp;
-
- if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, mod_start, mod_size)) {
+ while (1) {
+
+ /* Check heap, stack etc... */
+ if (check_mod_funs(rp, &rp->off_heap, mod_start, mod_size))
+ goto try_gc;
+ if (!(flags & ERTS_CPC_COPY_LITERALS)) {
+ /* Process ok. May contain old literals but we will be called
+ * again before module is purged.
+ */
+ return am_false;
+ }
+ if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, literals, lit_bsize)) {
rp->freason = EXC_NULL;
rp->fvalue = NIL;
rp->ftrace = NIL;
}
- if (any_heap_ref_ptrs(rp->stop, rp->hend, mod_start, mod_size)) {
- goto need_gc;
- }
- if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) {
- goto need_gc;
- }
-
- if (any_heap_refs(rp->old_heap, rp->old_htop, mod_start, mod_size)) {
- goto need_gc;
+ if (any_heap_ref_ptrs(rp->stop, rp->hend, literals, lit_bsize))
+ goto try_literal_gc;
+ if (any_heap_refs(rp->heap, rp->htop, literals, lit_bsize))
+ goto try_literal_gc;
+ if (any_heap_refs(rp->old_heap, rp->old_htop, literals, lit_bsize))
+ goto try_literal_gc;
+
+ /* Check dictionary */
+ if (rp->dictionary) {
+ Eterm* start = ERTS_PD_START(rp->dictionary);
+ Eterm* end = start + ERTS_PD_SIZE(rp->dictionary);
+
+ if (any_heap_ref_ptrs(start, end, literals, lit_bsize))
+ goto try_literal_gc;
}
- if (rp->dictionary != NULL) {
- Eterm* start = rp->dictionary->data;
- Eterm* end = start + rp->dictionary->used;
+ /* Check heap fragments */
+ for (hfrag = rp->mbuf; hfrag; hfrag = hfrag->next) {
+ Eterm *hp, *hp_end;
+ /* Off heap lists should already have been moved into process */
+ ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
- if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) {
- goto need_gc;
- }
+ hp = &hfrag->mem[0];
+ hp_end = &hfrag->mem[hfrag->used_size];
+ if (any_heap_refs(hp, hp_end, literals, lit_bsize))
+ goto try_literal_gc;
}
- for (mp = rp->msg.first; mp != NULL; mp = mp->next) {
- if (any_heap_ref_ptrs(mp->m, mp->m+2, mod_start, mod_size)) {
- goto need_gc;
+#ifdef DEBUG
+ /*
+ * Message buffer fragments should not have any references
+ * to constants, and off heap lists should already have
+ * been moved into process off heap structure.
+ */
+ for (msgp = rp->msg_frag; msgp; msgp = msgp->next) {
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ hfrag = &msgp->hfrag;
+ else
+ hfrag = msgp->data.heap_frag;
+ for (; hfrag; hfrag = hfrag->next) {
+ Eterm *hp, *hp_end;
+ ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
+
+ hp = &hfrag->mem[0];
+ hp_end = &hfrag->mem[hfrag->used_size];
+ ASSERT(!any_heap_refs(hp, hp_end, literals, lit_bsize));
}
}
- break;
- need_gc:
- if (done_gc) {
+#endif
+
+ return am_false;
+
+ try_literal_gc:
+ need_gc |= ERTS_LITERAL_GC__;
+
+ try_gc:
+ need_gc |= ERTS_ORDINARY_GC__;
+
+ if ((done_gc & need_gc) == need_gc)
return am_true;
- } else {
- Eterm* literals;
- Uint lit_size;
- struct erl_off_heap_header* oh;
- if (!allow_gc)
- return am_aborted;
+ if (!(flags & ERTS_CPC_ALLOW_GC))
+ return am_aborted;
- /*
- * Try to get rid of constants by by garbage collecting.
- * Clear both fvalue and ftrace.
- */
- rp->freason = EXC_NULL;
- rp->fvalue = NIL;
- rp->ftrace = NIL;
- done_gc = 1;
+ need_gc &= ~done_gc;
+
+ /*
+ * Try to get rid of constants by by garbage collecting.
+ * Clear both fvalue and ftrace.
+ */
+
+ rp->freason = EXC_NULL;
+ rp->fvalue = NIL;
+ rp->ftrace = NIL;
+
+ if (need_gc & ERTS_ORDINARY_GC__) {
FLAGS(rp) |= F_NEED_FULLSWEEP;
- *redsp += erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
- literals = (Eterm *) modp->old.code[MI_LITERALS_START];
- lit_size = (Eterm *) modp->old.code[MI_LITERALS_END] - literals;
- oh = (struct erl_off_heap_header *)
- modp->old.code[MI_LITERALS_OFF_HEAP];
- *redsp += lit_size / 10; /* Need, better value... */
- erts_garbage_collect_literals(rp, literals, lit_size, oh);
+ *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity);
+ done_gc |= ERTS_ORDINARY_GC__;
}
+ if (need_gc & ERTS_LITERAL_GC__) {
+ struct erl_off_heap_header* oh;
+ oh = modp->old.code_hdr->literals_off_heap;
+ *redsp += lit_bsize / 64; /* Need, better value... */
+ erts_garbage_collect_literals(rp, (Eterm*)literals, lit_bsize, oh);
+ done_gc |= ERTS_LITERAL_GC__;
+ }
+ need_gc = 0;
}
- return am_false;
-#undef INSIDE
-}
-#define in_area(ptr,start,nbytes) \
- ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
+#undef ERTS_ORDINARY_GC__
+#undef ERTS_LITERAL_GC__
+
+}
static int
any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
@@ -913,7 +984,7 @@ any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
case TAG_PRIMARY_LIST:
- if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) {
+ if (ErtsInArea(val, mod_start, mod_size)) {
return 1;
}
break;
@@ -933,7 +1004,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
case TAG_PRIMARY_LIST:
- if (in_area(EXPAND_POINTER(val), mod_start, mod_size)) {
+ if (ErtsInArea(val, mod_start, mod_size)) {
return 1;
}
break;
@@ -943,7 +1014,7 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
if (header_is_bin_matchstate(val)) {
ErlBinMatchState *ms = (ErlBinMatchState*) p;
ErlBinMatchBuffer *mb = &(ms->mb);
- if (in_area(EXPAND_POINTER(mb->orig), mod_start, mod_size)) {
+ if (ErtsInArea(mb->orig, mod_start, mod_size)) {
return 1;
}
}
@@ -958,7 +1029,104 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
#undef in_area
-BIF_RETTYPE purge_module_1(BIF_ALIST_1)
+#ifdef ERTS_SMP
+static void copy_literals_commit(void*);
+#endif
+
+copy_literals_t erts_clrange = {NULL, 0, THE_NON_VALUE};
+
+/* copy literals
+ *
+ * copy_literals.ptr = LitPtr
+ * copy_literals.sz = LitSz
+ * ------ THR PROG COMMIT -----
+ *
+ * - check process code
+ * - check process code
+ * ...
+ * copy_literals.ptr = NULL
+ * copy_literals.sz = 0
+ * ------ THR PROG COMMIT -----
+ * ...
+ */
+
+
+BIF_RETTYPE erts_internal_copy_literals_2(BIF_ALIST_2)
+{
+ ErtsCodeIndex code_ix;
+ Eterm res = am_true;
+
+ if (is_not_atom(BIF_ARG_1) || (am_true != BIF_ARG_2 && am_false != BIF_ARG_2)) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+
+ if (!erts_try_seize_code_write_permission(BIF_P)) {
+ ERTS_BIF_YIELD2(bif_export[BIF_erts_internal_copy_literals_2],
+ BIF_P, BIF_ARG_1, BIF_ARG_2);
+ }
+
+ code_ix = erts_active_code_ix();
+
+ if (BIF_ARG_2 == am_true) {
+ Module* modp = erts_get_module(BIF_ARG_1, code_ix);
+ if (!modp || !modp->old.code_hdr) {
+ res = am_false;
+ goto done;
+ }
+ if (erts_clrange.ptr != NULL
+ && !(BIF_P->static_flags & ERTS_STC_FLG_SYSTEM_PROC)) {
+ res = am_aborted;
+ goto done;
+ }
+ erts_clrange.ptr = modp->old.code_hdr->literals_start;
+ erts_clrange.sz = modp->old.code_hdr->literals_end - erts_clrange.ptr;
+ erts_clrange.pid = BIF_P->common.id;
+ } else if (BIF_ARG_2 == am_false) {
+ if (erts_clrange.pid != BIF_P->common.id) {
+ res = am_false;
+ goto done;
+ }
+ erts_clrange.ptr = NULL;
+ erts_clrange.sz = 0;
+ erts_clrange.pid = THE_NON_VALUE;
+ }
+
+#ifdef ERTS_SMP
+ ASSERT(committer_state.stager == NULL);
+ committer_state.stager = BIF_P;
+ erts_schedule_thr_prgr_later_op(copy_literals_commit, NULL, &committer_state.lop);
+ erts_proc_inc_refc(BIF_P);
+ erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
+ ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+#endif
+done:
+ erts_release_code_write_permission();
+ BIF_RET(res);
+}
+
+#ifdef ERTS_SMP
+static void copy_literals_commit(void* null) {
+ Process* p = committer_state.stager;
+#ifdef DEBUG
+ committer_state.stager = NULL;
+#endif
+ erts_release_code_write_permission();
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ if (!ERTS_PROC_IS_EXITING(p)) {
+ erts_resume(p, ERTS_PROC_LOCK_STATUS);
+ }
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_dec_refc(p);
+}
+#endif /* ERTS_SMP */
+
+
+/* Do the actualy module purging and return:
+ * true for success
+ * false if no such old module
+ * BADARG if not an atom
+ */
+BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
{
ErtsCodeIndex code_ix;
BeamInstr* code;
@@ -972,7 +1140,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
}
if (!erts_try_seize_code_write_permission(BIF_P)) {
- ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1);
+ ERTS_BIF_YIELD1(bif_export[BIF_erts_internal_purge_module_1],
+ BIF_P, BIF_ARG_1);
}
code_ix = erts_active_code_ix();
@@ -982,7 +1151,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
*/
if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ ERTS_BIF_PREP_RET(ret, am_false);
}
else {
erts_rwlock_old_code(code_ix);
@@ -990,8 +1159,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
/*
* Any code to purge?
*/
- if (modp->old.code == 0) {
- ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+ if (!modp->old.code_hdr) {
+ ERTS_BIF_PREP_RET(ret, am_false);
}
else {
/*
@@ -1013,14 +1182,17 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
*/
ASSERT(erts_total_code_size >= modp->old.code_length);
erts_total_code_size -= modp->old.code_length;
- code = modp->old.code;
+ code = (BeamInstr*) modp->old.code_hdr;
end = (BeamInstr *)((char *)code + modp->old.code_length);
erts_cleanup_funs_on_purge(code, end);
beam_catches_delmod(modp->old.catches, code, modp->old.code_length,
code_ix);
- decrement_refc(code);
+ decrement_refc(modp->old.code_hdr);
+ if (modp->old.code_hdr->literals_start) {
+ erts_free(ERTS_ALC_T_LITERAL, modp->old.code_hdr->literals_start);
+ }
erts_free(ERTS_ALC_T_CODE, (void *) code);
- modp->old.code = NULL;
+ modp->old.code_hdr = NULL;
modp->old.code_length = 0;
modp->old.catches = BEAM_CATCHES_NIL;
erts_remove_from_ranges(code);
@@ -1037,10 +1209,9 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
}
static void
-decrement_refc(BeamInstr* code)
+decrement_refc(BeamCodeHeader* code_hdr)
{
- struct erl_off_heap_header* oh =
- (struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP];
+ struct erl_off_heap_header* oh = code_hdr->literals_off_heap;
while (oh) {
Binary* bptr;
@@ -1089,7 +1260,7 @@ delete_code(Module* modp)
ASSERT(modp->curr.num_breakpoints == 0);
ASSERT(modp->curr.num_traced_exports == 0);
modp->old = modp->curr;
- modp->curr.code = NULL;
+ modp->curr.code_hdr = NULL;
modp->curr.code_length = 0;
modp->curr.catches = BEAM_CATCHES_NIL;
modp->curr.nif = NULL;
@@ -1106,9 +1277,9 @@ beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module)
* if not, delete old code; error if old code already exists.
*/
- if (modp->curr.code != NULL && modp->old.code != NULL) {
+ if (modp->curr.code_hdr && modp->old.code_hdr) {
return am_not_purged;
- } else if (modp->old.code == NULL) { /* Make the current version old. */
+ } else if (!modp->old.code_hdr) { /* Make the current version old. */
delete_code(modp);
}
return NIL;
diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c
index 016d0aaa32..5d471d168b 100644
--- a/erts/emulator/beam/beam_bp.c
+++ b/erts/emulator/beam/beam_bp.c
@@ -75,6 +75,16 @@ extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */
erts_smp_atomic32_t erts_active_bp_index;
erts_smp_atomic32_t erts_staging_bp_index;
+/*
+ * Inlined helpers
+ */
+
+static ERTS_INLINE ErtsMonotonicTime
+get_mtime(Process *c_p)
+{
+ return erts_get_monotonic_time(ERTS_PROC_GET_SCHDATA(c_p));
+}
+
/* *************************************************************************
** Local prototypes
*/
@@ -97,9 +107,6 @@ static int clear_function_break(BeamInstr *pc, Uint break_flags);
static BpDataTime* get_time_break(BeamInstr *pc);
static GenericBpData* check_break(BeamInstr *pc, Uint break_flags);
-static void bp_time_diff(bp_data_time_item_t *item,
- process_breakpoint_time_t *pbt,
- Uint ms, Uint s, Uint us);
static void bp_meta_unref(BpMetaPid* bmp);
static void bp_count_unref(BpCount* bcp);
@@ -110,13 +117,8 @@ static void uninstall_breakpoint(BeamInstr* pc);
/* bp_hash */
#define BP_TIME_ADD(pi0, pi1) \
do { \
- Uint r; \
(pi0)->count += (pi1)->count; \
- (pi0)->s_time += (pi1)->s_time; \
- (pi0)->us_time += (pi1)->us_time; \
- r = (pi0)->us_time / 1000000; \
- (pi0)->s_time += r; \
- (pi0)->us_time = (pi0)->us_time % 1000000; \
+ (pi0)->time += (pi1)->time; \
} while(0)
static void bp_hash_init(bp_time_hash_t *hash, Uint n);
@@ -152,8 +154,8 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
num_modules = 0;
for (current = 0; current < max_modules; current++) {
modp = module_code(current, code_ix);
- if (modp->curr.code) {
- max_funcs += modp->curr.code[MI_NUM_FUNCTIONS];
+ if (modp->curr.code_hdr) {
+ max_funcs += modp->curr.code_hdr->num_functions;
module[num_modules++] = modp;
}
}
@@ -161,9 +163,9 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
f->matching = (BpFunction *) Alloc(max_funcs*sizeof(BpFunction));
i = 0;
for (current = 0; current < num_modules; current++) {
- BeamInstr** code_base = (BeamInstr **) module[current]->curr.code;
+ BeamCodeHeader* code_hdr = module[current]->curr.code_hdr;
BeamInstr* code;
- Uint num_functions = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS];
+ Uint num_functions = (Uint)(UWord) code_hdr->num_functions;
Uint fi;
if (specified > 0) {
@@ -177,7 +179,7 @@ erts_bp_match_functions(BpFunctions* f, Eterm mfa[3], int specified)
BeamInstr* pc;
int wi;
- code = code_base[MI_FUNCTIONS+fi];
+ code = code_hdr->functions[fi];
ASSERT(code[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
pc = code+5;
if (erts_is_native_break(pc)) {
@@ -547,21 +549,21 @@ erts_clear_all_breaks(BpFunctions* f)
int
erts_clear_module_break(Module *modp) {
- BeamInstr** code_base;
+ BeamCodeHeader* code_hdr;
Uint n;
Uint i;
ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking());
ASSERT(modp);
- code_base = (BeamInstr **) modp->curr.code;
- if (code_base == NULL) {
+ code_hdr = modp->curr.code_hdr;
+ if (!code_hdr) {
return 0;
}
- n = (Uint)(UWord) code_base[MI_NUM_FUNCTIONS];
+ n = (Uint)(UWord) code_hdr->num_functions;
for (i = 0; i < n; ++i) {
BeamInstr* pc;
- pc = code_base[MI_FUNCTIONS+i] + 5;
+ pc = code_hdr->functions[i] + 5;
if (erts_is_native_break(pc)) {
continue;
}
@@ -573,7 +575,7 @@ erts_clear_module_break(Module *modp) {
for (i = 0; i < n; ++i) {
BeamInstr* pc;
- pc = code_base[MI_FUNCTIONS+i] + 5;
+ pc = code_hdr->functions[i] + 5;
if (erts_is_native_break(pc)) {
continue;
}
@@ -862,7 +864,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg,
Eterm* cpp;
int return_to_trace = 0;
BeamInstr w;
- BeamInstr *cp_save;
+ BeamInstr *cp_save = c_p->cp;
Uint32 flags;
Uint need = 0;
Eterm* E = c_p->stop;
@@ -948,7 +950,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg,
void
erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
{
- Uint ms,s,us;
+ ErtsMonotonicTime time;
process_breakpoint_time_t *pbt = NULL;
bp_data_time_item_t sitem, *item = NULL;
bp_time_hash_t *h = NULL;
@@ -961,7 +963,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
* from the process psd */
pbt = ERTS_PROC_GET_CALL_TIME(c_p);
- get_sys_now(&ms, &s, &us);
+ time = get_mtime(c_p);
/* get pbt
* timestamp = t0
@@ -976,7 +978,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
} else {
ASSERT(pbt->pc);
/* add time to previous code */
- bp_time_diff(&sitem, pbt, ms, s, us);
+ sitem.time = time - pbt->time;
sitem.pid = c_p->common.id;
sitem.count = 0;
@@ -1002,8 +1004,7 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
/* Add count to this code */
sitem.pid = c_p->common.id;
sitem.count = 1;
- sitem.s_time = 0;
- sitem.us_time = 0;
+ sitem.time = 0;
/* this breakpoint */
ASSERT(bdt);
@@ -1020,15 +1021,13 @@ erts_trace_time_call(Process* c_p, BeamInstr* I, BpDataTime* bdt)
}
pbt->pc = I;
- pbt->ms = ms;
- pbt->s = s;
- pbt->us = us;
+ pbt->time = time;
}
void
erts_trace_time_return(Process *p, BeamInstr *pc)
{
- Uint ms,s,us;
+ ErtsMonotonicTime time;
process_breakpoint_time_t *pbt = NULL;
bp_data_time_item_t sitem, *item = NULL;
bp_time_hash_t *h = NULL;
@@ -1041,7 +1040,7 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
* from the process psd */
pbt = ERTS_PROC_GET_CALL_TIME(p);
- get_sys_now(&ms,&s,&us);
+ time = get_mtime(p);
/* get pbt
* lookup bdt from code
@@ -1057,7 +1056,7 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
*/
ASSERT(pbt->pc);
- bp_time_diff(&sitem, pbt, ms, s, us);
+ sitem.time = time - pbt->time;
sitem.pid = p->common.id;
sitem.count = 0;
@@ -1080,9 +1079,7 @@ erts_trace_time_return(Process *p, BeamInstr *pc)
}
pbt->pc = pc;
- pbt->ms = ms;
- pbt->s = s;
- pbt->us = us;
+ pbt->time = time;
}
}
@@ -1183,10 +1180,14 @@ int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) {
for(ix = 0; ix < hash.n; ix++) {
item = &(hash.item[ix]);
if (item->pid != NIL) {
+ ErtsMonotonicTime sec, usec;
+ usec = ERTS_MONOTONIC_TO_USEC(item->time);
+ sec = usec / 1000000;
+ usec = usec - sec*1000000;
t = TUPLE4(hp, item->pid,
make_small(item->count),
- make_small(item->s_time),
- make_small(item->us_time));
+ make_small((Uint) sec),
+ make_small((Uint) usec));
hp += 5;
*retval = CONS(hp, t, *retval); hp += 2;
}
@@ -1204,17 +1205,17 @@ int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *retval) {
BeamInstr *
erts_find_local_func(Eterm mfa[3]) {
Module *modp;
- BeamInstr** code_base;
+ BeamCodeHeader* code_hdr;
BeamInstr* code_ptr;
Uint i,n;
if ((modp = erts_get_module(mfa[0], erts_active_code_ix())) == NULL)
return NULL;
- if ((code_base = (BeamInstr **) modp->curr.code) == NULL)
+ if ((code_hdr = modp->curr.code_hdr) == NULL)
return NULL;
- n = (BeamInstr) code_base[MI_NUM_FUNCTIONS];
+ n = (BeamInstr) code_hdr->num_functions;
for (i = 0; i < n; ++i) {
- code_ptr = code_base[MI_FUNCTIONS+i];
+ code_ptr = code_hdr->functions[i];
ASSERT(((BeamInstr) BeamOp(op_i_func_info_IaaI)) == code_ptr[0]);
ASSERT(mfa[0] == ((Eterm) code_ptr[2]) ||
is_nil((Eterm) code_ptr[2]));
@@ -1266,8 +1267,7 @@ static void bp_hash_rehash(bp_time_hash_t *hash, Uint n) {
}
item[hval].pid = hash->item[ix].pid;
item[hval].count = hash->item[ix].count;
- item[hval].s_time = hash->item[ix].s_time;
- item[hval].us_time = hash->item[ix].us_time;
+ item[hval].time = hash->item[ix].time;
}
}
@@ -1315,8 +1315,7 @@ static ERTS_INLINE bp_data_time_item_t * bp_hash_put(bp_time_hash_t *hash, bp_da
item = &(hash->item[hval]);
item->pid = sitem->pid;
- item->s_time = sitem->s_time;
- item->us_time = sitem->us_time;
+ item->time = sitem->time;
item->count = sitem->count;
hash->used++;
@@ -1330,41 +1329,7 @@ static void bp_hash_delete(bp_time_hash_t *hash) {
hash->item = NULL;
}
-static void bp_time_diff(bp_data_time_item_t *item, /* out */
- process_breakpoint_time_t *pbt, /* in */
- Uint ms, Uint s, Uint us) {
- int ds,dus;
-#ifdef DEBUG
- int dms;
-
-
- dms = ms - pbt->ms;
-#endif
- ds = s - pbt->s;
- dus = us - pbt->us;
-
- /* get_sys_now may return zero difftime,
- * this is ok.
- */
-
-#ifdef DEBUG
- ASSERT(dms >= 0 || ds >= 0 || dus >= 0);
-#endif
-
- if (dus < 0) {
- dus += 1000000;
- ds -= 1;
- }
- if (ds < 0) {
- ds += 1000000;
- }
-
- item->s_time = ds;
- item->us_time = dus;
-}
-
void erts_schedule_time_break(Process *p, Uint schedule) {
- Uint ms, s, us;
process_breakpoint_time_t *pbt = NULL;
bp_data_time_item_t sitem, *item = NULL;
bp_time_hash_t *h = NULL;
@@ -1387,8 +1352,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) {
pbdt = get_time_break(pbt->pc);
if (pbdt) {
- get_sys_now(&ms,&s,&us);
- bp_time_diff(&sitem, pbt, ms, s, us);
+ sitem.time = get_mtime(p) - pbt->time;
sitem.pid = p->common.id;
sitem.count = 0;
@@ -1410,10 +1374,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) {
* timestamp it and remove the previous
* timestamp in the psd.
*/
- get_sys_now(&ms,&s,&us);
- pbt->ms = ms;
- pbt->s = s;
- pbt->us = us;
+ pbt->time = get_mtime(p);
break;
default :
ASSERT(0);
diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h
index 97d0539ac7..2b89d6fc71 100644
--- a/erts/emulator/beam/beam_bp.h
+++ b/erts/emulator/beam/beam_bp.h
@@ -29,8 +29,7 @@
typedef struct {
Eterm pid;
Sint count;
- Uint s_time;
- Uint us_time;
+ ErtsMonotonicTime time;
} bp_data_time_item_t;
typedef struct {
@@ -46,9 +45,7 @@ typedef struct bp_data_time { /* Call time */
} BpDataTime;
typedef struct {
- Uint ms;
- Uint s;
- Uint us;
+ ErtsMonotonicTime time;
BeamInstr *pc;
} process_breakpoint_time_t; /* used within psd */
diff --git a/erts/emulator/beam/beam_catches.c b/erts/emulator/beam/beam_catches.c
index c1fd17c65d..7a1f4901aa 100644
--- a/erts/emulator/beam/beam_catches.c
+++ b/erts/emulator/beam/beam_catches.c
@@ -143,7 +143,7 @@ BeamInstr *beam_catches_car(unsigned i)
struct bc_pool* p = &bccix[erts_active_code_ix()];
if (i >= p->tabsize ) {
- erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i);
+ erts_exit(ERTS_ERROR_EXIT, "beam_catches_delmod: index %#x is out of range\r\n", i);
}
return p->beam_catches[i].cp;
}
@@ -157,10 +157,10 @@ void beam_catches_delmod(unsigned head, BeamInstr *code, unsigned code_bytes,
ASSERT((code_ix == erts_active_code_ix()) != bccix[erts_staging_code_ix()].is_staging);
for(i = head; i != (unsigned)-1;) {
if (i >= p->tabsize) {
- erl_exit(1, "beam_catches_delmod: index %#x is out of range\r\n", i);
+ erts_exit(ERTS_ERROR_EXIT, "beam_catches_delmod: index %#x is out of range\r\n", i);
}
if( (char*)p->beam_catches[i].cp - (char*)code >= code_bytes ) {
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"beam_catches_delmod: item %#x has cp %p which is not "
"in module's range [%p,%p[\r\n",
i, p->beam_catches[i].cp, code, ((char*)code + code_bytes));
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 90985e4f53..e37bd4d78c 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -73,6 +73,40 @@ erts_debug_flat_size_1(BIF_ALIST_1)
}
}
+BIF_RETTYPE
+erts_debug_size_shared_1(BIF_ALIST_1)
+{
+ Process* p = BIF_P;
+ Eterm term = BIF_ARG_1;
+ Uint size = size_shared(term);
+
+ if (IS_USMALL(0, size)) {
+ BIF_RET(make_small(size));
+ } else {
+ Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE);
+ BIF_RET(uint_to_big(size, hp));
+ }
+}
+
+BIF_RETTYPE
+erts_debug_copy_shared_1(BIF_ALIST_1)
+{
+ Process* p = BIF_P;
+ Eterm term = BIF_ARG_1;
+ Uint size;
+ Eterm* hp;
+ Eterm copy;
+ erts_shcopy_t info;
+ INITIALIZE_SHCOPY(info);
+
+ size = copy_shared_calculate(term, &info);
+ if (size > 0) {
+ hp = HAlloc(p, size);
+ }
+ copy = copy_shared_perform(term, size, &info, &hp, &p->off_heap);
+ DESTROY_SHCOPY(info);
+ BIF_RET(copy);
+}
BIF_RETTYPE
erts_debug_breakpoint_2(BIF_ALIST_2)
@@ -208,7 +242,7 @@ erts_debug_disassemble_1(BIF_ALIST_1)
Eterm bin;
Eterm mfa;
BeamInstr* funcinfo = NULL; /* Initialized to eliminate warning. */
- BeamInstr* code_base;
+ BeamCodeHeader* code_hdr;
BeamInstr* code_ptr = NULL; /* Initialized to eliminate warning. */
BeamInstr instr;
BeamInstr uaddr;
@@ -258,12 +292,12 @@ erts_debug_disassemble_1(BIF_ALIST_1)
*/
code_ptr = ((BeamInstr *) ep->addressv[code_ix]) - 5;
funcinfo = code_ptr+2;
- } else if (modp == NULL || (code_base = modp->curr.code) == NULL) {
+ } else if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL) {
BIF_RET(am_undef);
} else {
- n = code_base[MI_NUM_FUNCTIONS];
+ n = code_hdr->num_functions;
for (i = 0; i < n; i++) {
- code_ptr = (BeamInstr *) code_base[MI_FUNCTIONS+i];
+ code_ptr = code_hdr->functions[i];
if (code_ptr[3] == name && code_ptr[4] == arity) {
funcinfo = code_ptr+2;
break;
@@ -432,39 +466,33 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
while (*sign) {
switch (*sign) {
case 'r': /* x(0) */
- erts_print(to, to_arg, "x(0)");
+ erts_print(to, to_arg, "r(0)");
break;
case 'x': /* x(N) */
- if (reg_index(ap[0]) == 0) {
- erts_print(to, to_arg, "x[0]");
- } else {
- erts_print(to, to_arg, "x(%d)", reg_index(ap[0]));
+ {
+ Uint n = ap[0] / sizeof(Eterm);
+ erts_print(to, to_arg, "x(%d)", n);
+ ap++;
}
- ap++;
break;
case 'y': /* y(N) */
- erts_print(to, to_arg, "y(%d)", reg_index(ap[0]) - CP_SIZE);
- ap++;
+ {
+ Uint n = ap[0] / sizeof(Eterm) - CP_SIZE;
+ erts_print(to, to_arg, "y(%d)", n);
+ ap++;
+ }
break;
case 'n': /* Nil */
erts_print(to, to_arg, "[]");
break;
case 's': /* Any source (tagged constant or register) */
- tag = beam_reg_tag(*ap);
- if (tag == X_REG_DEF) {
- if (reg_index(*ap) == 0) {
- erts_print(to, to_arg, "x[0]");
- } else {
- erts_print(to, to_arg, "x(%d)", reg_index(*ap));
- }
- ap++;
- break;
- } else if (tag == Y_REG_DEF) {
- erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE);
+ tag = loader_tag(*ap);
+ if (tag == LOADER_X_REG) {
+ erts_print(to, to_arg, "x(%d)", loader_x_reg_index(*ap));
ap++;
break;
- } else if (tag == R_REG_DEF) {
- erts_print(to, to_arg, "x(0)");
+ } else if (tag == LOADER_Y_REG) {
+ erts_print(to, to_arg, "y(%d)", loader_y_reg_index(*ap) - CP_SIZE);
ap++;
break;
}
@@ -481,20 +509,12 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
ap++;
break;
case 'd': /* Destination (x(0), x(N), y(N)) */
- switch (beam_reg_tag(*ap)) {
- case X_REG_DEF:
- if (reg_index(*ap) == 0) {
- erts_print(to, to_arg, "x[0]");
- } else {
- erts_print(to, to_arg, "x(%d)", reg_index(*ap));
- }
- break;
- case Y_REG_DEF:
- erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE);
- break;
- case R_REG_DEF:
- erts_print(to, to_arg, "x(0)");
- break;
+ if (*ap & 1) {
+ erts_print(to, to_arg, "y(%d)",
+ *ap / sizeof(Eterm) - CP_SIZE);
+ } else {
+ erts_print(to, to_arg, "x(%d)",
+ *ap / sizeof(Eterm));
}
ap++;
break;
@@ -561,7 +581,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
ap++;
break;
case 'l': /* fr(N) */
- erts_print(to, to_arg, "fr(%d)", reg_index(ap[0]));
+ erts_print(to, to_arg, "fr(%d)", loader_reg_index(ap[0]));
ap++;
break;
default:
@@ -580,7 +600,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
unpacked = ap;
ap = addr + size;
switch (op) {
- case op_i_select_val_lins_rfI:
case op_i_select_val_lins_xfI:
case op_i_select_val_lins_yfI:
{
@@ -600,7 +619,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_select_val_bins_rfI:
case op_i_select_val_bins_xfI:
case op_i_select_val_bins_yfI:
{
@@ -614,7 +632,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_select_tuple_arity_rfI:
case op_i_select_tuple_arity_xfI:
case op_i_select_tuple_arity_yfI:
{
@@ -639,7 +656,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_jump_on_val_rfII:
case op_i_jump_on_val_xfII:
case op_i_jump_on_val_yfII:
{
@@ -651,7 +667,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_jump_on_val_zero_rfI:
case op_i_jump_on_val_zero_xfI:
case op_i_jump_on_val_zero_yfI:
{
@@ -663,7 +678,6 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
}
}
break;
- case op_i_put_tuple_rI:
case op_i_put_tuple_xI:
case op_i_put_tuple_yI:
case op_new_map_dII:
@@ -673,20 +687,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
int n = unpacked[-1];
while (n > 0) {
- if (!is_header(ap[0])) {
+ switch (loader_tag(ap[0])) {
+ case LOADER_X_REG:
+ erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0]));
+ break;
+ case LOADER_Y_REG:
+ erts_print(to, to_arg, " x(%d)", loader_y_reg_index(ap[0]));
+ break;
+ default:
erts_print(to, to_arg, " %T", (Eterm) ap[0]);
- } else {
- switch ((ap[0] >> 2) & 0x03) {
- case R_REG_DEF:
- erts_print(to, to_arg, " x(0)");
- break;
- case X_REG_DEF:
- erts_print(to, to_arg, " x(%d)", ap[0] >> 4);
- break;
- case Y_REG_DEF:
- erts_print(to, to_arg, " y(%d)", ap[0] >> 4);
- break;
- }
+ break;
}
ap++, size++, n--;
}
@@ -699,18 +709,16 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
while (n > 0) {
if (n % 3 == 1) {
erts_print(to, to_arg, " %X", ap[0]);
- } else if (!is_header(ap[0])) {
- erts_print(to, to_arg, " %T", (Eterm) ap[0]);
} else {
- switch ((ap[0] >> 2) & 0x03) {
- case R_REG_DEF:
- erts_print(to, to_arg, " x(0)");
+ switch (loader_tag(ap[0])) {
+ case LOADER_X_REG:
+ erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0]));
break;
- case X_REG_DEF:
- erts_print(to, to_arg, " x(%d)", ap[0] >> 4);
+ case LOADER_Y_REG:
+ erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]));
break;
- case Y_REG_DEF:
- erts_print(to, to_arg, " y(%d)", ap[0] >> 4);
+ default:
+ erts_print(to, to_arg, " %T", (Eterm) ap[0]);
break;
}
}
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 38def5d89f..a390422040 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -99,10 +99,7 @@ do { \
do { \
int i_; \
int Arity_ = PC[-1]; \
- if (Arity_ > 0) { \
- CHECK_TERM(r(0)); \
- } \
- for (i_ = 1; i_ < Arity_; i_++) { \
+ for (i_ = 0; i_ < Arity_; i_++) { \
CHECK_TERM(x(i_)); \
} \
} while (0)
@@ -116,6 +113,9 @@ do { \
#define MAX(x, y) (((x) > (y)) ? (x) : (y))
#endif
+#define GET_BIF_MODULE(p) ((Eterm) (((Export *) p)->code[0]))
+#define GET_BIF_FUNCTION(p) ((Eterm) (((Export *) p)->code[1]))
+#define GET_BIF_ARITY(p) ((Eterm) (((Export *) p)->code[2]))
#define GET_BIF_ADDRESS(p) ((BifFunction) (((Export *) p)->code[4]))
#define TermWords(t) (((t) / (sizeof(BeamInstr)/sizeof(Eterm))) + !!((t) % (sizeof(BeamInstr)/sizeof(Eterm))))
@@ -151,25 +151,21 @@ do { \
ASSERT(VALID_INSTR(* (Eterm *)(ip))); \
I = (ip)
-#define FetchArgs(S1, S2) tmp_arg1 = (S1); tmp_arg2 = (S2)
+/*
+ * Register target (X or Y register).
+ */
+#define REG_TARGET(Target) (*(((Target) & 1) ? &yb(Target-1) : &xb(Target)))
/*
* Store a result into a register given a destination descriptor.
*/
-#define StoreResult(Result, DestDesc) \
- do { \
- Eterm stb_reg; \
- stb_reg = (DestDesc); \
- CHECK_TERM(Result); \
- switch (beam_reg_tag(stb_reg)) { \
- case R_REG_DEF: \
- r(0) = (Result); break; \
- case X_REG_DEF: \
- xb(x_reg_offset(stb_reg)) = (Result); break; \
- default: \
- yb(y_reg_offset(stb_reg)) = (Result); break; \
- } \
+#define StoreResult(Result, DestDesc) \
+ do { \
+ Eterm stb_reg; \
+ stb_reg = (DestDesc); \
+ CHECK_TERM(Result); \
+ REG_TARGET(stb_reg) = (Result); \
} while (0)
#define StoreSimpleDest(Src, Dest) Dest = (Src)
@@ -180,22 +176,16 @@ do { \
* be just before the next instruction.
*/
-#define StoreBifResult(Dst, Result) \
- do { \
- BeamInstr* stb_next; \
- Eterm stb_reg; \
- stb_reg = Arg(Dst); \
- I += (Dst) + 2; \
- stb_next = (BeamInstr *) *I; \
- CHECK_TERM(Result); \
- switch (beam_reg_tag(stb_reg)) { \
- case R_REG_DEF: \
- r(0) = (Result); Goto(stb_next); \
- case X_REG_DEF: \
- xb(x_reg_offset(stb_reg)) = (Result); Goto(stb_next); \
- default: \
- yb(y_reg_offset(stb_reg)) = (Result); Goto(stb_next); \
- } \
+#define StoreBifResult(Dst, Result) \
+ do { \
+ BeamInstr* stb_next; \
+ Eterm stb_reg; \
+ stb_reg = Arg(Dst); \
+ I += (Dst) + 2; \
+ stb_next = (BeamInstr *) *I; \
+ CHECK_TERM(Result); \
+ REG_TARGET(stb_reg) = (Result); \
+ Goto(stb_next); \
} while (0)
#define ClauseFail() goto jump_f
@@ -250,6 +240,14 @@ void** beam_ops;
HEAP_TOP(c_p) = HTOP; \
c_p->stop = E
+#define HEAVY_SWAPIN \
+ SWAPIN; \
+ FCALLS = c_p->fcalls
+
+#define HEAVY_SWAPOUT \
+ SWAPOUT; \
+ c_p->fcalls = FCALLS
+
/*
* Use LIGHT_SWAPOUT when the called function
* will call HeapOnlyAlloc() (and never HAlloc()).
@@ -293,7 +291,7 @@ void** beam_ops;
#define Ib(N) (N)
#define x(N) reg[N]
#define y(N) E[N]
-#define r(N) x##N
+#define r(N) x(N)
/*
* Makes sure that there are StackNeed + HeapNeed + 1 words available
@@ -309,12 +307,10 @@ void** beam_ops;
needed = (StackNeed) + 1; \
if (E - HTOP < (needed + (HeapNeed))) { \
SWAPOUT; \
- reg[0] = r(0); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \
+ FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), reg, (M)); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
E -= needed; \
@@ -363,12 +359,10 @@ void** beam_ops;
unsigned need = (Nh); \
if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\
SWAPOUT; \
- reg[0] = r(0); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
HEAP_SPACE_VERIFIED(need); \
@@ -386,12 +380,10 @@ void** beam_ops;
unsigned need = (Nh); \
if (E - HTOP < need) { \
SWAPOUT; \
- reg[0] = r(0); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live));\
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- r(0) = reg[0]; \
SWAPIN; \
} \
HEAP_SPACE_VERIFIED(need); \
@@ -408,15 +400,11 @@ void** beam_ops;
unsigned need = (Nh); \
if (E - HTOP < need) { \
SWAPOUT; \
- reg[0] = r(0); \
reg[Live] = Extra; \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)+1); \
+ FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1); \
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \
PROCESS_MAIN_CHK_LOCKS(c_p); \
- if (Live > 0) { \
- r(0) = reg[0]; \
- } \
Extra = reg[Live]; \
SWAPIN; \
} \
@@ -438,10 +426,9 @@ void** beam_ops;
#define MakeFun(FunP, NumFree) \
do { \
- SWAPOUT; \
- reg[0] = r(0); \
+ HEAVY_SWAPOUT; \
r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \
- SWAPIN; \
+ HEAVY_SWAPIN; \
} while (0)
#define PutTuple(Dst, Arity) \
@@ -531,15 +518,19 @@ void** beam_ops;
ASSERT(VALID_INSTR(Dst)); \
Goto(Dst)
-#define GetR(pos, tr) \
- do { \
- tr = Arg(pos); \
- switch (beam_reg_tag(tr)) { \
- case R_REG_DEF: tr = r(0); break; \
- case X_REG_DEF: tr = xb(x_reg_offset(tr)); break; \
- case Y_REG_DEF: ASSERT(y_reg_offset(tr) >= 1); tr = yb(y_reg_offset(tr)); break; \
- } \
- CHECK_TERM(tr); \
+#define GetR(pos, tr) \
+ do { \
+ tr = Arg(pos); \
+ switch (loader_tag(tr)) { \
+ case LOADER_X_REG: \
+ tr = x(loader_x_reg_index(tr)); \
+ break; \
+ case LOADER_Y_REG: \
+ ASSERT(loader_y_reg_index(tr) >= 1); \
+ tr = y(loader_y_reg_index(tr)); \
+ break; \
+ } \
+ CHECK_TERM(tr); \
} while (0)
#define GetArg1(N, Dst) GetR((N), Dst)
@@ -557,24 +548,93 @@ void** beam_ops;
HTOP += 2; \
} while (0)
+#define Swap(R1, R2) \
+ do { \
+ Eterm V = R1; \
+ R1 = R2; \
+ R2 = V; \
+ } while (0)
+
+#define SwapTemp(R1, R2, Tmp) \
+ do { \
+ Eterm V = R1; \
+ R1 = R2; \
+ R2 = Tmp = V; \
+ } while (0)
+
#define Move(Src, Dst, Store) \
do { \
Eterm term = (Src); \
Store(term, Dst); \
} while (0)
-#define Move2(S1, D1, S2, D2) D1 = (S1); D2 = (S2)
+#define Move2Par(S1, D1, S2, D2) \
+ do { \
+ Eterm V1, V2; \
+ V1 = (S1); V2 = (S2); D1 = V1; D2 = V2; \
+ } while (0)
+
+#define MoveShift(Src, SD, D) \
+ do { \
+ Eterm V; \
+ V = Src; D = SD; SD = V; \
+ } while (0)
+
+#define MoveDup(Src, D1, D2) \
+ do { \
+ D1 = D2 = (Src); \
+ } while (0)
+
#define Move3(S1, D1, S2, D2, S3, D3) D1 = (S1); D2 = (S2); D3 = (S3)
-#define MoveGenDest(src, dstp) \
- if ((dstp) == NULL) { r(0) = (src); } else { *(dstp) = src; }
+#define MoveWindow3(S1, S2, S3, D) \
+ do { \
+ Eterm xt0, xt1, xt2; \
+ Eterm *y = &D; \
+ xt0 = S1; \
+ xt1 = S2; \
+ xt2 = S3; \
+ y[0] = xt0; \
+ y[1] = xt1; \
+ y[2] = xt2; \
+ } while (0)
+
+#define MoveWindow4(S1, S2, S3, S4, D) \
+ do { \
+ Eterm xt0, xt1, xt2, xt3; \
+ Eterm *y = &D; \
+ xt0 = S1; \
+ xt1 = S2; \
+ xt2 = S3; \
+ xt3 = S4; \
+ y[0] = xt0; \
+ y[1] = xt1; \
+ y[2] = xt2; \
+ y[3] = xt3; \
+ } while (0)
+
+#define MoveWindow5(S1, S2, S3, S4, S5, D) \
+ do { \
+ Eterm xt0, xt1, xt2, xt3, xt4; \
+ Eterm *y = &D; \
+ xt0 = S1; \
+ xt1 = S2; \
+ xt2 = S3; \
+ xt3 = S4; \
+ xt4 = S5; \
+ y[0] = xt0; \
+ y[1] = xt1; \
+ y[2] = xt2; \
+ y[3] = xt3; \
+ y[4] = xt4; \
+ } while (0)
-#define MoveReturn(Src, Dest) \
- (Dest) = (Src); \
- I = c_p->cp; \
- ASSERT(VALID_INSTR(*c_p->cp)); \
- c_p->cp = 0; \
- CHECK_TERM(r(0)); \
+#define MoveReturn(Src) \
+ x(0) = (Src); \
+ I = c_p->cp; \
+ ASSERT(VALID_INSTR(*c_p->cp)); \
+ c_p->cp = 0; \
+ CHECK_TERM(r(0)); \
Goto(*I)
#define DeallocateReturn(Deallocate) \
@@ -586,26 +646,26 @@ void** beam_ops;
Goto(*I); \
} while (0)
-#define MoveDeallocateReturn(Src, Dest, Deallocate) \
- (Dest) = (Src); \
+#define MoveDeallocateReturn(Src, Deallocate) \
+ x(0) = (Src); \
DeallocateReturn(Deallocate)
-#define MoveCall(Src, Dest, CallDest, Size) \
- (Dest) = (Src); \
+#define MoveCall(Src, CallDest, Size) \
+ x(0) = (Src); \
SET_CP(c_p, I+Size+1); \
- SET_I((BeamInstr *) CallDest); \
+ SET_I((BeamInstr *) CallDest); \
Dispatch();
-#define MoveCallLast(Src, Dest, CallDest, Deallocate) \
- (Dest) = (Src); \
- RESTORE_CP(E); \
- E = ADD_BYTE_OFFSET(E, (Deallocate)); \
- SET_I((BeamInstr *) CallDest); \
+#define MoveCallLast(Src, CallDest, Deallocate) \
+ x(0) = (Src); \
+ RESTORE_CP(E); \
+ E = ADD_BYTE_OFFSET(E, (Deallocate)); \
+ SET_I((BeamInstr *) CallDest); \
Dispatch();
-#define MoveCallOnly(Src, Dest, CallDest) \
- (Dest) = (Src); \
- SET_I((BeamInstr *) CallDest); \
+#define MoveCallOnly(Src, CallDest) \
+ x(0) = (Src); \
+ SET_I((BeamInstr *) CallDest); \
Dispatch();
#define MoveJump(Src) \
@@ -613,60 +673,58 @@ void** beam_ops;
SET_I((BeamInstr *) Arg(0)); \
Goto(*I);
-#define GetList(Src, H, T) do { \
- Eterm* tmp_ptr = list_val(Src); \
- H = CAR(tmp_ptr); \
- T = CDR(tmp_ptr); } while (0)
-
-#define GetTupleElement(Src, Element, Dest) \
- do { \
- tmp_arg1 = (Eterm) COMPRESS_POINTER(((unsigned char *) tuple_val(Src)) + \
- (Element)); \
- (Dest) = (*(Eterm *) EXPAND_POINTER(tmp_arg1)); \
- } while (0)
-
-#define ExtractNextElement(Dest) \
- tmp_arg1 += sizeof(Eterm); \
- (Dest) = (* (Eterm *) (((unsigned char *) EXPAND_POINTER(tmp_arg1))))
-
-#define ExtractNextElement2(Dest) \
- do { \
- Eterm* ene_dstp = &(Dest); \
- ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \
- ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \
- tmp_arg1 += sizeof(Eterm) + sizeof(Eterm); \
+#define GetList(Src, H, T) \
+ do { \
+ Eterm* tmp_ptr = list_val(Src); \
+ Eterm hd, tl; \
+ hd = CAR(tmp_ptr); \
+ tl = CDR(tmp_ptr); \
+ H = hd; T = tl; \
} while (0)
-#define ExtractNextElement3(Dest) \
- do { \
- Eterm* ene_dstp = &(Dest); \
- ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \
- ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \
- ene_dstp[2] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[3]; \
- tmp_arg1 += 3*sizeof(Eterm); \
+#define GetTupleElement(Src, Element, Dest) \
+ do { \
+ Eterm* src; \
+ src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
+ (Dest) = *src; \
} while (0)
-#define ExtractNextElement4(Dest) \
- do { \
- Eterm* ene_dstp = &(Dest); \
- ene_dstp[0] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[1]; \
- ene_dstp[1] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[2]; \
- ene_dstp[2] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[3]; \
- ene_dstp[3] = ((Eterm *) EXPAND_POINTER(tmp_arg1))[4]; \
- tmp_arg1 += 4*sizeof(Eterm); \
+#define GetTupleElement2(Src, Element, Dest) \
+ do { \
+ Eterm* src; \
+ Eterm* dst; \
+ Eterm E1, E2; \
+ src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
+ dst = &(Dest); \
+ E1 = src[0]; \
+ E2 = src[1]; \
+ dst[0] = E1; \
+ dst[1] = E2; \
} while (0)
-#define ExtractElement(Element, Dest) \
- do { \
- tmp_arg1 += (Element); \
- (Dest) = (* (Eterm *) EXPAND_POINTER(tmp_arg1)); \
+#define GetTupleElement3(Src, Element, Dest) \
+ do { \
+ Eterm* src; \
+ Eterm* dst; \
+ Eterm E1, E2, E3; \
+ src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \
+ dst = &(Dest); \
+ E1 = src[0]; \
+ E2 = src[1]; \
+ E3 = src[2]; \
+ dst[0] = E1; \
+ dst[1] = E2; \
+ dst[2] = E3; \
} while (0)
#define EqualImmed(X, Y, Action) if (X != Y) { Action; }
#define NotEqualImmed(X, Y, Action) if (X == Y) { Action; }
#define EqualExact(X, Y, Action) if (!EQ(X,Y)) { Action; }
-#define IsLessThan(X, Y, Action) if (CMP_GE(X, Y)) { Action; }
-#define IsGreaterEqual(X, Y, Action) if (CMP_LT(X, Y)) { Action; }
+#define NotEqualExact(X, Y, Action) if (EQ(X,Y)) { Action; }
+#define Equal(X, Y, Action) CMP_EQ_ACTION(X,Y,Action)
+#define NotEqual(X, Y, Action) CMP_NE_ACTION(X,Y,Action)
+#define IsLessThan(X, Y, Action) CMP_LT_ACTION(X,Y,Action)
+#define IsGreaterEqual(X, Y, Action) CMP_GE_ACTION(X,Y,Action)
#define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; }
@@ -690,18 +748,26 @@ void** beam_ops;
if (is_not_list(Src)) { Fail; } \
A(Need, Alive)
-#define IsNonemptyListTestHeap(Src, Need, Alive, Fail) \
- if (is_not_list(Src)) { Fail; } \
+#define IsNonemptyListTestHeap(Need, Alive, Fail) \
+ if (is_not_list(x(0))) { Fail; } \
TestHeap(Need, Alive)
+#define IsNonemptyListGetList(Src, H, T, Fail) \
+ if (is_not_list(Src)) { \
+ Fail; \
+ } else { \
+ Eterm* tmp_ptr = list_val(Src); \
+ Eterm hd, tl; \
+ hd = CAR(tmp_ptr); \
+ tl = CDR(tmp_ptr); \
+ H = hd; T = tl; \
+ }
+
#define IsTuple(X, Action) if (is_not_tuple(X)) Action
-#define IsArity(Pointer, Arity, Fail) \
- if (*(Eterm *) \
- EXPAND_POINTER(tmp_arg1 = (Eterm) \
- COMPRESS_POINTER(tuple_val(Pointer))) != (Arity)) \
- { \
- Fail; \
+#define IsArity(Pointer, Arity, Fail) \
+ if (*tuple_val(Pointer) != (Arity)) { \
+ Fail; \
}
#define IsMap(Src, Fail) if (!is_map(Src)) { Fail; }
@@ -738,15 +804,21 @@ void** beam_ops;
} \
} while (0)
-#define IsTupleOfArity(Src, Arity, Fail) \
- do { \
- if (is_not_tuple(Src) || \
- *(Eterm *) \
- EXPAND_POINTER(tmp_arg1 = \
- (Eterm) COMPRESS_POINTER(tuple_val(Src))) != Arity) { \
- Fail; \
- } \
+#ifdef DEBUG
+#define IsTupleOfArity(Src, Arityval, Fail) \
+ do { \
+ if (!(is_tuple(Src) && *tuple_val(Src) == Arityval)) { \
+ Fail; \
+ } \
} while (0)
+#else
+#define IsTupleOfArity(Src, Arityval, Fail) \
+ do { \
+ if (!(is_boxed(Src) && *tuple_val(Src) == Arityval)) { \
+ Fail; \
+ } \
+ } while (0)
+#endif
#define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; }
@@ -756,7 +828,7 @@ void** beam_ops;
#define IsBitstring(Src, Fail) \
if (is_not_binary(Src)) { Fail; }
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define BsSafeMul(A, B, Fail, Target) \
do { Uint64 _res = (A) * (B); \
if (_res / B != A) { Fail; } \
@@ -773,6 +845,7 @@ void** beam_ops;
#define BsGetFieldSize(Bits, Unit, Fail, Target) \
do { \
Sint _signed_size; Uint _uint_size; \
+ Uint temp_bits; \
if (is_small(Bits)) { \
_signed_size = signed_val(Bits); \
if (_signed_size < 0) { Fail; } \
@@ -787,6 +860,7 @@ void** beam_ops;
#define BsGetUncheckedFieldSize(Bits, Unit, Fail, Target) \
do { \
Sint _signed_size; Uint _uint_size; \
+ Uint temp_bits; \
if (is_small(Bits)) { \
_signed_size = signed_val(Bits); \
if (_signed_size < 0) { Fail; } \
@@ -998,23 +1072,17 @@ init_emulator(void)
*/
#if defined(__GNUC__) && defined(sparc) && !defined(DEBUG)
-# define REG_x0 asm("%l0")
# define REG_xregs asm("%l1")
# define REG_htop asm("%l2")
# define REG_stop asm("%l3")
# define REG_I asm("%l4")
# define REG_fcalls asm("%l5")
-# define REG_tmp_arg1 asm("%l6")
-# define REG_tmp_arg2 asm("%l7")
#else
-# define REG_x0
# define REG_xregs
# define REG_htop
# define REG_stop
# define REG_I
# define REG_fcalls
-# define REG_tmp_arg1
-# define REG_tmp_arg2
#endif
#ifdef USE_VM_PROBES
@@ -1132,11 +1200,6 @@ void process_main(void)
ERTS_DECLARE_DUMMY(Eterm pid);
#endif
- /*
- * X register zero; also called r(0)
- */
- register Eterm x0 REG_x0 = NIL;
-
/* Pointer to X registers: x(1)..x(N); reg[0] is used when doing GC,
* in all other cases x0 is used.
*/
@@ -1164,17 +1227,6 @@ void process_main(void)
register Sint FCALLS REG_fcalls = 0;
/*
- * Temporaries used for picking up arguments for instructions.
- */
- register Eterm tmp_arg1 REG_tmp_arg1 = NIL;
- register Eterm tmp_arg2 REG_tmp_arg2 = NIL;
-#if HEAP_ON_C_STACK
- Eterm tmp_big[2]; /* Temporary buffer for small bignums if HEAP_ON_C_STACK. */
-#else
- Eterm *tmp_big; /* Temporary buffer for small bignums if !HEAP_ON_C_STACK. */
-#endif
-
- /*
* X registers and floating point registers are located in
* scheduler specific data.
*/
@@ -1185,8 +1237,6 @@ void process_main(void)
*/
int neg_o_reds = 0;
- Eterm (*arith_func)(Process* p, Eterm* reg, Uint live);
-
#ifdef ERTS_OPCODE_COUNTER_SUPPORT
static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES };
#else
@@ -1197,13 +1247,13 @@ void process_main(void)
#endif
#endif
- Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */
-
Eterm pt_arity; /* Used by do_put_tuple */
Uint64 start_time = 0; /* Monitor long schedule */
BeamInstr* start_time_i = NULL;
+ ERTS_MSACC_DECLARE_CACHE_X() /* a cached value of the tsd pointer for msacc */
+
ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */
@@ -1247,9 +1297,6 @@ void process_main(void)
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
-#if HALFWORD_HEAP
- ASSERT(erts_get_scheduler_data()->num_tmp_heap_used == 0);
-#endif
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
c_p = schedule(c_p, reds_used);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
@@ -1260,6 +1307,8 @@ void process_main(void)
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_MSACC_UPDATE_CACHE_X();
+
if (erts_system_monitor_long_schedule != 0) {
start_time = erts_timestamp_millis();
start_time_i = c_p->i;
@@ -1267,9 +1316,6 @@ void process_main(void)
reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
-#if !HEAP_ON_C_STACK
- tmp_big = ERTS_PROC_GET_SCHDATA(c_p)->beam_emu_tmp_heap;
-#endif
ERL_BITS_RELOAD_STATEP(c_p);
{
int reds;
@@ -1278,7 +1324,7 @@ void process_main(void)
int i;
argp = c_p->arg_reg;
- for (i = c_p->arity - 1; i > 0; i--) {
+ for (i = c_p->arity - 1; i >= 0; i--) {
reg[i] = argp[i];
CHECK_TERM(reg[i]);
}
@@ -1302,12 +1348,6 @@ void process_main(void)
}
next = (BeamInstr *) *I;
- r(0) = c_p->arg_reg[0];
-#ifdef HARDDEBUG
- if (c_p->arity > 0) {
- CHECK_TERM(r(0));
- }
-#endif
SWAPIN;
ASSERT(VALID_INSTR(next));
@@ -1346,26 +1386,24 @@ void process_main(void)
#endif
#include "beam_hot.h"
-#define STORE_ARITH_RESULT(res) StoreBifResult(2, (res));
-#define ARITH_FUNC(name) erts_gc_##name
-
{
Eterm increment_reg_val;
Eterm increment_val;
Uint live;
Eterm result;
- OpCase(i_increment_yIId):
- increment_reg_val = yb(Arg(0));
+ OpCase(i_increment_rIId):
+ increment_reg_val = x(0);
+ I--;
goto do_increment;
OpCase(i_increment_xIId):
increment_reg_val = xb(Arg(0));
goto do_increment;
- OpCase(i_increment_rIId):
- increment_reg_val = r(0);
- I--;
+ OpCase(i_increment_yIId):
+ increment_reg_val = yb(Arg(0));
+ goto do_increment;
do_increment:
increment_val = Arg(1);
@@ -1374,229 +1412,133 @@ void process_main(void)
ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
if (MY_IS_SSMALL(i)) {
result = make_small(i);
- store_result:
StoreBifResult(3, result);
}
}
live = Arg(2);
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
reg[live] = increment_reg_val;
reg[live+1] = make_small(increment_val);
result = erts_gc_mixed_plus(c_p, reg, live);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPIN;
ERTS_HOLE_CHECK(c_p);
if (is_value(result)) {
- goto store_result;
+ StoreBifResult(3, result);
}
ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue));
goto find_func_info;
}
-#define DO_BIG_ARITH(Func,Arg1,Arg2) \
- do { \
- Uint live = Arg(1); \
- SWAPOUT; \
- reg[0] = r(0); \
- reg[live] = (Arg1); \
- reg[live+1] = (Arg2); \
- result = (Func)(c_p, reg, live); \
- r(0) = reg[0]; \
- SWAPIN; \
- ERTS_HOLE_CHECK(c_p); \
- if (is_value(result)) { \
- StoreBifResult(4,result); \
- } \
- goto lb_Cl_error; \
- } while(0)
+#define DO_OUTLINED_ARITH_2(name, Op1, Op2) \
+ do { \
+ Eterm result; \
+ Uint live = Arg(1); \
+ \
+ HEAVY_SWAPOUT; \
+ reg[live] = Op1; \
+ reg[live+1] = Op2; \
+ result = erts_gc_##name(c_p, reg, live); \
+ HEAVY_SWAPIN; \
+ ERTS_HOLE_CHECK(c_p); \
+ if (is_value(result)) { \
+ StoreBifResult(4, result); \
+ } \
+ goto lb_Cl_error; \
+ } while (0)
- OpCase(i_plus_jIxxd):
{
+ Eterm PlusOp1, PlusOp2;
Eterm result;
- if (is_both_small(xb(Arg(2)), xb(Arg(3)))) {
- Sint i = signed_val(xb(Arg(2))) + signed_val(xb(Arg(3)));
+ OpCase(i_plus_jIxxd):
+ PlusOp1 = xb(Arg(2));
+ PlusOp2 = xb(Arg(3));
+ goto do_plus;
+
+ OpCase(i_plus_jIxyd):
+ PlusOp1 = xb(Arg(2));
+ PlusOp2 = yb(Arg(3));
+ goto do_plus;
+
+ OpCase(i_plus_jIssd):
+ GetArg2(2, PlusOp1, PlusOp2);
+ goto do_plus;
+
+ do_plus:
+ if (is_both_small(PlusOp1, PlusOp2)) {
+ Sint i = signed_val(PlusOp1) + signed_val(PlusOp2);
ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
if (MY_IS_SSMALL(i)) {
result = make_small(i);
StoreBifResult(4, result);
}
}
- DO_BIG_ARITH(ARITH_FUNC(mixed_plus), xb(Arg(2)), xb(Arg(3)));
+ DO_OUTLINED_ARITH_2(mixed_plus, PlusOp1, PlusOp2);
}
- OpCase(i_plus_jId):
{
+ Eterm MinusOp1, MinusOp2;
Eterm result;
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint i = signed_val(tmp_arg1) + signed_val(tmp_arg2);
- ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
- if (MY_IS_SSMALL(i)) {
- result = make_small(i);
- STORE_ARITH_RESULT(result);
- }
- }
- arith_func = ARITH_FUNC(mixed_plus);
- goto do_big_arith2;
- }
-
OpCase(i_minus_jIxxd):
- {
- Eterm result;
+ MinusOp1 = xb(Arg(2));
+ MinusOp2 = xb(Arg(3));
+ goto do_minus;
- if (is_both_small(xb(Arg(2)), xb(Arg(3)))) {
- Sint i = signed_val(xb(Arg(2))) - signed_val(xb(Arg(3)));
- ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
- if (MY_IS_SSMALL(i)) {
- result = make_small(i);
- StoreBifResult(4, result);
- }
- }
- DO_BIG_ARITH(ARITH_FUNC(mixed_minus), xb(Arg(2)), xb(Arg(3)));
- }
+ OpCase(i_minus_jIssd):
+ GetArg2(2, MinusOp1, MinusOp2);
+ goto do_minus;
- OpCase(i_minus_jId):
- {
- Eterm result;
-
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint i = signed_val(tmp_arg1) - signed_val(tmp_arg2);
+ do_minus:
+ if (is_both_small(MinusOp1, MinusOp2)) {
+ Sint i = signed_val(MinusOp1) - signed_val(MinusOp2);
ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i));
if (MY_IS_SSMALL(i)) {
result = make_small(i);
- STORE_ARITH_RESULT(result);
+ StoreBifResult(4, result);
}
}
- arith_func = ARITH_FUNC(mixed_minus);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(mixed_minus, MinusOp1, MinusOp2);
}
- OpCase(i_is_lt_f):
- if (CMP_GE(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
- OpCase(i_is_ge_f):
- if (CMP_LT(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
- OpCase(i_is_eq_f):
- if (CMP_NE(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
- OpCase(i_is_ne_f):
- if (CMP_EQ(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
- OpCase(i_is_eq_exact_f):
- if (!EQ(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
{
Eterm is_eq_exact_lit_val;
- OpCase(i_is_eq_exact_literal_xfc):
- is_eq_exact_lit_val = xb(Arg(0));
- I++;
+ OpCase(i_is_eq_exact_literal_fxc):
+ is_eq_exact_lit_val = xb(Arg(1));
goto do_is_eq_exact_literal;
- OpCase(i_is_eq_exact_literal_yfc):
- is_eq_exact_lit_val = yb(Arg(0));
- I++;
+ OpCase(i_is_eq_exact_literal_fyc):
+ is_eq_exact_lit_val = yb(Arg(1));
goto do_is_eq_exact_literal;
- OpCase(i_is_eq_exact_literal_rfc):
- is_eq_exact_lit_val = r(0);
-
do_is_eq_exact_literal:
- if (!eq(Arg(1), is_eq_exact_lit_val)) {
+ if (!eq(Arg(2), is_eq_exact_lit_val)) {
ClauseFail();
}
- Next(2);
+ Next(3);
}
{
Eterm is_ne_exact_lit_val;
- OpCase(i_is_ne_exact_literal_xfc):
- is_ne_exact_lit_val = xb(Arg(0));
- I++;
+ OpCase(i_is_ne_exact_literal_fxc):
+ is_ne_exact_lit_val = xb(Arg(1));
goto do_is_ne_exact_literal;
- OpCase(i_is_ne_exact_literal_yfc):
- is_ne_exact_lit_val = yb(Arg(0));
- I++;
+ OpCase(i_is_ne_exact_literal_fyc):
+ is_ne_exact_lit_val = yb(Arg(1));
goto do_is_ne_exact_literal;
- OpCase(i_is_ne_exact_literal_rfc):
- is_ne_exact_lit_val = r(0);
-
do_is_ne_exact_literal:
- if (eq(Arg(1), is_ne_exact_lit_val)) {
+ if (eq(Arg(2), is_ne_exact_lit_val)) {
ClauseFail();
}
- Next(2);
+ Next(3);
}
- OpCase(move_window3_xxxy): {
- BeamInstr *next;
- Eterm xt0, xt1, xt2;
- Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(3)));
- PreFetch(4, next);
- xt0 = xb(Arg(0));
- xt1 = xb(Arg(1));
- xt2 = xb(Arg(2));
- y[0] = xt0;
- y[1] = xt1;
- y[2] = xt2;
- NextPF(4, next);
- }
- OpCase(move_window4_xxxxy): {
- BeamInstr *next;
- Eterm xt0, xt1, xt2, xt3;
- Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(4)));
- PreFetch(5, next);
- xt0 = xb(Arg(0));
- xt1 = xb(Arg(1));
- xt2 = xb(Arg(2));
- xt3 = xb(Arg(3));
- y[0] = xt0;
- y[1] = xt1;
- y[2] = xt2;
- y[3] = xt3;
- NextPF(5, next);
- }
- OpCase(move_window5_xxxxxy): {
- BeamInstr *next;
- Eterm xt0, xt1, xt2, xt3, xt4;
- Eterm *y = (Eterm *)(((unsigned char *)E) + (Arg(5)));
- PreFetch(6, next);
- xt0 = xb(Arg(0));
- xt1 = xb(Arg(1));
- xt2 = xb(Arg(2));
- xt3 = xb(Arg(3));
- xt4 = xb(Arg(4));
- y[0] = xt0;
- y[1] = xt1;
- y[2] = xt2;
- y[3] = xt3;
- y[4] = xt4;
- NextPF(6, next);
- }
-
- OpCase(i_move_call_only_fcr): {
+ OpCase(i_move_call_only_fc): {
r(0) = Arg(1);
}
/* FALL THROUGH */
@@ -1606,7 +1548,7 @@ void process_main(void)
Dispatch();
}
- OpCase(i_move_call_last_fPcr): {
+ OpCase(i_move_call_last_fPc): {
r(0) = Arg(2);
}
/* FALL THROUGH */
@@ -1618,7 +1560,7 @@ void process_main(void)
Dispatch();
}
- OpCase(i_move_call_crf): {
+ OpCase(i_move_call_cf): {
r(0) = Arg(0);
I++;
}
@@ -1630,7 +1572,7 @@ void process_main(void)
Dispatch();
}
- OpCase(i_move_call_ext_last_ePcr): {
+ OpCase(i_move_call_ext_last_ePc): {
r(0) = Arg(2);
}
/* FALL THROUGH */
@@ -1646,7 +1588,7 @@ void process_main(void)
DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
Dispatchx();
- OpCase(i_move_call_ext_cre): {
+ OpCase(i_move_call_ext_ce): {
r(0) = Arg(0);
I++;
}
@@ -1656,7 +1598,7 @@ void process_main(void)
DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0));
Dispatchx();
- OpCase(i_move_call_ext_only_ecr): {
+ OpCase(i_move_call_ext_only_ec): {
r(0) = Arg(1);
}
/* FALL THROUGH */
@@ -1722,17 +1664,11 @@ void process_main(void)
PRE_BIF_SWAPOUT(c_p);
c_p->fcalls = FCALLS - 1;
- reg[0] = r(0);
result = erl_send(c_p, r(0), x(1));
PreFetch(0, next);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
- if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) {
- result = erts_gc_after_bif_call(c_p, result, reg, 2);
- r(0) = reg[0];
- E = c_p->stop;
- }
HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
@@ -1743,7 +1679,6 @@ void process_main(void)
SET_CP(c_p, I+1);
SET_I(c_p->i);
SWAPIN;
- r(0) = reg[0];
Dispatch();
}
goto find_func_info;
@@ -1753,29 +1688,23 @@ void process_main(void)
Eterm element_index;
Eterm element_tuple;
- OpCase(i_element_xjsd):
- element_tuple = xb(Arg(0));
- I++;
+ OpCase(i_element_jxsd):
+ element_tuple = xb(Arg(1));
goto do_element;
- OpCase(i_element_yjsd):
- element_tuple = yb(Arg(0));
- I++;
+ OpCase(i_element_jysd):
+ element_tuple = yb(Arg(1));
goto do_element;
- OpCase(i_element_rjsd):
- element_tuple = r(0);
- /* Fall through */
-
do_element:
- GetArg1(1, element_index);
+ GetArg1(2, element_index);
if (is_small(element_index) && is_tuple(element_tuple)) {
Eterm* tp = tuple_val(element_tuple);
if ((signed_val(element_index) >= 1) &&
(signed_val(element_index) <= arityval(*tp))) {
Eterm result = tp[signed_val(element_index)];
- StoreBifResult(2, result);
+ StoreBifResult(3, result);
}
}
}
@@ -1789,29 +1718,24 @@ void process_main(void)
{
Eterm fast_element_tuple;
- OpCase(i_fast_element_rjId):
- fast_element_tuple = r(0);
+ OpCase(i_fast_element_jxId):
+ fast_element_tuple = xb(Arg(1));
+ goto do_fast_element;
+
+ OpCase(i_fast_element_jyId):
+ fast_element_tuple = yb(Arg(1));
+ goto do_fast_element;
do_fast_element:
if (is_tuple(fast_element_tuple)) {
Eterm* tp = tuple_val(fast_element_tuple);
- Eterm pos = Arg(1); /* Untagged integer >= 1 */
+ Eterm pos = Arg(2); /* Untagged integer >= 1 */
if (pos <= arityval(*tp)) {
Eterm result = tp[pos];
- StoreBifResult(2, result);
+ StoreBifResult(3, result);
}
}
goto badarg;
-
- OpCase(i_fast_element_xjId):
- fast_element_tuple = xb(Arg(0));
- I++;
- goto do_fast_element;
-
- OpCase(i_fast_element_yjId):
- fast_element_tuple = yb(Arg(0));
- I++;
- goto do_fast_element;
}
OpCase(catch_yf):
@@ -1832,11 +1756,10 @@ void process_main(void)
SWAPIN;
}
/* only x(2) is included in the rootset here */
- if (E - HTOP < 3 || c_p->mbuf) { /* Force GC in case add_stacktrace()
- * created heap fragments */
+ if (E - HTOP < 3) {
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
- FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1);
+ FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
@@ -1917,13 +1840,20 @@ void process_main(void)
* Pick up the next message and place it in x(0).
* If no message, jump to a wait or wait_timeout instruction.
*/
- OpCase(i_loop_rec_fr):
+ OpCase(i_loop_rec_f):
{
BeamInstr *next;
- ErlMessage* msgp;
+ ErtsMessage* msgp;
- loop_rec__:
+ /*
+ * We need to disable GC while matching messages
+ * in the queue. This since messages with data outside
+ * the heap will be corrupted by a GC.
+ */
+ ASSERT(!(c_p->flags & F_DELAY_GC));
+ c_p->flags |= F_DELAY_GC;
+ loop_rec__:
PROCESS_MAIN_CHK_LOCKS(c_p);
msgp = PEEK_MESSAGE(c_p);
@@ -1935,6 +1865,7 @@ void process_main(void)
if (ERTS_PROC_PENDING_EXIT(c_p)) {
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE);
SWAPOUT;
+ c_p->flags &= ~F_DELAY_GC;
goto do_schedule; /* Will be rescheduled for exit */
}
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
@@ -1944,32 +1875,27 @@ void process_main(void)
else
#endif
{
+ c_p->flags &= ~F_DELAY_GC;
SET_I((BeamInstr *) Arg(0));
Goto(*I); /* Jump to a wait or wait_timeout instruction */
}
}
- ErtsMoveMsgAttachmentIntoProc(msgp, c_p, E, HTOP, FCALLS,
- {
- SWAPOUT;
- reg[0] = r(0);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- },
- {
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- r(0) = reg[0];
- SWAPIN;
- });
if (is_non_value(ERL_MESSAGE_TERM(msgp))) {
- /*
- * A corrupt distribution message that we weren't able to decode;
- * remove it...
- */
- ASSERT(!msgp->data.attached);
- /* TODO: Add DTrace probe for this bad message situation? */
- UNLINK_MESSAGE(c_p, msgp);
- free_message(msgp);
- goto loop_rec__;
+ SWAPOUT; /* erts_decode_dist_message() may write to heap... */
+ if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) {
+ /*
+ * A corrupt distribution message that we weren't able to decode;
+ * remove it...
+ */
+ /* No swapin should be needed */
+ ASSERT(HTOP == c_p->htop && E == c_p->stop);
+ /* TODO: Add DTrace probe for this bad message situation? */
+ UNLINK_MESSAGE(c_p, msgp);
+ msgp->next = NULL;
+ erts_cleanup_messages(msgp);
+ goto loop_rec__;
+ }
+ SWAPIN;
}
PreFetch(1, next);
r(0) = ERL_MESSAGE_TERM(msgp);
@@ -1981,8 +1907,7 @@ void process_main(void)
*/
OpCase(remove_message): {
BeamInstr *next;
- ErlMessage* msgp;
-
+ ErtsMessage* msgp;
PROCESS_MAIN_CHK_LOCKS(c_p);
PreFetch(0, next);
@@ -1996,20 +1921,7 @@ void process_main(void)
if (DT_UTAG(c_p) != NIL) {
if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) {
SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag;
-#ifdef DTRACE_TAG_HARDDEBUG
- if (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING)
- erts_fprintf(stderr,
- "Dtrace -> (%T) stop spreading "
- "tag %T with message %T\r\n",
- c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp));
-#endif
} else {
-#ifdef DTRACE_TAG_HARDDEBUG
- erts_fprintf(stderr,
- "Dtrace -> (%T) kill tag %T with "
- "message %T\r\n",
- c_p->common.id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp));
-#endif
DT_UTAG(c_p) = NIL;
SEQ_TRACE_TOKEN(c_p) = NIL;
}
@@ -2029,12 +1941,6 @@ void process_main(void)
DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp);
}
DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING;
-#ifdef DTRACE_TAG_HARDDEBUG
- erts_fprintf(stderr,
- "Dtrace -> (%T) receive tag (%T) "
- "with message %T\r\n",
- c_p->common.id, DT_UTAG(c_p), ERL_MESSAGE_TERM(msgp));
-#endif
} else {
#endif
ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p)));
@@ -2064,7 +1970,7 @@ void process_main(void)
dtrace_proc_str(c_p, receiver_name);
token2 = SEQ_TRACE_TOKEN(c_p);
- if (token2 != NIL && token2 != am_have_dt_utag) {
+ if (have_seqtrace(token2)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token2));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2));
@@ -2077,11 +1983,21 @@ void process_main(void)
UNLINK_MESSAGE(c_p, msgp);
JOIN_MESSAGE(c_p);
CANCEL_TIMER(c_p);
- free_message(msgp);
+
+ erts_save_message_in_proc(c_p, msgp);
+ c_p->flags &= ~F_DELAY_GC;
+
+ if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) {
+ /*
+ * We want to GC soon but we leave a few
+ * reductions giving the message some time
+ * to turn into garbage.
+ */
+ ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS);
+ }
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
-
NextPF(0, next);
}
@@ -2090,9 +2006,22 @@ void process_main(void)
* message didn't match), then jump to the loop_rec instruction.
*/
OpCase(loop_rec_end_f): {
+
+ ASSERT(c_p->flags & F_DELAY_GC);
+
SET_I((BeamInstr *) Arg(0));
SAVE_MESSAGE(c_p);
- goto loop_rec__;
+ if (FCALLS > 0 || FCALLS > neg_o_reds) {
+ FCALLS--;
+ goto loop_rec__;
+ }
+
+ c_p->flags &= ~F_DELAY_GC;
+ c_p->i = I;
+ SWAPOUT;
+ c_p->arity = 0;
+ c_p->current = NULL;
+ goto do_schedule;
}
/*
* Prepare to wait for a message or a timeout, whichever occurs first.
@@ -2131,8 +2060,6 @@ void process_main(void)
* c_p->def_arg_reg[0]. Note that it is safe to use this
* location because there are no living x registers in
* a receive statement.
- * Note that for the halfword emulator, the two first elements
- * of the array are used.
*/
BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg;
*pi = I+3;
@@ -2249,10 +2176,6 @@ void process_main(void)
select_val2 = xb(Arg(0));
goto do_select_tuple_arity2;
- OpCase(i_select_tuple_arity2_rfAAff):
- select_val2 = r(0);
- I--;
-
do_select_tuple_arity2:
if (is_not_tuple(select_val2)) {
goto select_val2_fail;
@@ -2268,10 +2191,6 @@ void process_main(void)
select_val2 = xb(Arg(0));
goto do_select_val2;
- OpCase(i_select_val2_rfccff):
- select_val2 = r(0);
- I--;
-
do_select_val2:
if (select_val2 == Arg(2)) {
I += 3;
@@ -2295,10 +2214,6 @@ void process_main(void)
select_val = yb(Arg(0));
goto do_select_tuple_arity;
- OpCase(i_select_tuple_arity_rfI):
- select_val = r(0);
- I--;
-
do_select_tuple_arity:
if (is_tuple(select_val)) {
select_val = *tuple_val(select_val);
@@ -2315,10 +2230,6 @@ void process_main(void)
select_val = yb(Arg(0));
goto do_linear_search;
- OpCase(i_select_val_lins_rfI):
- select_val = r(0);
- I--;
-
do_linear_search: {
BeamInstr *vs = &Arg(3);
int ix = 0;
@@ -2345,10 +2256,6 @@ void process_main(void)
select_val = yb(Arg(0));
goto do_binary_search;
- OpCase(i_select_val_bins_rfI):
- select_val = r(0);
- I--;
-
do_binary_search:
{
struct Pairs {
@@ -2409,10 +2316,6 @@ void process_main(void)
jump_on_val_zero_index = xb(Arg(0));
goto do_jump_on_val_zero_index;
- OpCase(i_jump_on_val_zero_rfI):
- jump_on_val_zero_index = r(0);
- I--;
-
do_jump_on_val_zero_index:
if (is_small(jump_on_val_zero_index)) {
jump_on_val_zero_index = signed_val(jump_on_val_zero_index);
@@ -2437,10 +2340,6 @@ void process_main(void)
jump_on_val_index = xb(Arg(0));
goto do_jump_on_val_index;
- OpCase(i_jump_on_val_rfII):
- jump_on_val_index = r(0);
- I--;
-
do_jump_on_val_index:
if (is_small(jump_on_val_index)) {
jump_on_val_index = (Uint) (signed_val(jump_on_val_index) - Arg(3));
@@ -2460,15 +2359,12 @@ void process_main(void)
do {
Eterm term = *I++;
- switch (term & _TAG_IMMED1_MASK) {
- case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
- *hp++ = r(0);
- break;
- case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
- *hp++ = x(term >> _TAG_IMMED1_SIZE);
+ switch (loader_tag(term)) {
+ case LOADER_X_REG:
+ *hp++ = x(loader_x_reg_index(term));
break;
- case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER:
- *hp++ = y(term >> _TAG_IMMED1_SIZE);
+ case LOADER_Y_REG:
+ *hp++ = y(loader_y_reg_index(term));
break;
default:
*hp++ = term;
@@ -2482,31 +2378,26 @@ void process_main(void)
OpCase(new_map_dII): {
Eterm res;
- x(0) = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
res = new_map(c_p, reg, I-1);
- SWAPIN;
- r(0) = x(0);
+ HEAVY_SWAPIN;
StoreResult(res, Arg(0));
Next(3+Arg(2));
}
-#define PUT_TERM_REG(term, desc) \
-do { \
- switch ((desc) & _TAG_IMMED1_MASK) { \
- case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- r(0) = (term); \
- break; \
- case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- x((desc) >> _TAG_IMMED1_SIZE) = (term); \
- break; \
- case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- y((desc) >> _TAG_IMMED1_SIZE) = (term); \
- break; \
- default: \
- ASSERT(0); \
- break; \
- } \
+#define PUT_TERM_REG(term, desc) \
+do { \
+ switch (loader_tag(desc)) { \
+ case LOADER_X_REG: \
+ x(loader_x_reg_index(desc)) = (term); \
+ break; \
+ case LOADER_Y_REG: \
+ y(loader_y_reg_index(desc)) = (term); \
+ break; \
+ default: \
+ ASSERT(0); \
+ break; \
+ } \
} while(0)
OpCase(i_get_map_elements_fsI): {
@@ -2577,12 +2468,10 @@ do { \
Eterm map;
GetArg1(1, map);
- x(0) = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
res = update_map_assoc(c_p, reg, map, I);
- SWAPIN;
+ HEAVY_SWAPIN;
if (is_value(res)) {
- r(0) = x(0);
StoreResult(res, Arg(2));
Next(5+Arg(4));
} else {
@@ -2601,12 +2490,10 @@ do { \
Eterm map;
GetArg1(1, map);
- x(0) = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
res = update_map_exact(c_p, reg, map, I);
- SWAPIN;
+ HEAVY_SWAPIN;
if (is_value(res)) {
- r(0) = x(0);
StoreResult(res, Arg(2));
Next(5+Arg(4));
} else {
@@ -2688,13 +2575,10 @@ do { \
{
typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
GcBifFunction bf;
- Eterm arg;
Eterm result;
Uint live = (Uint) Arg(3);
- GetArg1(2, arg);
- reg[0] = r(0);
- reg[live] = arg;
+ GetArg1(2, x(live));
bf = (GcBifFunction) Arg(1);
c_p->fcalls = FCALLS;
SWAPOUT;
@@ -2705,7 +2589,6 @@ do { \
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
- r(0) = reg[0];
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
@@ -2715,12 +2598,12 @@ do { \
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
- reg[0] = arg;
+ x(0) = x(live);
I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
goto post_error_handling;
}
- OpCase(i_gc_bif2_jIId): /* Note, one less parameter than the i_gc_bif1
+ OpCase(i_gc_bif2_jIIssd): /* Note, one less parameter than the i_gc_bif1
and i_gc_bif3 */
{
typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
@@ -2728,9 +2611,13 @@ do { \
Eterm result;
Uint live = (Uint) Arg(2);
- reg[0] = r(0);
- reg[live++] = tmp_arg1;
- reg[live] = tmp_arg2;
+ GetArg2(3, x(live), x(live+1));
+ /*
+ * XXX This calling convention does not make sense. 'live'
+ * should point out the first argument, not the second
+ * (i.e. 'live' should not be incremented below).
+ */
+ live++;
bf = (GcBifFunction) Arg(1);
c_p->fcalls = FCALLS;
SWAPOUT;
@@ -2741,35 +2628,37 @@ do { \
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
- r(0) = reg[0];
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
- StoreBifResult(3, result);
+ StoreBifResult(5, result);
}
if (Arg(0) != 0) {
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
- reg[0] = tmp_arg1;
- reg[1] = tmp_arg2;
+ live--;
+ x(0) = x(live);
+ x(1) = x(live+1);
I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
goto post_error_handling;
}
- OpCase(i_gc_bif3_jIsId):
+ OpCase(i_gc_bif3_jIIssd):
{
typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
GcBifFunction bf;
- Eterm arg;
Eterm result;
- Uint live = (Uint) Arg(3);
+ Uint live = (Uint) Arg(2);
- GetArg1(2, arg);
- reg[0] = r(0);
- reg[live++] = arg;
- reg[live++] = tmp_arg1;
- reg[live] = tmp_arg2;
+ x(live) = x(SCRATCH_X_REG);
+ GetArg2(3, x(live+1), x(live+2));
+ /*
+ * XXX This calling convention does not make sense. 'live'
+ * should point out the first argument, not the third
+ * (i.e. 'live' should not be incremented below).
+ */
+ live += 2;
bf = (GcBifFunction) Arg(1);
c_p->fcalls = FCALLS;
SWAPOUT;
@@ -2780,19 +2669,19 @@ do { \
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
SWAPIN;
- r(0) = reg[0];
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
- StoreBifResult(4, result);
+ StoreBifResult(5, result);
}
if (Arg(0) != 0) {
SET_I((BeamInstr *) Arg(0));
Goto(*I);
}
- reg[0] = arg;
- reg[1] = tmp_arg1;
- reg[2] = tmp_arg2;
+ live -= 2;
+ x(0) = x(live);
+ x(1) = x(live+1);
+ x(2) = x(live+2);
I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf));
goto post_error_handling;
}
@@ -2800,12 +2689,13 @@ do { \
/*
* Guards bifs and, or, xor in guards.
*/
- OpCase(i_bif2_fbd):
+ OpCase(i_bif2_fbssd):
{
- Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
+ Eterm tmp_reg[2];
Eterm (*bf)(Process*, Eterm*);
Eterm result;
+ GetArg2(2, tmp_reg[0], tmp_reg[1]);
bf = (BifFunction) Arg(1);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2817,7 +2707,7 @@ do { \
ERTS_HOLE_CHECK(c_p);
FCALLS = c_p->fcalls;
if (is_value(result)) {
- StoreBifResult(2, result);
+ StoreBifResult(4, result);
}
SET_I((BeamInstr *) Arg(0));
Goto(*I);
@@ -2826,12 +2716,13 @@ do { \
/*
* Guards bifs and, or, xor, relational operators in body.
*/
- OpCase(i_bif2_body_bd):
+ OpCase(i_bif2_body_bssd):
{
- Eterm tmp_reg[2] = {tmp_arg1, tmp_arg2};
+ Eterm tmp_reg[2];
Eterm (*bf)(Process*, Eterm*);
Eterm result;
+ GetArg2(1, tmp_reg[0], tmp_reg[1]);
bf = (BifFunction) Arg(0);
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
@@ -2842,10 +2733,10 @@ do { \
ERTS_HOLE_CHECK(c_p);
if (is_value(result)) {
ASSERT(!is_CP(result));
- StoreBifResult(1, result);
+ StoreBifResult(3, result);
}
- reg[0] = tmp_arg1;
- reg[1] = tmp_arg2;
+ reg[0] = tmp_reg[0];
+ reg[1] = tmp_reg[1];
SWAPOUT;
I = handle_error(c_p, I, reg, bf);
goto post_error_handling;
@@ -2857,9 +2748,20 @@ do { \
*/
OpCase(call_bif_e):
{
- Eterm (*bf)(Process*, Eterm*, BeamInstr*) = GET_BIF_ADDRESS(Arg(0));
+ Eterm (*bf)(Process*, Eterm*, BeamInstr*);
Eterm result;
BeamInstr *next;
+ ErlHeapFragment *live_hf_end;
+
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X()) {
+ if (GET_BIF_MODULE(Arg(0)) == am_ets) {
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS);
+ } else {
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF);
+ }
+ }
+
+ bf = GET_BIF_ADDRESS(Arg(0));
PRE_BIF_SWAPOUT(c_p);
c_p->fcalls = FCALLS - 1;
@@ -2869,20 +2771,26 @@ do { \
PreFetch(1, next);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- reg[0] = r(0);
+ live_hf_end = c_p->mbuf;
result = (*bf)(c_p, reg, I);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_HOLE_CHECK(c_p);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- if (c_p->mbuf || MSO(c_p).overhead >= BIN_VHEAP_SZ(c_p)) {
+ if (ERTS_IS_GC_DESIRED(c_p)) {
Uint arity = ((Export *)Arg(0))->code[2];
- result = erts_gc_after_bif_call(c_p, result, reg, arity);
+ result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, reg, arity);
E = c_p->stop;
}
+ PROCESS_MAIN_CHK_LOCKS(c_p);
HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
+ /* We have to update the cache if we are enabled in order
+ to make sure no book keeping is done after we disabled
+ msacc. We don't always do this as it is quite expensive. */
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X())
+ ERTS_MSACC_UPDATE_CACHE_X();
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
if (is_value(result)) {
r(0) = result;
CHECK_TERM(r(0));
@@ -2891,7 +2799,6 @@ do { \
SET_CP(c_p, I+2);
SET_I(c_p->i);
SWAPIN;
- r(0) = reg[0];
Dispatch();
}
@@ -2907,111 +2814,81 @@ do { \
* Arithmetic operations.
*/
- OpCase(i_times_jId):
+ OpCase(i_times_jIssd):
{
- arith_func = ARITH_FUNC(mixed_times);
- goto do_big_arith2;
+ Eterm Op1, Op2;
+ GetArg2(2, Op1, Op2);
+ DO_OUTLINED_ARITH_2(mixed_times, Op1, Op2);
}
- OpCase(i_m_div_jId):
+ OpCase(i_m_div_jIssd):
{
- arith_func = ARITH_FUNC(mixed_div);
- goto do_big_arith2;
+ Eterm Op1, Op2;
+ GetArg2(2, Op1, Op2);
+ DO_OUTLINED_ARITH_2(mixed_div, Op1, Op2);
}
- OpCase(i_int_div_jId):
+ OpCase(i_int_div_jIssd):
{
- Eterm result;
+ Eterm Op1, Op2;
- if (tmp_arg2 == SMALL_ZERO) {
+ GetArg2(2, Op1, Op2);
+ if (Op2 == SMALL_ZERO) {
goto badarith;
- } else if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint ires = signed_val(tmp_arg1) / signed_val(tmp_arg2);
+ } else if (is_both_small(Op1, Op2)) {
+ Sint ires = signed_val(Op1) / signed_val(Op2);
if (MY_IS_SSMALL(ires)) {
- result = make_small(ires);
- STORE_ARITH_RESULT(result);
+ Eterm result = make_small(ires);
+ StoreBifResult(4, result);
}
}
- arith_func = ARITH_FUNC(int_div);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(int_div, Op1, Op2);
}
- OpCase(i_rem_jIxxd):
{
- Eterm result;
+ Eterm RemOp1, RemOp2;
- if (xb(Arg(3)) == SMALL_ZERO) {
- goto badarith;
- } else if (is_both_small(xb(Arg(2)), xb(Arg(3)))) {
- result = make_small(signed_val(xb(Arg(2))) % signed_val(xb(Arg(3))));
+ OpCase(i_rem_jIxxd):
+ RemOp1 = xb(Arg(2));
+ RemOp2 = xb(Arg(3));
+ goto do_rem;
+
+ OpCase(i_rem_jIssd):
+ GetArg2(2, RemOp1, RemOp2);
+ goto do_rem;
+
+ do_rem:
+ if (RemOp2 == SMALL_ZERO) {
+ goto badarith;
+ } else if (is_both_small(RemOp1, RemOp2)) {
+ Eterm result = make_small(signed_val(RemOp1) % signed_val(RemOp2));
StoreBifResult(4, result);
+ } else {
+ DO_OUTLINED_ARITH_2(int_rem, RemOp1, RemOp2);
}
- DO_BIG_ARITH(ARITH_FUNC(int_rem),xb(Arg(2)),xb(Arg(3)));
}
- OpCase(i_rem_jId):
{
- Eterm result;
-
- if (tmp_arg2 == SMALL_ZERO) {
- goto badarith;
- } else if (is_both_small(tmp_arg1, tmp_arg2)) {
- result = make_small(signed_val(tmp_arg1) % signed_val(tmp_arg2));
- STORE_ARITH_RESULT(result);
- } else {
- arith_func = ARITH_FUNC(int_rem);
- goto do_big_arith2;
- }
- }
+ Eterm BandOp1, BandOp2;
OpCase(i_band_jIxcd):
- {
- Eterm result;
+ BandOp1 = xb(Arg(2));
+ BandOp2 = Arg(3);
+ goto do_band;
- if (is_both_small(xb(Arg(2)), Arg(3))) {
+ OpCase(i_band_jIssd):
+ GetArg2(2, BandOp1, BandOp2);
+ goto do_band;
+
+ do_band:
+ if (is_both_small(BandOp1, BandOp2)) {
/*
* No need to untag -- TAG & TAG == TAG.
*/
- result = xb(Arg(2)) & Arg(3);
+ Eterm result = BandOp1 & BandOp2;
StoreBifResult(4, result);
}
- DO_BIG_ARITH(ARITH_FUNC(band),xb(Arg(2)),Arg(3));
- }
-
- OpCase(i_band_jId):
- {
- Eterm result;
-
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- /*
- * No need to untag -- TAG & TAG == TAG.
- */
- result = tmp_arg1 & tmp_arg2;
- STORE_ARITH_RESULT(result);
- }
- arith_func = ARITH_FUNC(band);
- goto do_big_arith2;
- }
-
-#undef DO_BIG_ARITH
-
- do_big_arith2:
- {
- Eterm result;
- Uint live = Arg(1);
-
- SWAPOUT;
- reg[0] = r(0);
- reg[live] = tmp_arg1;
- reg[live+1] = tmp_arg2;
- result = arith_func(c_p, reg, live);
- r(0) = reg[0];
- SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- if (is_value(result)) {
- STORE_ARITH_RESULT(result);
- }
- goto lb_Cl_error;
+ DO_OUTLINED_ARITH_2(band, BandOp1, BandOp2);
}
/*
@@ -3032,97 +2909,105 @@ do { \
goto find_func_info;
}
- OpCase(i_bor_jId):
+ OpCase(i_bor_jIssd):
{
- Eterm result;
+ Eterm Op1, Op2;
- if (is_both_small(tmp_arg1, tmp_arg2)) {
+ GetArg2(2, Op1, Op2);
+ if (is_both_small(Op1, Op2)) {
/*
* No need to untag -- TAG | TAG == TAG.
*/
- result = tmp_arg1 | tmp_arg2;
- STORE_ARITH_RESULT(result);
+ Eterm result = Op1 | Op2;
+ StoreBifResult(4, result);
}
- arith_func = ARITH_FUNC(bor);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(bor, Op1, Op2);
}
- OpCase(i_bxor_jId):
+ OpCase(i_bxor_jIssd):
{
- Eterm result;
+ Eterm Op1, Op2;
- if (is_both_small(tmp_arg1, tmp_arg2)) {
+ GetArg2(2, Op1, Op2);
+ if (is_both_small(Op1, Op2)) {
/*
* We could extract the tag from one argument, but a tag extraction
* could mean a shift. Therefore, play it safe here.
*/
- result = make_small(signed_val(tmp_arg1) ^ signed_val(tmp_arg2));
- STORE_ARITH_RESULT(result);
+ Eterm result = make_small(signed_val(Op1) ^ signed_val(Op2));
+ StoreBifResult(4, result);
}
- arith_func = ARITH_FUNC(bxor);
- goto do_big_arith2;
+ DO_OUTLINED_ARITH_2(bxor, Op1, Op2);
}
{
+ Eterm Op1, Op2;
Sint i;
Sint ires;
Eterm* bigp;
+ Eterm tmp_big[2];
- OpCase(i_bsr_jId):
- if (is_small(tmp_arg2)) {
- i = -signed_val(tmp_arg2);
- if (is_small(tmp_arg1)) {
+ OpCase(i_bsr_jIssd):
+ GetArg2(2, Op1, Op2);
+ if (is_small(Op2)) {
+ i = -signed_val(Op2);
+ if (is_small(Op1)) {
goto small_shift;
- } else if (is_big(tmp_arg1)) {
+ } else if (is_big(Op1)) {
if (i == 0) {
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
}
goto big_shift;
}
- } else if (is_big(tmp_arg2)) {
+ } else if (is_big(Op2)) {
/*
* N bsr NegativeBigNum == N bsl MAX_SMALL
* N bsr PositiveBigNum == N bsl MIN_SMALL
*/
- tmp_arg2 = make_small(bignum_header_is_neg(*big_val(tmp_arg2)) ?
+ Op2 = make_small(bignum_header_is_neg(*big_val(Op2)) ?
MAX_SMALL : MIN_SMALL);
goto do_bsl;
}
goto badarith;
- OpCase(i_bsl_jId):
+ OpCase(i_bsl_jIssd):
+ GetArg2(2, Op1, Op2);
+
do_bsl:
- if (is_small(tmp_arg2)) {
- i = signed_val(tmp_arg2);
+ if (is_small(Op2)) {
+ i = signed_val(Op2);
- if (is_small(tmp_arg1)) {
+ if (is_small(Op1)) {
small_shift:
- ires = signed_val(tmp_arg1);
+ ires = signed_val(Op1);
if (i == 0 || ires == 0) {
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
} else if (i < 0) { /* Right shift */
i = -i;
if (i >= SMALL_BITS-1) {
- tmp_arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
+ Op1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
} else {
- tmp_arg1 = make_small(ires >> i);
+ Op1 = make_small(ires >> i);
}
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
} else if (i < SMALL_BITS-1) { /* Left shift */
if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) ||
((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) {
- tmp_arg1 = make_small(ires << i);
- StoreBifResult(2, tmp_arg1);
+ Op1 = make_small(ires << i);
+ StoreBifResult(4, Op1);
}
}
- tmp_arg1 = small_to_big(ires, tmp_big);
+ Op1 = small_to_big(ires, tmp_big);
+#ifdef TAG_LITERAL_PTR
+ Op1 |= TAG_LITERAL_PTR;
+#endif
big_shift:
if (i > 0) { /* Left shift. */
- ires = big_size(tmp_arg1) + (i / D_EXP);
+ ires = big_size(Op1) + (i / D_EXP);
} else { /* Right shift. */
- ires = big_size(tmp_arg1);
+ ires = big_size(Op1);
if (ires <= (-i / D_EXP))
ires = 3; /* ??? */
else
@@ -3140,14 +3025,14 @@ do { \
c_p->freason = SYSTEM_LIMIT;
goto lb_Cl_error;
}
- TestHeapPreserve(ires+1, Arg(1), tmp_arg1);
+ TestHeapPreserve(ires+1, Arg(1), Op1);
bigp = HTOP;
- tmp_arg1 = big_lshift(tmp_arg1, i, bigp);
- if (is_big(tmp_arg1)) {
+ Op1 = big_lshift(Op1, i, bigp);
+ if (is_big(Op1)) {
HTOP += bignum_header_arity(*HTOP) + 1;
}
HEAP_SPACE_VERIFIED(0);
- if (is_nil(tmp_arg1)) {
+ if (is_nil(Op1)) {
/*
* This result must have been only slight larger
* than allowed since it wasn't caught by the
@@ -3157,25 +3042,25 @@ do { \
goto lb_Cl_error;
}
ERTS_HOLE_CHECK(c_p);
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
}
- } else if (is_big(tmp_arg1)) {
+ } else if (is_big(Op1)) {
if (i == 0) {
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
}
goto big_shift;
}
- } else if (is_big(tmp_arg2)) {
- if (bignum_header_is_neg(*big_val(tmp_arg2))) {
+ } else if (is_big(Op2)) {
+ if (bignum_header_is_neg(*big_val(Op2))) {
/*
* N bsl NegativeBigNum is either 0 or -1, depending on
* the sign of N. Since we don't believe this case
* is common, do the calculation with the minimum
* amount of code.
*/
- tmp_arg2 = make_small(MIN_SMALL);
+ Op2 = make_small(MIN_SMALL);
goto do_bsl;
- } else if (is_small(tmp_arg1) || is_big(tmp_arg1)) {
+ } else if (is_small(Op1) || is_big(Op1)) {
/*
* N bsl PositiveBigNum is too large to represent.
*/
@@ -3199,12 +3084,10 @@ do { \
bnot_val = make_small(~signed_val(bnot_val));
} else {
Uint live = Arg(2);
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
reg[live] = bnot_val;
bnot_val = erts_gc_bnot(c_p, reg, live);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPIN;
ERTS_HOLE_CHECK(c_p);
if (is_nil(bnot_val)) {
goto lb_Cl_error;
@@ -3219,11 +3102,10 @@ do { \
OpCase(i_apply): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+1);
SET_I(next);
Dispatch();
@@ -3234,12 +3116,11 @@ do { \
OpCase(i_apply_last_P): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
- SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0]));
+ SET_CP(c_p, (BeamInstr *) E[0]);
E = ADD_BYTE_OFFSET(E, Arg(0));
SET_I(next);
Dispatch();
@@ -3250,11 +3131,10 @@ do { \
OpCase(i_apply_only): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply(c_p, r(0), x(1), x(2), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_I(next);
Dispatch();
}
@@ -3265,12 +3145,10 @@ do { \
OpCase(apply_I): {
BeamInstr *next;
- reg[0] = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = fixed_apply(c_p, reg, Arg(0));
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+2);
SET_I(next);
Dispatch();
@@ -3282,13 +3160,11 @@ do { \
OpCase(apply_last_IP): {
BeamInstr *next;
- reg[0] = r(0);
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = fixed_apply(c_p, reg, Arg(0));
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
- SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0]));
+ SET_CP(c_p, (BeamInstr *) E[0]);
E = ADD_BYTE_OFFSET(E, Arg(1));
SET_I(next);
Dispatch();
@@ -3300,11 +3176,10 @@ do { \
OpCase(i_apply_fun): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply_fun(c_p, r(0), x(1), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+1);
SET_I(next);
Dispatchfun();
@@ -3315,12 +3190,11 @@ do { \
OpCase(i_apply_fun_last_P): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply_fun(c_p, r(0), x(1), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
- SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0]));
+ SET_CP(c_p, (BeamInstr *) E[0]);
E = ADD_BYTE_OFFSET(E, Arg(0));
SET_I(next);
Dispatchfun();
@@ -3331,11 +3205,10 @@ do { \
OpCase(i_apply_fun_only): {
BeamInstr *next;
- SWAPOUT;
+ HEAVY_SWAPOUT;
next = apply_fun(c_p, r(0), x(1), reg);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_I(next);
Dispatchfun();
}
@@ -3345,13 +3218,10 @@ do { \
OpCase(i_call_fun_I): {
BeamInstr *next;
- SWAPOUT;
- reg[0] = r(0);
-
+ HEAVY_SWAPOUT;
next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_CP(c_p, I+2);
SET_I(next);
Dispatchfun();
@@ -3362,13 +3232,11 @@ do { \
OpCase(i_call_fun_last_IP): {
BeamInstr *next;
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
- SET_CP(c_p, (BeamInstr *) EXPAND_POINTER(E[0]));
+ SET_CP(c_p, (BeamInstr *) E[0]);
E = ADD_BYTE_OFFSET(E, Arg(1));
SET_I(next);
Dispatchfun();
@@ -3452,10 +3320,9 @@ do { \
*/
argp = c_p->arg_reg;
- for (i = c_p->arity - 1; i > 0; i--) {
+ for (i = c_p->arity - 1; i >= 0; i--) {
argp[i] = reg[i];
}
- c_p->arg_reg[0] = r(0);
SWAPOUT;
c_p->i = I;
goto do_schedule1;
@@ -3468,19 +3335,14 @@ do { \
Eterm* p;
PreFetch(3, next);
- GetArg2(0, element, tuple);
+ GetArg1(0, element);
+ tuple = REG_TARGET(Arg(1));
ASSERT(is_tuple(tuple));
p = (Eterm *) ((unsigned char *) tuple_val(tuple) + Arg(2));
*p = element;
NextPF(3, next);
}
- OpCase(i_is_ne_exact_f):
- if (EQ(tmp_arg1, tmp_arg2)) {
- ClauseFail();
- }
- Next(1);
-
OpCase(normal_exit): {
SWAPOUT;
c_p->freason = EXC_NORMAL;
@@ -3547,25 +3409,14 @@ do { \
{
Eterm badmatch_val;
- OpCase(badmatch_y):
- badmatch_val = yb(Arg(0));
- goto do_badmatch;
-
OpCase(badmatch_x):
badmatch_val = xb(Arg(0));
- goto do_badmatch;
-
- OpCase(badmatch_r):
- badmatch_val = r(0);
-
- do_badmatch:
c_p->fvalue = badmatch_val;
c_p->freason = BADMATCH;
}
/* Fall through here */
find_func_info: {
- reg[0] = r(0);
SWAPOUT;
I = handle_error(c_p, I, reg, NULL);
goto post_error_handling;
@@ -3582,11 +3433,9 @@ do { \
* code[3]: &&call_error_handler
* code[4]: Not used
*/
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
I = call_error_handler(c_p, I-3, reg, am_undefined_function);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPIN;
if (I) {
Goto(*I);
}
@@ -3594,18 +3443,13 @@ do { \
/* Fall through */
OpCase(error_action_code): {
handle_error:
- reg[0] = r(0);
SWAPOUT;
I = handle_error(c_p, NULL, reg, NULL);
post_error_handling:
if (I == 0) {
goto do_schedule;
} else {
- r(0) = reg[0];
ASSERT(!is_value(r(0)));
- if (c_p->mbuf) {
- erts_garbage_collect(c_p, 0, reg+1, 3);
- }
SWAPIN;
Goto(*I);
}
@@ -3629,6 +3473,9 @@ do { \
* I[3]: Function pointer to dirty NIF
*/
BifFunction vbf;
+ ErlHeapFragment *live_hf_end;
+
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF);
DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
c_p->current = I-3; /* current and vbf set to please handle_error */
@@ -3644,7 +3491,7 @@ do { \
NifF* fp = vbf = (NifF*) I[1];
struct enif_environment_t env;
erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]);
- reg[0] = r(0);
+ live_hf_end = c_p->mbuf;
nif_bif_result = (*fp)(&env, bif_nif_arity, reg);
if (env.exception_thrown)
nif_bif_result = THE_NON_VALUE;
@@ -3654,6 +3501,8 @@ do { \
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
+
DTRACE_NIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
goto apply_bif_or_nif_epilogue;
@@ -3668,6 +3517,13 @@ do { \
* code[3]: &&apply_bif
* code[4]: Function pointer to BIF function
*/
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X()) {
+ if ((Eterm)I[-3] == am_ets) {
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ETS);
+ } else {
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_BIF);
+ }
+ }
c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */
c_p->i = I; /* In case we apply check_process_code/2. */
@@ -3683,25 +3539,32 @@ do { \
bif_nif_arity = I[-1];
ASSERT(bif_nif_arity <= 4);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
- reg[0] = r(0);
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
{
Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf;
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ live_hf_end = c_p->mbuf;
nif_bif_result = (*bf)(c_p, reg, I);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
is_non_value(nif_bif_result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
}
-
+ /* We have to update the cache if we are enabled in order
+ to make sure no book keeping is done after we disabled
+ msacc. We don't always do this as it is quite expensive. */
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X())
+ ERTS_MSACC_UPDATE_CACHE_X();
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
DTRACE_BIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]);
apply_bif_or_nif_epilogue:
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
ERTS_HOLE_CHECK(c_p);
- if (c_p->mbuf) {
- nif_bif_result = erts_gc_after_bif_call(c_p, nif_bif_result,
- reg, bif_nif_arity);
+ if (ERTS_IS_GC_DESIRED(c_p)) {
+ nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end,
+ nif_bif_result,
+ reg, bif_nif_arity);
}
SWAPIN; /* There might have been a garbage collection. */
FCALLS = c_p->fcalls;
@@ -3713,7 +3576,6 @@ do { \
Goto(*I);
} else if (c_p->freason == TRAP) {
SET_I(c_p->i);
- r(0) = reg[0];
if (c_p->flags & F_HIBERNATE_SCHED) {
c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
@@ -3735,21 +3597,21 @@ do { \
StoreBifResult(1, result);
}
+ OpCase(i_get_hash_cId):
+ {
+ Eterm arg;
+ Eterm result;
+
+ GetArg1(0, arg);
+ result = erts_pd_hash_get_with_hx(c_p, Arg(1), arg);
+ StoreBifResult(2, result);
+ }
+
{
Eterm case_end_val;
OpCase(case_end_x):
case_end_val = xb(Arg(0));
- goto do_case_end;
-
- OpCase(case_end_y):
- case_end_val = yb(Arg(0));
- goto do_case_end;
-
- OpCase(case_end_r):
- case_end_val = r(0);
-
- do_case_end:
c_p->fvalue = case_end_val;
c_p->freason = EXC_CASE_CLAUSE;
goto find_func_info;
@@ -3797,19 +3659,13 @@ do { \
goto do_bs_init_bits_known;
}
- OpCase(i_bs_init_bits_fail_heap_IjId): {
- /* tmp_arg1 was fetched by an i_fetch instruction */
- num_bits_term = tmp_arg1;
- alloc = Arg(0);
- I++;
+ OpCase(i_bs_init_bits_fail_heap_sIjId): {
+ GetArg1(0, num_bits_term);
+ alloc = Arg(1);
+ I += 2;
goto do_bs_init_bits;
}
- OpCase(i_bs_init_bits_fail_rjId): {
- num_bits_term = r(0);
- alloc = 0;
- goto do_bs_init_bits;
- }
OpCase(i_bs_init_bits_fail_yjId): {
num_bits_term = yb(Arg(0));
I++;
@@ -3929,52 +3785,48 @@ do { \
}
{
- OpCase(i_bs_init_fail_heap_IjId): {
- /* tmp_arg1 was fetched by an i_fetch instruction */
- tmp_arg2 = Arg(0);
- I++;
- goto do_bs_init;
- }
+ Eterm BsOp1, BsOp2;
- OpCase(i_bs_init_fail_rjId): {
- tmp_arg1 = r(0);
- tmp_arg2 = 0;
+ OpCase(i_bs_init_fail_heap_sIjId): {
+ GetArg1(0, BsOp1);
+ BsOp2 = Arg(1);
+ I += 2;
goto do_bs_init;
}
OpCase(i_bs_init_fail_yjId): {
- tmp_arg1 = yb(Arg(0));
- tmp_arg2 = 0;
+ BsOp1 = yb(Arg(0));
+ BsOp2 = 0;
I++;
goto do_bs_init;
}
OpCase(i_bs_init_fail_xjId): {
- tmp_arg1 = xb(Arg(0));
- tmp_arg2 = 0;
+ BsOp1 = xb(Arg(0));
+ BsOp2 = 0;
I++;
}
/* FALL THROUGH */
do_bs_init:
- if (is_small(tmp_arg1)) {
- Sint size = signed_val(tmp_arg1);
+ if (is_small(BsOp1)) {
+ Sint size = signed_val(BsOp1);
if (size < 0) {
goto badarg;
}
- tmp_arg1 = (Eterm) size;
+ BsOp1 = (Eterm) size;
} else {
Uint bytes;
- if (!term_to_Uint(tmp_arg1, &bytes)) {
+ if (!term_to_Uint(BsOp1, &bytes)) {
c_p->freason = bytes;
goto lb_Cl_error;
}
if ((bytes >> (8*sizeof(Uint)-3)) != 0) {
goto system_limit;
}
- tmp_arg1 = (Eterm) bytes;
+ BsOp1 = (Eterm) bytes;
}
- if (tmp_arg1 <= ERL_ONHEAP_BIN_LIMIT) {
+ if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) {
goto do_heap_bin_alloc;
} else {
goto do_proc_bin_alloc;
@@ -3982,15 +3834,15 @@ do { \
OpCase(i_bs_init_heap_IIId): {
- tmp_arg1 = Arg(0);
- tmp_arg2 = Arg(1);
+ BsOp1 = Arg(0);
+ BsOp2 = Arg(1);
I++;
goto do_proc_bin_alloc;
}
OpCase(i_bs_init_IId): {
- tmp_arg1 = Arg(0);
- tmp_arg2 = 0;
+ BsOp1 = Arg(0);
+ BsOp2 = 0;
}
/* FALL THROUGH */
do_proc_bin_alloc: {
@@ -3999,13 +3851,13 @@ do { \
erts_bin_offset = 0;
erts_writable_bin = 0;
- TestBinVHeap(tmp_arg1 / sizeof(Eterm),
- tmp_arg2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1));
+ TestBinVHeap(BsOp1 / sizeof(Eterm),
+ BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1));
/*
* Allocate the binary struct itself.
*/
- bptr = erts_bin_nrml_alloc(tmp_arg1);
+ bptr = erts_bin_nrml_alloc(BsOp1);
erts_refc_init(&bptr->refc, 1);
erts_current_bin = (byte *) bptr->orig_bytes;
@@ -4015,28 +3867,28 @@ do { \
pb = (ProcBin *) HTOP;
HTOP += PROC_BIN_SIZE;
pb->thing_word = HEADER_PROC_BIN;
- pb->size = tmp_arg1;
+ pb->size = BsOp1;
pb->next = MSO(c_p).first;
MSO(c_p).first = (struct erl_off_heap_header*) pb;
pb->val = bptr;
pb->bytes = (byte*) bptr->orig_bytes;
pb->flags = 0;
- OH_OVERHEAD(&(MSO(c_p)), tmp_arg1 / sizeof(Eterm));
+ OH_OVERHEAD(&(MSO(c_p)), BsOp1 / sizeof(Eterm));
StoreBifResult(2, make_binary(pb));
}
OpCase(i_bs_init_heap_bin_heap_IIId): {
- tmp_arg1 = Arg(0);
- tmp_arg2 = Arg(1);
+ BsOp1 = Arg(0);
+ BsOp2 = Arg(1);
I++;
goto do_heap_bin_alloc;
}
OpCase(i_bs_init_heap_bin_IId): {
- tmp_arg1 = Arg(0);
- tmp_arg2 = 0;
+ BsOp1 = Arg(0);
+ BsOp2 = 0;
}
/* Fall through */
do_heap_bin_alloc:
@@ -4044,33 +3896,36 @@ do { \
ErlHeapBin* hb;
Uint bin_need;
- bin_need = heap_bin_size(tmp_arg1);
+ bin_need = heap_bin_size(BsOp1);
erts_bin_offset = 0;
erts_writable_bin = 0;
- TestHeap(bin_need+tmp_arg2+ERL_SUB_BIN_SIZE, Arg(1));
+ TestHeap(bin_need+BsOp2+ERL_SUB_BIN_SIZE, Arg(1));
hb = (ErlHeapBin *) HTOP;
HTOP += bin_need;
- hb->thing_word = header_heap_bin(tmp_arg1);
- hb->size = tmp_arg1;
+ hb->thing_word = header_heap_bin(BsOp1);
+ hb->size = BsOp1;
erts_current_bin = (byte *) hb->data;
- tmp_arg1 = make_binary(hb);
- StoreBifResult(2, tmp_arg1);
+ BsOp1 = make_binary(hb);
+ StoreBifResult(2, BsOp1);
}
}
- OpCase(i_bs_add_jId): {
- Uint Unit = Arg(1);
- if (is_both_small(tmp_arg1, tmp_arg2)) {
- Sint Arg1 = signed_val(tmp_arg1);
- Sint Arg2 = signed_val(tmp_arg2);
+ OpCase(bs_add_jssId): {
+ Eterm Op1, Op2;
+ Uint Unit = Arg(3);
+
+ GetArg2(1, Op1, Op2);
+ if (is_both_small(Op1, Op2)) {
+ Sint Arg1 = signed_val(Op1);
+ Sint Arg2 = signed_val(Op2);
if (Arg1 >= 0 && Arg2 >= 0) {
- BsSafeMul(Arg2, Unit, goto system_limit, tmp_arg1);
- tmp_arg1 += Arg1;
+ BsSafeMul(Arg2, Unit, goto system_limit, Op1);
+ Op1 += Arg1;
store_bs_add_result:
- if (MY_IS_SSMALL((Sint) tmp_arg1)) {
- tmp_arg1 = make_small(tmp_arg1);
+ if (Op1 <= MAX_SMALL) {
+ Op1 = make_small(Op1);
} else {
/*
* May generate a heap fragment, but in this
@@ -4082,10 +3937,10 @@ do { \
* references (such as the heap).
*/
SWAPOUT;
- tmp_arg1 = erts_make_integer(tmp_arg1, c_p);
+ Op1 = erts_make_integer(Op1, c_p);
HTOP = HEAP_TOP(c_p);
}
- StoreBifResult(2, tmp_arg1);
+ StoreBifResult(4, Op1);
}
goto badarg;
} else {
@@ -4108,16 +3963,16 @@ do { \
* an Uint, the reason is SYSTEM_LIMIT.
*/
- if (!term_to_Uint(tmp_arg1, &a)) {
+ if (!term_to_Uint(Op1, &a)) {
if (a == BADARG) {
goto badarg;
}
- if (!term_to_Uint(tmp_arg2, &b)) {
+ if (!term_to_Uint(Op2, &b)) {
c_p->freason = b;
goto lb_Cl_error;
}
goto system_limit;
- } else if (!term_to_Uint(tmp_arg2, &b)) {
+ } else if (!term_to_Uint(Op2, &b)) {
c_p->freason = b;
goto lb_Cl_error;
}
@@ -4127,8 +3982,8 @@ do { \
*/
BsSafeMul(b, Unit, goto system_limit, c);
- tmp_arg1 = a + c;
- if (tmp_arg1 < a) {
+ Op1 = a + c;
+ if (Op1 < a) {
/*
* If the result is less than one of the
* arguments, there must have been an overflow.
@@ -4150,52 +4005,47 @@ do { \
}
/*
- * tmp_arg1 = Number of bytes to build
- * tmp_arg2 = Source binary
- * Operands: Fail ExtraHeap Live Unit Dst
+ * x(SCRATCH_X_REG);
+ * Operands: Fail ExtraHeap Live Unit Size Dst
*/
- OpCase(i_bs_append_jIIId): {
+ OpCase(i_bs_append_jIIIsd): {
Uint live = Arg(2);
Uint res;
+ Eterm Size;
- SWAPOUT;
- reg[0] = r(0);
- reg[live] = tmp_arg2;
- res = erts_bs_append(c_p, reg, live, tmp_arg1, Arg(1), Arg(3));
- r(0) = reg[0];
- SWAPIN;
+ GetArg1(4, Size);
+ HEAVY_SWAPOUT;
+ reg[live] = x(SCRATCH_X_REG);
+ res = erts_bs_append(c_p, reg, live, Size, Arg(1), Arg(3));
+ HEAVY_SWAPIN;
if (is_non_value(res)) {
/* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */
goto lb_Cl_error;
}
- StoreBifResult(4, res);
+ StoreBifResult(5, res);
}
/*
- * tmp_arg1 = Number of bytes to build
- * tmp_arg2 = Source binary
- * Operands: Fail Unit Dst
+ * Operands: Fail Size Src Unit Dst
*/
- OpCase(i_bs_private_append_jId): {
+ OpCase(i_bs_private_append_jIssd): {
Eterm res;
+ Eterm Size, Src;
- res = erts_bs_private_append(c_p, tmp_arg2, tmp_arg1, Arg(1));
+ GetArg2(2, Size, Src);
+ res = erts_bs_private_append(c_p, Src, Size, Arg(1));
if (is_non_value(res)) {
/* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */
goto lb_Cl_error;
}
- StoreBifResult(2, res);
+ StoreBifResult(4, res);
}
- /*
- * tmp_arg1 = Initial size of writable binary
- * Operands: Live Dst
- */
OpCase(bs_init_writable): {
- SWAPOUT;
+ HEAVY_SWAPOUT;
r(0) = erts_bs_init_writable(c_p, r(0));
- SWAPIN;
+ HEAVY_SWAPIN;
Next(0);
}
@@ -4286,26 +4136,29 @@ do { \
/*
* Only used for validating a value matched out.
- *
- * tmp_arg1 = Integer to validate
- * tmp_arg2 = Match context
*/
- OpCase(i_bs_validate_unicode_retract_j): {
- /*
- * There is no need to untag the integer, but it IS necessary
- * to make sure it is small (a bignum pointer could fall in
- * the valid range).
- */
- if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) ||
- (make_small(0xD800UL) <= tmp_arg1 &&
- tmp_arg1 <= make_small(0xDFFFUL))) {
- ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2);
+ OpCase(i_bs_validate_unicode_retract_jss): {
+ Eterm i; /* Integer to validate */
- mb->offset -= 32;
- goto badarg;
- }
- Next(1);
- }
+ /*
+ * There is no need to untag the integer, but it IS necessary
+ * to make sure it is small (a bignum pointer could fall in
+ * the valid range).
+ */
+
+ GetArg1(1, i);
+ if (is_not_small(i) || i > make_small(0x10FFFFUL) ||
+ (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) {
+ Eterm ms; /* Match context */
+ ErlBinMatchBuffer* mb;
+
+ GetArg1(2, ms);
+ mb = ms_matchbuffer(ms);
+ mb->offset -= 32;
+ goto badarg;
+ }
+ Next(3);
+ }
/*
* Matching of binaries.
@@ -4317,9 +4170,6 @@ do { \
Uint slots;
Eterm context;
- OpCase(i_bs_start_match2_rfIId): {
- context = r(0);
-
do_start_match:
slots = Arg(2);
if (!is_boxed(context)) {
@@ -4366,7 +4216,7 @@ do { \
ClauseFail();
}
NextPF(4, next);
- }
+
OpCase(i_bs_start_match2_xfIId): {
context = xb(Arg(0));
I++;
@@ -4379,18 +4229,6 @@ do { \
}
}
- OpCase(bs_test_zero_tail2_fr): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
-
- PreFetch(1, next);
- _mb = (ErlBinMatchBuffer*) ms_matchbuffer(r(0));
- if (_mb->size != _mb->offset) {
- ClauseFail();
- }
- NextPF(1, next);
- }
-
OpCase(bs_test_zero_tail2_fx): {
BeamInstr *next;
ErlBinMatchBuffer *_mb;
@@ -4403,16 +4241,6 @@ do { \
NextPF(2, next);
}
- OpCase(bs_test_tail_imm2_frI): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(2, next);
- _mb = ms_matchbuffer(r(0));
- if (_mb->size - _mb->offset != Arg(1)) {
- ClauseFail();
- }
- NextPF(2, next);
- }
OpCase(bs_test_tail_imm2_fxI): {
BeamInstr *next;
ErlBinMatchBuffer *_mb;
@@ -4424,16 +4252,6 @@ do { \
NextPF(3, next);
}
- OpCase(bs_test_unit_frI): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(2, next);
- _mb = ms_matchbuffer(r(0));
- if ((_mb->size - _mb->offset) % Arg(1)) {
- ClauseFail();
- }
- NextPF(2, next);
- }
OpCase(bs_test_unit_fxI): {
BeamInstr *next;
ErlBinMatchBuffer *_mb;
@@ -4445,16 +4263,6 @@ do { \
NextPF(3, next);
}
- OpCase(bs_test_unit8_fr): {
- BeamInstr *next;
- ErlBinMatchBuffer *_mb;
- PreFetch(1, next);
- _mb = ms_matchbuffer(r(0));
- if ((_mb->size - _mb->offset) & 7) {
- ClauseFail();
- }
- NextPF(1, next);
- }
OpCase(bs_test_unit8_fx): {
BeamInstr *next;
ErlBinMatchBuffer *_mb;
@@ -4469,19 +4277,11 @@ do { \
{
Eterm bs_get_integer8_context;
- OpCase(i_bs_get_integer_8_rfd): {
- bs_get_integer8_context = r(0);
- goto do_bs_get_integer_8;
- }
-
OpCase(i_bs_get_integer_8_xfd): {
- bs_get_integer8_context = xb(Arg(0));
- I++;
- }
-
- do_bs_get_integer_8: {
ErlBinMatchBuffer *_mb;
Eterm _result;
+ bs_get_integer8_context = xb(Arg(0));
+ I++;
_mb = ms_matchbuffer(bs_get_integer8_context);
if (_mb->size - _mb->offset < 8) {
ClauseFail();
@@ -4499,15 +4299,10 @@ do { \
{
Eterm bs_get_integer_16_context;
- OpCase(i_bs_get_integer_16_rfd):
- bs_get_integer_16_context = r(0);
- goto do_bs_get_integer_16;
-
OpCase(i_bs_get_integer_16_xfd):
bs_get_integer_16_context = xb(Arg(0));
I++;
- do_bs_get_integer_16:
{
ErlBinMatchBuffer *_mb;
Eterm _result;
@@ -4528,17 +4323,10 @@ do { \
{
Eterm bs_get_integer_32_context;
- OpCase(i_bs_get_integer_32_rfId):
- bs_get_integer_32_context = r(0);
- goto do_bs_get_integer_32;
-
-
OpCase(i_bs_get_integer_32_xfId):
bs_get_integer_32_context = xb(Arg(0));
I++;
-
- do_bs_get_integer_32:
{
ErlBinMatchBuffer *_mb;
Uint32 _integer;
@@ -4551,11 +4339,11 @@ do { \
_integer = get_int32(_mb->base + _mb->offset/8);
}
_mb->offset += 32;
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
if (IS_USMALL(0, _integer)) {
#endif
_result = make_small(_integer);
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
} else {
TestHeap(BIG_UINT_HEAP_SIZE, Arg(1));
_result = uint_to_big((Uint) _integer, HTOP);
@@ -4567,103 +4355,82 @@ do { \
}
}
- /* Operands: Size Live Fail Flags Dst */
- OpCase(i_bs_get_integer_imm_rIIfId): {
- tmp_arg1 = r(0);
- /* Operands: Size Live Fail Flags Dst */
- goto do_bs_get_integer_imm_test_heap;
- }
+ {
+ Eterm Ms, Sz;
- /* Operands: x(Reg) Size Live Fail Flags Dst */
+ /* Operands: x(Reg) Size Live Fail Flags Dst */
OpCase(i_bs_get_integer_imm_xIIfId): {
- tmp_arg1 = xb(Arg(0));
- I++;
- /* Operands: Size Live Fail Flags Dst */
- goto do_bs_get_integer_imm_test_heap;
- }
-
- /*
- * tmp_arg1 = match context
- * Operands: Size Live Fail Flags Dst
- */
- do_bs_get_integer_imm_test_heap: {
- Uint wordsneeded;
- tmp_arg2 = Arg(0);
- wordsneeded = 1+WSIZE(NBYTES(tmp_arg2));
- TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1);
- I += 2;
- /* Operands: Fail Flags Dst */
- goto do_bs_get_integer_imm;
- }
-
- /* Operands: Size Fail Flags Dst */
- OpCase(i_bs_get_integer_small_imm_rIfId): {
- tmp_arg1 = r(0);
- tmp_arg2 = Arg(0);
- I++;
- /* Operands: Fail Flags Dst */
- goto do_bs_get_integer_imm;
- }
+ Uint wordsneeded;
+ Ms = xb(Arg(0));
+ Sz = Arg(1);
+ wordsneeded = 1+WSIZE(NBYTES(Sz));
+ TestHeapPreserve(wordsneeded, Arg(2), Ms);
+ I += 3;
+ /* Operands: Fail Flags Dst */
+ goto do_bs_get_integer_imm;
+ }
- /* Operands: x(Reg) Size Fail Flags Dst */
+ /* Operands: x(Reg) Size Fail Flags Dst */
OpCase(i_bs_get_integer_small_imm_xIfId): {
- tmp_arg1 = xb(Arg(0));
- tmp_arg2 = Arg(1);
- I += 2;
- /* Operands: Fail Flags Dst */
- goto do_bs_get_integer_imm;
- }
+ Ms = xb(Arg(0));
+ Sz = Arg(1);
+ I += 2;
+ /* Operands: Fail Flags Dst */
+ goto do_bs_get_integer_imm;
+ }
- /*
- * tmp_arg1 = match context
- * tmp_arg2 = size of field
- * Operands: Fail Flags Dst
- */
+ /*
+ * Ms = match context
+ * Sz = size of field
+ * Operands: Fail Flags Dst
+ */
do_bs_get_integer_imm: {
- ErlBinMatchBuffer* mb;
- Eterm result;
+ ErlBinMatchBuffer* mb;
+ Eterm result;
- mb = ms_matchbuffer(tmp_arg1);
- LIGHT_SWAPOUT;
- result = erts_bs_get_integer_2(c_p, tmp_arg2, Arg(1), mb);
- LIGHT_SWAPIN;
- HEAP_SPACE_VERIFIED(0);
- if (is_non_value(result)) {
- ClauseFail();
+ mb = ms_matchbuffer(Ms);
+ LIGHT_SWAPOUT;
+ result = erts_bs_get_integer_2(c_p, Sz, Arg(1), mb);
+ LIGHT_SWAPIN;
+ HEAP_SPACE_VERIFIED(0);
+ if (is_non_value(result)) {
+ ClauseFail();
+ }
+ StoreBifResult(2, result);
}
- StoreBifResult(2, result);
}
/*
- * tmp_arg1 = Match context
- * tmp_arg2 = Size field
- * Operands: Fail Live FlagsAndUnit Dst
+ * Operands: Fail Live FlagsAndUnit Ms Sz Dst
*/
- OpCase(i_bs_get_integer_fIId): {
+ OpCase(i_bs_get_integer_fIIssd): {
Uint flags;
Uint size;
+ Eterm Ms;
+ Eterm Sz;
ErlBinMatchBuffer* mb;
Eterm result;
flags = Arg(2);
- BsGetFieldSize(tmp_arg2, (flags >> 3), ClauseFail(), size);
+ GetArg2(3, Ms, Sz);
+ BsGetFieldSize(Sz, (flags >> 3), ClauseFail(), size);
if (size >= SMALL_BITS) {
Uint wordsneeded;
- /* check bits size before potential gc.
+ /* Check bits size before potential gc.
* We do not want a gc and then realize we don't need
- * the allocated space (i.e. if the op fails)
+ * the allocated space (i.e. if the op fails).
*
- * remember to reacquire the matchbuffer after gc.
+ * Remember to re-acquire the matchbuffer after gc.
*/
- mb = ms_matchbuffer(tmp_arg1);
+ mb = ms_matchbuffer(Ms);
if (mb->size - mb->offset < size) {
ClauseFail();
}
wordsneeded = 1+WSIZE(NBYTES((Uint) size));
- TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1);
+ TestHeapPreserve(wordsneeded, Arg(1), Ms);
}
- mb = ms_matchbuffer(tmp_arg1);
+ mb = ms_matchbuffer(Ms);
LIGHT_SWAPOUT;
result = erts_bs_get_integer_2(c_p, size, flags, mb);
LIGHT_SWAPIN;
@@ -4671,18 +4438,13 @@ do { \
if (is_non_value(result)) {
ClauseFail();
}
- StoreBifResult(3, result);
+ StoreBifResult(5, result);
}
{
Eterm get_utf8_context;
/* Operands: MatchContext Fail Dst */
- OpCase(i_bs_get_utf8_rfd): {
- get_utf8_context = r(0);
- goto do_bs_get_utf8;
- }
-
OpCase(i_bs_get_utf8_xfd): {
get_utf8_context = xb(Arg(0));
I++;
@@ -4693,7 +4455,7 @@ do { \
* Operands: Fail Dst
*/
- do_bs_get_utf8: {
+ {
Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context));
if (is_non_value(result)) {
ClauseFail();
@@ -4706,12 +4468,7 @@ do { \
Eterm get_utf16_context;
/* Operands: MatchContext Fail Flags Dst */
- OpCase(i_bs_get_utf16_rfId): {
- get_utf16_context = r(0);
- goto do_bs_get_utf16;
- }
-
- OpCase(i_bs_get_utf16_xfId): {
+ OpCase(i_bs_get_utf16_xfId): {
get_utf16_context = xb(Arg(0));
I++;
}
@@ -4720,7 +4477,7 @@ do { \
* get_utf16_context = match_context
* Operands: Fail Flags Dst
*/
- do_bs_get_utf16: {
+ {
Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context),
Arg(1));
if (is_non_value(result)) {
@@ -4739,26 +4496,10 @@ do { \
Uint orig;
Uint hole_size;
- OpCase(bs_context_to_binary_r): {
- context_to_binary_context = x0;
- I -= 2;
- goto do_context_to_binary;
- }
-
- /* Unfortunately, inlining can generate this instruction. */
- OpCase(bs_context_to_binary_y): {
- context_to_binary_context = yb(Arg(0));
- goto do_context_to_binary0;
- }
-
- OpCase(bs_context_to_binary_x): {
+ OpCase(bs_context_to_binary_x):
context_to_binary_context = xb(Arg(0));
-
- do_context_to_binary0:
I--;
- }
- do_context_to_binary:
if (is_boxed(context_to_binary_context) &&
header_is_bin_matchstate(*boxed_val(context_to_binary_context))) {
ErlBinMatchState* ms;
@@ -4770,17 +4511,11 @@ do { \
}
Next(2);
- OpCase(i_bs_get_binary_all_reuse_rfI): {
- context_to_binary_context = x0;
- goto do_bs_get_binary_all_reuse;
- }
-
OpCase(i_bs_get_binary_all_reuse_xfI): {
context_to_binary_context = xb(Arg(0));
I++;
}
- do_bs_get_binary_all_reuse:
mb = ms_matchbuffer(context_to_binary_context);
size = mb->size - mb->offset;
if (size % Arg(1) != 0) {
@@ -4808,16 +4543,11 @@ do { \
{
Eterm match_string_context;
- OpCase(i_bs_match_string_rfII): {
- match_string_context = r(0);
- goto do_bs_match_string;
- }
OpCase(i_bs_match_string_xfII): {
match_string_context = xb(Arg(0));
I++;
}
- do_bs_match_string:
{
BeamInstr *next;
byte* bytes;
@@ -4845,14 +4575,6 @@ do { \
}
}
- OpCase(i_bs_save2_rI): {
- BeamInstr *next;
- ErlBinMatchState *_ms;
- PreFetch(1, next);
- _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0));
- _ms->save_offset[Arg(0)] = _ms->mb.offset;
- NextPF(1, next);
- }
OpCase(i_bs_save2_xI): {
BeamInstr *next;
ErlBinMatchState *_ms;
@@ -4862,14 +4584,6 @@ do { \
NextPF(2, next);
}
- OpCase(i_bs_restore2_rI): {
- BeamInstr *next;
- ErlBinMatchState *_ms;
- PreFetch(1, next);
- _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0));
- _ms->mb.offset = _ms->save_offset[Arg(0)];
- NextPF(1, next);
- }
OpCase(i_bs_restore2_xI): {
BeamInstr *next;
ErlBinMatchState *_ms;
@@ -4917,9 +4631,7 @@ do { \
BeamInstr real_I;
ASSERT(I[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
SWAPOUT;
- reg[0] = r(0);
real_I = erts_generic_breakpoint(c_p, I, reg);
- r(0) = reg[0];
SWAPIN;
ASSERT(VALID_INSTR(real_I));
Goto(real_I);
@@ -4979,7 +4691,7 @@ do { \
BeamInstr *next;
PreFetch(2, next);
- GetR(0, targ1);
+ targ1 = REG_TARGET(Arg(0));
/* Arg(0) == HEADER_FLONUM */
GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr));
NextPF(2, next);
@@ -4999,7 +4711,7 @@ do { \
Eterm fr = Arg(1);
BeamInstr *next;
- GetR(0, targ1);
+ targ1 = REG_TARGET(Arg(0));
PreFetch(2, next);
if (is_small(targ1)) {
fb(fr) = (double) signed_val(targ1);
@@ -5018,7 +4730,7 @@ do { \
#ifdef NO_FPE_SIGNALS
OpCase(fclearerror):
OpCase(i_fcheckerror):
- erl_exit(1, "fclearerror/i_fcheckerror without fpe signals (beam_emu)");
+ erts_exit(ERTS_ERROR_EXIT, "fclearerror/i_fcheckerror without fpe signals (beam_emu)");
# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT
# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR
#else
@@ -5095,7 +4807,12 @@ do { \
#ifdef HIPE
{
- unsigned cmd;
+#define HIPE_MODE_SWITCH(Cmd) \
+ SWAPOUT; \
+ c_p->fcalls = FCALLS; \
+ c_p->def_arg_reg[4] = -neg_o_reds; \
+ c_p = hipe_mode_switch(c_p, Cmd, reg); \
+ goto L_post_hipe_mode_switch
OpCase(hipe_trap_call): {
/*
@@ -5109,52 +4826,45 @@ do { \
*/
ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
c_p->hipe.u.ncallee = (void(*)(void)) I[-4];
- cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8);
++hipe_trap_count;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8));
}
OpCase(hipe_trap_call_closure): {
ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
c_p->hipe.u.ncallee = (void(*)(void)) I[-4];
- cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8);
++hipe_trap_count;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8));
}
OpCase(hipe_trap_return): {
- cmd = HIPE_MODE_SWITCH_CMD_RETURN;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN);
}
OpCase(hipe_trap_throw): {
- cmd = HIPE_MODE_SWITCH_CMD_THROW;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW);
}
OpCase(hipe_trap_resume): {
- cmd = HIPE_MODE_SWITCH_CMD_RESUME;
- goto L_hipe_mode_switch;
+ HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME);
}
- L_hipe_mode_switch:
- /* XXX: this abuse of def_arg_reg[] is horrid! */
- SWAPOUT;
- c_p->fcalls = FCALLS;
- c_p->def_arg_reg[4] = -neg_o_reds;
- reg[0] = r(0);
- c_p = hipe_mode_switch(c_p, cmd, reg);
+#undef HIPE_MODE_SWITCH
+
+ L_post_hipe_mode_switch:
reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array;
freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array;
ERL_BITS_RELOAD_STATEP(c_p);
+ /* XXX: this abuse of def_arg_reg[] is horrid! */
neg_o_reds = -c_p->def_arg_reg[4];
FCALLS = c_p->fcalls;
SWAPIN;
- switch( c_p->def_arg_reg[3] ) { /* Halfword wont work with hipe yet! */
+ switch( c_p->def_arg_reg[3] ) {
case HIPE_MODE_SWITCH_RES_RETURN:
ASSERT(is_value(reg[0]));
- MoveReturn(reg[0], r(0));
+ SET_I(c_p->cp);
+ c_p->cp = 0;
+ Goto(*I);
case HIPE_MODE_SWITCH_RES_CALL_EXPORTED:
c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()];
/*fall through*/
case HIPE_MODE_SWITCH_RES_CALL_BEAM:
SET_I(c_p->i);
- r(0) = reg[0];
Dispatch();
case HIPE_MODE_SWITCH_RES_CALL_CLOSURE:
/* This can be used to call any function value, but currently it's
@@ -5163,9 +4873,8 @@ do { \
BeamInstr *next;
next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE);
- SWAPIN;
+ HEAVY_SWAPIN;
if (next != NULL) {
- r(0) = reg[0];
SET_I(next);
Dispatchfun();
}
@@ -5176,7 +4885,7 @@ do { \
I = handle_error(c_p, I, reg, NULL);
goto post_error_handling;
default:
- erl_exit(1, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]);
+ erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]);
}
}
OpCase(hipe_call_count): {
@@ -5213,22 +4922,54 @@ do { \
}
OpCase(i_hibernate): {
- SWAPOUT;
+ HEAVY_SWAPOUT;
if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) {
+ FCALLS = c_p->fcalls;
c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
} else {
+ HEAVY_SWAPIN;
I = handle_error(c_p, I, reg, hibernate_3);
goto post_error_handling;
}
}
+ /* This is optimised as an instruction because
+ it has to be very very fast */
+ OpCase(i_perf_counter): {
+ BeamInstr* next;
+ ErtsSysPerfCounter ts;
+ PreFetch(0, next);
+
+ ts = erts_sys_perf_counter();
+
+ if (IS_SSMALL(ts)) {
+ r(0) = make_small((Sint)ts);
+ } else {
+ TestHeap(ERTS_SINT64_HEAP_SIZE(ts),0);
+ r(0) = make_big(HTOP);
+#if defined(ARCH_32) || HALFWORD_HEAP
+ if (ts >= (((Uint64) 1) << 32)) {
+ *HTOP = make_pos_bignum_header(2);
+ BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff));
+ BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff));
+ HTOP += 3;
+ }
+ else
+#endif
+ {
+ *HTOP = make_pos_bignum_header(1);
+ BIG_DIGIT(HTOP, 0) = (Uint) ts;
+ HTOP += 2;
+ }
+ }
+ NextPF(0, next);
+ }
+
OpCase(i_debug_breakpoint): {
- SWAPOUT;
- reg[0] = r(0);
+ HEAVY_SWAPOUT;
I = call_error_handler(c_p, I-3, reg, am_breakpoint);
- r(0) = reg[0];
- SWAPIN;
+ HEAVY_SWAPIN;
if (I) {
Goto(*I);
}
@@ -5256,7 +4997,7 @@ do { \
OpCase(label_L):
OpCase(on_load):
OpCase(line_I):
- erl_exit(1, "meta op\n");
+ erts_exit(ERTS_ERROR_EXIT, "meta op\n");
/*
* One-time initialization of Beam emulator.
@@ -5310,7 +5051,7 @@ do { \
}
#ifdef NO_JUMP_TABLE
default:
- erl_exit(1, "unexpected op code %d\n",Go);
+ erts_exit(ERTS_ERROR_EXIT, "unexpected op code %d\n",Go);
}
#endif
return; /* Never executed */
@@ -5355,7 +5096,7 @@ translate_gc_bif(void* gcf)
} else if (gcf == erts_gc_binary_part_3) {
return binary_part_3;
} else {
- erl_exit(1, "bad gc bif");
+ erts_exit(ERTS_ERROR_EXIT, "bad gc bif");
}
}
@@ -5420,7 +5161,7 @@ handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf)
Eterm* hp;
Eterm Value = c_p->fvalue;
Eterm Args = am_true;
- c_p->i = pc; /* In case we call erl_exit(). */
+ c_p->i = pc; /* In case we call erts_exit(). */
ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */
@@ -5484,7 +5225,7 @@ handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, BifFunction bf)
c_p->cp = 0; /* To avoid keeping stale references. */
return new_pc;
}
- if (c_p->catches > 0) erl_exit(1, "Catch not found");
+ if (c_p->catches > 0) erts_exit(ERTS_ERROR_EXIT, "Catch not found");
}
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
terminate_proc(c_p, Value);
@@ -6439,7 +6180,7 @@ call_fun(Process* p, /* Current process. */
*/
module = fe->module;
if ((modp = erts_get_module(module, code_ix)) != NULL
- && modp->curr.code != NULL) {
+ && modp->curr.code_hdr != NULL) {
/*
* There is a module loaded, but obviously the fun is not
* defined in it. We must not call the error_handler
@@ -6644,23 +6385,20 @@ static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx)
return vs ? *vs : THE_NON_VALUE;
}
-#define GET_TERM(term, dest) \
-do { \
- Eterm src = (Eterm)(term); \
- switch (src & _TAG_IMMED1_MASK) { \
- case (R_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- dest = x(0); \
- break; \
- case (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- dest = x(src >> _TAG_IMMED1_SIZE); \
- break; \
- case (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER: \
- dest = y(src >> _TAG_IMMED1_SIZE); \
- break; \
- default: \
- dest = src; \
- break; \
- } \
+#define GET_TERM(term, dest) \
+do { \
+ Eterm src = (Eterm)(term); \
+ switch (loader_tag(src)) { \
+ case LOADER_X_REG: \
+ dest = x(loader_x_reg_index(src)); \
+ break; \
+ case LOADER_Y_REG: \
+ dest = y(loader_y_reg_index(src)); \
+ break; \
+ default: \
+ dest = src; \
+ break; \
+ } \
} while(0)
@@ -6699,13 +6437,6 @@ new_map(Process* p, Eterm* reg, BeamInstr* I)
erts_factory_proc_init(&factory, p);
res = erts_hashmap_from_array(&factory, thp, n/2, 0);
erts_factory_close(&factory);
- if (p->mbuf) {
- Uint live = Arg(2);
- reg[live] = res;
- erts_garbage_collect(p, 0, reg, live+1);
- res = reg[live];
- E = p->stop;
- }
return res;
}
@@ -6771,13 +6502,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
hx = hashmap_make_hash(new_key);
res = erts_hashmap_insert(p, hx, new_key, val, res, 0);
- if (p->mbuf) {
- Uint live = Arg(3);
- reg[live] = res;
- erts_garbage_collect(p, 0, reg, live+1);
- res = reg[live];
- E = p->stop;
- }
new_p += 2;
}
@@ -6937,12 +6661,6 @@ update_map_assoc(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
/* The expensive case, need to build a hashmap */
if (n > MAP_SMALL_MAP_LIMIT) {
res = erts_hashmap_from_ks_and_vs(p,flatmap_get_keys(mp),flatmap_get_values(mp),n);
- if (p->mbuf) {
- Uint live = Arg(3);
- reg[live] = res;
- erts_garbage_collect(p, 0, reg, live+1);
- res = reg[live];
- }
}
return res;
}
@@ -6998,14 +6716,6 @@ update_map_exact(Process* p, Eterm* reg, Eterm map, BeamInstr* I)
return res;
}
- if (p->mbuf) {
- Uint live = Arg(3);
- reg[live] = res;
- erts_garbage_collect(p, 0, reg, live+1);
- res = reg[live];
- E = p->stop;
- }
-
new_p += 2;
}
return res;
@@ -7114,6 +6824,15 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity)
Export e;
Export* ep;
+ if (Mod == am_erlang && Name == am_apply && arity == 3) {
+ /*
+ * Special case. apply/3 is built-in (implemented in C),
+ * but implemented in a different way than all other
+ * BIFs.
+ */
+ return 1;
+ }
+
e.code[0] = Mod;
e.code[1] = Name;
e.code[2] = arity;
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index b70e5b9a2d..f115df935f 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -80,7 +80,7 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int);
typedef struct {
Uint value; /* Value of label (NULL if not known yet). */
- Uint patches; /* Index (into code buffer) to first location
+ Sint patches; /* Index (into code buffer) to first location
* which must be patched with the value of this label.
*/
#ifdef ERTS_SMP
@@ -284,9 +284,10 @@ typedef struct LoaderState {
int specific_op; /* Specific opcode (-1 if not found). */
int num_functions; /* Number of functions in module. */
int num_labels; /* Number of labels. */
- int code_buffer_size; /* Size of code buffer in words. */
- BeamInstr* code; /* Loaded code. */
- int ci; /* Current index into loaded code. */
+ BeamCodeHeader* hdr; /* Loaded code header */
+ BeamInstr* codev; /* Loaded code buffer */
+ int codev_size; /* Size of code buffer in words. */
+ int ci; /* Current index into loaded code buffer. */
Label* labels;
StringPatch* string_patches; /* Linked list of position into string table to patch. */
BeamInstr catches; /* Linked list of catch_yf instructions. */
@@ -480,7 +481,7 @@ static void free_literal_fragment(ErlHeapFragment*);
static void loader_state_dtor(Binary* magic);
static Eterm insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
Eterm group_leader, Eterm module,
- BeamInstr* code, Uint size);
+ BeamCodeHeader* code, Uint size);
static int init_iff_file(LoaderState* stp, byte* code, Uint size);
static int scan_iff_file(LoaderState* stp, Uint* chunk_types,
Uint num_types, Uint num_mandatory);
@@ -526,15 +527,15 @@ static void new_string_patch(LoaderState* stp, int pos);
static Uint new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size);
static int genopargcompare(GenOpArg* a, GenOpArg* b);
static Eterm get_module_info(Process* p, ErtsCodeIndex code_ix,
- BeamInstr* code, Eterm module, Eterm what);
+ BeamCodeHeader*, Eterm module, Eterm what);
static Eterm exported_from_module(Process* p, ErtsCodeIndex code_ix,
Eterm mod);
-static Eterm functions_in_module(Process* p, BeamInstr* code);
-static Eterm attributes_for_module(Process* p, BeamInstr* code);
-static Eterm compilation_info_for_module(Process* p, BeamInstr* code);
-static Eterm md5_of_module(Process* p, BeamInstr* code);
-static Eterm has_native(BeamInstr* code);
-static Eterm native_addresses(Process* p, BeamInstr* code);
+static Eterm functions_in_module(Process* p, BeamCodeHeader*);
+static Eterm attributes_for_module(Process* p, BeamCodeHeader*);
+static Eterm compilation_info_for_module(Process* p, BeamCodeHeader*);
+static Eterm md5_of_module(Process* p, BeamCodeHeader*);
+static Eterm has_native(BeamCodeHeader*);
+static Eterm native_addresses(Process* p, BeamCodeHeader*);
int patch_funentries(Eterm Patchlist);
int patch(Eterm Addresses, Uint fe);
static int safe_mul(UWord a, UWord b, UWord* resp);
@@ -601,6 +602,7 @@ extern void check_allocated_block(Uint type, void *blk);
#define CHKBLK(TYPE,BLK) /* nothing */
#endif
+
Eterm
erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
Eterm* modp, byte* code, Uint unloaded_size)
@@ -641,20 +643,27 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
/*
* Initialize code area.
*/
- stp->code_buffer_size = 2048 + stp->num_functions;
- stp->code = (BeamInstr *) erts_alloc(ERTS_ALC_T_CODE,
- sizeof(BeamInstr) * stp->code_buffer_size);
+ stp->codev_size = 2048 + stp->num_functions;
+ stp->hdr = (BeamCodeHeader*) erts_alloc(ERTS_ALC_T_CODE,
+ (offsetof(BeamCodeHeader,functions)
+ + sizeof(BeamInstr) * stp->codev_size));
- stp->code[MI_NUM_FUNCTIONS] = stp->num_functions;
- stp->ci = MI_FUNCTIONS + stp->num_functions + 1;
+ stp->hdr->num_functions = stp->num_functions;
- stp->code[MI_ATTR_PTR] = 0;
- stp->code[MI_ATTR_SIZE] = 0;
- stp->code[MI_ATTR_SIZE_ON_HEAP] = 0;
- stp->code[MI_COMPILE_PTR] = 0;
- stp->code[MI_COMPILE_SIZE] = 0;
- stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0;
- stp->code[MI_MD5_PTR] = 0;
+ /* Let the codev array start at functions[0] in order to index
+ * both function pointers and the loaded code itself that follows.
+ */
+ stp->codev = (BeamInstr*) &stp->hdr->functions;
+ stp->ci = stp->num_functions + 1;
+
+ stp->hdr->attr_ptr = NULL;
+ stp->hdr->attr_size = 0;
+ stp->hdr->attr_size_on_heap = 0;
+ stp->hdr->compile_ptr = NULL;
+ stp->hdr->compile_size = 0;
+ stp->hdr->compile_size_on_heap = 0;
+ stp->hdr->literals_start = NULL;
+ stp->hdr->md5_ptr = NULL;
/*
* Read the atom table.
@@ -776,7 +785,7 @@ erts_finish_loading(Binary* magic, Process* c_p,
CHKBLK(ERTS_ALC_T_CODE,stp->code);
retval = insert_new_code(c_p, c_p_locks, stp->group_leader, stp->module,
- stp->code, stp->loaded_size);
+ stp->hdr, stp->loaded_size);
if (retval != NIL) {
goto load_error;
}
@@ -799,7 +808,8 @@ erts_finish_loading(Binary* magic, Process* c_p,
debug_dump_code(stp->code,stp->ci);
#endif
#endif
- stp->code = NULL; /* Prevent code from being freed. */
+ stp->hdr = NULL; /* Prevent code from being freed. */
+ stp->codev = NULL;
*modp = stp->module;
/*
@@ -831,7 +841,8 @@ erts_alloc_loader_state(void)
stp->specific_op = -1;
stp->genop = NULL;
stp->atom = NULL;
- stp->code = NULL;
+ stp->hdr = NULL;
+ stp->codev = NULL;
stp->labels = NULL;
stp->import = NULL;
stp->export = NULL;
@@ -870,13 +881,30 @@ erts_module_for_prepared_code(Binary* magic)
return NIL;
}
stp = ERTS_MAGIC_BIN_DATA(magic);
- if (stp->code != 0) {
+ if (stp->hdr != 0) {
return stp->module;
} else {
return NIL;
}
}
+/*
+ * Return a non-zero value if the module has an on_load function,
+ * or 0 if it does not.
+ */
+
+Eterm
+erts_has_code_on_load(Binary* magic)
+{
+ LoaderState* stp;
+
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != loader_state_dtor) {
+ return NIL;
+ }
+ stp = ERTS_MAGIC_BIN_DATA(magic);
+ return stp->on_load ? am_true : am_false;
+}
+
static void
free_loader_state(Binary* magic)
{
@@ -891,7 +919,7 @@ static ErlHeapFragment* new_literal_fragment(Uint size)
ErlHeapFragment* bp;
bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_PREPARED_CODE,
ERTS_HEAP_FRAG_SIZE(size));
- ERTS_INIT_HEAP_FRAG(bp, size);
+ ERTS_INIT_HEAP_FRAG(bp, size, size);
return bp;
}
@@ -920,9 +948,13 @@ loader_state_dtor(Binary* magic)
driver_free_binary(stp->bin);
stp->bin = 0;
}
- if (stp->code != 0) {
- erts_free(ERTS_ALC_T_CODE, stp->code);
- stp->code = 0;
+ if (stp->hdr != 0) {
+ if (stp->hdr->literals_start) {
+ erts_free(ERTS_ALC_T_LITERAL, stp->hdr->literals_start);
+ }
+ erts_free(ERTS_ALC_T_CODE, stp->hdr);
+ stp->hdr = 0;
+ stp->codev = 0;
}
if (stp->labels != 0) {
erts_free(ERTS_ALC_T_PREPARED_CODE, (void *) stp->labels);
@@ -995,7 +1027,7 @@ loader_state_dtor(Binary* magic)
static Eterm
insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
- Eterm group_leader, Eterm module, BeamInstr* code,
+ Eterm group_leader, Eterm module, BeamCodeHeader* code_hdr,
Uint size)
{
Module* modp;
@@ -1016,7 +1048,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
erts_total_code_size += size;
modp = erts_put_module(module);
- modp->curr.code = code;
+ modp->curr.code_hdr = code_hdr;
modp->curr.code_length = size;
modp->curr.catches = BEAM_CATCHES_NIL; /* Will be filled in later. */
@@ -1024,7 +1056,7 @@ insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
* Update ranges (used for finding a function from a PC value).
*/
- erts_update_ranges(code, size);
+ erts_update_ranges((BeamInstr*)modp->curr.code_hdr, size);
return NIL;
}
@@ -1373,7 +1405,7 @@ read_export_table(LoaderState* stp)
if (value == 0) {
LoadError2(stp, "export table entry %d: label %d not resolved", i, n);
}
- stp->export[i].address = address = stp->code + value;
+ stp->export[i].address = address = stp->codev + value;
/*
* Find out if there is a BIF with the same name.
@@ -1392,7 +1424,7 @@ read_export_table(LoaderState* stp)
* any other functions that walk through all local functions.
*/
- if (stp->labels[n].patches) {
+ if (stp->labels[n].patches >= 0) {
LoadError3(stp, "there are local calls to the stub for "
"the BIF %T:%T/%d",
stp->module, func, arity);
@@ -1513,8 +1545,8 @@ read_literal_table(LoaderState* stp)
}
if (heap_size > 0) {
- erts_factory_message_init(&factory, NULL, NULL,
- new_literal_fragment(heap_size));
+ erts_factory_heap_frag_init(&factory,
+ new_literal_fragment(heap_size));
factory.alloc_type = ERTS_ALC_T_PREPARED_CODE;
val = erts_decode_ext(&factory, &p);
@@ -1735,7 +1767,7 @@ read_code_header(LoaderState* stp)
stp->num_labels * sizeof(Label));
for (i = 0; i < stp->num_labels; i++) {
stp->labels[i].value = 0;
- stp->labels[i].patches = 0;
+ stp->labels[i].patches = -1;
#ifdef ERTS_SMP
stp->labels[i].looprec_targeted = 0;
#endif
@@ -1754,13 +1786,14 @@ read_code_header(LoaderState* stp)
} else {}
#define CodeNeed(w) do { \
- ASSERT(ci <= code_buffer_size); \
- if (code_buffer_size < ci+(w)) { \
- code_buffer_size = 2*ci+(w); \
- stp->code = code = \
- (BeamInstr *) erts_realloc(ERTS_ALC_T_CODE, \
- (void *) code, \
- code_buffer_size * sizeof(BeamInstr)); \
+ ASSERT(ci <= codev_size); \
+ if (codev_size < ci+(w)) { \
+ codev_size = 2*ci+(w); \
+ stp->hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, \
+ (void *) stp->hdr, \
+ (offsetof(BeamCodeHeader,functions) \
+ + codev_size * sizeof(BeamInstr))); \
+ code = stp->codev = (BeamInstr*) &stp->hdr->functions; \
} \
} while (0)
@@ -1776,7 +1809,7 @@ load_code(LoaderState* stp)
int arg; /* Number of current argument. */
int num_specific; /* Number of specific ops for current. */
BeamInstr* code;
- int code_buffer_size;
+ int codev_size;
int specific;
Uint last_label = 0; /* Number of last label. */
Uint function_number = 0;
@@ -1793,15 +1826,15 @@ load_code(LoaderState* stp)
FUNC_INFO_SZ = 5
};
- code = stp->code;
- code_buffer_size = stp->code_buffer_size;
+ code = stp->codev;
+ codev_size = stp->codev_size;
ci = stp->ci;
for (;;) {
int new_op;
GenOp* tmp_op;
- ASSERT(ci <= code_buffer_size);
+ ASSERT(ci <= codev_size);
get_next_instr:
GetByte(stp, new_op);
@@ -1847,9 +1880,7 @@ load_code(LoaderState* stp)
case TAG_o:
break;
case TAG_x:
- if (last_op->a[arg].val == 0) {
- last_op->a[arg].type = TAG_r;
- } else if (last_op->a[arg].val >= MAX_REG) {
+ if (last_op->a[arg].val >= MAX_REG) {
LoadError1(stp, "invalid x register number: %u",
last_op->a[arg].val);
}
@@ -1894,15 +1925,14 @@ load_code(LoaderState* stp)
*/
{
Eterm* hp;
-/* XXX:PaN - Halfword should use ARCH_64 variant instead */
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
Uint high, low;
# endif
last_op->a[arg].val = new_literal(stp, &hp,
FLOAT_SIZE_OBJECT);
hp[0] = HEADER_FLONUM;
last_op->a[arg].type = TAG_q;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
GetInt(stp, 8, hp[1]);
# else
GetInt(stp, 4, high);
@@ -2056,7 +2086,42 @@ load_code(LoaderState* stp)
if (((opc[specific].mask[0] & mask[0]) == mask[0]) &&
((opc[specific].mask[1] & mask[1]) == mask[1]) &&
((opc[specific].mask[2] & mask[2]) == mask[2])) {
- break;
+
+ if (!opc[specific].involves_r) {
+ break; /* No complications - match */
+ }
+
+ /*
+ * The specific operation uses the 'r' operand,
+ * which is shorthand for x(0). Now things
+ * get complicated. First we must check whether
+ * all operands that should be of type 'r' use
+ * x(0) (as opposed to some other X register).
+ */
+ for (arg = 0; arg < arity; arg++) {
+ if (opc[specific].involves_r & (1 << arg) &&
+ tmp_op->a[arg].type == TAG_x) {
+ if (tmp_op->a[arg].val != 0) {
+ break; /* Other X register than 0 */
+ }
+ }
+ }
+
+ if (arg == arity) {
+ /*
+ * All 'r' operands use x(0) in the generic
+ * operation. That means a match. Now we
+ * will need to rewrite the generic instruction
+ * to actually use 'r' instead of 'x(0)'.
+ */
+ for (arg = 0; arg < arity; arg++) {
+ if (opc[specific].involves_r & (1 << arg) &&
+ tmp_op->a[arg].type == TAG_x) {
+ tmp_op->a[arg].type = TAG_r;
+ }
+ }
+ break; /* Match */
+ }
}
specific++;
}
@@ -2167,14 +2232,11 @@ load_code(LoaderState* stp)
break;
case 's': /* Any source (tagged constant or register) */
switch (tag) {
- case TAG_r:
- code[ci++] = make_rreg();
- break;
case TAG_x:
- code[ci++] = make_xreg(tmp_op->a[arg].val);
+ code[ci++] = make_loader_x_reg(tmp_op->a[arg].val);
break;
case TAG_y:
- code[ci++] = make_yreg(tmp_op->a[arg].val);
+ code[ci++] = make_loader_y_reg(tmp_op->a[arg].val);
break;
case TAG_i:
code[ci++] = (BeamInstr) make_small((Uint)tmp_op->a[arg].val);
@@ -2185,6 +2247,10 @@ load_code(LoaderState* stp)
case TAG_n:
code[ci++] = NIL;
break;
+ case TAG_q:
+ new_literal_patch(stp, ci);
+ code[ci++] = tmp_op->a[arg].val;
+ break;
default:
LoadError1(stp, "bad tag %d for general source",
tmp_op->a[arg].type);
@@ -2193,14 +2259,11 @@ load_code(LoaderState* stp)
break;
case 'd': /* Destination (x(0), x(N), y(N) */
switch (tag) {
- case TAG_r:
- code[ci++] = make_rreg();
- break;
case TAG_x:
- code[ci++] = make_xreg(tmp_op->a[arg].val);
+ code[ci++] = tmp_op->a[arg].val * sizeof(Eterm);
break;
case TAG_y:
- code[ci++] = make_yreg(tmp_op->a[arg].val);
+ code[ci++] = tmp_op->a[arg].val * sizeof(Eterm) + 1;
break;
default:
LoadError1(stp, "bad tag %d for destination",
@@ -2357,20 +2420,13 @@ load_code(LoaderState* stp)
stp->labels[tmp_op->a[arg].val].patches = ci;
ci++;
break;
- case TAG_r:
- CodeNeed(1);
- code[ci++] = (R_REG_DEF << _TAG_PRIMARY_SIZE) |
- TAG_PRIMARY_HEADER;
- break;
case TAG_x:
CodeNeed(1);
- code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) |
- (X_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER;
+ code[ci++] = make_loader_x_reg(tmp_op->a[arg].val);
break;
case TAG_y:
CodeNeed(1);
- code[ci++] = (tmp_op->a[arg].val << _TAG_IMMED1_SIZE) |
- (Y_REG_DEF << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER;
+ code[ci++] = make_loader_y_reg(tmp_op->a[arg].val);
break;
case TAG_n:
CodeNeed(1);
@@ -2393,8 +2449,7 @@ load_code(LoaderState* stp)
switch (stp->specific_op) {
case op_i_func_info_IaaI:
{
- Uint offset;
-
+ Sint offset;
if (function_number >= stp->num_functions) {
LoadError1(stp, "too many functions in module (header said %d)",
stp->num_functions);
@@ -2436,15 +2491,15 @@ load_code(LoaderState* stp)
stp->arity = code[ci-1];
ASSERT(stp->labels[last_label].value == ci - FUNC_INFO_SZ);
- offset = MI_FUNCTIONS + function_number;
- code[offset] = stp->labels[last_label].patches;
+ stp->hdr->functions[function_number] = (BeamInstr*) stp->labels[last_label].patches;
+ offset = function_number;
stp->labels[last_label].patches = offset;
function_number++;
if (stp->arity > MAX_ARG) {
LoadError1(stp, "too many arguments: %d", stp->arity);
}
#ifdef DEBUG
- ASSERT(stp->labels[0].patches == 0); /* Should not be referenced. */
+ ASSERT(stp->labels[0].patches < 0); /* Should not be referenced. */
for (i = 1; i < stp->num_labels; i++) {
ASSERT(stp->labels[i].patches < ci);
}
@@ -2458,7 +2513,6 @@ load_code(LoaderState* stp)
stp->on_load = ci;
break;
case op_bs_put_string_II:
- case op_i_bs_match_string_rfII:
case op_i_bs_match_string_xfII:
new_string_patch(stp, ci-1);
break;
@@ -2515,7 +2569,7 @@ load_code(LoaderState* stp)
* End of code found.
*/
case op_int_code_end:
- stp->code_buffer_size = code_buffer_size;
+ stp->codev_size = codev_size;
stp->ci = ci;
stp->function = THE_NON_VALUE;
stp->genop = NULL;
@@ -2680,6 +2734,12 @@ same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label)
Target.val == Label.val;
}
+static int
+is_killed(LoaderState* stp, GenOpArg Reg, GenOpArg Live)
+{
+ return Reg.type == TAG_x && Live.type == TAG_u &&
+ Live.val <= Reg.val;
+}
/*
* Generate an instruction for element/2.
@@ -2696,17 +2756,17 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index,
op->next = NULL;
if (Index.type == TAG_i && Index.val > 0 &&
- (Tuple.type == TAG_r || Tuple.type == TAG_x || Tuple.type == TAG_y)) {
+ (Tuple.type == TAG_x || Tuple.type == TAG_y)) {
op->op = genop_i_fast_element_4;
- op->a[0] = Tuple;
- op->a[1] = Fail;
+ op->a[0] = Fail;
+ op->a[1] = Tuple;
op->a[2].type = TAG_u;
op->a[2].val = Index.val;
op->a[3] = Dst;
} else {
op->op = genop_i_element_4;
- op->a[0] = Tuple;
- op->a[1] = Fail;
+ op->a[0] = Fail;
+ op->a[1] = Tuple;
op->a[2] = Index;
op->a[3] = Dst;
}
@@ -2832,23 +2892,16 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
goto generic;
}
} else {
- GenOp* op2;
- NEW_GENOP(stp, op2);
-
- op->op = genop_i_fetch_2;
- op->arity = 2;
- op->a[0] = Ms;
- op->a[1] = Size;
- op->next = op2;
-
- op2->op = genop_i_bs_get_integer_4;
- op2->arity = 4;
- op2->a[0] = Fail;
- op2->a[1] = Live;
- op2->a[2].type = TAG_u;
- op2->a[2].val = (Unit.val << 3) | Flags.val;
- op2->a[3] = Dst;
- op2->next = NULL;
+ op->op = genop_i_bs_get_integer_6;
+ op->arity = 6;
+ op->a[0] = Fail;
+ op->a[1] = Live;
+ op->a[2].type = TAG_u;
+ op->a[2].val = (Unit.val << 3) | Flags.val;
+ op->a[3] = Ms;
+ op->a[4] = Size;
+ op->a[5] = Dst;
+ op->next = NULL;
return op;
}
op->next = NULL;
@@ -3272,14 +3325,14 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
op->a[1].type = TAG_u;
if (Time.type == TAG_i && (timeout = Time.val) >= 0 &&
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
(timeout >> 32) == 0
#else
1
#endif
) {
op->a[1].val = timeout;
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
} else if (Time.type == TAG_q) {
Eterm big;
@@ -3296,7 +3349,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
}
#endif
} else {
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
error:
#endif
op->op = genop_i_wait_error_0;
@@ -3319,14 +3372,14 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
op->a[1].type = TAG_u;
if (Time.type == TAG_i && (timeout = Time.val) >= 0 &&
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
(timeout >> 32) == 0
#else
1
#endif
) {
op->a[1].val = timeout;
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
} else if (Time.type == TAG_q) {
Eterm big;
@@ -3343,7 +3396,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time)
}
#endif
} else {
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
error:
#endif
op->op = genop_i_wait_error_locked_0;
@@ -3899,9 +3952,7 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx)
/*
* Rewrite gc_bifs with one parameter (the common case). Utilized
* in ops.tab to rewrite instructions calling bif's in guards
- * to use a garbage collecting implementation. The instructions
- * are sometimes once again rewritten to handle literals (putting the
- * parameter in the mostly unused r[0] before the instruction is executed).
+ * to use a garbage collecting implementation.
*/
static GenOp*
gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
@@ -3956,10 +4007,6 @@ gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
/*
* This is used by the ops.tab rule that rewrites gc_bifs with two parameters.
- * The instruction returned is then again rewritten to an i_load instruction
- * followed by i_gc_bif2_jIId, to handle literals properly.
- * As opposed to the i_gc_bif1_jIsId, the instruction i_gc_bif2_jIId is
- * always rewritten, regardless of if there actually are any literals.
*/
static GenOp*
gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
@@ -3986,23 +4033,19 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
op->a[2].val = stp->import[Bif.val].arity;
return op;
}
- op->op = genop_ii_gc_bif2_6;
+ op->op = genop_i_gc_bif2_6;
op->arity = 6;
op->a[0] = Fail;
op->a[1].type = TAG_u;
- op->a[2] = S1;
- op->a[3] = S2;
- op->a[4] = Live;
+ op->a[2] = Live;
+ op->a[3] = S1;
+ op->a[4] = S2;
op->a[5] = Dst;
return op;
}
/*
* This is used by the ops.tab rule that rewrites gc_bifs with three parameters.
- * The instruction returned is then again rewritten to a move instruction that
- * uses r[0] for temp storage, followed by an i_load instruction,
- * followed by i_gc_bif3_jIsId, to handle literals properly. Rewriting
- * always occur, as with the gc_bif2 counterpart.
*/
static GenOp*
gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
@@ -4033,10 +4076,10 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
op->arity = 7;
op->a[0] = Fail;
op->a[1].type = TAG_u;
- op->a[2] = S1;
- op->a[3] = S2;
- op->a[4] = S3;
- op->a[5] = Live;
+ op->a[2] = Live;
+ op->a[3] = S1;
+ op->a[4] = S2;
+ op->a[5] = S3;
op->a[6] = Dst;
op->next = NULL;
return op;
@@ -4258,6 +4301,53 @@ gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
return op;
}
+static int
+hash_internal_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx)
+{
+ switch (Key.type) {
+ case TAG_a:
+ *hx = atom_tab(atom_val(Key.val))->slot.bucket.hvalue;
+ return 1;
+ case TAG_i:
+ *hx = Key.val;
+ return 1;
+ case TAG_n:
+ *hx = make_internal_hash(NIL);
+ return 1;
+ case TAG_q:
+ *hx = make_internal_hash(stp->literals[Key.val].term);
+ return 1;
+ default:
+ return 0;
+ }
+}
+
+
+static GenOp*
+gen_get(LoaderState* stp, GenOpArg Src, GenOpArg Dst)
+{
+ GenOp* op;
+ Uint32 hx = 0;
+
+ NEW_GENOP(stp, op);
+ op->next = NULL;
+ if (hash_internal_genop_arg(stp, Src, &hx)) {
+ op->arity = 3;
+ op->op = genop_i_get_hash_3;
+ op->a[0] = Src;
+ op->a[1].type = TAG_u;
+ op->a[1].val = (BeamInstr) hx;
+ op->a[2] = Dst;
+ } else {
+ op->arity = 2;
+ op->op = genop_i_get_2;
+ op->a[0] = Src;
+ op->a[1] = Dst;
+ }
+ return op;
+}
+
+
static GenOp*
gen_get_map_elements(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
GenOpArg Size, GenOpArg* Rest)
@@ -4323,7 +4413,7 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
for (i = 0; i < n; i++) {
op->a[3+2*i] = Rest[i];
op->a[3+2*i+1].type = TAG_x;
- op->a[3+2*i+1].val = 0; /* x(0); normally not used */
+ op->a[3+2*i+1].val = SCRATCH_X_REG; /* Ignore result */
}
return op;
}
@@ -4336,8 +4426,8 @@ gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src,
static int
freeze_code(LoaderState* stp)
{
- BeamInstr* code = stp->code;
- Uint *literal_end = NULL;
+ BeamCodeHeader* code_hdr = stp->hdr;
+ BeamInstr* codev = (BeamInstr*) &stp->hdr->functions;
int i;
byte* str_table;
unsigned strtab_size = stp->chunks[STR_CHUNK].size;
@@ -4362,77 +4452,76 @@ freeze_code(LoaderState* stp)
if (stp->line_instr == 0) {
line_size = 0;
} else {
- line_size = (MI_LINE_FUNC_TAB + (stp->num_functions + 1) +
- (stp->current_li+1) + stp->num_fnames) *
- sizeof(Eterm) + (stp->current_li+1) * stp->loc_size;
+ line_size = (offsetof(BeamCodeLineTab,func_tab)
+ + (stp->num_functions + 1) * sizeof(BeamInstr**) /* func_tab */
+ + (stp->current_li + 1) * sizeof(BeamInstr*) /* line items */
+ + stp->num_fnames * sizeof(Eterm) /* fname table */
+ + (stp->current_li + 1) * stp->loc_size); /* loc_tab */
}
- size = (stp->ci * sizeof(BeamInstr)) +
- (stp->total_literal_size * sizeof(Eterm)) +
+ size = offsetof(BeamCodeHeader,functions) + (stp->ci * sizeof(BeamInstr)) +
strtab_size + attr_size + compile_size + MD5_SIZE + line_size;
/*
* Move the code to its final location.
*/
- code = (BeamInstr *) erts_realloc(ERTS_ALC_T_CODE, (void *) code, size);
- CHKBLK(ERTS_ALC_T_CODE,code);
+ code_hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, (void *) code_hdr, size);
+ codev = (BeamInstr*) &code_hdr->functions;
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
/*
* Place a pointer to the op_int_code_end instruction in the
* function table in the beginning of the file.
*/
- code[MI_FUNCTIONS+stp->num_functions] = (BeamInstr) (code + stp->ci - 1);
- CHKBLK(ERTS_ALC_T_CODE,code);
+ code_hdr->functions[stp->num_functions] = (codev + stp->ci - 1);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
/*
* Store the pointer to the on_load function.
*/
if (stp->on_load) {
- code[MI_ON_LOAD_FUNCTION_PTR] = (BeamInstr) (code + stp->on_load);
+ code_hdr->on_load_function_ptr = codev + stp->on_load;
} else {
- code[MI_ON_LOAD_FUNCTION_PTR] = 0;
+ code_hdr->on_load_function_ptr = NULL;
}
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
- literal_end = (Uint *) (code+stp->ci);
/*
- * Place the literal heap directly after the code and fix up all
- * instructions that refer to it.
+ * Place the literals in their own allocated heap (for fast range check)
+ * and fix up all instructions that refer to it.
*/
{
- Uint* ptr;
- Uint* low;
- Uint* high;
+ Eterm* ptr;
LiteralPatch* lp;
ErlOffHeap code_off_heap;
ERTS_INIT_OFF_HEAP(&code_off_heap);
- low = (Uint *) (code+stp->ci);
- high = low + stp->total_literal_size;
- code[MI_LITERALS_START] = (BeamInstr) low;
- code[MI_LITERALS_END] = (BeamInstr) high;
- ptr = low;
+ ptr = (Eterm*)erts_alloc(ERTS_ALC_T_LITERAL,
+ stp->total_literal_size*sizeof(Eterm));
+ code_hdr->literals_start = ptr;
+ code_hdr->literals_end = ptr + stp->total_literal_size;
for (i = 0; i < stp->num_literals; i++) {
- if (stp->literals[i].heap_frags) {
- move_multi_frags(&ptr, &code_off_heap, stp->literals[i].heap_frags,
- &stp->literals[i].term, 1);
+ if (is_not_immed(stp->literals[i].term)) {
+ erts_move_multi_frags(&ptr, &code_off_heap,
+ stp->literals[i].heap_frags,
+ &stp->literals[i].term, 1, 1);
+ ASSERT(erts_is_literal(stp->literals[i].term,
+ ptr_val(stp->literals[i].term)));
}
- else ASSERT(is_immed(stp->literals[i].term));
}
- code[MI_LITERALS_OFF_HEAP] = (BeamInstr) code_off_heap.first;
+ code_hdr->literals_off_heap = code_off_heap.first;
lp = stp->literal_patches;
while (lp != 0) {
BeamInstr* op_ptr;
Literal* lit;
- op_ptr = code + lp->pos;
+ op_ptr = codev + lp->pos;
lit = &stp->literals[op_ptr[0]];
op_ptr[0] = lit->term;
lp = lp->next;
}
- literal_end += stp->total_literal_size;
}
CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4440,52 +4529,49 @@ freeze_code(LoaderState* stp)
* If there is line information, place it here.
*/
if (stp->line_instr == 0) {
- code[MI_LINE_TABLE] = (BeamInstr) 0;
- str_table = (byte *) literal_end;
+ code_hdr->line_table = NULL;
+ str_table = (byte *) (codev + stp->ci);
} else {
- Eterm* line_tab = (Eterm *) literal_end;
- Eterm* p;
- int ftab_size = stp->num_functions;
- int num_instrs = stp->current_li;
- Eterm* first_line_item;
+ BeamCodeLineTab* const line_tab = (BeamCodeLineTab *) (codev+stp->ci);
+ const int ftab_size = stp->num_functions;
+ const int num_instrs = stp->current_li;
+ const BeamInstr** const line_items =
+ (const BeamInstr**) &line_tab->func_tab[ftab_size + 1];
- code[MI_LINE_TABLE] = (BeamInstr) line_tab;
- p = line_tab + MI_LINE_FUNC_TAB;
+ code_hdr->line_table = line_tab;
- first_line_item = (p + ftab_size + 1);
for (i = 0; i < ftab_size; i++) {
- *p++ = (Eterm) (BeamInstr) (first_line_item + stp->func_line[i]);
+ line_tab->func_tab[i] = line_items + stp->func_line[i];
}
- *p++ = (Eterm) (BeamInstr) (first_line_item + num_instrs);
- ASSERT(p == first_line_item);
+ line_tab->func_tab[i] = line_items + num_instrs;
+
for (i = 0; i < num_instrs; i++) {
- *p++ = (Eterm) (BeamInstr) (code + stp->line_instr[i].pos);
+ line_items[i] = codev + stp->line_instr[i].pos;
}
- *p++ = (Eterm) (BeamInstr) (code + stp->ci - 1);
+ line_items[i] = codev + stp->ci - 1;
- line_tab[MI_LINE_FNAME_PTR] = (Eterm) (BeamInstr) p;
- memcpy(p, stp->fname, stp->num_fnames*sizeof(Eterm));
- p += stp->num_fnames;
+ line_tab->fname_ptr = (Eterm*) &line_items[i + 1];
+ memcpy(line_tab->fname_ptr, stp->fname, stp->num_fnames*sizeof(Eterm));
- line_tab[MI_LINE_LOC_TAB] = (Eterm) (BeamInstr) p;
- line_tab[MI_LINE_LOC_SIZE] = stp->loc_size;
+ line_tab->loc_size = stp->loc_size;
if (stp->loc_size == 2) {
- Uint16* locp = (Uint16 *) p;
- for (i = 0; i < num_instrs; i++) {
+ Uint16* locp = (Uint16 *) &line_tab->fname_ptr[stp->num_fnames];
+ line_tab->loc_tab.p2 = locp;
+ for (i = 0; i < num_instrs; i++) {
*locp++ = (Uint16) stp->line_instr[i].loc;
- }
- *locp++ = LINE_INVALID_LOCATION;
- str_table = (byte *) locp;
+ }
+ *locp++ = LINE_INVALID_LOCATION;
+ str_table = (byte *) locp;
} else {
- Uint32* locp = (Uint32 *) p;
- ASSERT(stp->loc_size == 4);
+ Uint32* locp = (Uint32 *) &line_tab->fname_ptr[stp->num_fnames];
+ ASSERT(stp->loc_size == 4);
+ line_tab->loc_tab.p4 = locp;
for (i = 0; i < num_instrs; i++) {
*locp++ = stp->line_instr[i].loc;
}
*locp++ = LINE_INVALID_LOCATION;
- str_table = (byte *) locp;
+ str_table = (byte *) locp;
}
-
CHKBLK(ERTS_ALC_T_CODE,code);
}
@@ -4497,13 +4583,13 @@ freeze_code(LoaderState* stp)
if (attr_size) {
byte* attr = str_table + strtab_size;
sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size);
- code[MI_ATTR_PTR] = (BeamInstr) attr;
- code[MI_ATTR_SIZE] = (BeamInstr) stp->chunks[ATTR_CHUNK].size;
+ code_hdr->attr_ptr = attr;
+ code_hdr->attr_size = (BeamInstr) stp->chunks[ATTR_CHUNK].size;
decoded_size = erts_decode_ext_size(attr, attr_size);
if (decoded_size < 0) {
LoadError0(stp, "bad external term representation of module attributes");
}
- code[MI_ATTR_SIZE_ON_HEAP] = decoded_size;
+ code_hdr->attr_size_on_heap = decoded_size;
}
CHKBLK(ERTS_ALC_T_CODE,code);
if (compile_size) {
@@ -4513,9 +4599,9 @@ freeze_code(LoaderState* stp)
stp->chunks[COMPILE_CHUNK].size);
CHKBLK(ERTS_ALC_T_CODE,code);
- code[MI_COMPILE_PTR] = (BeamInstr) compile_info;
+ code_hdr->compile_ptr = compile_info;
CHKBLK(ERTS_ALC_T_CODE,code);
- code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
+ code_hdr->compile_size = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
CHKBLK(ERTS_ALC_T_CODE,code);
decoded_size = erts_decode_ext_size(compile_info, compile_size);
CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4523,7 +4609,7 @@ freeze_code(LoaderState* stp)
LoadError0(stp, "bad external term representation of compilation information");
}
CHKBLK(ERTS_ALC_T_CODE,code);
- code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size;
+ code_hdr->compile_size_on_heap = decoded_size;
}
CHKBLK(ERTS_ALC_T_CODE,code);
{
@@ -4531,7 +4617,7 @@ freeze_code(LoaderState* stp)
CHKBLK(ERTS_ALC_T_CODE,code);
sys_memcpy(md5_sum, stp->mod_md5, MD5_SIZE);
CHKBLK(ERTS_ALC_T_CODE,code);
- code[MI_MD5_PTR] = (BeamInstr) md5_sum;
+ code_hdr->md5_ptr = md5_sum;
CHKBLK(ERTS_ALC_T_CODE,code);
}
CHKBLK(ERTS_ALC_T_CODE,code);
@@ -4540,7 +4626,7 @@ freeze_code(LoaderState* stp)
* Make sure that we have not overflowed the allocated code space.
*/
ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE ==
- ((byte *) code) + size);
+ ((byte *) code_hdr) + size);
/*
* Patch all instructions that refer to the string table.
@@ -4552,46 +4638,47 @@ freeze_code(LoaderState* stp)
BeamInstr* op_ptr;
byte* strp;
- op_ptr = code + sp->pos;
+ op_ptr = codev + sp->pos;
strp = str_table + op_ptr[0];
op_ptr[0] = (BeamInstr) strp;
sp = sp->next;
}
}
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
/*
* Resolve all labels.
*/
for (i = 0; i < stp->num_labels; i++) {
- Uint this_patch;
- Uint next_patch;
+ Sint this_patch;
+ Sint next_patch;
Uint value = stp->labels[i].value;
- if (value == 0 && stp->labels[i].patches != 0) {
+ if (value == 0 && stp->labels[i].patches >= 0) {
LoadError1(stp, "label %d not resolved", i);
}
ASSERT(value < stp->ci);
this_patch = stp->labels[i].patches;
- while (this_patch != 0) {
+ while (this_patch >= 0) {
ASSERT(this_patch < stp->ci);
- next_patch = code[this_patch];
+ next_patch = codev[this_patch];
ASSERT(next_patch < stp->ci);
- code[this_patch] = (BeamInstr) (code + value);
+ codev[this_patch] = (BeamInstr) (codev + value);
this_patch = next_patch;
}
}
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
/*
* Save the updated code pointer and code size.
*/
- stp->code = code;
+ stp->hdr = code_hdr;
+ stp->codev = codev;
stp->loaded_size = size;
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code_hdr);
return 1;
load_error:
@@ -4599,7 +4686,8 @@ freeze_code(LoaderState* stp)
* Make sure that the caller frees the newly reallocated block, and
* not the old one (in case it has moved).
*/
- stp->code = code;
+ stp->hdr = code_hdr;
+ stp->codev = codev;
return 0;
}
@@ -4610,7 +4698,7 @@ final_touch(LoaderState* stp)
int on_load = stp->on_load;
unsigned catches;
Uint index;
- BeamInstr* code = stp->code;
+ BeamInstr* codev = stp->codev;
Module* modp;
/*
@@ -4620,10 +4708,10 @@ final_touch(LoaderState* stp)
index = stp->catches;
catches = BEAM_CATCHES_NIL;
while (index != 0) {
- BeamInstr next = code[index];
- code[index] = BeamOpCode(op_catch_yf);
- catches = beam_catches_cons((BeamInstr *)code[index+2], catches);
- code[index+2] = make_catch(catches);
+ BeamInstr next = codev[index];
+ codev[index] = BeamOpCode(op_catch_yf);
+ catches = beam_catches_cons((BeamInstr *)codev[index+2], catches);
+ codev[index+2] = make_catch(catches);
index = next;
}
modp = erts_put_module(stp->module);
@@ -4674,8 +4762,8 @@ final_touch(LoaderState* stp)
current = stp->import[i].patches;
while (current != 0) {
ASSERT(current < stp->ci);
- next = stp->code[current];
- stp->code[current] = import;
+ next = stp->codev[current];
+ stp->codev[current] = import;
current = next;
}
}
@@ -4688,7 +4776,7 @@ final_touch(LoaderState* stp)
for (i = 0; i < stp->num_lambdas; i++) {
unsigned entry_label = stp->lambdas[i].label;
ErlFunEntry* fe = stp->lambdas[i].fe;
- BeamInstr* code_ptr = (BeamInstr *) (stp->code + stp->labels[entry_label].value);
+ BeamInstr* code_ptr = stp->codev + stp->labels[entry_label].value;
if (fe->address[0] != 0) {
/*
@@ -4801,7 +4889,8 @@ transform_engine(LoaderState* st)
if (var[i].type != instr->a[ap].type)
goto restart;
switch (var[i].type) {
- case TAG_r: case TAG_n: break;
+ case TAG_n:
+ break;
default:
if (var[i].val != instr->a[ap].val)
goto restart;
@@ -5311,7 +5400,7 @@ new_label(LoaderState* stp)
(void *) stp->labels,
stp->num_labels * sizeof(Label));
stp->labels[num].value = 0;
- stp->labels[num].patches = 0;
+ stp->labels[num].patches = -1;
return num;
}
@@ -5371,7 +5460,7 @@ erts_module_info_0(Process* p, Eterm module)
{
Module* modp;
ErtsCodeIndex code_ix = erts_active_code_ix();
- BeamInstr* code;
+ BeamCodeHeader* code_hdr;
Eterm *hp;
Eterm list = NIL;
Eterm tup;
@@ -5385,13 +5474,13 @@ erts_module_info_0(Process* p, Eterm module)
return THE_NON_VALUE;
}
- code = modp->curr.code;
- if (code == NULL) {
+ code_hdr = modp->curr.code_hdr;
+ if (code_hdr == NULL) {
return THE_NON_VALUE;
}
#define BUILD_INFO(What) \
- tup = get_module_info(p, code_ix, code, module, What); \
+ tup = get_module_info(p, code_ix, code_hdr, module, What); \
hp = HAlloc(p, 5); \
tup = TUPLE2(hp, What, tup); \
hp += 3; \
@@ -5414,7 +5503,7 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
{
Module* modp;
ErtsCodeIndex code_ix = erts_active_code_ix();
- BeamInstr* code;
+ BeamCodeHeader* code_hdr;
if (is_not_atom(module)) {
return THE_NON_VALUE;
@@ -5425,34 +5514,34 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
return THE_NON_VALUE;
}
- code = modp->curr.code;
- if (code == NULL) {
+ code_hdr = modp->curr.code_hdr;
+ if (code_hdr == NULL) {
return THE_NON_VALUE;
}
- return get_module_info(p, code_ix, code, module, what);
+ return get_module_info(p, code_ix, code_hdr, module, what);
}
static Eterm
-get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code,
+get_module_info(Process* p, ErtsCodeIndex code_ix, BeamCodeHeader* code_hdr,
Eterm module, Eterm what)
{
if (what == am_module) {
return module;
} else if (what == am_md5) {
- return md5_of_module(p, code);
+ return md5_of_module(p, code_hdr);
} else if (what == am_exports) {
return exported_from_module(p, code_ix, module);
} else if (what == am_functions) {
- return functions_in_module(p, code);
+ return functions_in_module(p, code_hdr);
} else if (what == am_attributes) {
- return attributes_for_module(p, code);
+ return attributes_for_module(p, code_hdr);
} else if (what == am_compile) {
- return compilation_info_for_module(p, code);
+ return compilation_info_for_module(p, code_hdr);
} else if (what == am_native_addresses) {
- return native_addresses(p, code);
+ return native_addresses(p, code_hdr);
} else if (what == am_native) {
- return has_native(code);
+ return has_native(code_hdr);
}
return THE_NON_VALUE;
}
@@ -5464,7 +5553,7 @@ get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code,
Eterm
functions_in_module(Process* p, /* Process whose heap to use. */
- BeamInstr* code)
+ BeamCodeHeader* code_hdr)
{
int i;
Uint num_functions;
@@ -5473,12 +5562,12 @@ functions_in_module(Process* p, /* Process whose heap to use. */
Eterm* hp_end;
Eterm result = NIL;
- num_functions = code[MI_NUM_FUNCTIONS];
+ num_functions = code_hdr->num_functions;
need = 5*num_functions;
hp = HAlloc(p, need);
hp_end = hp + need;
for (i = num_functions-1; i >= 0 ; i--) {
- BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+ BeamInstr* func_info = code_hdr->functions[i];
Eterm name = (Eterm) func_info[3];
int arity = (int) func_info[4];
Eterm tuple;
@@ -5504,11 +5593,11 @@ functions_in_module(Process* p, /* Process whose heap to use. */
*/
static Eterm
-has_native(BeamInstr *code)
+has_native(BeamCodeHeader *code_hdr)
{
Eterm result = am_false;
#ifdef HIPE
- if (erts_is_module_native(code)) {
+ if (erts_is_module_native(code_hdr)) {
result = am_true;
}
#endif
@@ -5516,15 +5605,15 @@ has_native(BeamInstr *code)
}
int
-erts_is_module_native(BeamInstr* code)
+erts_is_module_native(BeamCodeHeader* code_hdr)
{
Uint i, num_functions;
/* Check NativeAdress of first real function in module */
- if (code != NULL) {
- num_functions = code[MI_NUM_FUNCTIONS];
+ if (code_hdr != NULL) {
+ num_functions = code_hdr->num_functions;
for (i=0; i<num_functions; i++) {
- BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+ BeamInstr* func_info = (BeamInstr *) code_hdr->functions[i];
Eterm name = (Eterm) func_info[3];
if (is_atom(name)) {
return func_info[1] != 0;
@@ -5541,7 +5630,7 @@ erts_is_module_native(BeamInstr* code)
*/
static Eterm
-native_addresses(Process* p, BeamInstr* code)
+native_addresses(Process* p, BeamCodeHeader* code_hdr)
{
int i;
Eterm* hp;
@@ -5550,12 +5639,12 @@ native_addresses(Process* p, BeamInstr* code)
Eterm* hp_end;
Eterm result = NIL;
- num_functions = code[MI_NUM_FUNCTIONS];
+ num_functions = code_hdr->num_functions;
need = (6+BIG_UINT_HEAP_SIZE)*num_functions;
hp = HAlloc(p, need);
hp_end = hp + need;
for (i = num_functions-1; i >= 0 ; i--) {
- BeamInstr* func_info = (BeamInstr *) code[MI_FUNCTIONS+i];
+ BeamInstr* func_info = code_hdr->functions[i];
Eterm name = (Eterm) func_info[3];
int arity = (int) func_info[4];
Eterm tuple;
@@ -5621,15 +5710,15 @@ exported_from_module(Process* p, /* Process whose heap to use. */
Eterm
attributes_for_module(Process* p, /* Process whose heap to use. */
- BeamInstr* code)
+ BeamCodeHeader* code_hdr)
{
byte* ext;
Eterm result = NIL;
- ext = (byte *) code[MI_ATTR_PTR];
+ ext = code_hdr->attr_ptr;
if (ext != NULL) {
ErtsHeapFactory factory;
- erts_factory_proc_prealloc_init(&factory, p, code[MI_ATTR_SIZE_ON_HEAP]);
+ erts_factory_proc_prealloc_init(&factory, p, code_hdr->attr_size_on_heap);
result = erts_decode_ext(&factory, &ext);
if (is_value(result)) {
erts_factory_close(&factory);
@@ -5644,15 +5733,15 @@ attributes_for_module(Process* p, /* Process whose heap to use. */
Eterm
compilation_info_for_module(Process* p, /* Process whose heap to use. */
- BeamInstr* code)
+ BeamCodeHeader* code_hdr)
{
byte* ext;
Eterm result = NIL;
- ext = (byte *) code[MI_COMPILE_PTR];
+ ext = code_hdr->compile_ptr;
if (ext != NULL) {
ErtsHeapFactory factory;
- erts_factory_proc_prealloc_init(&factory, p, code[MI_COMPILE_SIZE_ON_HEAP]);
+ erts_factory_proc_prealloc_init(&factory, p, code_hdr->compile_size_on_heap);
result = erts_decode_ext(&factory, &ext);
if (is_value(result)) {
erts_factory_close(&factory);
@@ -5667,9 +5756,9 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */
Eterm
md5_of_module(Process* p, /* Process whose heap to use. */
- BeamInstr* code)
+ BeamCodeHeader* code_hdr)
{
- return new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE);
+ return new_binary(p, code_hdr->md5_ptr, MD5_SIZE);
}
/*
@@ -5868,7 +5957,7 @@ make_stub(BeamInstr* fp, Eterm mod, Eterm func, Uint arity, Uint native, BeamIns
fp[4] = arity;
#ifdef HIPE
if (native) {
- fp[5] = BeamOpCode(op_move_return_nr);
+ fp[5] = BeamOpCode(op_move_return_n);
hipe_mfa_save_orig_beam_op(mod, func, arity, fp+5);
}
#endif
@@ -5880,7 +5969,7 @@ static byte*
stub_copy_info(LoaderState* stp,
int chunk, /* Chunk: ATTR_CHUNK or COMPILE_CHUNK */
byte* info, /* Where to store info. */
- BeamInstr* ptr_word, /* Where to store pointer into info. */
+ byte** ptr_word, /* Where to store pointer into info. */
BeamInstr* size_word, /* Where to store size into info. */
BeamInstr* size_on_heap_word) /* Where to store size on heap. */
{
@@ -5888,7 +5977,7 @@ stub_copy_info(LoaderState* stp,
Uint size = stp->chunks[chunk].size;
if (size != 0) {
memcpy(info, stp->chunks[chunk].start, size);
- *ptr_word = (BeamInstr) info;
+ *ptr_word = info;
decoded_size = erts_decode_ext_size(info, size);
if (decoded_size < 0) {
return 0;
@@ -6143,15 +6232,14 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
BeamInstr Patchlist;
Eterm MD5Bin;
Eterm* tp;
- BeamInstr* code = NULL;
- BeamInstr* ptrs;
+ BeamCodeHeader* code_hdr;
+ BeamInstr* code_base;
BeamInstr* fp;
byte* info;
- Uint ci;
- int n;
+ Sint n;
int code_size;
int rval;
- int i;
+ Sint i;
byte* temp_alloc = NULL;
byte* bytes;
Uint size;
@@ -6225,39 +6313,40 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Allocate memory for the stub module.
*/
- code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(BeamInstr);
- code_size += stp->chunks[ATTR_CHUNK].size;
- code_size += stp->chunks[COMPILE_CHUNK].size;
- code_size += MD5_SIZE;
- code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
- if (!code) {
+ code_size = (offsetof(BeamCodeHeader,functions)
+ + ((n+1) * sizeof(BeamInstr*))
+ + (WORDS_PER_FUNCTION*n + 1) * sizeof(BeamInstr)
+ + stp->chunks[ATTR_CHUNK].size
+ + stp->chunks[COMPILE_CHUNK].size
+ + MD5_SIZE);
+ code_hdr = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size);
+ if (!code_hdr) {
goto error;
}
/*
- * Initialize code area.
+ * Initialize code header.
*/
- code[MI_NUM_FUNCTIONS] = n;
- code[MI_ATTR_PTR] = 0;
- code[MI_ATTR_SIZE] = 0;
- code[MI_ATTR_SIZE_ON_HEAP] = 0;
- code[MI_COMPILE_PTR] = 0;
- code[MI_COMPILE_SIZE] = 0;
- code[MI_COMPILE_SIZE_ON_HEAP] = 0;
- code[MI_LITERALS_START] = 0;
- code[MI_LITERALS_END] = 0;
- code[MI_LITERALS_OFF_HEAP] = 0;
- code[MI_ON_LOAD_FUNCTION_PTR] = 0;
- code[MI_MD5_PTR] = 0;
- ci = MI_FUNCTIONS + n + 1;
+ code_hdr->num_functions = n;
+ code_hdr->attr_ptr = NULL;
+ code_hdr->attr_size = 0;
+ code_hdr->attr_size_on_heap = 0;
+ code_hdr->compile_ptr = NULL;
+ code_hdr->compile_size = 0;
+ code_hdr->compile_size_on_heap = 0;
+ code_hdr->literals_start = NULL;
+ code_hdr->literals_end = NULL;
+ code_hdr->literals_off_heap = 0;
+ code_hdr->on_load_function_ptr = NULL;
+ code_hdr->line_table = NULL;
+ code_hdr->md5_ptr = NULL;
/*
* Make stubs for all functions.
*/
- ptrs = code + MI_FUNCTIONS;
- fp = code + ci;
+ fp = code_base = (BeamInstr*) &code_hdr->functions[n+1];
for (i = 0; i < n; i++) {
Eterm* listp;
Eterm tuple;
@@ -6300,11 +6389,11 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Set the pointer and make the stub. Put a return instruction
* as the body until we know what kind of trap we should put there.
*/
- ptrs[i] = (BeamInstr) fp;
+ code_hdr->functions[i] = fp;
#ifdef HIPE
op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */
#else
- op = (Eterm) BeamOpCode(op_move_return_nr);
+ op = (Eterm) BeamOpCode(op_move_return_n);
#endif
fp = make_stub(fp, Mod, func, arity, (Uint)native_address, op);
}
@@ -6313,7 +6402,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Insert the last pointer and the int_code_end instruction.
*/
- ptrs[i] = (BeamInstr) fp;
+ code_hdr->functions[i] = fp;
*fp++ = (BeamInstr) BeamOp(op_int_code_end);
/*
@@ -6322,16 +6411,16 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
info = (byte *) fp;
info = stub_copy_info(stp, ATTR_CHUNK, info,
- code+MI_ATTR_PTR,
- code+MI_ATTR_SIZE,
- code+MI_ATTR_SIZE_ON_HEAP);
+ &code_hdr->attr_ptr,
+ &code_hdr->attr_size,
+ &code_hdr->attr_size_on_heap);
if (info == NULL) {
goto error;
}
info = stub_copy_info(stp, COMPILE_CHUNK, info,
- code+MI_COMPILE_PTR,
- code+MI_COMPILE_SIZE,
- code+MI_COMPILE_SIZE_ON_HEAP);
+ &code_hdr->compile_ptr,
+ &code_hdr->compile_size,
+ &code_hdr->compile_size_on_heap);
if (info == NULL) {
goto error;
}
@@ -6340,7 +6429,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
byte *md5 = NULL;
if ((md5 = erts_get_aligned_binary_bytes(MD5Bin, &tmp)) != NULL) {
sys_memcpy(info, md5, MD5_SIZE);
- code[MI_MD5_PTR] = (BeamInstr) info;
+ code_hdr->md5_ptr = info;
}
erts_free_aligned_binary_bytes(tmp);
}
@@ -6349,7 +6438,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Insert the module in the module table.
*/
- rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size);
+ rval = insert_new_code(p, 0, p->group_leader, Mod, code_hdr, code_size);
if (rval != NIL) {
goto error;
}
@@ -6358,7 +6447,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
* Export all stub functions and insert the correct type of HiPE trap.
*/
- fp = code + ci;
+ fp = code_base;
for (i = 0; i < n; i++) {
stub_final_touch(stp, fp);
fp += WORDS_PER_FUNCTION;
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index d5af634fad..22ab71c868 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -24,7 +24,6 @@
#include "beam_opcodes.h"
#include "erl_process.h"
-int erts_is_module_native(BeamInstr* code);
Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks,
Eterm module);
@@ -52,6 +51,7 @@ extern BeamInstr* em_call_error_handler;
extern BeamInstr* em_apply_bif;
extern BeamInstr* em_call_nif;
+
/*
* The following variables keep a sorted list of address ranges for
* each module. It allows us to quickly find a function given an
@@ -60,72 +60,81 @@ extern BeamInstr* em_call_nif;
/* Total code size in bytes */
extern Uint erts_total_code_size;
-/*
- * Index into start of code chunks which contains additional information
- * about the loaded module.
- *
- * First number of functions.
- */
-#define MI_NUM_FUNCTIONS 0
+typedef struct BeamCodeLineTab_ BeamCodeLineTab;
/*
- * The attributes retrieved by Mod:module_info(attributes).
- */
-
-#define MI_ATTR_PTR 1
-#define MI_ATTR_SIZE 2
-#define MI_ATTR_SIZE_ON_HEAP 3
-
-/*
- * The compilation information retrieved by Mod:module_info(compile).
- */
-
-#define MI_COMPILE_PTR 4
-#define MI_COMPILE_SIZE 5
-#define MI_COMPILE_SIZE_ON_HEAP 6
-
-/*
- * Literal area (constant pool).
- */
-#define MI_LITERALS_START 7
-#define MI_LITERALS_END 8
-#define MI_LITERALS_OFF_HEAP 9
-
-/*
- * Pointer to the on_load function (or NULL if none).
- */
-#define MI_ON_LOAD_FUNCTION_PTR 10
-
-/*
- * Pointer to the line table (or NULL if none).
- */
-#define MI_LINE_TABLE 11
-
-/*
- * Pointer to the module MD5 sum (16 bytes)
- */
-#define MI_MD5_PTR 12
-
-/*
- * Start of function pointer table. This table contains pointers to
- * all functions in the module plus an additional pointer just beyond
- * the end of the last function.
- *
- * The actual loaded code (for the first function) start just beyond
- * this table.
+ * Header of code chunks which contains additional information
+ * about the loaded module.
*/
-
-#define MI_FUNCTIONS 13
+typedef struct beam_code_header {
+ /*
+ * Number of functions.
+ */
+ UWord num_functions;
+
+ /*
+ * The attributes retrieved by Mod:module_info(attributes).
+ */
+ byte* attr_ptr;
+ UWord attr_size;
+ UWord attr_size_on_heap;
+
+ /*
+ * The compilation information retrieved by Mod:module_info(compile).
+ */
+ byte* compile_ptr;
+ UWord compile_size;
+ UWord compile_size_on_heap;
+
+ /*
+ * Literal area (constant pool).
+ */
+ Eterm* literals_start;
+ Eterm* literals_end;
+ struct erl_off_heap_header* literals_off_heap;
+
+ /*
+ * Pointer to the on_load function (or NULL if none).
+ */
+ BeamInstr* on_load_function_ptr;
+
+ /*
+ * Pointer to the line table (or NULL if none).
+ */
+ BeamCodeLineTab* line_table;
+
+ /*
+ * Pointer to the module MD5 sum (16 bytes)
+ */
+ byte* md5_ptr;
+
+ /*
+ * Start of function pointer table. This table contains pointers to
+ * all functions in the module plus an additional pointer just beyond
+ * the end of the last function.
+ *
+ * The actual loaded code (for the first function) start just beyond
+ * this table.
+ */
+ BeamInstr* functions[1];
+
+}BeamCodeHeader;
+
+int erts_is_module_native(BeamCodeHeader* code);
/*
* Layout of the line table.
*/
-
-#define MI_LINE_FNAME_PTR 0
-#define MI_LINE_LOC_TAB 1
-#define MI_LINE_LOC_SIZE 2
-#define MI_LINE_FUNC_TAB 3
+struct BeamCodeLineTab_ {
+ Eterm* fname_ptr;
+ int loc_size;
+ union {
+ Uint16* p2;
+ Uint32* p4;
+ }loc_tab;
+ const BeamInstr** func_tab[1];
+};
#define LINE_INVALID_LOCATION (0)
diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c
index 19079ba150..54c337ee72 100644
--- a/erts/emulator/beam/beam_ranges.c
+++ b/erts/emulator/beam/beam_ranges.c
@@ -37,8 +37,8 @@ typedef struct {
#define RANGE_END(R) ((BeamInstr*)erts_smp_atomic_read_nob(&(R)->end))
static Range* find_range(BeamInstr* pc);
-static void lookup_loc(FunctionInfo* fi, BeamInstr* pc,
- BeamInstr* modp, int idx);
+static void lookup_loc(FunctionInfo* fi, const BeamInstr* pc,
+ BeamCodeHeader*, int idx);
/*
* The following variables keep a sorted list of address ranges for
@@ -53,6 +53,7 @@ struct ranges {
};
static struct ranges r[ERTS_NUM_CODE_IX];
static erts_smp_atomic_t mem_used;
+static Range* write_ptr;
#ifdef HARD_DEBUG
static void check_consistency(struct ranges* p)
@@ -72,6 +73,17 @@ static void check_consistency(struct ranges* p)
# define CHECK(r)
#endif /* HARD_DEBUG */
+static int
+rangecompare(Range* a, Range* b)
+{
+ if (a->start < b->start) {
+ return -1;
+ } else if (a->start == b->start) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
void
erts_init_ranges(void)
@@ -88,45 +100,70 @@ erts_init_ranges(void)
}
void
-erts_start_staging_ranges(void)
+erts_start_staging_ranges(int num_new)
{
+ ErtsCodeIndex src = erts_active_code_ix();
ErtsCodeIndex dst = erts_staging_code_ix();
+ Sint need;
if (r[dst].modules) {
erts_smp_atomic_add_nob(&mem_used, -r[dst].allocated);
erts_free(ERTS_ALC_T_MODULE_REFS, r[dst].modules);
- r[dst].modules = NULL;
}
+
+ need = r[dst].allocated = r[src].n + num_new;
+ erts_smp_atomic_add_nob(&mem_used, need);
+ write_ptr = erts_alloc(ERTS_ALC_T_MODULE_REFS,
+ need * sizeof(Range));
+ r[dst].modules = write_ptr;
}
void
erts_end_staging_ranges(int commit)
{
- ErtsCodeIndex dst = erts_staging_code_ix();
-
- if (commit && r[dst].modules == NULL) {
+ if (commit) {
Sint i;
- Sint n;
-
- /* No modules added, just clone src and remove purged code. */
ErtsCodeIndex src = erts_active_code_ix();
+ ErtsCodeIndex dst = erts_staging_code_ix();
+ Range* mp;
+ Sint num_inserted;
- erts_smp_atomic_add_nob(&mem_used, r[src].n);
- r[dst].modules = erts_alloc(ERTS_ALC_T_MODULE_REFS,
- r[src].n * sizeof(Range));
- r[dst].allocated = r[src].n;
- n = 0;
+ mp = r[dst].modules;
+ num_inserted = write_ptr - mp;
for (i = 0; i < r[src].n; i++) {
Range* rp = r[src].modules+i;
if (rp->start < RANGE_END(rp)) {
/* Only insert a module that has not been purged. */
- r[dst].modules[n] = *rp;
- n++;
+ write_ptr->start = rp->start;
+ erts_smp_atomic_init_nob(&write_ptr->end,
+ (erts_aint_t)(RANGE_END(rp)));
+ write_ptr++;
+ }
+ }
+
+ /*
+ * There are num_inserted new range entries (unsorted) at the
+ * beginning of the modules array, followed by the old entries
+ * (sorted). We must now sort the entire array.
+ */
+
+ r[dst].n = write_ptr - mp;
+ if (num_inserted > 1) {
+ qsort(mp, r[dst].n, sizeof(Range),
+ (int (*)(const void *, const void *)) rangecompare);
+ } else if (num_inserted == 1) {
+ /* Sift the new range into place. This is faster than qsort(). */
+ Range t = mp[0];
+ for (i = 0; i < r[dst].n-1 && t.start > mp[i+1].start; i++) {
+ mp[i] = mp[i+1];
}
+ mp[i] = t;
}
- r[dst].n = n;
+ r[dst].modules = mp;
+ CHECK(&r[dst]);
erts_smp_atomic_set_nob(&r[dst].mid,
- (erts_aint_t) (r[dst].modules + n / 2));
+ (erts_aint_t) (r[dst].modules +
+ r[dst].n / 2));
}
}
@@ -135,82 +172,29 @@ erts_update_ranges(BeamInstr* code, Uint size)
{
ErtsCodeIndex dst = erts_staging_code_ix();
ErtsCodeIndex src = erts_active_code_ix();
- Sint i;
- Sint n;
- Sint need;
if (src == dst) {
ASSERT(!erts_initialized);
/*
- * During start-up of system, the indices are the same.
- * Handle this by faking a source area.
+ * During start-up of system, the indices are the same
+ * and erts_start_staging_ranges() has not been called.
*/
- src = (src+1) % ERTS_NUM_CODE_IX;
- if (r[src].modules) {
- erts_smp_atomic_add_nob(&mem_used, -r[src].allocated);
- erts_free(ERTS_ALC_T_MODULE_REFS, r[src].modules);
+ if (r[dst].modules == NULL) {
+ Sint need = 128;
+ erts_smp_atomic_add_nob(&mem_used, need);
+ r[dst].modules = erts_alloc(ERTS_ALC_T_MODULE_REFS,
+ need * sizeof(Range));
+ r[dst].allocated = need;
+ write_ptr = r[dst].modules;
}
- r[src] = r[dst];
- r[dst].modules = 0;
}
- CHECK(&r[src]);
-
- ASSERT(r[dst].modules == NULL);
- need = r[dst].allocated = r[src].n + 1;
- erts_smp_atomic_add_nob(&mem_used, need);
- r[dst].modules = (Range *) erts_alloc(ERTS_ALC_T_MODULE_REFS,
- need * sizeof(Range));
- n = 0;
- for (i = 0; i < r[src].n; i++) {
- Range* rp = r[src].modules+i;
- if (code < rp->start) {
- r[dst].modules[n].start = code;
- erts_smp_atomic_init_nob(&r[dst].modules[n].end,
- (erts_aint_t)(((byte *)code) + size));
- ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < code);
- n++;
- break;
- }
- if (rp->start < RANGE_END(rp)) {
- /* Only insert a module that has not been purged. */
- r[dst].modules[n].start = rp->start;
- erts_smp_atomic_init_nob(&r[dst].modules[n].end,
- (erts_aint_t)(RANGE_END(rp)));
- ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < rp->start);
- n++;
- }
- }
-
- while (i < r[src].n) {
- Range* rp = r[src].modules+i;
- if (rp->start < RANGE_END(rp)) {
- /* Only insert a module that has not been purged. */
- r[dst].modules[n].start = rp->start;
- erts_smp_atomic_init_nob(&r[dst].modules[n].end,
- (erts_aint_t)(RANGE_END(rp)));
- ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < rp->start);
- n++;
- }
- i++;
- }
-
- if (n == 0 || code > r[dst].modules[n-1].start) {
- r[dst].modules[n].start = code;
- erts_smp_atomic_init_nob(&r[dst].modules[n].end,
- (erts_aint_t)(((byte *)code) + size));
- ASSERT(!n || RANGE_END(&r[dst].modules[n-1]) < code);
- n++;
- }
-
- ASSERT(n <= r[src].n+1);
- r[dst].n = n;
- erts_smp_atomic_set_nob(&r[dst].mid,
- (erts_aint_t) (r[dst].modules + n / 2));
-
- CHECK(&r[dst]);
- CHECK(&r[src]);
+ ASSERT(r[dst].modules);
+ write_ptr->start = code;
+ erts_smp_atomic_init_nob(&(write_ptr->end),
+ (erts_aint_t)(((byte *)code) + size));
+ write_ptr++;
}
void
@@ -241,6 +225,7 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
BeamInstr** high;
BeamInstr** mid;
Range* rp;
+ BeamCodeHeader* hdr;
fi->current = NULL;
fi->needed = 5;
@@ -249,9 +234,10 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
if (rp == 0) {
return;
}
+ hdr = (BeamCodeHeader*) rp->start;
- low = (BeamInstr **) (rp->start + MI_FUNCTIONS);
- high = low + rp->start[MI_NUM_FUNCTIONS];
+ low = hdr->functions;
+ high = low + hdr->num_functions;
while (low < high) {
mid = low + (high-low) / 2;
if (pc < mid[0]) {
@@ -259,10 +245,9 @@ erts_lookup_function_info(FunctionInfo* fi, BeamInstr* pc, int full_info)
} else if (pc < mid[1]) {
fi->current = mid[0]+2;
if (full_info) {
- BeamInstr** fp = (BeamInstr **) (rp->start +
- MI_FUNCTIONS);
+ BeamInstr** fp = hdr->functions;
int idx = mid - fp;
- lookup_loc(fi, pc, rp->start, idx);
+ lookup_loc(fi, pc, hdr, idx);
}
return;
} else {
@@ -295,39 +280,34 @@ find_range(BeamInstr* pc)
}
static void
-lookup_loc(FunctionInfo* fi, BeamInstr* orig_pc, BeamInstr* modp, int idx)
+lookup_loc(FunctionInfo* fi, const BeamInstr* pc,
+ BeamCodeHeader* code_hdr, int idx)
{
- Eterm* line = (Eterm *) modp[MI_LINE_TABLE];
- Eterm* low;
- Eterm* high;
- Eterm* mid;
- Eterm pc;
+ BeamCodeLineTab* lt = code_hdr->line_table;
+ const BeamInstr** low;
+ const BeamInstr** high;
+ const BeamInstr** mid;
- if (line == 0) {
+ if (lt == NULL) {
return;
}
- pc = (Eterm) (BeamInstr) orig_pc;
- fi->fname_ptr = (Eterm *) (BeamInstr) line[MI_LINE_FNAME_PTR];
- low = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx];
- high = (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB+idx+1];
+ fi->fname_ptr = lt->fname_ptr;
+ low = lt->func_tab[idx];
+ high = lt->func_tab[idx+1];
while (high > low) {
mid = low + (high-low) / 2;
if (pc < mid[0]) {
high = mid;
} else if (pc < mid[1]) {
int file;
- int index = mid - (Eterm *) (BeamInstr) line[MI_LINE_FUNC_TAB];
+ int index = mid - lt->func_tab[0];
- if (line[MI_LINE_LOC_SIZE] == 2) {
- Uint16* loc_table =
- (Uint16 *) (BeamInstr) line[MI_LINE_LOC_TAB];
- fi->loc = loc_table[index];
+ if (lt->loc_size == 2) {
+ fi->loc = lt->loc_tab.p2[index];
} else {
- Uint32* loc_table =
- (Uint32 *) (BeamInstr) line[MI_LINE_LOC_TAB];
- ASSERT(line[MI_LINE_LOC_SIZE] == 4);
- fi->loc = loc_table[index];
+ ASSERT(lt->loc_size == 4);
+ fi->loc = lt->loc_tab.p4[index];
}
if (fi->loc == LINE_INVALID_LOCATION) {
return;
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 0bd46a2dae..37bb28c6f8 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -44,6 +44,7 @@
#include "erl_ptab.h"
#include "erl_bits.h"
#include "erl_bif_unique.h"
+#include "erl_msacc.h"
Export *erts_await_result;
static Export* flush_monitor_messages_trap = NULL;
@@ -54,6 +55,9 @@ Export* erts_format_cpu_topology_trap = NULL;
static Export dsend_continue_trap_export;
Export *erts_convert_time_unit_trap = NULL;
+static Export *await_msacc_mod_trap = NULL;
+static erts_smp_atomic32_t msacc;
+
static Export *await_sched_wall_time_mod_trap;
static erts_smp_atomic32_t sched_wall_time;
@@ -72,7 +76,7 @@ BIF_RETTYPE spawn_3(BIF_ALIST_3)
ErlSpawnOpts so;
Eterm pid;
- so.flags = 0;
+ so.flags = erts_default_spo_flags;
pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so);
if (is_non_value(pid)) {
BIF_ERROR(BIF_P, so.error_code);
@@ -589,7 +593,7 @@ erts_queue_monitor_message(Process *p,
Eterm reason_copy, ref_copy, item_copy;
Uint reason_size, ref_size, item_size, heap_size;
ErlOffHeap *ohp;
- ErlHeapFragment *bp;
+ ErtsMessage *msgp;
reason_size = IS_CONST(reason) ? 0 : size_object(reason);
item_size = IS_CONST(item) ? 0 : size_object(item);
@@ -597,11 +601,8 @@ erts_queue_monitor_message(Process *p,
heap_size = 6+reason_size+ref_size+item_size;
- hp = erts_alloc_message_heap(heap_size,
- &bp,
- &ohp,
- p,
- p_locksp);
+ msgp = erts_alloc_message_heap(p, p_locksp, heap_size,
+ &hp, &ohp);
reason_copy = (IS_CONST(reason)
? reason
@@ -612,7 +613,7 @@ erts_queue_monitor_message(Process *p,
ref_copy = copy_struct(ref, ref_size, &hp, ohp);
tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy);
- erts_queue_message(p, p_locksp, bp, tup, NIL);
+ erts_queue_message(p, p_locksp, msgp, tup, NIL);
}
static BIF_RETTYPE
@@ -841,7 +842,7 @@ BIF_RETTYPE spawn_link_3(BIF_ALIST_3)
ErlSpawnOpts so;
Eterm pid;
- so.flags = SPO_LINK;
+ so.flags = erts_default_spo_flags|SPO_LINK;
pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so);
if (is_non_value(pid)) {
BIF_ERROR(BIF_P, so.error_code);
@@ -878,7 +879,7 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1)
/*
* Store default values for options.
*/
- so.flags = SPO_USE_ARGS;
+ so.flags = erts_default_spo_flags|SPO_USE_ARGS;
so.min_heap_size = H_MIN_SIZE;
so.min_vheap_size = BIN_VH_MIN_SIZE;
so.priority = PRIORITY_NORMAL;
@@ -913,6 +914,22 @@ BIF_RETTYPE spawn_opt_1(BIF_ALIST_1)
so.priority = PRIORITY_LOW;
else
goto error;
+ } else if (arg == am_message_queue_data) {
+ switch (val) {
+ case am_mixed:
+ so.flags &= ~(SPO_OFF_HEAP_MSGQ|SPO_ON_HEAP_MSGQ);
+ break;
+ case am_on_heap:
+ so.flags &= ~SPO_OFF_HEAP_MSGQ;
+ so.flags |= SPO_ON_HEAP_MSGQ;
+ break;
+ case am_off_heap:
+ so.flags &= ~SPO_ON_HEAP_MSGQ;
+ so.flags |= SPO_OFF_HEAP_MSGQ;
+ break;
+ default:
+ goto error;
+ }
} else if (arg == am_min_heap_size && is_small(val)) {
Sint min_heap_size = signed_val(val);
if (min_heap_size < 0) {
@@ -1691,6 +1708,12 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2)
}
BIF_RET(old_value);
}
+ else if (BIF_ARG_1 == am_message_queue_data) {
+ old_value = erts_change_message_queue_management(BIF_P, BIF_ARG_2);
+ if (is_non_value(old_value))
+ goto error;
+ BIF_RET(old_value);
+ }
else if (BIF_ARG_1 == am_sensitive) {
Uint is_sensitive;
if (BIF_ARG_2 == am_true) {
@@ -1931,7 +1954,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx)
} else if (is_atom(to)) {
Eterm id = erts_whereis_name_to_id(p, to);
- rp = erts_proc_lookup(id);
+ rp = erts_proc_lookup_raw(id);
if (rp) {
if (IS_TRACED(p))
trace_send(p, to, msg);
@@ -2023,11 +2046,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx)
if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
save_calls(p, &exp_send);
- if (SEQ_TRACE_TOKEN(p) != NIL
-#ifdef USE_VM_PROBES
- && SEQ_TRACE_TOKEN(p) != am_have_dt_utag
-#endif
- ) {
+ if (have_seqtrace(SEQ_TRACE_TOKEN(p))) {
seq_trace_update_send(p);
seq_trace_output(SEQ_TRACE_TOKEN(p), msg,
SEQ_TRACE_SEND, portid, p);
@@ -2128,7 +2147,11 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
int connect = !0;
Eterm l = opts;
Sint result;
+
DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P);
+
+ ERTS_MSACC_PUSH_STATE_M_X();
+
UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P);
ctx->suspend = !0;
@@ -2157,7 +2180,10 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
ref = NIL;
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_SEND);
result = do_send(p, to, msg, &ref, ctx);
+ ERTS_MSACC_POP_STATE_M_X();
+
if (result > 0) {
ERTS_VBUMP_REDS(p, result);
if (ERTS_IS_PROC_OUT_OF_REDS(p))
@@ -2216,7 +2242,7 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
erts_dsend_export_trap_context(p, ctx));
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "send_3 invalid result %d\n", (int)result);
+ erts_exit(ERTS_ABORT_EXIT, "send_3 invalid result %d\n", (int)result);
break;
}
@@ -2260,7 +2286,7 @@ static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1)
BIF_TRAP1(&dsend_continue_trap_export, BIF_P, BIF_ARG_1);
}
default:
- erl_exit(ERTS_ABORT_EXIT, "dsend_continue_trap invalid result %d\n", (int)result);
+ erts_exit(ERTS_ABORT_EXIT, "dsend_continue_trap invalid result %d\n", (int)result);
break;
}
ASSERT(! "Can not arrive here");
@@ -2273,8 +2299,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
Eterm ref;
Sint result;
DeclareTypedTmpHeap(ErtsSendContext, ctx, p);
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_SEND);
UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p);
-
#ifdef DEBUG
ref = NIL;
#endif
@@ -2285,7 +2311,9 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT;
result = do_send(p, to, msg, &ref, ctx);
-
+
+ ERTS_MSACC_POP_STATE_M_X();
+
if (result > 0) {
ERTS_VBUMP_REDS(p, result);
if (ERTS_IS_PROC_OUT_OF_REDS(p))
@@ -2332,7 +2360,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
erts_dsend_export_trap_context(p, ctx));
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "invalid send result %d\n", (int)result);
+ erts_exit(ERTS_ABORT_EXIT, "invalid send result %d\n", (int)result);
break;
}
@@ -2809,7 +2837,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1)
{
Eterm res;
char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS);
- int i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS);
+ Sint i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS);
if (i < 0) {
erts_free(ERTS_ALC_T_TMP, (void *) buf);
@@ -2829,7 +2857,7 @@ BIF_RETTYPE list_to_atom_1(BIF_ALIST_1)
BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1)
{
- int i;
+ Sint i;
char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_CHARACTERS);
if ((i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_CHARACTERS)) < 0) {
@@ -2889,175 +2917,20 @@ BIF_RETTYPE integer_to_list_1(BIF_ALIST_1)
/**********************************************************************/
-/* convert a list of ascii ascii integer value to an integer */
-
-
-#define LTI_BAD_STRUCTURE 0
-#define LTI_NO_INTEGER 1
-#define LTI_SOME_INTEGER 2
-#define LTI_ALL_INTEGER 3
-
-static int do_list_to_integer(Process *p, Eterm orig_list,
- Eterm *integer, Eterm *rest)
-{
- Sint i = 0;
- Uint ui = 0;
- int skip = 0;
- int neg = 0;
- Sint n = 0;
- int m;
- int lg2;
- Eterm res;
- Eterm* hp;
- Eterm *hp_end;
- Eterm lst = orig_list;
- Eterm tail = lst;
- int error_res = LTI_BAD_STRUCTURE;
-
- if (is_nil(lst)) {
- error_res = LTI_NO_INTEGER;
- error:
- *rest = tail;
- *integer = make_small(0);
- return error_res;
- }
- if (is_not_list(lst))
- goto error;
-
- /* if first char is a '-' then it is a negative integer */
- if (CAR(list_val(lst)) == make_small('-')) {
- neg = 1;
- skip = 1;
- lst = CDR(list_val(lst));
- if (is_not_list(lst)) {
- tail = lst;
- error_res = LTI_NO_INTEGER;
- goto error;
- }
- } else if (CAR(list_val(lst)) == make_small('+')) {
- /* ignore plus */
- skip = 1;
- lst = CDR(list_val(lst));
- if (is_not_list(lst)) {
- tail = lst;
- error_res = LTI_NO_INTEGER;
- goto error;
- }
- }
-
- /* Calculate size and do type check */
-
- while(1) {
- if (is_not_small(CAR(list_val(lst)))) {
- break;
- }
- if (unsigned_val(CAR(list_val(lst))) < '0' ||
- unsigned_val(CAR(list_val(lst))) > '9') {
- break;
- }
- ui = ui * 10;
- ui = ui + unsigned_val(CAR(list_val(lst))) - '0';
- n++;
- lst = CDR(list_val(lst));
- if (is_nil(lst)) {
- break;
- }
- if (is_not_list(lst)) {
- break;
- }
- }
-
- tail = lst;
- if (!n) {
- error_res = LTI_NO_INTEGER;
- goto error;
- }
-
-
- /* If n <= 8 then we know it's a small int
- ** since 2^27 = 134217728. If n > 8 then we must
- ** construct a bignum and let that routine do the checking
- */
-
- if (n <= SMALL_DIGITS) { /* It must be small */
- if (neg) i = -(Sint)ui;
- else i = (Sint)ui;
- res = make_small(i);
- } else {
- /* Convert from log10 to log2 by multiplying with 1/log10(2)=3.3219
- which we round up to (3 + 1/3) */
- lg2 = (n+1)*3 + (n+1)/3 + 1;
- m = (lg2+D_EXP-1)/D_EXP; /* number of digits */
- m = BIG_NEED_SIZE(m); /* number of words + thing */
-
- hp = HAlloc(p, m);
- hp_end = hp + m;
-
- lst = orig_list;
- if (skip)
- lst = CDR(list_val(lst));
-
- /* load first digits (at least one digit) */
- if ((i = (n % D_DECIMAL_EXP)) == 0)
- i = D_DECIMAL_EXP;
- n -= i;
- m = 0;
- while(i--) {
- m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0');
- lst = CDR(list_val(lst));
- }
- res = small_to_big(m, hp); /* load first digits */
-
- while(n) {
- i = D_DECIMAL_EXP;
- n -= D_DECIMAL_EXP;
- m = 0;
- while(i--) {
- m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0');
- lst = CDR(list_val(lst));
- }
- if (is_small(res))
- res = small_to_big(signed_val(res), hp);
- res = big_times_small(res, D_DECIMAL_BASE, hp);
- if (is_small(res))
- res = small_to_big(signed_val(res), hp);
- res = big_plus_small(res, m, hp);
- }
-
- if (neg) {
- if (is_small(res))
- res = make_small(-signed_val(res));
- else {
- Uint *big = big_val(res); /* point to thing */
- *big = bignum_header_neg(*big);
- }
- }
-
- if (is_not_small(res)) {
- res = big_plus_small(res, 0, hp); /* includes conversion to small */
+/*
+ * Converts a list of ascii base10 digits to an integer fully or partially.
+ * Returns result and the remaining tail.
+ * On error returns: {error,not_a_list}, or {error, no_integer}
+ */
- if (is_not_small(res)) {
- hp += (big_arity(res)+1);
- }
- }
- HRelease(p,hp_end,hp);
- }
- *integer = res;
- *rest = tail;
- if (tail != NIL) {
- return LTI_SOME_INTEGER;
- }
- return LTI_ALL_INTEGER;
-}
BIF_RETTYPE string_to_integer_1(BIF_ALIST_1)
{
Eterm res;
Eterm tail;
Eterm *hp;
/* must be a list */
- switch (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&tail)) {
- /* HAlloc after do_list_to_integer as it
- might HAlloc itself (bignum) */
+ switch (erts_list_to_integer(BIF_P, BIF_ARG_1, 10, &res, &tail)) {
+ /* HAlloc after erts_list_to_integer as it might HAlloc itself (bignum) */
case LTI_BAD_STRUCTURE:
hp = HAlloc(BIF_P,3);
BIF_RET(TUPLE2(hp, am_error, am_not_a_list));
@@ -3072,13 +2945,14 @@ BIF_RETTYPE string_to_integer_1(BIF_ALIST_1)
BIF_RETTYPE list_to_integer_1(BIF_ALIST_1)
{
- /* Using do_list_to_integer is about twice as fast as using
+ /* Using erts_list_to_integer is about twice as fast as using
erts_chars_to_integer because we do not have to copy the
entire list */
Eterm res;
Eterm dummy;
/* must be a list */
- if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) {
+ if (erts_list_to_integer(BIF_P, BIF_ARG_1, 10,
+ &res, &dummy) != LTI_ALL_INTEGER) {
BIF_ERROR(BIF_P,BADARG);
}
BIF_RET(res);
@@ -3086,14 +2960,12 @@ BIF_RETTYPE list_to_integer_1(BIF_ALIST_1)
BIF_RETTYPE list_to_integer_2(BIF_ALIST_2)
{
-
/* Bif implementation is about 50% faster than pure erlang,
and since we have erts_chars_to_integer now it is simpler
as well. This could be optmized further if we did not have to
copy the list to buf. */
- int i;
- Eterm res;
- char *buf = NULL;
+ Sint i;
+ Eterm res, dummy;
int base;
i = erts_list_length(BIF_ARG_1);
@@ -3101,31 +2973,16 @@ BIF_RETTYPE list_to_integer_2(BIF_ALIST_2)
BIF_ERROR(BIF_P, BADARG);
base = signed_val(BIF_ARG_2);
-
+
if (base < 2 || base > 36)
BIF_ERROR(BIF_P, BADARG);
- /* Take fast path if base it 10 */
- if (base == 10)
- return list_to_integer_1(BIF_P,&BIF_ARG_1);
-
- buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1);
-
- if (intlist_to_buf(BIF_ARG_1, buf, i) < 0)
- goto list_to_integer_1_error;
- buf[i] = '\0'; /* null terminal */
-
- if ((res = erts_chars_to_integer(BIF_P,buf,i,base)) == THE_NON_VALUE)
- goto list_to_integer_1_error;
-
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
+ if (erts_list_to_integer(BIF_P, BIF_ARG_1, base,
+ &res, &dummy) != LTI_ALL_INTEGER) {
+ BIF_ERROR(BIF_P,BADARG);
+ }
BIF_RET(res);
-
- list_to_integer_1_error:
- erts_free(ERTS_ALC_T_TMP, (void *) buf);
- BIF_ERROR(BIF_P, BADARG);
-
- }
+}
/**********************************************************************/
@@ -3431,7 +3288,7 @@ static BIF_RETTYPE do_charbuf_to_float(Process *BIF_P,char *buf) {
BIF_RETTYPE list_to_float_1(BIF_ALIST_1)
{
- int i;
+ Sint i;
Eterm res;
char *buf = NULL;
@@ -3548,7 +3405,7 @@ BIF_RETTYPE list_to_tuple_1(BIF_ALIST_1)
Eterm* cons;
Eterm res;
Eterm* hp;
- int len;
+ Sint len;
if ((len = erts_list_length(list)) < 0 || len > ERTS_MAX_TUPLE_SIZE) {
BIF_ERROR(BIF_P, BADARG);
@@ -3824,11 +3681,9 @@ BIF_RETTYPE now_0(BIF_ALIST_0)
BIF_RETTYPE garbage_collect_0(BIF_ALIST_0)
{
- int reds;
-
FLAGS(BIF_P) |= F_NEED_FULLSWEEP;
- reds = erts_garbage_collect(BIF_P, 0, NULL, 0);
- BIF_RET2(am_true, reds);
+ erts_garbage_collect(BIF_P, 0, NULL, 0);
+ BIF_RET(am_true);
}
/**********************************************************************/
@@ -3883,7 +3738,7 @@ BIF_RETTYPE erts_debug_display_1(BIF_ALIST_1)
erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(64);
pres = erts_dsprintf(dsbufp, "%.*T\n", INT_MAX, BIF_ARG_1);
if (pres < 0)
- erl_exit(1, "Failed to convert term to string: %d (%s)\n",
+ erts_exit(ERTS_ERROR_EXIT, "Failed to convert term to string: %d (%s)\n",
-pres, erl_errno_id(-pres));
hp = HAlloc(BIF_P, 2*dsbufp->str_len); /* we need length * 2 heap words */
res = buf_to_intlist(&hp, dsbufp->str, dsbufp->str_len, NIL);
@@ -3897,7 +3752,7 @@ BIF_RETTYPE display_string_1(BIF_ALIST_1)
{
Process* p = BIF_P;
Eterm string = BIF_ARG_1;
- int len = is_string(string);
+ Sint len = is_string(string);
char *str;
if (len <= 0) {
@@ -3905,7 +3760,7 @@ BIF_RETTYPE display_string_1(BIF_ALIST_1)
}
str = (char *) erts_alloc(ERTS_ALC_T_TMP, sizeof(char)*(len + 1));
if (intlist_to_buf(string, str, len) != len)
- erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__);
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
str[len] = '\0';
erts_fprintf(stderr, "%s", str);
erts_free(ERTS_ALC_T_TMP, (void *) str);
@@ -3925,7 +3780,7 @@ BIF_RETTYPE display_nl_0(BIF_ALIST_0)
BIF_RETTYPE halt_0(BIF_ALIST_0)
{
VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt()\n"));
- erl_halt(0);
+ erts_halt(0);
ERTS_BIF_YIELD1(bif_export[BIF_halt_1], BIF_P, am_undefined);
}
@@ -3938,20 +3793,21 @@ static char halt_msg[HALT_MSG_SIZE];
/* ARGSUSED */
BIF_RETTYPE halt_1(BIF_ALIST_1)
{
- Sint code;
+ Uint code;
- if (is_small(BIF_ARG_1) && (code = signed_val(BIF_ARG_1)) >= 0) {
+ if (term_to_Uint_mask(BIF_ARG_1, &code)) {
+ int pos_int_code = (int) (code & INT_MAX);
VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%T)\n", BIF_ARG_1));
- erl_halt((int)(- code));
+ erts_halt(pos_int_code);
ERTS_BIF_YIELD1(bif_export[BIF_halt_1], BIF_P, am_undefined);
}
else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) {
VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%T)\n", BIF_ARG_1));
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erl_exit(ERTS_ABORT_EXIT, "");
+ erts_exit(ERTS_ABORT_EXIT, "");
}
else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
- int i;
+ Sint i;
if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) {
goto error;
@@ -3959,11 +3815,11 @@ BIF_RETTYPE halt_1(BIF_ALIST_1)
halt_msg[i] = '\0';
VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%T)\n", BIF_ARG_1));
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erl_exit(ERTS_DUMP_EXIT, "%s\n", halt_msg);
+ erts_exit(ERTS_DUMP_EXIT, "%s\n", halt_msg);
}
else
goto error;
- return NIL; /* Pedantic (lint does not know about erl_exit) */
+ return NIL; /* Pedantic (lint does not know about erts_exit) */
error:
BIF_ERROR(BIF_P, BADARG);
}
@@ -3974,7 +3830,7 @@ BIF_RETTYPE halt_1(BIF_ALIST_1)
/* ARGSUSED */
BIF_RETTYPE halt_2(BIF_ALIST_2)
{
- Sint code;
+ Uint code;
Eterm optlist = BIF_ARG_2;
int flush = 1;
@@ -4001,26 +3857,27 @@ BIF_RETTYPE halt_2(BIF_ALIST_2)
if (is_not_nil(optlist))
goto error;
- if (is_small(BIF_ARG_1) && (code = signed_val(BIF_ARG_1)) >= 0) {
+ if (term_to_Uint_mask(BIF_ARG_1, &code)) {
+ int pos_int_code = (int) (code & INT_MAX);
VERBOSE(DEBUG_SYSTEM,
("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
if (flush) {
- erl_halt((int)(- code));
+ erts_halt(pos_int_code);
ERTS_BIF_YIELD1(bif_export[BIF_halt_1], BIF_P, am_undefined);
}
else {
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erl_exit((int)(- code), "");
+ erts_exit(pos_int_code, "");
}
}
else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) {
VERBOSE(DEBUG_SYSTEM,
("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erl_exit(ERTS_ABORT_EXIT, "");
+ erts_exit(ERTS_ABORT_EXIT, "");
}
else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) {
- int i;
+ Sint i;
if ((i = intlist_to_buf(BIF_ARG_1, halt_msg, HALT_MSG_SIZE-1)) < 0) {
goto error;
@@ -4029,11 +3886,11 @@ BIF_RETTYPE halt_2(BIF_ALIST_2)
VERBOSE(DEBUG_SYSTEM,
("System halted by BIF halt(%T, %T)\n", BIF_ARG_1, BIF_ARG_2));
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- erl_exit(ERTS_DUMP_EXIT, "%s\n", halt_msg);
+ erts_exit(ERTS_DUMP_EXIT, "%s\n", halt_msg);
}
else
goto error;
- return NIL; /* Pedantic (lint does not know about erl_exit) */
+ return NIL; /* Pedantic (lint does not know about erts_exit) */
error:
BIF_ERROR(BIF_P, BADARG);
}
@@ -4089,7 +3946,7 @@ term2list_dsprintf(Process *p, Eterm term)
erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(64);
pres = erts_dsprintf(dsbufp, "%T", term);
if (pres < 0)
- erl_exit(1, "Failed to convert term to list: %d (%s)\n",
+ erts_exit(ERTS_ERROR_EXIT, "Failed to convert term to list: %d (%s)\n",
-pres, erl_errno_id(-pres));
hp = HAlloc(p, 2*dsbufp->str_len); /* we need length * 2 heap words */
res = buf_to_intlist(&hp, dsbufp->str, dsbufp->str_len, NIL);
@@ -4117,16 +3974,9 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3)
if (arity < 0) {
goto error;
}
-#if HALFWORD_HEAP
- hp = HAlloc(BIF_P, 3);
- hp[0] = HEADER_EXPORT;
- /* Yes, May be misaligned, but X86_64 will fix it... */
- *((Export **) (hp+1)) = erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
-#else
hp = HAlloc(BIF_P, 2);
hp[0] = HEADER_EXPORT;
hp[1] = (Eterm) erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
-#endif
BIF_RET(make_export(hp));
}
@@ -4170,7 +4020,7 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
{
Uint a = 0, b = 0, c = 0;
char* cp;
- int i;
+ Sint i;
DistEntry *dep = NULL;
char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, 65);
/*
@@ -4231,6 +4081,7 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
goto bad;
enp = erts_find_or_insert_node(dep->sysname, dep->creation);
+ ASSERT(enp != erts_this_node);
etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1);
etp->header = make_external_pid_header(1);
@@ -4346,22 +4197,33 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
Sint n;
if (BIF_ARG_1 == am_multi_scheduling) {
- if (BIF_ARG_2 == am_block || BIF_ARG_2 == am_unblock) {
+ if (BIF_ARG_2 == am_block || BIF_ARG_2 == am_unblock
+ || BIF_ARG_2 == am_block_normal || BIF_ARG_2 == am_unblock_normal) {
#ifndef ERTS_SMP
BIF_RET(am_disabled);
#else
+ int block = (BIF_ARG_2 == am_block
+ || BIF_ARG_2 == am_block_normal);
+ int normal = (BIF_ARG_2 == am_block_normal
+ || BIF_ARG_2 == am_unblock_normal);
if (erts_no_schedulers == 1)
BIF_RET(am_disabled);
else {
switch (erts_block_multi_scheduling(BIF_P,
ERTS_PROC_LOCK_MAIN,
- BIF_ARG_2 == am_block,
+ block,
+ normal,
0)) {
case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
BIF_RET(am_blocked);
+ case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED:
+ BIF_RET(am_blocked_normal);
case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED:
ERTS_BIF_YIELD_RETURN_X(BIF_P, am_blocked,
am_multi_scheduling);
+ case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED:
+ ERTS_BIF_YIELD_RETURN_X(BIF_P, am_blocked_normal,
+ am_multi_scheduling);
case ERTS_SCHDLR_SSPND_DONE:
BIF_RET(am_enabled);
case ERTS_SCHDLR_SSPND_YIELD_RESTART:
@@ -4394,11 +4256,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
switch (erts_set_schedulers_online(BIF_P,
ERTS_PROC_LOCK_MAIN,
signed_val(BIF_ARG_2),
- &old_no
-#ifdef ERTS_DIRTY_SCHEDULERS
- , 0
-#endif
- )) {
+ &old_no, 0)) {
case ERTS_SCHDLR_SSPND_DONE:
BIF_RET(make_small(old_no));
case ERTS_SCHDLR_SSPND_YIELD_RESTART:
@@ -4486,7 +4344,7 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
}
} else if (BIF_ARG_1 == make_small(1)) {
int i, max;
- ErlMessage* mp;
+ ErtsMessage* mp;
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_smp_thr_progress_block();
@@ -4579,6 +4437,31 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
default:
ERTS_INTERNAL_ERROR("Unknown state");
}
+#ifdef ERTS_ENABLE_MSACC
+ } else if (BIF_ARG_1 == am_microstate_accounting) {
+ Eterm threads;
+ if (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false) {
+ erts_aint32_t new = BIF_ARG_2 == am_true ? ERTS_MSACC_ENABLE : ERTS_MSACC_DISABLE;
+ erts_aint32_t old = erts_smp_atomic32_xchg_nob(&msacc, new);
+ Eterm ref = erts_msacc_request(BIF_P, new, &threads);
+ if (is_non_value(ref))
+ BIF_RET(old ? am_true : am_false);
+ BIF_TRAP3(await_msacc_mod_trap,
+ BIF_P,
+ ref,
+ old ? am_true : am_false,
+ threads);
+ } else if (BIF_ARG_2 == am_reset) {
+ Eterm ref = erts_msacc_request(BIF_P, ERTS_MSACC_RESET, &threads);
+ erts_aint32_t old = erts_smp_atomic32_read_nob(&msacc);
+ ASSERT(is_value(ref));
+ BIF_TRAP3(await_msacc_mod_trap,
+ BIF_P,
+ ref,
+ old ? am_true : am_false,
+ threads);
+ }
+#endif
} else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) {
int what;
if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2))
@@ -4631,7 +4514,7 @@ BIF_RETTYPE hash_2(BIF_ALIST_2)
if ((range = signed_val(BIF_ARG_2)) <= 0) { /* [1..MAX_SMALL] */
BIF_ERROR(BIF_P, BADARG);
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (range > ((1L << 27) - 1))
BIF_ERROR(BIF_P, BADARG);
#endif
@@ -4703,7 +4586,7 @@ BIF_RETTYPE phash2_2(BIF_ALIST_2)
/*
* Return either a small or a big. Use the heap for bigs if there is room.
*/
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
BIF_RET(make_small(final_hash));
#else
if (IS_USMALL(0, final_hash)) {
@@ -4743,29 +4626,27 @@ BIF_RETTYPE erts_internal_cmp_term_2(BIF_ALIST_2) {
/*
* Processes doing yield on return in a bif ends up in bif_return_trap().
*/
-static BIF_RETTYPE bif_return_trap(
-#ifdef DEBUG
- BIF_ALIST_2
-#else
- BIF_ALIST_1
-#endif
- )
+static BIF_RETTYPE bif_return_trap(BIF_ALIST_2)
{
-#ifdef DEBUG
+ Eterm res = BIF_ARG_1;
+
switch (BIF_ARG_2) {
- case am_multi_scheduling:
#ifdef ERTS_SMP
- erts_dbg_multi_scheduling_return_trap(BIF_P, BIF_ARG_1);
-#endif
- break;
- case am_schedulers_online:
+ case am_multi_scheduling: {
+ int msb = erts_is_multi_scheduling_blocked();
+ if (msb > 0)
+ res = am_blocked;
+ else if (msb < 0)
+ res = am_blocked_normal;
+ else
+ ERTS_INTERNAL_ERROR("Unexpected multi scheduling block state");
break;
+ }
+#endif
default:
break;
}
-#endif
-
- BIF_RET(BIF_ARG_1);
+ BIF_RET(res);
}
/*
@@ -4870,17 +4751,12 @@ void erts_init_bif(void)
erts_smp_atomic_init_nob(&erts_dead_ports_ptr, (erts_aint_t) NULL);
/*
- * bif_return_trap/1 is a hidden BIF that bifs that need to
- * yield the calling process traps to. The only thing it does:
- * return the value passed as argument.
+ * bif_return_trap/2 is a hidden BIF that bifs that need to
+ * yield the calling process traps to.
*/
- erts_init_trap_export(&bif_return_trap_export, am_erlang, am_bif_return_trap,
-#ifdef DEBUG
- 2
-#else
- 1
-#endif
- , &bif_return_trap);
+ erts_init_trap_export(&bif_return_trap_export,
+ am_erlang, am_bif_return_trap, 2,
+ &bif_return_trap);
erts_await_result = erts_export_put(am_erts_internal,
am_await_result,
@@ -4908,8 +4784,12 @@ void erts_init_bif(void)
await_port_send_result_trap
= erts_export_put(am_erts_internal, am_await_port_send_result, 3);
await_sched_wall_time_mod_trap
- = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2);
+ = erts_export_put(am_erlang, am_await_sched_wall_time_modifications, 2);
+ await_msacc_mod_trap
+ = erts_export_put(am_erts_internal, am_await_microstate_accounting_modifications, 3);
+
erts_smp_atomic32_init_nob(&sched_wall_time, 0);
+ erts_smp_atomic32_init_nob(&msacc, ERTS_MSACC_IS_ENABLED());
}
#ifdef HARDDEBUG
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index c6ed60376a..46af552b39 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -54,22 +54,24 @@ extern Export *erts_convert_time_unit_trap;
(p)->fcalls = -CONTEXT_REDS; \
} while(0)
-
-#define ERTS_VBUMP_ALL_REDS(p) \
+#define ERTS_VBUMP_ALL_REDS_INTERNAL(p, fcalls) \
do { \
if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) { \
- if ((p)->fcalls > 0) \
- ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (p)->fcalls; \
- (p)->fcalls = 0; \
+ if ((fcalls) > 0) \
+ ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (fcalls); \
+ (fcalls) = 0; \
} \
else { \
- if ((p)->fcalls > -CONTEXT_REDS) \
+ if ((fcalls) > -CONTEXT_REDS) \
ERTS_PROC_GET_SCHDATA((p))->virtual_reds \
- += ((p)->fcalls - (-CONTEXT_REDS)); \
- (p)->fcalls = -CONTEXT_REDS; \
+ += ((fcalls) - (-CONTEXT_REDS)); \
+ (fcalls) = -CONTEXT_REDS; \
} \
} while(0)
+#define ERTS_VBUMP_ALL_REDS(p) \
+ ERTS_VBUMP_ALL_REDS_INTERNAL((p), (p)->fcalls)
+
#define BUMP_REDS(p, gc) do { \
ASSERT(p); \
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p));\
@@ -110,10 +112,34 @@ do { \
} \
} while(0)
-#define ERTS_BIF_REDS_LEFT(p) \
+#define ERTS_VBUMP_LEAVE_REDS_INTERNAL(P, Reds, FCalls) \
+ do { \
+ if (ERTS_PROC_GET_SAVED_CALLS_BUF((P))) { \
+ int nreds__ = ((int)(Reds)) - CONTEXT_REDS; \
+ if ((FCalls) > nreds__) { \
+ ERTS_PROC_GET_SCHDATA((P))->virtual_reds \
+ += (FCalls) - nreds__; \
+ (FCalls) = nreds__; \
+ } \
+ } \
+ else { \
+ if ((FCalls) > (Reds)) { \
+ ERTS_PROC_GET_SCHDATA((P))->virtual_reds \
+ += (FCalls) - (Reds); \
+ (FCalls) = (Reds); \
+ } \
+ } \
+ } while (0)
+
+#define ERTS_VBUMP_LEAVE_REDS(P, Reds) \
+ ERTS_VBUMP_LEAVE_REDS_INTERNAL(P, Reds, (P)->fcalls)
+
+#define ERTS_REDS_LEFT(p, FCalls) \
(ERTS_PROC_GET_SAVED_CALLS_BUF((p)) \
- ? ((p)->fcalls > -CONTEXT_REDS ? ((p)->fcalls - (-CONTEXT_REDS)) : 0)\
- : ((p)->fcalls > 0 ? (p)->fcalls : 0))
+ ? ((FCalls) > -CONTEXT_REDS ? ((FCalls) - (-CONTEXT_REDS)) : 0) \
+ : ((FCalls) > 0 ? (FCalls) : 0))
+
+#define ERTS_BIF_REDS_LEFT(p) ERTS_REDS_LEFT(p, p->fcalls)
#define BIF_RET2(x, gc) do { \
BUMP_REDS(BIF_P, (gc)); \
@@ -312,37 +338,20 @@ do { \
} while(0)
extern Export bif_return_trap_export;
-#ifdef DEBUG
-#define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, DEBUG_VAL) \
-do { \
- ERTS_VBUMP_ALL_REDS(P); \
- ERTS_BIF_PREP_TRAP2(RET, &bif_return_trap_export, (P), (VAL), \
- (DEBUG_VAL)); \
-} while (0)
-#else
-#define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, DEBUG_VAL) \
+#define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, OP) \
do { \
ERTS_VBUMP_ALL_REDS(P); \
- ERTS_BIF_PREP_TRAP1(RET, &bif_return_trap_export, (P), (VAL)); \
+ ERTS_BIF_PREP_TRAP2(RET, &bif_return_trap_export, (P), (VAL), (OP));\
} while (0)
-#endif
#define ERTS_BIF_PREP_YIELD_RETURN(RET, P, VAL) \
ERTS_BIF_PREP_YIELD_RETURN_X(RET, (P), (VAL), am_undefined)
-#ifdef DEBUG
-#define ERTS_BIF_YIELD_RETURN_X(P, VAL, DEBUG_VAL) \
+#define ERTS_BIF_YIELD_RETURN_X(P, VAL, OP) \
do { \
ERTS_VBUMP_ALL_REDS(P); \
- BIF_TRAP2(&bif_return_trap_export, (P), (VAL), (DEBUG_VAL)); \
+ BIF_TRAP2(&bif_return_trap_export, (P), (VAL), (OP)); \
} while (0)
-#else
-#define ERTS_BIF_YIELD_RETURN_X(P, VAL, DEBUG_VAL) \
-do { \
- ERTS_VBUMP_ALL_REDS(P); \
- BIF_TRAP1(&bif_return_trap_export, (P), (VAL)); \
-} while (0)
-#endif
#define ERTS_BIF_RETURN_YIELD(P) ERTS_VBUMP_ALL_REDS((P))
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 4f0656d174..a6670c10e8 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -115,7 +115,7 @@ bif erlang:time_offset/0
bif erlang:time_offset/1
bif erlang:timestamp/0
-bif erlang:open_port/2
+bif erts_internal:open_port/2
bif erlang:pid_to_list/1
bif erlang:ports/0
@@ -125,7 +125,6 @@ bif erlang:process_flag/3
bif erlang:process_info/1
bif erlang:process_info/2
bif erlang:processes/0
-bif erlang:purge_module/1
bif erlang:put/2
bif erlang:register/2
bif erlang:registered/0
@@ -167,13 +166,16 @@ bif erts_internal:request_system_task/3
bif erts_internal:check_process_code/2
bif erts_internal:map_to_tuple_keys/1
-bif erts_internal:map_type/1
+bif erts_internal:term_type/1
bif erts_internal:map_hashmap_children/1
bif erts_internal:time_unit/0
+bif erts_internal:perf_counter_unit/0
bif erts_internal:is_system_process/1
+bif erts_internal:system_check/1
+
# inet_db support
bif erlang:port_set_data/2
bif erlang:port_get_data/1
@@ -370,6 +372,7 @@ bif os:getpid/0
bif os:timestamp/0
bif os:system_time/0
bif os:system_time/1
+bif os:perf_counter/0
#
# Bifs in the erl_ddll module (the module actually does not exist)
@@ -639,6 +642,18 @@ bif ets:update_counter/4
bif erts_debug:map_info/1
#
+# New in 19.0
+#
+
+bif erts_internal:copy_literals/2
+bif erts_internal:purge_module/1
+bif binary:split/2
+bif binary:split/3
+bif erts_debug:size_shared/1
+bif erts_debug:copy_shared/1
+bif erlang:has_prepared_code_on_load/1
+
+#
# Obsolete
#
diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c
index 15bcd44fb9..c738a9ecf5 100644
--- a/erts/emulator/beam/big.c
+++ b/erts/emulator/beam/big.c
@@ -48,7 +48,7 @@
_t_dst = (dst)+((sz)-1); \
_t_src = (src)+((sz)-1); \
while(_t_sz--) *_t_dst-- = *_t_src--; \
- } \
+ } \
} while(0)
/* add a and b with carry in + out */
@@ -423,6 +423,25 @@
#endif
+/* Forward declaration of lookup tables (See below in this file) used in list to
+ * integer conversions for different bases. Also used in bignum printing.
+ */
+static const byte digits_per_sint_lookup[36-1];
+static const byte digits_per_small_lookup[36-1];
+static const Sint largest_power_of_base_lookup[36-1];
+
+static ERTS_INLINE byte get_digits_per_signed_int(Uint base) {
+ return digits_per_sint_lookup[base-2];
+}
+
+static ERTS_INLINE byte get_digits_per_small(Uint base) {
+ return digits_per_small_lookup[base-2];
+}
+
+static ERTS_INLINE Sint get_largest_power_of_base(Uint base) {
+ return largest_power_of_base_lookup[base-2];
+}
+
/*
** compare two number vectors
*/
@@ -1487,20 +1506,8 @@ Eterm uint_to_big(Uint x, Eterm *y)
Eterm uword_to_big(UWord x, Eterm *y)
{
-#if HALFWORD_HEAP
- Uint upper = x >> 32;
- Uint lower = x & 0xFFFFFFFFUL;
- if (upper == 0) {
- *y = make_pos_bignum_header(1);
- } else {
- *y = make_pos_bignum_header(2);
- BIG_DIGIT(y, 1) = upper;
- }
- BIG_DIGIT(y, 0) = lower;
-#else
*y = make_pos_bignum_header(1);
BIG_DIGIT(y, 0) = x;
-#endif
return make_big(y);
}
@@ -1525,7 +1532,7 @@ Eterm small_to_big(Sint x, Eterm *y)
Eterm erts_uint64_to_big(Uint64 x, Eterm **hpp)
{
Eterm *hp = *hpp;
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
if (x >= (((Uint64) 1) << 32)) {
*hp = make_pos_bignum_header(2);
BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff));
@@ -1555,7 +1562,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp)
neg = 1;
ux = -(Uint64)x;
}
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
if (ux >= (((Uint64) 1) << 32)) {
if (neg)
*hp = make_neg_bignum_header(2);
@@ -1588,7 +1595,7 @@ erts_uint64_array_to_big(Uint **hpp, int neg, int len, Uint64 *array)
pot_digits = digits = 0;
for (i = 0; i < len; i++) {
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
Uint low_val = array[i] & ((Uint) 0xffffffff);
Uint high_val = (array[i] >> 32) & ((Uint) 0xffffffff);
BIG_DIGIT(headerp, pot_digits) = low_val;
@@ -1651,8 +1658,6 @@ big_to_double(Wterm x, double* resp)
/*
* Logic has been copied from erl_bif_guard.c and slightly
* modified to use a static instead of dynamic heap
- *
- * HALFWORD: Return relative term with 'heap' as base.
*/
Eterm
double_to_big(double x, Eterm *heap, Uint hsz)
@@ -1683,7 +1688,7 @@ double_to_big(double x, Eterm *heap, Uint hsz)
sz = BIG_NEED_SIZE(ds); /* number of words including arity */
hp = heap;
- res = make_big_rel(hp, heap);
+ res = make_big(hp);
xp = (ErtsDigit*) (hp + 1);
ASSERT(ds < hsz);
@@ -1733,8 +1738,10 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg)
short sign = BIG_SIGN(xp);
ErtsDigit rem;
Uint n = 0;
+ const Uint digits_per_Sint = get_digits_per_signed_int(10);
+ const Sint largest_pow_of_base = get_largest_power_of_base(10);
- if (xl == 1 && *dx < D_DECIMAL_BASE) {
+ if (xl == 1 && *dx < largest_pow_of_base) {
rem = *dx;
if (rem == 0) {
(*write_func)(arg, '0'); n++;
@@ -1752,7 +1759,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg)
MOVE_DIGITS(tmp, dx, xl);
while(1) {
- tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem);
+ tmpl = D_div(tmp, tmpl, largest_pow_of_base, tmp, &rem);
if (tmpl == 1 && *tmp == 0) {
while(rem) {
(*write_func)(arg, (rem % 10)+'0'); n++;
@@ -1760,7 +1767,7 @@ static Uint write_big(Wterm x, void (*write_func)(void *, char), void *arg)
}
break;
} else {
- int i = D_DECIMAL_EXP;
+ Uint i = digits_per_Sint;
while(i--) {
(*write_func)(arg, (rem % 10)+'0'); n++;
rem /= 10;
@@ -2028,6 +2035,32 @@ term_to_Uint(Eterm term, Uint *up)
}
}
+/* same as term_to_Uint()
+ but also accept larger bignums by masking
+ */
+int
+term_to_Uint_mask(Eterm term, Uint *up)
+{
+ if (is_small(term)) {
+ Sint i = signed_val(term);
+ if (i < 0) {
+ *up = BADARG;
+ return 0;
+ }
+ *up = (Uint) i;
+ return 1;
+ } else if (is_big(term) && !big_sign(term)) {
+ ErtsDigit* xr = big_v(term);
+
+ ERTS_CT_ASSERT(sizeof(ErtsDigit) == sizeof(Uint));
+ *up = (Uint)*xr; /* just pick first word */
+ return 1;
+ } else {
+ *up = BADARG;
+ return 0;
+ }
+}
+
int
term_to_UWord(Eterm term, UWord *up)
{
@@ -2536,63 +2569,100 @@ int term_equals_2pow32(Eterm x)
}
}
+static ERTS_INLINE int c2int_is_invalid_char(byte ch, int base) {
+ return (ch < '0'
+ || (ch > ('0' + base - 1)
+ && !(base > 10
+ && ((ch >= 'a' && ch < ('a' + base - 10))
+ || (ch >= 'A' && ch < ('A' + base - 10))))));
+}
+
+static ERTS_INLINE byte c2int_digit_from_base(byte ch) {
+ return ch <= '9' ? ch - '0'
+ : (10 + (ch <= 'Z' ? ch - 'A' : ch - 'a'));
+}
-#define IS_VALID_CHARACTER(CHAR,BASE) \
- (CHAR < '0' \
- || (CHAR > ('0' + BASE - 1) \
- && !(BASE > 10 \
- && ((CHAR >= 'a' && CHAR < ('a' + BASE - 10)) \
- || (CHAR >= 'A' && CHAR < ('A' + BASE - 10))))))
-#define CHARACTER_FROM_BASE(CHAR) \
- ((CHAR <= '9') ? CHAR - '0' : 10 + ((CHAR <= 'Z') ? CHAR - 'A' : CHAR - 'a'))
-#define D_BASE_EXP(BASE) (d_base_exp_lookup[BASE-2])
-#define D_BASE_BASE(BASE) (d_base_base_lookup[BASE-2])
-#define LG2_LOOKUP(BASE) (lg2_lookup[base-2])
+/*
+ * How many bits are needed to store 1 digit of given base in binary
+ * Wo.Alpha formula: Table [log2[n], {n,2,36}]
+ */
+static const double lg2_lookup[36-1] = {
+ 1.0, 1.58496, 2.0, 2.32193, 2.58496, 2.80735, 3.0, 3.16993, 3.32193,
+ 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0, 4.08746, 4.16993, 4.24793,
+ 4.32193, 4.39232, 4.45943, 4.52356, 4.58496, 4.64386, 4.70044, 4.75489,
+ 4.80735, 4.85798, 4.90689, 4.9542, 5.0, 5.04439, 5.08746, 5.12928, 5.16993
+};
+static ERTS_INLINE double lookup_log2(Uint base) {
+ return lg2_lookup[base - 2];
+}
/*
- * for i in 2..64 do
- * lg2_lookup[i-2] = log2(i)
- * end
- * How many bits are needed to store string of size n
+ * How many digits can fit into a signed int (Sint) for given base, we take
+ * one digit away just to be on the safer side (some corner cases).
*/
-const double lg2_lookup[] = { 1.0, 1.58496, 2, 2.32193, 2.58496, 2.80735, 3.0,
- 3.16993, 3.32193, 3.45943, 3.58496, 3.70044, 3.80735, 3.90689, 4.0,
- 4.08746, 4.16993, 4.24793, 4.32193, 4.39232, 4.45943, 4.52356, 4.58496,
- 4.64386, 4.70044, 4.75489, 4.80735, 4.85798, 4.90689, 4.9542, 5.0,
- 5.04439, 5.08746, 5.12928, 5.16993, 5.20945, 5.24793, 5.2854, 5.32193,
- 5.35755, 5.39232, 5.42626, 5.45943, 5.49185, 5.52356, 5.55459, 5.58496,
- 5.61471, 5.64386, 5.67243, 5.70044, 5.72792, 5.75489, 5.78136, 5.80735,
- 5.83289, 5.85798, 5.88264, 5.90689, 5.93074, 5.9542, 5.97728, 6.0 };
+static const byte digits_per_sint_lookup[36-1] = {
+#if (SIZEOF_VOID_P == 4)
+ /* Wo.Alpha formula: Table [Trunc[31 / log[2,n]]-1, {n, 2, 36}] */
+ 30, 18, 14, 12, 10, 10, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4
+#elif (SIZEOF_VOID_P == 8)
+ /* Wo.Alpha formula: Table [Trunc[63 / log[2,n]]-1, {n, 2, 36}] */
+ 62, 38, 30, 26, 23, 21, 20, 18, 17, 17, 16, 16, 15, 15, 14, 14, 14, 13, 13,
+ 13, 13, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11, 11, 11
+#else
+ #error "Please produce a lookup table for the new architecture"
+#endif
+};
/*
- * for i in 2..64 do
- * d_base_exp_lookup[i-2] = 31 / lg2_lookup[i-2];
- * end
- * How many characters can fit in 31 bits
+ * How many digits can fit into Erlang Small (SMALL_BITS-1) counting sign bit
*/
-const byte d_base_exp_lookup[] = { 31, 19, 15, 13, 11, 11, 10, 9, 9, 8, 8, 8, 8,
- 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5,
- 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
- 5, 5 };
+static const byte digits_per_small_lookup[36-1] = {
+#if (SIZEOF_VOID_P == 4)
+ /* Wo.Alpha formula: Table [Trunc[27 / log[2,n]]-1, {n, 2, 36}] */
+ 27, 17, 13, 11, 10, 9, 9, 8, 8, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 5, 5, 5,
+ 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5
+#elif (SIZEOF_VOID_P == 8)
+ /* Wo.Alpha formula: Table [Trunc[59 / log[2,n]]-1, {n, 2, 36}] */
+ 59, 37, 29, 25, 22, 21, 19, 18, 17, 17, 16, 15, 15, 15, 14, 14, 14, 13, 13,
+ 13, 13, 13, 12, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11
+#else
+ #error "Please produce a lookup table for the new architecture"
+#endif
+};
/*
- * for i in 2..64 do
- * d_base_base_lookup[i-2] = pow(i,d_base_exp_lookup[i-2]);
- * end
- * How much can the characters which fit in 31 bit represent
+ * Largest power of base which can be represented in a signed int (Sint).
+ * Calculated by base 2..36 to the power of corresponding element from
+ * digits_per_sint_lookup.
*/
-const Uint d_base_base_lookup[] = { 2147483648u, 1162261467u, 1073741824u,
- 1220703125u, 362797056u, 1977326743u, 1073741824u, 387420489u,
- 1000000000u, 214358881u, 429981696u, 815730721u, 1475789056u,
- 170859375u, 268435456u, 410338673u, 612220032u, 893871739u, 1280000000u,
- 1801088541u, 113379904u, 148035889u, 191102976u, 244140625u, 308915776u,
- 387420489u, 481890304u, 594823321u, 729000000u, 887503681u, 1073741824u,
- 1291467969u, 1544804416u, 1838265625u, 60466176u, 69343957u, 79235168u,
- 90224199u, 102400000u, 115856201u, 130691232u, 147008443u, 164916224u,
- 184528125u, 205962976u, 229345007u, 254803968u, 282475249u, 312500000u,
- 345025251u, 380204032u, 418195493u, 459165024u, 503284375u, 550731776u,
- 601692057u, 656356768u, 714924299u, 777600000u, 844596301u, 916132832u,
- 992436543u, 1073741824u };
+static const Sint largest_power_of_base_lookup[36-1] = {
+#if (SIZEOF_VOID_P == 4)
+ /* Wo.Alpha formula: Table [Pow[n, Trunc[31 / log[2,n]]-1], {n, 2, 36}] */
+ 1073741824, 387420489, 268435456, 244140625, 60466176, 282475249, 134217728,
+ 43046721, 100000000, 19487171, 35831808, 62748517, 105413504, 11390625,
+ 16777216, 24137569, 34012224, 47045881, 64000000, 85766121, 5153632,
+ 6436343,7962624, 9765625, 11881376, 14348907, 17210368, 20511149, 24300000,
+ 28629151, 33554432, 39135393, 45435424, 52521875, 1679616
+#elif (SIZEOF_VOID_P == 8)
+ /* Wo.Alpha formula: Table [Pow[n, Trunc[63 / log[2,n]]-1], {n, 2, 36}]
+ * with LL added after each element manually */
+ 4611686018427387904LL, 1350851717672992089LL, 1152921504606846976LL,
+ 1490116119384765625LL, 789730223053602816LL, 558545864083284007LL,
+ 1152921504606846976LL, 150094635296999121LL, 100000000000000000LL,
+ 505447028499293771LL, 184884258895036416LL, 665416609183179841LL,
+ 155568095557812224LL, 437893890380859375LL, 72057594037927936LL,
+ 168377826559400929LL, 374813367582081024LL, 42052983462257059LL,
+ 81920000000000000LL, 154472377739119461LL, 282810057883082752LL,
+ 21914624432020321LL, 36520347436056576LL, 59604644775390625LL,
+ 95428956661682176LL, 150094635296999121LL, 232218265089212416LL,
+ 12200509765705829LL, 17714700000000000LL, 25408476896404831LL,
+ 36028797018963968LL, 50542106513726817LL, 70188843638032384LL,
+ 96549157373046875LL, 131621703842267136LL
+#else
+ #error "Please produce a lookup table for the new architecture"
+#endif
+};
Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
Uint size, const int base) {
@@ -2602,8 +2672,11 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
int neg = 0;
byte b;
Eterm *hp, *hp_end;
- int m;
+ Sint m;
int lg2;
+ const Uint digits_per_small = get_digits_per_small(base);
+ const Uint digits_per_Sint = get_digits_per_signed_int(base);
+ const Sint largest_pow_of_base = get_largest_power_of_base(base);
if (size == 0)
goto bytebuf_to_integer_1_error;
@@ -2618,57 +2691,68 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
size--;
}
+ /* Trim leading zeroes */
+ if (size) {
+ while (*bytes == '0') {
+ bytes++;
+ size--;
+ if (!size) {
+ /* All zero! */
+ res = make_small(0);
+ goto bytebuf_to_integer_1_done;
+ }
+ }
+ }
+
if (size == 0)
goto bytebuf_to_integer_1_error;
- if (size < SMALL_DIGITS && base <= 10) {
- /* *
- * Take shortcut if we know that all chars are '0' < b < '9' and
- * fit in a small. This improves speed by about 10% over the generic
- * small case.
- * */
- while (size--) {
- b = *bytes++;
+ if (size < digits_per_small) {
+ if (base <= 10) {
+ /* *
+ * Take shortcut if we know that all chars are '0' < b < '9' and
+ * fit in a small. This improves speed by about 10% over the generic
+ * small case.
+ * */
+ while (size--) {
+ b = *bytes++;
- if (b < '0' || b > ('0'+base-1))
- goto bytebuf_to_integer_1_error;
+ if (b < '0' || b > ('0'+base-1))
+ goto bytebuf_to_integer_1_error;
- i = i * base + b - '0';
- }
+ i = i * base + b - '0';
+ }
- if (neg)
- i = -i;
- res = make_small(i);
- goto bytebuf_to_integer_1_done;
+ if (neg)
+ i = -i;
+ res = make_small(i);
+ goto bytebuf_to_integer_1_done;
+ }
+
+ /* Take shortcut if we know it will fit in a small.
+ * This improves speed by about 30%.
+ */
+ while (size) {
+ b = *bytes++;
+ size--;
+
+ if (c2int_is_invalid_char(b, base))
+ goto bytebuf_to_integer_1_error;
+
+ i = i * base + c2int_digit_from_base(b);
+ }
+
+ if (neg)
+ i = -i;
+ res = make_small(i);
+ goto bytebuf_to_integer_1_done;
}
/*
* Calculate the maximum number of bits which will
* be needed to represent the binary
*/
- lg2 = ((size+2)*LG2_LOOKUP(base)+1);
-
- if (lg2 < SMALL_BITS) {
- /* Take shortcut if we know it will fit in a small.
- * This improves speed by about 30%.
- */
- while (size) {
- b = *bytes++;
- size--;
-
- if (IS_VALID_CHARACTER(b,base))
- goto bytebuf_to_integer_1_error;
-
- i = i * base + CHARACTER_FROM_BASE(b);
-
- }
-
- if (neg)
- i = -i;
- res = make_small(i);
- goto bytebuf_to_integer_1_done;
-
- }
+ lg2 = ((size+2)*lookup_log2(base)+1);
/* Start calculating bignum */
m = (lg2 + D_EXP-1)/D_EXP;
@@ -2677,8 +2761,8 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
hp = HAlloc(BIF_P, m);
hp_end = hp + m;
- if ((i = (size % D_BASE_EXP(base))) == 0)
- i = D_BASE_EXP(base);
+ if ((i = (size % digits_per_Sint)) == 0)
+ i = digits_per_Sint;
n = size - i;
m = 0;
@@ -2686,34 +2770,34 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes,
while (i--) {
b = *bytes++;
- if (IS_VALID_CHARACTER(b,base)) {
+ if (c2int_is_invalid_char(b,base)) {
HRelease(BIF_P, hp_end, hp);
goto bytebuf_to_integer_1_error;
}
- m = base * m + CHARACTER_FROM_BASE(b);
+ m = base * m + c2int_digit_from_base(b);
}
res = small_to_big(m, hp);
while (n) {
- i = D_BASE_EXP(base);
- n -= D_BASE_EXP(base);
+ i = digits_per_Sint;
+ n -= digits_per_Sint;
m = 0;
while (i--) {
b = *bytes++;
- if (IS_VALID_CHARACTER(b,base)) {
+ if (c2int_is_invalid_char(b,base)) {
HRelease(BIF_P, hp_end, hp);
goto bytebuf_to_integer_1_error;
}
- m = base * m + CHARACTER_FROM_BASE(b);
+ m = base * m + c2int_digit_from_base(b);
}
if (is_small(res)) {
res = small_to_big(signed_val(res), hp);
}
- res = big_times_small(res, D_BASE_BASE(base), hp);
+ res = big_times_small(res, largest_pow_of_base, hp);
if (is_small(res)) {
res = small_to_big(signed_val(res), hp);
}
@@ -2744,5 +2828,166 @@ bytebuf_to_integer_1_error:
bytebuf_to_integer_1_done:
return res;
+}
+/* Converts list of digits with given 'base' to integer sequentially. Returns
+ * result in 'integer_out', remaining tail goes to 'tail_out' and returns result
+ * code if the list was consumed fully or partially or there was an error
+ */
+LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list,
+ const Uint base,
+ Eterm *integer_out, Eterm *tail_out)
+{
+ Sint i = 0;
+ Uint ui = 0;
+ int skip = 0;
+ int neg = 0;
+ Sint n = 0;
+ Sint m;
+ int lg2;
+ Eterm res;
+ Eterm lst = orig_list;
+ Eterm tail = lst;
+ int error_res = LTI_BAD_STRUCTURE;
+ const Uint digits_per_small = get_digits_per_small(base);
+ const Uint digits_per_Sint = get_digits_per_signed_int(base);
+
+ if (is_nil(lst)) {
+ error_res = LTI_NO_INTEGER;
+ error:
+ *tail_out = tail;
+ *integer_out = make_small(0);
+ return error_res;
+ }
+ if (is_not_list(lst))
+ goto error;
+
+ /* if first char is a '-' then it is a negative integer */
+ if (CAR(list_val(lst)) == make_small('-')) {
+ neg = 1;
+ skip = 1;
+ lst = CDR(list_val(lst));
+ if (is_not_list(lst)) {
+ tail = lst;
+ error_res = LTI_NO_INTEGER;
+ goto error;
+ }
+ } else if (CAR(list_val(lst)) == make_small('+')) {
+ /* ignore plus */
+ skip = 1;
+ lst = CDR(list_val(lst));
+ if (is_not_list(lst)) {
+ tail = lst;
+ error_res = LTI_NO_INTEGER;
+ goto error;
+ }
+ }
+
+ /* Calculate size and do type check */
+
+ while(1) {
+ byte ch;
+ if (is_not_small(CAR(list_val(lst)))) {
+ break;
+ }
+ ch = unsigned_val(CAR(list_val(lst)));
+ if (c2int_is_invalid_char(ch, base)) {
+ break;
+ }
+ ui = ui * base;
+ ui = ui + c2int_digit_from_base(ch);
+ n++;
+ lst = CDR(list_val(lst));
+ if (is_nil(lst)) {
+ break;
+ }
+ if (is_not_list(lst)) {
+ break;
+ }
+ }
+
+ tail = lst;
+ if (!n) {
+ error_res = LTI_NO_INTEGER;
+ goto error;
+ }
+
+
+ /* If length fits inside Sint then we know it's a small int. Else we
+ * must construct a bignum and let that routine do the checking
+ */
+
+ if (n <= digits_per_small) { /* It must be small */
+ i = neg ? -(Sint)ui : (Sint)ui;
+ res = make_small(i);
+ } else {
+ const Sint largest_pow_of_base = get_largest_power_of_base(base);
+ Eterm *hp;
+ Eterm *hp_end;
+
+ /* Convert from log_base to log2 using lookup table */
+ lg2 = ((n+2)*lookup_log2(base)+1);
+ m = (lg2+D_EXP-1)/D_EXP; /* number of digits */
+ m = BIG_NEED_SIZE(m); /* number of words + thing */
+
+ hp = HAlloc(BIF_P, m);
+ hp_end = hp + m;
+
+ lst = orig_list;
+ if (skip)
+ lst = CDR(list_val(lst));
+
+ /* load first digits (at least one digit) */
+ if ((i = (n % digits_per_Sint)) == 0)
+ i = digits_per_Sint;
+ n -= i;
+ m = 0;
+ while(i--) {
+ m *= base;
+ m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst))));
+ lst = CDR(list_val(lst));
+ }
+ res = small_to_big(m, hp); /* load first digits */
+
+ while(n) {
+ i = digits_per_Sint;
+ n -= digits_per_Sint;
+ m = 0;
+ while(i--) {
+ m *= base;
+ m += c2int_digit_from_base(unsigned_val(CAR(list_val(lst))));
+ lst = CDR(list_val(lst));
+ }
+ if (is_small(res))
+ res = small_to_big(signed_val(res), hp);
+ res = big_times_small(res, largest_pow_of_base, hp);
+ if (is_small(res))
+ res = small_to_big(signed_val(res), hp);
+ res = big_plus_small(res, m, hp);
+ }
+
+ if (neg) {
+ if (is_small(res))
+ res = make_small(-signed_val(res));
+ else {
+ Uint *big = big_val(res); /* point to thing */
+ *big = bignum_header_neg(*big);
+ }
+ }
+
+ if (is_not_small(res)) {
+ res = big_plus_small(res, 0, hp); /* includes conversion to small */
+
+ if (is_not_small(res)) {
+ hp += (big_arity(res)+1);
+ }
+ }
+ HRelease(BIF_P, hp_end, hp);
+ }
+ *integer_out = res;
+ *tail_out = tail;
+ if (tail != NIL) {
+ return LTI_SOME_INTEGER;
+ }
+ return LTI_ALL_INTEGER;
}
diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h
index 4aa9724ae3..ee51e5d313 100644
--- a/erts/emulator/beam/big.h
+++ b/erts/emulator/beam/big.h
@@ -35,7 +35,7 @@
typedef Uint ErtsDigit;
-#if ((SIZEOF_VOID_P == 4) || HALFWORD_HEAP) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8)
+#if (SIZEOF_VOID_P == 4) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8)
/* Assume 32-bit machine with long long support */
typedef Uint64 ErtsDoubleDigit;
typedef Uint16 ErtsHalfDigit;
@@ -54,9 +54,6 @@ typedef Uint32 ErtsHalfDigit;
#error "can not determine machine size"
#endif
-#define D_DECIMAL_EXP 9
-#define D_DECIMAL_BASE 1000000000
-
typedef Uint dsize_t; /* Vector size type */
#define D_EXP (ERTS_SIZEOF_ETERM*8)
@@ -90,13 +87,9 @@ typedef Uint dsize_t; /* Vector size type */
#define BIG_UINT_HEAP_SIZE (1 + 1) /* always, since sizeof(Uint) <= sizeof(Eterm) */
-#if HALFWORD_HEAP
-#define BIG_UWORD_HEAP_SIZE(UW) (((UW) >> (sizeof(Uint) * 8)) ? 3 : 2)
-#else
#define BIG_UWORD_HEAP_SIZE(UW) BIG_UINT_HEAP_SIZE
-#endif
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
#define ERTS_UINT64_BIG_HEAP_SIZE__(X) \
((X) >= (((Uint64) 1) << 32) ? (1 + 2) : (1 + 1))
@@ -161,6 +154,7 @@ Eterm bytes_to_big(byte*, dsize_t, int, Eterm*);
byte* big_to_bytes(Eterm, byte*);
int term_to_Uint(Eterm, Uint*);
+int term_to_Uint_mask(Eterm, Uint*);
int term_to_UWord(Eterm, UWord*);
int term_to_Sint(Eterm, Sint*);
#if HAVE_INT64
@@ -177,5 +171,15 @@ Eterm erts_sint64_to_big(Sint64, Eterm **);
Eterm erts_chars_to_integer(Process *, char*, Uint, const int);
+/* How list_to_integer classifies the input, was it even a string? */
+typedef enum {
+ LTI_BAD_STRUCTURE = 0,
+ LTI_NO_INTEGER = 1,
+ LTI_SOME_INTEGER = 2,
+ LTI_ALL_INTEGER = 3
+} LTI_result_t;
+
+LTI_result_t erts_list_to_integer(Process *BIF_P, Eterm orig_list,
+ const Uint base,
+ Eterm *integer_out, Eterm *tail_out);
#endif
-
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index e670fbf31c..3fd284b589 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -34,6 +34,9 @@
#include "erl_binary.h"
#include "erl_bits.h"
+#define L2B_B2L_MIN_EXEC_REDS (CONTEXT_REDS/4)
+#define L2B_B2L_RESCHED_REDS (CONTEXT_REDS/40)
+
static Export binary_to_list_continue_export;
static Export list_to_binary_continue_export;
@@ -47,7 +50,7 @@ erts_init_binary(void)
if ((((UWord) &((Binary *) 0)->orig_bytes[0]) % ((UWord) 8)) != 0) {
/* I assume that any compiler should be able to optimize this
away. If not, this test is not very expensive... */
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Internal error: Address of orig_bytes[0] of a Binary"
" is *not* 8-byte aligned\n");
}
@@ -415,10 +418,10 @@ binary_to_list_chunk(Process *c_p,
}
static ERTS_INLINE BIF_RETTYPE
-binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes, Uint size, Uint bitoffs)
+binary_to_list(Process *c_p, Eterm *hp, Eterm tail, byte *bytes,
+ Uint size, Uint bitoffs, int reds_left, int one_chunk)
{
- int reds_left = ERTS_BIF_REDS_LEFT(c_p);
- if (size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION) {
+ if (one_chunk) {
Eterm res;
BIF_RETTYPE ret;
int bump_reds = (size - 1)/ERTS_B2L_BYTES_PER_REDUCTION + 1;
@@ -472,11 +475,29 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1)
Uint size;
Uint bitsize;
Uint bitoffs;
+ int reds_left;
+ int one_chunk;
if (is_not_binary(BIF_ARG_1)) {
goto error;
}
+
size = binary_size(BIF_ARG_1);
+ reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+ one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION;
+ if (!one_chunk) {
+ if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) {
+ if (reds_left <= L2B_B2L_RESCHED_REDS) {
+ /* Yield and do it with full context reds... */
+ ERTS_BIF_YIELD1(bif_export[BIF_binary_to_list_1],
+ BIF_P, BIF_ARG_1);
+ }
+ /* Allow a bit more reductions... */
+ one_chunk = 1;
+ reds_left = L2B_B2L_MIN_EXEC_REDS;
+ }
+ }
+
ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize);
if (bitsize != 0) {
goto error;
@@ -486,7 +507,8 @@ BIF_RETTYPE binary_to_list_1(BIF_ALIST_1)
} else {
Eterm* hp = HAlloc(BIF_P, 2 * size);
byte* bytes = binary_bytes(real_bin)+offset;
- return binary_to_list(BIF_P, hp, NIL, bytes, size, bitoffs);
+ return binary_to_list(BIF_P, hp, NIL, bytes, size,
+ bitoffs, reds_left, one_chunk);
}
error:
@@ -505,6 +527,8 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
Uint start;
Uint stop;
Eterm* hp;
+ int reds_left;
+ int one_chunk;
if (is_not_binary(BIF_ARG_1)) {
goto error;
@@ -513,6 +537,21 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
goto error;
}
size = binary_size(BIF_ARG_1);
+ reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+ one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION;
+ if (!one_chunk) {
+ if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) {
+ if (reds_left <= L2B_B2L_RESCHED_REDS) {
+ /* Yield and do it with full context reds... */
+ ERTS_BIF_YIELD3(bif_export[BIF_binary_to_list_3],
+ BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ }
+ /* Allow a bit more reductions... */
+ one_chunk = 1;
+ reds_left = L2B_B2L_MIN_EXEC_REDS;
+ }
+ }
+
ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize);
if (start < 1 || start > size || stop < 1 ||
stop > size || stop < start ) {
@@ -520,7 +559,8 @@ BIF_RETTYPE binary_to_list_3(BIF_ALIST_3)
}
i = stop-start+1;
hp = HAlloc(BIF_P, 2*i);
- return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i, bitoffs);
+ return binary_to_list(BIF_P, hp, NIL, bytes+start-1, i,
+ bitoffs, reds_left, one_chunk);
error:
BIF_ERROR(BIF_P, BADARG);
}
@@ -537,11 +577,27 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
byte* bytes;
Eterm previous = NIL;
Eterm* hp;
+ int reds_left;
+ int one_chunk;
if (is_not_binary(BIF_ARG_1)) {
BIF_ERROR(BIF_P, BADARG);
}
size = binary_size(BIF_ARG_1);
+ reds_left = ERTS_BIF_REDS_LEFT(BIF_P);
+ one_chunk = size < reds_left*ERTS_B2L_BYTES_PER_REDUCTION;
+ if (!one_chunk) {
+ if (size < L2B_B2L_MIN_EXEC_REDS*ERTS_B2L_BYTES_PER_REDUCTION) {
+ if (reds_left <= L2B_B2L_RESCHED_REDS) {
+ /* Yield and do it with full context reds... */
+ ERTS_BIF_YIELD1(bif_export[BIF_bitstring_to_list_1],
+ BIF_P, BIF_ARG_1);
+ }
+ /* Allow a bit more reductions... */
+ one_chunk = 1;
+ reds_left = L2B_B2L_MIN_EXEC_REDS;
+ }
+ }
ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize);
bytes = binary_bytes(real_bin)+offset;
if (bitsize == 0) {
@@ -566,7 +622,8 @@ BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1)
hp += 2;
}
- return binary_to_list(BIF_P, hp, previous, bytes, size, bitoffs);
+ return binary_to_list(BIF_P, hp, previous, bytes, size,
+ bitoffs, reds_left, one_chunk);
}
@@ -795,8 +852,19 @@ static BIF_RETTYPE list_to_binary_continue(BIF_ALIST_1)
BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif)
{
+ int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p);
BIF_RETTYPE ret;
+ if (orig_reds_left < L2B_B2L_MIN_EXEC_REDS) {
+ if (orig_reds_left <= L2B_B2L_RESCHED_REDS) {
+ /* Yield and do it with full context reds... */
+ ERTS_BIF_PREP_YIELD1(ret, bif, c_p, arg);
+ return ret;
+ }
+ /* Allow a bit more reductions... */
+ orig_reds_left = L2B_B2L_MIN_EXEC_REDS;
+ }
+
if (is_nil(arg))
ERTS_BIF_PREP_RET(ret, new_binary(c_p, (byte *) "", 0));
else if (is_not_list(arg))
@@ -818,7 +886,6 @@ BIF_RETTYPE erts_list_to_binary_bif(Process *c_p, Eterm arg, Export *bif)
bif,
erts_iolist_size_yielding,
erts_iolist_to_buf_yielding);
- int orig_reds_left = ERTS_BIF_REDS_LEFT(c_p);
/*
* First try to do it all at once without having to use
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 8647b621d5..446598362c 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -104,7 +104,7 @@ process_killer(void)
erts_printf("(k)ill (n)ext (r)eturn:\n");
while(1) {
if ((j = sys_get_key(0)) <= 0)
- erl_exit(0, "");
+ erts_exit(0, "");
switch(j) {
case 'k': {
ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
@@ -252,7 +252,7 @@ print_process_info(int to, void *to_arg, Process *p)
/* display the message queue only if there is anything in it */
if (!ERTS_IS_CRASH_DUMPING && p->msg.first != NULL && !garbing) {
- ErlMessage* mp;
+ ErtsMessage* mp;
erts_print(to, to_arg, "Message queue: [");
for (mp = p->msg.first; mp; mp = mp->next)
erts_print(to, to_arg, mp->next ? "%T," : "%T", ERL_MESSAGE_TERM(mp));
@@ -323,7 +323,7 @@ print_process_info(int to, void *to_arg, Process *p)
erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop));
erts_print(to, to_arg, "OldHeap unused: %bpu\n",
(OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HTOP(p)) );
- erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p));
+ erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p, !0));
if (garbing) {
print_garb_info(to, to_arg, p);
@@ -381,7 +381,7 @@ loaded(int to, void *to_arg)
int i;
int old = 0;
int cur = 0;
- BeamInstr* code;
+ BeamCodeHeader* code;
Module* modp;
ErtsCodeIndex code_ix;
@@ -439,30 +439,30 @@ loaded(int to, void *to_arg)
erts_print(to, to_arg, "\n");
erts_print(to, to_arg, "Current size: %d\n",
modp->curr.code_length);
- code = modp->curr.code;
- if (code != NULL && code[MI_ATTR_PTR]) {
+ code = modp->curr.code_hdr;
+ if (code != NULL && code->attr_ptr) {
erts_print(to, to_arg, "Current attributes: ");
- dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR],
- code[MI_ATTR_SIZE]);
+ dump_attributes(to, to_arg, code->attr_ptr,
+ code->attr_size);
}
- if (code != NULL && code[MI_COMPILE_PTR]) {
+ if (code != NULL && code->compile_ptr) {
erts_print(to, to_arg, "Current compilation info: ");
- dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR],
- code[MI_COMPILE_SIZE]);
+ dump_attributes(to, to_arg, code->compile_ptr,
+ code->compile_size);
}
if (modp->old.code_length != 0) {
erts_print(to, to_arg, "Old size: %d\n", modp->old.code_length);
- code = modp->old.code;
- if (code[MI_ATTR_PTR]) {
+ code = modp->old.code_hdr;
+ if (code->attr_ptr) {
erts_print(to, to_arg, "Old attributes: ");
- dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR],
- code[MI_ATTR_SIZE]);
+ dump_attributes(to, to_arg, code->attr_ptr,
+ code->attr_size);
}
- if (code[MI_COMPILE_PTR]) {
+ if (code->compile_ptr) {
erts_print(to, to_arg, "Old compilation info: ");
- dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR],
- code[MI_COMPILE_SIZE]);
+ dump_attributes(to, to_arg, code->compile_ptr,
+ code->compile_size);
}
}
}
@@ -493,7 +493,7 @@ do_break(void)
halt immediately if break is called */
mode = erts_read_env("ERL_CONSOLE_MODE");
if (mode && strcmp(mode, "window") != 0)
- erl_exit(0, "");
+ erts_exit(0, "");
erts_free_read_env(mode);
#endif /* __WIN32__ */
@@ -503,7 +503,7 @@ do_break(void)
while (1) {
if ((i = sys_get_key(0)) <= 0)
- erl_exit(0, "");
+ erts_exit(0, "");
switch (i) {
case 'q':
case 'a':
@@ -513,9 +513,9 @@ do_break(void)
* The usual reason for a read error is Ctrl-C. Treat this as
* 'a' to avoid infinite loop.
*/
- erl_exit(0, "");
+ erts_exit(0, "");
case 'A': /* Halt generating crash dump */
- erl_exit(1, "Crash dump requested by user");
+ erts_exit(ERTS_ERROR_EXIT, "Crash dump requested by user");
case 'c':
return;
case 'p':
@@ -785,7 +785,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
erts_fdprintf(fd, "Atoms: %d\n", atom_table_size());
#ifdef USE_THREADS
- /* We want to note which thread it was that called erl_exit */
+ /* We want to note which thread it was that called erts_exit */
if (erts_get_scheduler_data()) {
erts_fdprintf(fd, "Calling Thread: scheduler:%d\n",
erts_get_scheduler_data()->no);
diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c
index 209d008d18..1b0968c55c 100644
--- a/erts/emulator/beam/code_ix.c
+++ b/erts/emulator/beam/code_ix.c
@@ -65,12 +65,12 @@ void erts_code_ix_init(void)
CIX_TRACE("init");
}
-void erts_start_staging_code_ix(void)
+void erts_start_staging_code_ix(int num_new)
{
beam_catches_start_staging();
export_start_staging();
module_start_staging();
- erts_start_staging_ranges();
+ erts_start_staging_ranges(num_new);
CIX_TRACE("start");
}
diff --git a/erts/emulator/beam/code_ix.h b/erts/emulator/beam/code_ix.h
index 5f00b409ef..7a66211a5b 100644
--- a/erts/emulator/beam/code_ix.h
+++ b/erts/emulator/beam/code_ix.h
@@ -100,7 +100,7 @@ void erts_release_code_write_permission(void);
* Must be followed by calls to either "end" and "commit" or "abort" before
* code write permission can be released.
*/
-void erts_start_staging_code_ix(void);
+void erts_start_staging_code_ix(int num_new);
/* End the staging.
* Preceded by "start" and must be followed by "commit".
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 8849dadd00..b38ebe066b 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -35,56 +35,59 @@
#include "erl_bits.h"
#include "dtrace-wrapper.h"
-static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*);
+static void move_one_frag(Eterm** hpp, ErlHeapFragment*, ErlOffHeap*, int);
/*
* Copy object "obj" to process p.
*/
-Eterm
-copy_object(Eterm obj, Process* to)
-{
- Uint size = size_object(obj);
- Eterm* hp = HAlloc(to, size);
- Eterm res;
+Eterm copy_object_x(Eterm obj, Process* to, Uint extra) {
+ if (!is_immed(obj)) {
+ Uint size = size_object(obj);
+ Eterm* hp = HAllocX(to, size, extra);
+ Eterm res;
#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(copy_object)) {
- DTRACE_CHARBUF(proc_name, 64);
+ if (DTRACE_ENABLED(copy_object)) {
+ DTRACE_CHARBUF(proc_name, 64);
- erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)),
- "%T", to->common.id);
- DTRACE2(copy_object, proc_name, size);
- }
+ erts_snprintf(proc_name, sizeof(DTRACE_CHARBUF_NAME(proc_name)),
+ "%T", to->common.id);
+ DTRACE2(copy_object, proc_name, size);
+ }
#endif
- res = copy_struct(obj, size, &hp, &to->off_heap);
+ res = copy_struct(obj, size, &hp, &to->off_heap);
#ifdef DEBUG
- if (eq(obj, res) == 0) {
- erl_exit(ERTS_ABORT_EXIT, "copy not equal to source\n");
- }
+ if (eq(obj, res) == 0) {
+ erts_exit(ERTS_ABORT_EXIT, "copy not equal to source\n");
+ }
#endif
- return res;
+ return res;
+ }
+ return obj;
}
/*
* Return the "flat" size of the object.
*/
-#if HALFWORD_HEAP
-Uint size_object_rel(Eterm obj, Eterm* base)
-#else
Uint size_object(Eterm obj)
-#endif
{
Uint sum = 0;
Eterm* ptr;
int arity;
+#ifdef DEBUG
+ Eterm mypid = erts_get_current_pid();
+#endif
DECLARE_ESTACK(s);
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size_object %p\n", mypid, obj));
+
for (;;) {
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
sum += 2;
- ptr = list_val_rel(obj,base);
+ ptr = list_val(obj);
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
@@ -93,11 +96,11 @@ Uint size_object(Eterm obj)
break;
case TAG_PRIMARY_BOXED:
{
- Eterm hdr = *boxed_val_rel(obj,base);
+ Eterm hdr = *boxed_val(obj);
ASSERT(is_header(hdr));
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
- ptr = tuple_val_rel(obj,base);
+ ptr = tuple_val(obj);
arity = header_arity(hdr);
sum += arity + 1;
if (arity == 0) { /* Empty tuple -- unusual. */
@@ -113,7 +116,7 @@ Uint size_object(Eterm obj)
break;
case FUN_SUBTAG:
{
- Eterm* bptr = fun_val_rel(obj,base);
+ Eterm* bptr = fun_val(obj);
ErlFunThing* funp = (ErlFunThing *) bptr;
unsigned eterms = 1 /* creator */ + funp->num_free;
unsigned sz = thing_arityval(hdr);
@@ -134,7 +137,7 @@ Uint size_object(Eterm obj)
{
Uint n;
flatmap_t *mp;
- mp = (flatmap_t*)flatmap_val_rel(obj,base);
+ mp = (flatmap_t*)flatmap_val(obj);
ptr = (Eterm *)mp;
n = flatmap_get_size(mp) + 1;
sum += n + 2;
@@ -153,7 +156,7 @@ Uint size_object(Eterm obj)
{
Eterm *head;
Uint sz;
- head = hashmap_val_rel(obj, base);
+ head = hashmap_val(obj);
sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
sum += 1 + sz + header_arity(hdr);
head += 1 + header_arity(hdr);
@@ -171,7 +174,7 @@ Uint size_object(Eterm obj)
}
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "size_object: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ erts_exit(ERTS_ABORT_EXIT, "size_object: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
}
break;
case SUB_BINARY_SUBTAG:
@@ -182,7 +185,7 @@ Uint size_object(Eterm obj)
Uint bitoffs;
Uint extra_bytes;
Eterm hdr;
- ERTS_GET_REAL_BIN_REL(obj, real_bin, offset, bitoffs, bitsize, base);
+ ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
if ((bitsize + bitoffs) > 8) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 2;
@@ -192,17 +195,17 @@ Uint size_object(Eterm obj)
} else {
extra_bytes = 0;
}
- hdr = *binary_val_rel(real_bin,base);
+ hdr = *binary_val(real_bin);
if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) {
sum += PROC_BIN_SIZE;
} else {
- sum += heap_bin_size(binary_size_rel(obj,base)+extra_bytes);
+ sum += heap_bin_size(binary_size(obj)+extra_bytes);
}
goto pop_next;
}
break;
case BIN_MATCHSTATE_SUBTAG:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"size_object: matchstate term not allowed");
default:
sum += thing_arityval(hdr) + 1;
@@ -214,25 +217,389 @@ Uint size_object(Eterm obj)
pop_next:
if (ESTACK_ISEMPTY(s)) {
DESTROY_ESTACK(s);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", mypid, sum));
return sum;
}
obj = ESTACK_POP(s);
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "size_object: bad tag for %#x\n", obj);
+ erts_exit(ERTS_ABORT_EXIT, "size_object: bad tag for %#x\n", obj);
}
}
}
/*
+ * Machinery for sharing preserving information
+ * Using a WSTACK but not very transparently; consider refactoring
+ */
+
+#define DECLARE_BITSTORE(s) \
+ DECLARE_WSTACK(s); \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ int WSTK_CONCAT(s,_offset) = 0; \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DESTROY_BITSTORE(s) DESTROY_WSTACK(s)
+#define BITSTORE_PUT(s,i) \
+do { \
+ WSTK_CONCAT(s,_buffer) |= i << WSTK_CONCAT(s,_bitoffs); \
+ WSTK_CONCAT(s,_bitoffs) += 2; \
+ if (WSTK_CONCAT(s,_bitoffs) >= 8*sizeof(UWord)) { \
+ WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \
+ WSTK_CONCAT(s,_bitoffs) = 0; \
+ WSTK_CONCAT(s,_buffer) = 0; \
+ } \
+} while(0)
+#define BITSTORE_CLOSE(s) \
+do { \
+ if (WSTK_CONCAT(s,_bitoffs) > 0) { \
+ WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \
+ WSTK_CONCAT(s,_bitoffs) = 0; \
+ } \
+} while(0)
+
+#define BITSTORE_FETCH(s,dst) \
+do { \
+ UWord result; \
+ if (WSTK_CONCAT(s,_bitoffs) <= 0) { \
+ WSTK_CONCAT(s,_buffer) = s.wstart[WSTK_CONCAT(s,_offset)]; \
+ WSTK_CONCAT(s,_offset)++; \
+ WSTK_CONCAT(s,_bitoffs) = 8*sizeof(UWord); \
+ } \
+ WSTK_CONCAT(s,_bitoffs) -= 2; \
+ result = WSTK_CONCAT(s,_buffer) & 3; \
+ WSTK_CONCAT(s,_buffer) >>= 2; \
+ (dst) = result; \
+} while(0)
+
+#define BOXED_VISITED_MASK ((Eterm) 3)
+#define BOXED_VISITED ((Eterm) 1)
+#define BOXED_SHARED_UNPROCESSED ((Eterm) 2)
+#define BOXED_SHARED_PROCESSED ((Eterm) 3)
+
+#define COUNT_OFF_HEAP (0)
+
+#define IN_LITERAL_PURGE_AREA(info, ptr) \
+ ((info)->range_ptr && ( \
+ (info)->range_ptr <= (ptr) && \
+ (ptr) < ((info)->range_ptr + (info)->range_sz)))
+/*
+ * Return the real size of an object and find sharing information
+ * This currently returns the same as erts_debug:size/1.
+ * It is argued whether the size of subterms in constant pools
+ * should be counted or not.
+ */
+
+Uint size_shared(Eterm obj)
+{
+ Eterm saved_obj = obj;
+ Uint sum = 0;
+ Eterm* ptr;
+
+ DECLARE_EQUEUE(s);
+ DECLARE_BITSTORE(b);
+
+ for (;;) {
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ ptr = list_val(obj);
+ /* we're not counting anything that's outside our heap */
+ if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) {
+ goto pop_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it's visited, don't count it */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER ||
+ primary_tag(head) == TAG_PRIMARY_HEADER) {
+ goto pop_next;
+ }
+ /* else make it visited now */
+ switch (primary_tag(tail)) {
+ case TAG_PRIMARY_LIST:
+ ptr[1] = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER;
+ break;
+ case TAG_PRIMARY_IMMED1:
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head);
+ break;
+ case TAG_PRIMARY_BOXED:
+ BITSTORE_PUT(b, primary_tag(head));
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and count it */
+ sum += 2;
+ if (!IS_CONST(head)) {
+ EQUEUE_PUT(s, head);
+ }
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ ptr = boxed_val(obj);
+ /* we're not counting anything that's outside our heap */
+ if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) {
+ goto pop_next;
+ }
+ hdr = *ptr;
+ /* if it's visited, don't count it */
+ if (primary_tag(hdr) != TAG_PRIMARY_HEADER) {
+ goto pop_next;
+ }
+ /* else make it visited now */
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED;
+ /* and count it */
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ sum += arity + 1;
+ if (arity == 0) { /* Empty tuple -- unusual. */
+ goto pop_next;
+ }
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ unsigned sz = thing_arityval(hdr);
+ sum += 1 /* header */ + sz + eterms;
+ ptr += 1 /* header */ + sz;
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Uint extra_bytes;
+ Eterm hdr;
+ ASSERT((sb->thing_word & ~BOXED_VISITED_MASK) == HEADER_SUB_BIN);
+ if (sb->bitsize + sb->bitoffs > 8) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 2;
+ } else if (sb->bitsize + sb->bitoffs > 0) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ ptr = binary_val(sb->orig);
+ hdr = (*ptr) & ~BOXED_VISITED_MASK;
+ if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) {
+ sum += PROC_BIN_SIZE;
+ } else {
+ ASSERT(thing_subtag(hdr) == HEAP_BINARY_SUBTAG);
+ sum += heap_bin_size(binary_size(obj) + extra_bytes);
+ }
+ goto pop_next;
+ }
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t*)flatmap_val(obj);
+ Uint n = flatmap_get_size(mp) + 1;
+ ptr = (Eterm *)mp;
+ sum += n + 2;
+ ptr += 2; /* hdr + size words */
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP : {
+ Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ sum += 1 + n + header_arity(hdr);
+ ptr += 1 + header_arity(hdr);
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ case BIN_MATCHSTATE_SUBTAG:
+ erts_exit(ERTS_ABORT_EXIT,
+ "size_shared: matchstate term not allowed");
+ default:
+ sum += thing_arityval(hdr) + 1;
+ goto pop_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ pop_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ goto cleanup;
+ }
+ obj = EQUEUE_GET(s);
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj);
+ }
+ }
+
+cleanup:
+ obj = saved_obj;
+ BITSTORE_CLOSE(b);
+ for (;;) {
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ ptr = list_val(obj);
+ if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) {
+ goto cleanup_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if not already clean, clean it up */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER) {
+ if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ Eterm saved;
+ BITSTORE_FETCH(b, saved);
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | saved;
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_BOXED;
+ } else {
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_LIST;
+ }
+ } else if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail);
+ CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1;
+ } else {
+ goto cleanup_next;
+ }
+ /* and its children too */
+ if (!IS_CONST(head)) {
+ EQUEUE_PUT_UNCHECKED(s, head);
+ }
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ ptr = boxed_val(obj);
+ if (!COUNT_OFF_HEAP && erts_is_literal(obj,ptr)) {
+ goto cleanup_next;
+ }
+ hdr = *ptr;
+ /* if not already clean, clean it up */
+ if (primary_tag(hdr) == TAG_PRIMARY_HEADER) {
+ goto cleanup_next;
+ }
+ else {
+ ASSERT(primary_tag(hdr) == BOXED_VISITED);
+ *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
+ }
+ /* and its children too */
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ if (arity == 0) { /* Empty tuple -- unusual. */
+ goto cleanup_next;
+ }
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ }
+ }
+ goto cleanup_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ unsigned sz = thing_arityval(hdr);
+ ptr += 1 /* header */ + sz;
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ }
+ }
+ goto cleanup_next;
+ }
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t *) ptr;
+ Uint n = flatmap_get_size(mp) + 1;
+ ptr += 2; /* hdr + size words */
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ }
+ }
+ goto cleanup_next;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP : {
+ Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ sum += 1 + n + header_arity(hdr);
+ ptr += 1 + header_arity(hdr);
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ }
+ }
+ goto cleanup_next;
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "size_shared: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ default:
+ goto cleanup_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ cleanup_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ goto all_clean;
+ }
+ obj = EQUEUE_GET(s);
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj);
+ }
+ }
+
+ all_clean:
+ /* Return the result */
+ DESTROY_EQUEUE(s);
+ DESTROY_BITSTORE(b);
+ return sum;
+}
+
+
+/*
* Copy a structure to a heap.
*/
-#if HALFWORD_HEAP
-Eterm copy_struct_rel(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap,
- Eterm* src_base, Eterm* dst_base)
-#else
-Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
-#endif
+Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint *bsz)
{
char* hstart;
Uint hsize;
@@ -247,19 +614,23 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
Eterm* argp;
Eterm* const_tuple;
Eterm hdr;
+ Eterm *hend;
int i;
#ifdef DEBUG
Eterm org_obj = obj;
Uint org_sz = sz;
+ Eterm mypid = erts_get_current_pid();
#endif
if (IS_CONST(obj))
return obj;
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_struct %p\n", mypid, obj));
+
DTRACE1(copy_struct, (int32_t)sz);
hp = htop = *hpp;
- hbot = htop + sz;
+ hbot = hend = htop + sz;
hstart = (char *)htop;
hsize = (char*) hbot - hstart;
const_tuple = 0;
@@ -268,11 +639,11 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
argp = &res;
- objp = list_val_rel(obj,src_base);
+ objp = list_val(obj);
goto L_copy_list;
case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed;
default:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
@@ -286,14 +657,11 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
hp++;
break;
case TAG_PRIMARY_LIST:
- objp = list_val_rel(obj,src_base);
- #if !HALFWORD_HEAP || defined(DEBUG)
- if (in_area(objp,hstart,hsize)) {
- ASSERT(!HALFWORD_HEAP);
+ objp = list_val(obj);
+ if (ErtsInArea(objp,hstart,hsize)) {
hp++;
break;
}
- #endif
argp = hp++;
/* Fall through */
@@ -309,52 +677,41 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
else {
CAR(htop) = elem;
- #if HALFWORD_HEAP
- CDR(htop) = CDR(objp);
- *tailp = make_list_rel(htop,dst_base);
- htop += 2;
- goto L_copy;
- #else
tailp = &CDR(htop);
htop += 2;
- #endif
}
- ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot);
- *tp = make_list_rel(tailp - 1, dst_base);
+ *tp = make_list(tailp - 1);
obj = CDR(objp);
if (!is_list(obj)) {
break;
}
- objp = list_val_rel(obj,src_base);
+ objp = list_val(obj);
}
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy;
case TAG_PRIMARY_BOXED: argp = tailp; goto L_copy_boxed;
default:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
case TAG_PRIMARY_BOXED:
- #if !HALFWORD_HEAP || defined(DEBUG)
- if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) {
- ASSERT(!HALFWORD_HEAP);
+ if (ErtsInArea(boxed_val(obj),hstart,hsize)) {
hp++;
break;
}
- #endif
argp = hp++;
L_copy_boxed:
- objp = boxed_val_rel(obj, src_base);
+ objp = boxed_val(obj);
hdr = *objp;
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
int const_flag = 1; /* assume constant tuple */
i = arityval(hdr);
- *argp = make_tuple_rel(htop, dst_base);
+ *argp = make_tuple(htop);
tp = htop; /* tp is pointer to new arity value */
*htop++ = *objp++; /* copy arity value */
while (i--) {
@@ -383,7 +740,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
while (i--) {
*tp++ = *objp++;
}
- *argp = make_binary_rel(hbot, dst_base);
+ *argp = make_binary(hbot);
pb = (ProcBin*) hbot;
erts_refc_inc(&pb->val->refc, 2);
pb->next = off_heap->first;
@@ -410,7 +767,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
extra_bytes = 0;
}
real_size = size+extra_bytes;
- objp = binary_val_rel(real_bin,src_base);
+ objp = binary_val(real_bin);
if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) {
ErlHeapBin* from = (ErlHeapBin *) objp;
ErlHeapBin* to;
@@ -440,7 +797,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
off_heap->first = (struct erl_off_heap_header*) to;
OH_OVERHEAD(off_heap, to->size / sizeof(Eterm));
}
- *argp = make_binary_rel(hbot, dst_base);
+ *argp = make_binary(hbot);
if (extra_bytes != 0) {
ErlSubBin* res;
hbot -= ERL_SUB_BIN_SIZE;
@@ -452,7 +809,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
res->offs = 0;
res->is_writable = 0;
res->orig = *argp;
- *argp = make_binary_rel(hbot, dst_base);
+ *argp = make_binary(hbot);
}
break;
}
@@ -470,7 +827,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
erts_refc_inc(&funp->fe->refc, 2);
- *argp = make_fun_rel(tp, dst_base);
+ *argp = make_fun(tp);
}
break;
case EXTERNAL_PID_SUBTAG:
@@ -490,7 +847,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
off_heap->first = (struct erl_off_heap_header*)etp;
erts_refc_inc(&etp->node->refc, 2);
- *argp = make_external_rel(tp, dst_base);
+ *argp = make_external(tp);
}
break;
case MAP_SUBTAG:
@@ -498,7 +855,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
switch (MAP_HEADER_TYPE(hdr)) {
case MAP_HEADER_TAG_FLATMAP_HEAD :
i = flatmap_get_size(objp) + 3;
- *argp = make_flatmap_rel(htop, dst_base);
+ *argp = make_flatmap(htop);
while (i--) {
*htop++ = *objp++;
}
@@ -509,20 +866,20 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
i = 1 + hashmap_bitcount(MAP_HEADER_VAL(hdr));
while (i--) { *htop++ = *objp++; }
- *argp = make_hashmap_rel(tp, dst_base);
+ *argp = make_hashmap(tp);
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ erts_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
}
break;
case BIN_MATCHSTATE_SUBTAG:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"copy_struct: matchstate term not allowed");
default:
i = thing_arityval(hdr)+1;
hbot -= i;
tp = hbot;
- *argp = make_boxed_rel(hbot, dst_base);
+ *argp = make_boxed(hbot);
while (i--) {
*tp++ = *objp++;
}
@@ -538,22 +895,870 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
}
+ if (bsz) {
+ *hpp = htop;
+ *bsz = hend - hbot;
+ } else {
#ifdef DEBUG
- if (htop != hbot)
- erl_exit(ERTS_ABORT_EXIT,
- "Internal error in copy_struct() when copying %T:"
- " htop=%p != hbot=%p (sz=%beu)\n",
- org_obj, htop, hbot, org_sz);
+ if (htop != hbot)
+ erts_exit(ERTS_ABORT_EXIT,
+ "Internal error in copy_struct() when copying %T:"
+ " htop=%p != hbot=%p (sz=%beu)\n",
+ org_obj, htop, hbot, org_sz);
#else
- if (htop > hbot) {
- erl_exit(ERTS_ABORT_EXIT,
- "Internal error in copy_struct(): htop, hbot overrun\n");
- }
+ if (htop > hbot) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "Internal error in copy_struct(): htop, hbot overrun\n");
+ }
#endif
- *hpp = (Eterm *) (hstart+hsize);
+ *hpp = (Eterm *) (hstart+hsize);
+ }
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, res));
return res;
}
+
+/*
+ * Machinery for the table used by the sharing preserving copier
+ * Using an ESTACK but not very transparently; consider refactoring
+ */
+
+#define DECLARE_SHTABLE(s) \
+ DECLARE_ESTACK(s); \
+ Uint ESTK_CONCAT(s,_offset) = 0
+#define DESTROY_SHTABLE(s) DESTROY_ESTACK(s)
+#define SHTABLE_INCR 4
+#define SHTABLE_NEXT(s) ESTK_CONCAT(s,_offset)
+#define SHTABLE_PUSH(s,x,y,b) \
+do { \
+ if (s.sp > s.end - SHTABLE_INCR) { \
+ erl_grow_estack(&(s), SHTABLE_INCR); \
+ } \
+ *s.sp++ = (x); \
+ *s.sp++ = (y); \
+ *s.sp++ = (Eterm) NULL; \
+ *s.sp++ = (Eterm) (b); \
+ ESTK_CONCAT(s,_offset) += SHTABLE_INCR; \
+} while(0)
+#define SHTABLE_X(s,e) (s.start[e])
+#define SHTABLE_Y(s,e) (s.start[(e)+1])
+#define SHTABLE_FWD(s,e) ((Eterm *) (s.start[(e)+2]))
+#define SHTABLE_FWD_UPD(s,e,p) (s.start[(e)+2] = (Eterm) (p))
+#define SHTABLE_REV(s,e) ((Eterm *) (s.start[(e)+3]))
+
+#define LIST_SHARED_UNPROCESSED ((Eterm) 0)
+#define LIST_SHARED_PROCESSED ((Eterm) 1)
+
+#define HEAP_ELEM_TO_BE_FILLED _unchecked_make_list(NULL)
+
+
+/*
+ * Specialized macros for using/reusing the persistent state
+ */
+
+#define DECLARE_EQUEUE_INIT_INFO(q, info) \
+ UWord* EQUE_DEF_QUEUE(q) = info->queue_default; \
+ ErtsEQueue q = { \
+ EQUE_DEF_QUEUE(q), /* start */ \
+ EQUE_DEF_QUEUE(q), /* front */ \
+ EQUE_DEF_QUEUE(q), /* back */ \
+ 1, /* possibly_empty */ \
+ EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }
+
+#define DECLARE_EQUEUE_FROM_INFO(q, info) \
+ /* no EQUE_DEF_QUEUE(q), read-only */ \
+ ErtsEQueue q = { \
+ info->queue_start, /* start */ \
+ info->queue_start, /* front */ \
+ info->queue_start, /* back */ \
+ 1, /* possibly_empty */ \
+ info->queue_end, /* end */ \
+ info->queue_alloc_type /* alloc_type */ \
+ }
+
+#define DECLARE_BITSTORE_INIT_INFO(s, info) \
+ UWord* WSTK_DEF_STACK(s) = info->bitstore_default; \
+ ErtsWStack s = { \
+ WSTK_DEF_STACK(s), /* wstart */ \
+ WSTK_DEF_STACK(s), /* wsp */ \
+ WSTK_DEF_STACK(s) + DEF_WSTACK_SIZE, /* wend */ \
+ WSTK_DEF_STACK(s), /* wdflt */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }; \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ /* no WSTK_CONCAT(s,_offset), write-only */ \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DECLARE_BITSTORE_FROM_INFO(s, info) \
+ /* no WSTK_DEF_STACK(s), read-only */ \
+ ErtsWStack s = { \
+ info->bitstore_start, /* wstart */ \
+ NULL, /* wsp, read-only */ \
+ NULL, /* wend, read-only */ \
+ NULL, /* wdef, read-only */ \
+ info->bitstore_alloc_type /* alloc_type */ \
+ }; \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ int WSTK_CONCAT(s,_offset) = 0; \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DECLARE_SHTABLE_INIT_INFO(s, info) \
+ Eterm* ESTK_DEF_STACK(s) = info->shtable_default; \
+ ErtsEStack s = { \
+ ESTK_DEF_STACK(s), /* start */ \
+ ESTK_DEF_STACK(s), /* sp */ \
+ ESTK_DEF_STACK(s) + DEF_ESTACK_SIZE, /* end */ \
+ ESTK_DEF_STACK(s), /* default */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }; \
+ Uint ESTK_CONCAT(s,_offset) = 0
+
+#define DECLARE_SHTABLE_FROM_INFO(s, info) \
+ /* no ESTK_DEF_STACK(s), read-only */ \
+ ErtsEStack s = { \
+ info->shtable_start, /* start */ \
+ NULL, /* sp, read-only */ \
+ NULL, /* end, read-only */ \
+ NULL, /* def, read-only */ \
+ info->shtable_alloc_type /* alloc_type */ \
+ }; \
+ /* no ESTK_CONCAT(s,_offset), read-only */
+
+/*
+ * Copy object "obj" preserving sharing.
+ * First half: count size and calculate sharing.
+ */
+Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info)
+{
+ Uint sum;
+ Uint e;
+ unsigned sz;
+ Eterm* ptr;
+#ifdef DEBUG
+ Eterm mypid = erts_get_current_pid();
+#endif
+
+ DECLARE_EQUEUE_INIT_INFO(s, info);
+ DECLARE_BITSTORE_INIT_INFO(b, info);
+ DECLARE_SHTABLE_INIT_INFO(t, info);
+
+ /* step #0:
+ -------------------------------------------------------
+ get rid of the easy cases first:
+ - copying constants
+ - if not a proper process, do flat copy
+ */
+
+ if (IS_CONST(obj))
+ return 0;
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_calculate %p\n", mypid, obj));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] message is %T\n", mypid, obj));
+
+ /* step #1:
+ -------------------------------------------------------
+ traverse the term and calculate the size;
+ when traversing, transform as you do in size_shared
+ but when you find shared objects:
+
+ a. add entry in the table, indexed by i
+ b. mark them:
+ b1. boxed terms, set header to (i | 11)
+ store (old header, NONV, NULL, backptr) in the entry
+ b2. cons cells, set CDR to NONV, set CAR to i
+ store (old CAR, old CDR, NULL, backptr) in the entry
+ */
+
+ sum = 0;
+
+ for (;;) {
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ ptr = list_val(obj);
+ /* off heap list pointers are copied verbatim */
+ if (erts_is_literal(obj,ptr)) {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj));
+ if (IN_LITERAL_PURGE_AREA(info,ptr))
+ info->literal_size += size_object(obj);
+ goto pop_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it's visited, don't count it;
+ if not already shared, make it shared and store it in the table */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER ||
+ primary_tag(head) == TAG_PRIMARY_HEADER) {
+ if (tail != THE_NON_VALUE) {
+ e = SHTABLE_NEXT(t);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling L %p\n", mypid, ptr));
+ SHTABLE_PUSH(t, head, tail, ptr);
+ CAR(ptr) = (e << _TAG_PRIMARY_SIZE) | LIST_SHARED_UNPROCESSED;
+ CDR(ptr) = THE_NON_VALUE;
+ }
+ goto pop_next;
+ }
+ /* else make it visited now */
+ switch (primary_tag(tail)) {
+ case TAG_PRIMARY_LIST:
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/L %p\n", mypid, ptr));
+ CDR(ptr) = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER;
+ break;
+ case TAG_PRIMARY_IMMED1:
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/I %p\n", mypid, ptr));
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head);
+ break;
+ case TAG_PRIMARY_BOXED:
+ BITSTORE_PUT(b, primary_tag(head));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling L/B %p\n", mypid, ptr));
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and count it */
+ sum += 2;
+ if (!IS_CONST(head)) {
+ EQUEUE_PUT(s, head);
+ }
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ ptr = boxed_val(obj);
+ /* off heap pointers to boxes are copied verbatim */
+ if (erts_is_literal(obj,ptr)) {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] bypassed copying %p is %T\n", mypid, ptr, obj));
+ if (IN_LITERAL_PURGE_AREA(info,ptr))
+ info->literal_size += size_object(obj);
+ goto pop_next;
+ }
+ hdr = *ptr;
+ /* if it's visited, don't count it;
+ if not already shared, make it shared and store it in the table */
+ if (primary_tag(hdr) != TAG_PRIMARY_HEADER) {
+ if (primary_tag(hdr) == BOXED_VISITED) {
+ e = SHTABLE_NEXT(t);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabling B %p\n", mypid, ptr));
+ SHTABLE_PUSH(t, hdr, THE_NON_VALUE, ptr);
+ *ptr = (e << _TAG_PRIMARY_SIZE) | BOXED_SHARED_UNPROCESSED;
+ }
+ goto pop_next;
+ }
+ /* else make it visited now */
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] mangling B %p\n", mypid, ptr));
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED;
+ /* and count it */
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ sum += arity + 1;
+ if (arity == 0) { /* Empty tuple -- unusual. */
+ goto pop_next;
+ }
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ sz = thing_arityval(hdr);
+ sum += 1 /* header */ + sz + eterms;
+ ptr += 1 /* header */ + sz;
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Eterm real_bin = sb->orig;
+ Uint bit_offset = sb->bitoffs;
+ Uint bit_size = sb->bitsize;
+ size_t size = sb->size;
+ Uint extra_bytes;
+ Eterm hdr;
+ if (bit_size + bit_offset > 8) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 2;
+ } else if (bit_size + bit_offset > 0) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ ASSERT(is_boxed(real_bin) &&
+ (((*boxed_val(real_bin)) &
+ (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK))
+ == _TAG_HEADER_REFC_BIN));
+ hdr = *_unchecked_binary_val(real_bin) & ~BOXED_VISITED_MASK;
+ if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) {
+ sum += heap_bin_size(size+extra_bytes);
+ } else {
+ ASSERT(thing_subtag(hdr) == REFC_BINARY_SUBTAG);
+ sum += PROC_BIN_SIZE;
+ }
+ goto pop_next;
+ }
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t *) ptr;
+ Uint n = flatmap_get_size(mp) + 1;
+ sum += n + 2;
+ ptr += 2; /* hdr + size words */
+ while (n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP : {
+ Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ sum += 1 + n + header_arity(hdr);
+ ptr += 1 + header_arity(hdr);
+
+ if (n == 0) {
+ goto pop_next;
+ }
+ while(n--) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "copy_shared_calculate: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ case BIN_MATCHSTATE_SUBTAG:
+ erts_exit(ERTS_ABORT_EXIT,
+ "size_shared: matchstate term not allowed");
+ default:
+ sum += thing_arityval(hdr) + 1;
+ goto pop_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ pop_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ /* add sentinel to the table */
+ SHTABLE_PUSH(t, THE_NON_VALUE, THE_NON_VALUE, NULL);
+ /* store persistent info */
+ BITSTORE_CLOSE(b);
+ info->queue_start = s.start;
+ info->queue_end = s.end;
+ info->queue_alloc_type = s.alloc_type;
+ info->bitstore_start = b.wstart;
+ info->bitstore_alloc_type = b.alloc_type;
+ info->shtable_start = t.start;
+ info->shtable_alloc_type = t.alloc_type;
+ /* single point of return: the size of the object */
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] size was: %u\n", mypid, sum));
+ return sum + info->literal_size;
+ }
+ obj = EQUEUE_GET(s);
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "[pid=%T] size_shared: bad tag for %#x\n", obj);
+ }
+ }
+}
+
+/*
+ * Copy object "obj" preserving sharing.
+ * Second half: copy and restore the object.
+ */
+Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info,
+ Eterm** hpp, ErlOffHeap* off_heap) {
+ Uint e;
+ unsigned sz;
+ Eterm* ptr;
+ Eterm* hp;
+ Eterm* hscan;
+ Eterm result;
+ Eterm* resp;
+ Eterm *hbot, *hend;
+ unsigned remaining;
+#ifdef DEBUG
+ Eterm mypid = erts_get_current_pid();
+ Eterm saved_obj = obj;
+#endif
+
+ DECLARE_EQUEUE_FROM_INFO(s, info);
+ DECLARE_BITSTORE_FROM_INFO(b, info);
+ DECLARE_SHTABLE_FROM_INFO(t, info);
+
+ /* step #0:
+ -------------------------------------------------------
+ get rid of the easy cases first:
+ - copying constants
+ - if not a proper process, do flat copy
+ */
+
+ if (IS_CONST(obj))
+ return obj;
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", mypid, obj));
+
+ /* step #2: was performed before this function was called
+ -------------------------------------------------------
+ allocate new space
+ */
+
+ hscan = hp = *hpp;
+ hbot = hend = hp + size;
+
+ /* step #3:
+ -------------------------------------------------------
+ traverse the term a second time and when traversing:
+ a. if the object is marked as shared
+ a1. if the entry contains a forwarding ptr, use that
+ a2. otherwise, copy it to the new space and store the
+ forwarding ptr to the entry
+ b. otherwise, reverse-transform as you do in size_shared
+ and copy to the new space
+ */
+
+ resp = &result;
+ remaining = 0;
+ for (;;) {
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ ptr = list_val(obj);
+ /* off heap list pointers are copied verbatim */
+ if (erts_is_literal(obj,ptr)) {
+ if (!IN_LITERAL_PURGE_AREA(info,ptr)) {
+ *resp = obj;
+ } else {
+ Uint bsz = 0;
+ *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz);
+ hbot -= bsz;
+ }
+ goto cleanup_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it is shared */
+ if (tail == THE_NON_VALUE) {
+ e = head >> _TAG_PRIMARY_SIZE;
+ /* if it has been processed, just use the forwarding pointer */
+ if (primary_tag(head) == LIST_SHARED_PROCESSED) {
+ *resp = make_list(SHTABLE_FWD(t, e));
+ goto cleanup_next;
+ }
+ /* else, let's process it now,
+ copy it and keep the forwarding pointer */
+ else {
+ CAR(ptr) = (head - primary_tag(head)) + LIST_SHARED_PROCESSED;
+ head = SHTABLE_X(t, e);
+ tail = SHTABLE_Y(t, e);
+ ptr = &(SHTABLE_X(t, e));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled L %p is %p\n", mypid, ptr, SHTABLE_REV(t, e)));
+ SHTABLE_FWD_UPD(t, e, hp);
+ }
+ }
+ /* if not already clean, clean it up and copy it */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER) {
+ if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ Eterm saved;
+ BITSTORE_FETCH(b, saved);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", mypid, ptr));
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved;
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED;
+ } else {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", mypid, ptr));
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST;
+ }
+ } else if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/I %p\n", mypid, ptr));
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail);
+ CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1;
+ } else {
+ ASSERT(0 && "cannot come here");
+ goto cleanup_next;
+ }
+ /* and its children too */
+ if (IS_CONST(head)) {
+ CAR(hp) = head;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, head);
+ CAR(hp) = HEAP_ELEM_TO_BE_FILLED;
+ }
+ *resp = make_list(hp);
+ resp = &(CDR(hp));
+ hp += 2;
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ ptr = boxed_val(obj);
+ /* off heap pointers to boxes are copied verbatim */
+ if (erts_is_literal(obj,ptr)) {
+ if (!IN_LITERAL_PURGE_AREA(info,ptr)) {
+ *resp = obj;
+ } else {
+ Uint bsz = 0;
+ *resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz);
+ hbot -= bsz;
+ }
+ goto cleanup_next;
+ }
+ hdr = *ptr;
+ /* clean it up, unless it's already clean or shared and processed */
+ switch (primary_tag(hdr)) {
+ case TAG_PRIMARY_HEADER:
+ ASSERT(0 && "cannot come here");
+ /* if it is shared and has been processed,
+ just use the forwarding pointer */
+ case BOXED_SHARED_PROCESSED:
+ e = hdr >> _TAG_PRIMARY_SIZE;
+ *resp = make_boxed(SHTABLE_FWD(t, e));
+ goto cleanup_next;
+ /* if it is shared but has not been processed yet, let's process
+ it now: copy it and keep the forwarding pointer */
+ case BOXED_SHARED_UNPROCESSED:
+ e = hdr >> _TAG_PRIMARY_SIZE;
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED;
+ hdr = SHTABLE_X(t, e);
+ ASSERT(primary_tag(hdr) == BOXED_VISITED);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled B %p is %p\n", mypid, ptr, SHTABLE_REV(t, e)));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr));
+ SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
+ SHTABLE_FWD_UPD(t, e, hp);
+ break;
+ case BOXED_VISITED:
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr));
+ *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and its children too */
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ *resp = make_boxed(hp);
+ *hp++ = hdr;
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ goto cleanup_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ sz = thing_arityval(hdr);
+ funp = (ErlFunThing *) hp;
+ *resp = make_fun(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ funp->next = off_heap->first;
+ off_heap->first = (struct erl_off_heap_header*) funp;
+ erts_refc_inc(&funp->fe->refc, 2);
+ goto cleanup_next;
+ }
+ case MAP_SUBTAG:
+ *resp = make_flatmap(hp);
+ *hp++ = hdr;
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t *) ptr;
+ Uint n = flatmap_get_size(mp) + 1;
+ *hp++ = *++ptr; /* keys */
+ while (n--) {
+ obj = *++ptr;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ goto cleanup_next;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ *hp++ = *++ptr; /* total map size */
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP : {
+ Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr));
+ while (n--) {
+ obj = *++ptr;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ goto cleanup_next;
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "copy_shared_perform: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ case REFC_BINARY_SUBTAG: {
+ ProcBin* pb = (ProcBin *) ptr;
+ sz = thing_arityval(hdr);
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+ }
+ pb = (ProcBin *) hp;
+ *resp = make_binary(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ erts_refc_inc(&pb->val->refc, 2);
+ pb->next = off_heap->first;
+ pb->flags = 0;
+ off_heap->first = (struct erl_off_heap_header*) pb;
+ OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm));
+ goto cleanup_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Eterm real_bin = sb->orig;
+ Uint bit_offset = sb->bitoffs;
+ Uint bit_size = sb->bitsize;
+ Uint offset = sb->offs;
+ size_t size = sb->size;
+ Uint extra_bytes;
+ Uint real_size;
+ if ((bit_size + bit_offset) > 8) {
+ extra_bytes = 2;
+ } else if ((bit_size + bit_offset) > 0) {
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ real_size = size+extra_bytes;
+ ASSERT(is_boxed(real_bin) &&
+ (((*boxed_val(real_bin)) &
+ (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK))
+ == _TAG_HEADER_REFC_BIN));
+ ptr = _unchecked_binary_val(real_bin);
+ *resp = make_binary(hp);
+ if (extra_bytes != 0) {
+ ErlSubBin* res = (ErlSubBin *) hp;
+ hp += ERL_SUB_BIN_SIZE;
+ res->thing_word = HEADER_SUB_BIN;
+ res->size = size;
+ res->bitsize = bit_size;
+ res->bitoffs = bit_offset;
+ res->offs = 0;
+ res->is_writable = 0;
+ res->orig = make_binary(hp);
+ }
+ if (thing_subtag(*ptr & ~BOXED_VISITED_MASK) == HEAP_BINARY_SUBTAG) {
+ ErlHeapBin* from = (ErlHeapBin *) ptr;
+ ErlHeapBin* to = (ErlHeapBin *) hp;
+ hp += heap_bin_size(real_size);
+ to->thing_word = header_heap_bin(real_size);
+ to->size = real_size;
+ sys_memcpy(to->data, ((byte *)from->data)+offset, real_size);
+ } else {
+ ProcBin* from = (ProcBin *) ptr;
+ ProcBin* to = (ProcBin *) hp;
+ ASSERT(thing_subtag(*ptr & ~BOXED_VISITED_MASK) == REFC_BINARY_SUBTAG);
+ if (from->flags) {
+ erts_emasculate_writable_binary(from);
+ }
+ hp += PROC_BIN_SIZE;
+ to->thing_word = HEADER_PROC_BIN;
+ to->size = real_size;
+ to->val = from->val;
+ erts_refc_inc(&to->val->refc, 2);
+ to->bytes = from->bytes + offset;
+ to->next = off_heap->first;
+ to->flags = 0;
+ off_heap->first = (struct erl_off_heap_header*) to;
+ OH_OVERHEAD(off_heap, to->size / sizeof(Eterm));
+ }
+ goto cleanup_next;
+ }
+ case EXTERNAL_PID_SUBTAG:
+ case EXTERNAL_PORT_SUBTAG:
+ case EXTERNAL_REF_SUBTAG: {
+ ExternalThing *etp = (ExternalThing *) hp;
+ sz = thing_arityval(hdr);
+ *resp = make_external(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ etp->next = off_heap->first;
+ off_heap->first = (struct erl_off_heap_header*) etp;
+ erts_refc_inc(&etp->node->refc, 2);
+ goto cleanup_next;
+ }
+ default:
+ sz = thing_arityval(hdr);
+ *resp = make_boxed(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ goto cleanup_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ *resp = obj;
+ cleanup_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ goto all_clean;
+ }
+ obj = EQUEUE_GET(s);
+ for (;;) {
+ ASSERT(hscan < hp);
+ if (remaining == 0) {
+ if (*hscan == HEAP_ELEM_TO_BE_FILLED) {
+ resp = hscan;
+ hscan += 2;
+ break; /* scanning loop */
+ } else if (primary_tag(*hscan) == TAG_PRIMARY_HEADER) {
+ switch (*hscan & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG:
+ remaining = header_arity(*hscan);
+ hscan++;
+ break;
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) hscan;
+ hscan += 1 + thing_arityval(*hscan);
+ remaining = 1 + funp->num_free;
+ break;
+ }
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(*hscan)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD : {
+ flatmap_t *mp = (flatmap_t *) hscan;
+ remaining = flatmap_get_size(mp) + 1;
+ hscan += 2;
+ break;
+ }
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
+ remaining = hashmap_bitcount(MAP_HEADER_VAL(*hscan));
+ hscan += MAP_HEADER_ARITY(*hscan) + 1;
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT,
+ "copy_shared_perform: bad hashmap type %d\n",
+ MAP_HEADER_TYPE(*hscan));
+ }
+ break;
+ case SUB_BINARY_SUBTAG:
+ ASSERT(((ErlSubBin *) hscan)->bitoffs +
+ ((ErlSubBin *) hscan)->bitsize > 0);
+ hscan += ERL_SUB_BIN_SIZE;
+ break;
+ default:
+ hscan += 1 + thing_arityval(*hscan);
+ break;
+ }
+ } else {
+ hscan++;
+ }
+ } else if (*hscan == HEAP_ELEM_TO_BE_FILLED) {
+ resp = hscan++;
+ remaining--;
+ break; /* scanning loop */
+ } else {
+ hscan++;
+ remaining--;
+ }
+ }
+ ASSERT(resp < hp);
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj);
+ }
+ }
+
+ /* step #4:
+ -------------------------------------------------------
+ traverse the table and reverse-transform all stored entries
+ */
+
+all_clean:
+ for (e = 0; ; e += SHTABLE_INCR) {
+ ptr = SHTABLE_REV(t, e);
+ if (ptr == NULL)
+ break;
+ VERBOSE(DEBUG_SHCOPY, ("[copy] restoring shared: %x\n", ptr));
+ /* entry was a list */
+ if (SHTABLE_Y(t, e) != THE_NON_VALUE) {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling L %p\n", mypid, ptr));
+ CAR(ptr) = SHTABLE_X(t, e);
+ CDR(ptr) = SHTABLE_Y(t, e);
+ }
+ /* entry was boxed */
+ else {
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling B %p\n", mypid, ptr));
+ *ptr = SHTABLE_X(t, e);
+ ASSERT(primary_tag(*ptr) == TAG_PRIMARY_HEADER);
+ }
+ }
+
+#ifdef DEBUG
+ if (eq(saved_obj, result) == 0) {
+ erts_fprintf(stderr, "original = %T\n", saved_obj);
+ erts_fprintf(stderr, "copy = %T\n", result);
+ erts_exit(ERTS_ABORT_EXIT, "copy (shared) not equal to source\n");
+ }
+#endif
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] original was %T\n", mypid, saved_obj));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", mypid, result));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, result));
+
+ ASSERT(hbot == hp);
+ ASSERT(size == ((hp - *hpp) + (hend - hbot)));
+ *hpp = hend;
+ return result;
+}
+
+
/*
* Copy a term that is guaranteed to be contained in a single
* heap block. The heap block is copied word by word, and any
@@ -563,21 +1768,12 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
*
* NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr).
*/
-#if HALFWORD_HEAP
-Eterm copy_shallow_rel(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap,
- Eterm* src_base)
-#else
Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
-#endif
{
Eterm* tp = ptr;
Eterm* hp = *hpp;
const Eterm res = make_tuple(hp);
-#if HALFWORD_HEAP
- const Sint offs = COMPRESS_POINTER(hp - (tp - src_base));
-#else
const Sint offs = (hp - tp) * sizeof(Eterm);
-#endif
while (sz--) {
Eterm val = *tp++;
@@ -652,17 +1848,24 @@ Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
* move markers.
* Typically used to copy a multi-fragmented message (from NIF).
*/
-void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
- Eterm* refs, unsigned nrefs)
+void erts_move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
+ Eterm* refs, unsigned nrefs, int literals)
{
ErlHeapFragment* bp;
Eterm* hp_start = *hpp;
Eterm* hp_end;
Eterm* hp;
unsigned i;
+ Eterm literal_tag;
+
+#ifdef TAG_LITERAL_PTR
+ literal_tag = (Eterm) literals ? TAG_LITERAL_PTR : 0;
+#else
+ literal_tag = (Eterm) 0;
+#endif
for (bp=first; bp!=NULL; bp=bp->next) {
- move_one_frag(hpp, bp, off_heap);
+ move_one_frag(hpp, bp, off_heap, literals);
}
hp_end = *hpp;
for (hp=hp_start; hp<hp_end; ++hp) {
@@ -675,6 +1878,9 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
val = *ptr;
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
+#ifdef TAG_LITERAL_PTR
+ val |= literal_tag;
+#endif
*hp = val;
}
break;
@@ -682,7 +1888,11 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
ptr = list_val(gval);
val = *ptr;
if (IS_MOVED_CONS(val)) {
- *hp = ptr[1];
+ val = ptr[1];
+#ifdef TAG_LITERAL_PTR
+ val |= literal_tag;
+#endif
+ *hp = val;
}
break;
case TAG_PRIMARY_HEADER:
@@ -693,12 +1903,12 @@ void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
}
}
for (i=0; i<nrefs; ++i) {
- refs[i] = follow_moved(refs[i]);
+ refs[i] = follow_moved(refs[i], literal_tag);
}
}
static void
-move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap)
+move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int literals)
{
Eterm* ptr = frag->mem;
Eterm* end = ptr + frag->used_size;
@@ -735,4 +1945,3 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap)
OH_OVERHEAD(off_heap, frag->off_heap.overhead);
frag->off_heap.first = NULL;
}
-
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 0bbcc5f966..fa385f105d 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -378,10 +378,11 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp)
ASSERT(lnk->type == LINK_NODE);
if (is_internal_pid(lnk->pid)) {
ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
- rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks);
- if (!rp) {
+ ErlOffHeap *ohp;
+ rp = erts_proc_lookup(lnk->pid);
+ if (!rp)
goto done;
- }
+ erts_smp_proc_lock(rp, rp_locks);
rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name);
if (rlnk != NULL) {
ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE));
@@ -389,12 +390,14 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp)
}
n = ERTS_LINK_REFC(lnk);
for (i = 0; i < n; ++i) {
- ErlHeapFragment* bp;
- ErlOffHeap *ohp;
Eterm tup;
- Eterm *hp = erts_alloc_message_heap(3,&bp,&ohp,rp,&rp_locks);
+ Eterm *hp;
+ ErtsMessage *msgp;
+
+ msgp = erts_alloc_message_heap(rp, &rp_locks,
+ 3, &hp, &ohp);
tup = TUPLE2(hp, am_nodedown, name);
- erts_queue_message(rp, &rp_locks, bp, tup, NIL);
+ erts_queue_message(rp, &rp_locks, msgp, tup, NIL);
}
erts_smp_proc_unlock(rp, rp_locks);
}
@@ -737,19 +740,11 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx)
Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx),
erts_dsend_context_dtor);
struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin);
- Uint ctl_size = !HALFWORD_HEAP ? 0 : (arityval(ctx->ctl_heap[0]) + 1);
- Eterm* hp = HAlloc(p, ctl_size + PROC_BIN_SIZE);
+ Eterm* hp = HAlloc(p, PROC_BIN_SIZE);
sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext));
ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap));
-#if !HALFWORD_HEAP
dst->ctx.dss.ctl = make_tuple(dst->ctx.ctl_heap);
-#else
- /* Must put control tuple in low mem */
- sys_memcpy(hp, ctx->ctl_heap, ctl_size*sizeof(Eterm));
- dst->ctx.dss.ctl = make_tuple(hp);
- hp += ctl_size;
-#endif
if (ctx->dss.acmp) {
sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap));
dst->ctx.dss.acmp = &dst->acm;
@@ -886,11 +881,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
DTRACE_CHARBUF(receiver_name, 64);
#endif
- if (SEQ_TRACE_TOKEN(sender) != NIL
-#ifdef USE_VM_PROBES
- && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag
-#endif
- ) {
+ if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) {
seq_trace_update_send(sender);
token = SEQ_TRACE_TOKEN(sender);
seq_trace_output(token, message, SEQ_TRACE_SEND, remote, sender);
@@ -905,7 +896,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)),
"%T", remote);
msize = size_object(message);
- if (token != NIL && token != am_have_dt_utag) {
+ if (have_seqtrace(token)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -947,11 +938,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
DTRACE_CHARBUF(receiver_name, 128);
#endif
- if (SEQ_TRACE_TOKEN(sender) != NIL
-#ifdef USE_VM_PROBES
- && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag
-#endif
- ) {
+ if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) {
seq_trace_update_send(sender);
token = SEQ_TRACE_TOKEN(sender);
seq_trace_output(token, message, SEQ_TRACE_SEND, remote_name, sender);
@@ -966,7 +953,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)),
"{%T,%s}", remote_name, node_name);
msize = size_object(message);
- if (token != NIL && token != am_have_dt_utag) {
+ if (have_seqtrace(token)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -1011,11 +998,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
#endif
UseTmpHeapNoproc(6);
- if (token != NIL
-#ifdef USE_VM_PROBES
- && token != am_have_dt_utag
-#endif
- ) {
+ if (have_seqtrace(token)) {
seq_trace_update_send(dsdp->proc);
seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local);
ctl = TUPLE5(&ctl_heap[0],
@@ -1034,7 +1017,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
"{%T,%s}", remote, node_name);
erts_snprintf(reason_str, sizeof(DTRACE_CHARBUF_NAME(reason_str)),
"%T", reason);
- if (token != NIL && token != am_have_dt_utag) {
+ if (have_seqtrace(token)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -1153,7 +1136,6 @@ int erts_net_message(Port *prt,
Process* rp;
DeclareTmpHeapNoproc(ctl_default,DIST_CTL_DEFAULT_SIZE);
Eterm* ctl = ctl_default;
- ErlOffHeap off_heap;
ErtsHeapFactory factory;
Eterm* hp;
Sint type;
@@ -1168,9 +1150,6 @@ int erts_net_message(Port *prt,
#endif
UseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
- /* Thanks to Luke Gorrie */
- off_heap.first = NULL;
- off_heap.overhead = 0;
ERTS_SMP_CHK_NO_PROC_LOCKS;
@@ -1231,15 +1210,15 @@ int erts_net_message(Port *prt,
}
hp = ctl;
- erts_factory_static_init(&factory, ctl, ctl_len, &off_heap);
+ erts_factory_tmp_init(&factory, ctl, ctl_len, ERTS_ALC_T_DCTRL_BUF);
arg = erts_decode_dist_ext(&factory, &ede);
if (is_non_value(arg)) {
#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, "DIST MSG DEBUG: erts_dist_ext_size(CTL) failed:\n");
+ erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext(CTL) failed:\n");
bw(buf, orig_len);
#endif
PURIFY_MSG("data error");
- goto data_error;
+ goto decode_error;
}
ctl_len = t - buf;
@@ -1470,7 +1449,7 @@ int erts_net_message(Port *prt,
ErlOffHeap *ohp;
ASSERT(xsize);
heap_frag = erts_dist_ext_trailer(ede_copy);
- ERTS_INIT_HEAP_FRAG(heap_frag, token_size);
+ ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size);
hp = heap_frag->mem;
ohp = &heap_frag->off_heap;
token = tuple[5];
@@ -1519,7 +1498,7 @@ int erts_net_message(Port *prt,
ErlOffHeap *ohp;
ASSERT(xsize);
heap_frag = erts_dist_ext_trailer(ede_copy);
- ERTS_INIT_HEAP_FRAG(heap_frag, token_size);
+ ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size);
hp = heap_frag->mem;
ohp = &heap_frag->off_heap;
token = tuple[4];
@@ -1719,7 +1698,7 @@ int erts_net_message(Port *prt,
goto invalid_message;
}
- erts_cleanup_offheap(&off_heap);
+ erts_factory_close(&factory);
if (ctl != ctl_default) {
erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl);
}
@@ -1732,12 +1711,13 @@ int erts_net_message(Port *prt,
erts_dsprintf(dsbufp, "Invalid distribution message: %.200T", arg);
erts_send_error_to_logger_nogl(dsbufp);
}
- data_error:
+decode_error:
PURIFY_MSG("data error");
- erts_cleanup_offheap(&off_heap);
+ erts_factory_close(&factory);
if (ctl != ctl_default) {
erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl);
}
+data_error:
UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
erts_deliver_port_exit(prt, dep->cid, am_killed, 0);
ERTS_SMP_CHK_NO_PROC_LOCKS;
@@ -1962,7 +1942,7 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
goto done;
}
default:
- erl_exit(ERTS_ABORT_EXIT, "dsig_send invalid phase (%d)\n", (int)ctx->phase);
+ erts_exit(ERTS_ABORT_EXIT, "dsig_send invalid phase (%d)\n", (int)ctx->phase);
}
}
@@ -1983,7 +1963,7 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf)
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
if (size > (Uint) INT_MAX)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Absurdly large distribution output data buffer "
"(%beu bytes) passed.\n",
size);
@@ -2023,7 +2003,7 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
if (size > (Uint) INT_MAX)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Absurdly large distribution output data buffer "
"(%beu bytes) passed.\n",
size);
@@ -2065,9 +2045,9 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define ERTS_PORT_REDS_MASK__ 0x003fffffffffffffL
-#elif defined(ARCH_32) || HALFWORD_HEAP
+#elif defined(ARCH_32)
#define ERTS_PORT_REDS_MASK__ 0x003fffff
#else
# error "Ohh come on ... !?!"
@@ -2576,7 +2556,9 @@ int distribution_info(int to, void *arg) /* Called by break handler */
}
for (dep = erts_not_connected_dist_entries; dep; dep = dep->next) {
- info_dist_entry(to, arg, dep, 0, 0);
+ if (dep != erts_this_dist_entry) {
+ info_dist_entry(to, arg, dep, 0, 0);
+ }
}
return(0);
@@ -2654,13 +2636,8 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2)
if (!net_kernel)
goto error;
- /* By setting dist_entry==erts_this_dist_entry and DISTRIBUTION on
- net_kernel do_net_exist will be called when net_kernel
- is terminated !! */
- (void) ERTS_PROC_SET_DIST_ENTRY(net_kernel,
- ERTS_PROC_LOCK_MAIN,
- erts_this_dist_entry);
- erts_refc_inc(&erts_this_dist_entry->refc, 2);
+ /* By setting F_DISTRIBUTION on net_kernel,
+ * do_net_exist will be called when net_kernel is terminated !! */
net_kernel->flags |= F_DISTRIBUTION;
if (net_kernel != BIF_P)
@@ -3021,11 +2998,11 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1)
erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx);
- ASSERT(erts_no_of_not_connected_dist_entries >= 0);
+ ASSERT(erts_no_of_not_connected_dist_entries > 0);
ASSERT(erts_no_of_hidden_dist_entries >= 0);
ASSERT(erts_no_of_visible_dist_entries >= 0);
if(not_connected)
- length += erts_no_of_not_connected_dist_entries;
+ length += (erts_no_of_not_connected_dist_entries - 1);
if(hidden)
length += erts_no_of_hidden_dist_entries;
if(visible)
@@ -3047,8 +3024,10 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1)
#endif
if(not_connected)
for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) {
- result = CONS(hp, dep->sysname, result);
- hp += 2;
+ if (dep != erts_this_dist_entry) {
+ result = CONS(hp, dep->sysname, result);
+ hp += 2;
+ }
}
if(hidden)
for(dep = erts_hidden_dist_entries; dep; dep = dep->next) {
@@ -3279,11 +3258,16 @@ send_nodes_mon_msg(Process *rp,
Uint sz)
{
Eterm msg;
- ErlHeapFragment* bp;
+ Eterm *hp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
- Eterm *hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, rp_locksp);
#ifdef DEBUG
- Eterm *hend = hp + sz;
+ Eterm *hend;
+#endif
+
+ mp = erts_alloc_message_heap(rp, rp_locksp, sz, &hp, &ohp);
+#ifdef DEBUG
+ hend = hp + sz;
#endif
if (!nmp->opts) {
@@ -3329,7 +3313,7 @@ send_nodes_mon_msg(Process *rp,
}
ASSERT(hend == hp);
- erts_queue_message(rp, rp_locksp, bp, msg, NIL);
+ erts_queue_message(rp, rp_locksp, mp, msg, NIL);
}
static void
@@ -3386,7 +3370,7 @@ send_nodes_mon_msgs(Process *c_p, Eterm what, Eterm node, Eterm type, Eterm reas
continue;
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "Bad node type found\n");
+ erts_exit(ERTS_ABORT_EXIT, "Bad node type found\n");
}
}
@@ -3695,7 +3679,7 @@ erts_processes_monitoring_nodes(Process *c_p)
case ERTS_NODES_MON_OPT_TYPES: type = am_all; break;
case ERTS_NODES_MON_OPT_TYPE_VISIBLE: type = am_visible; break;
case ERTS_NODES_MON_OPT_TYPE_HIDDEN: type = am_hidden; break;
- default: erl_exit(ERTS_ABORT_EXIT, "Bad node type found\n");
+ default: erts_exit(ERTS_ABORT_EXIT, "Bad node type found\n");
}
olist = erts_bld_cons(hpp, szp,
erts_bld_tuple(hpp, szp, 2,
diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c
index 47dafa53c0..4b0541c10e 100644
--- a/erts/emulator/beam/erl_afit_alloc.c
+++ b/erts/emulator/beam/erl_afit_alloc.c
@@ -241,7 +241,7 @@ info_options(Allctr_t *allctr,
if (hpp || szp) {
if (!atoms_initialized)
- erl_exit(1, "%s:%d: Internal error: Atoms not initialized",
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error: Atoms not initialized",
__FILE__, __LINE__);;
res = NIL;
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 55c164bf11..490e0c0915 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -103,9 +103,9 @@ static Uint install_debug_functions(void);
static int lock_all_physical_memory = 0;
-ErtsAllocatorFunctions_t erts_allctrs[ERTS_ALC_A_MAX+1];
+ErtsAllocatorFunctions_t ERTS_WRITE_UNLIKELY(erts_allctrs[ERTS_ALC_A_MAX+1]);
ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1];
-ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1];
+ErtsAllocatorThrSpec_t ERTS_WRITE_UNLIKELY(erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]);
#define ERTS_MIN(A, B) ((A) < (B) ? (A) : (B))
#define ERTS_MAX(A, B) ((A) > (B) ? (A) : (B))
@@ -123,10 +123,6 @@ typedef union {
static ErtsAllocatorState_t std_alloc_state;
static ErtsAllocatorState_t ll_alloc_state;
-#if HALFWORD_HEAP
-static ErtsAllocatorState_t std_low_alloc_state;
-static ErtsAllocatorState_t ll_low_alloc_state;
-#endif
static ErtsAllocatorState_t sl_alloc_state;
static ErtsAllocatorState_t temp_alloc_state;
static ErtsAllocatorState_t eheap_alloc_state;
@@ -134,6 +130,8 @@ static ErtsAllocatorState_t binary_alloc_state;
static ErtsAllocatorState_t ets_alloc_state;
static ErtsAllocatorState_t driver_alloc_state;
static ErtsAllocatorState_t fix_alloc_state;
+static ErtsAllocatorState_t literal_alloc_state;
+static ErtsAllocatorState_t test_alloc_state;
typedef struct {
erts_smp_atomic32_t refc;
@@ -150,24 +148,10 @@ typedef struct {
#define ERTS_ALC_INFO_A_MSEG_ALLOC (ERTS_ALC_A_MAX + 2)
#define ERTS_ALC_INFO_A_MAX ERTS_ALC_INFO_A_MSEG_ALLOC
-#if !HALFWORD_HEAP
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(aireq,
- ErtsAllocInfoReq,
- 5,
- ERTS_ALC_T_AINFO_REQ)
-#else
-static ERTS_INLINE ErtsAllocInfoReq *
-aireq_alloc(void)
-{
- return erts_alloc(ERTS_ALC_T_AINFO_REQ, sizeof(ErtsAllocInfoReq));
-}
-
-static ERTS_INLINE void
-aireq_free(ErtsAllocInfoReq *ptr)
-{
- erts_free(ERTS_ALC_T_AINFO_REQ, ptr);
-}
-#endif
+ ErtsAllocInfoReq,
+ 5,
+ ERTS_ALC_T_AINFO_REQ)
ErtsAlcType_t erts_fix_core_allocator_ix;
@@ -181,6 +165,8 @@ enum allctr_type {
struct au_init {
int enable;
int thr_spec;
+ int disable_allowed;
+ int thr_spec_allowed;
int carrier_migration_allowed;
enum allctr_type atype;
struct {
@@ -229,13 +215,11 @@ typedef struct {
struct au_init ets_alloc;
struct au_init driver_alloc;
struct au_init fix_alloc;
-#if HALFWORD_HEAP
- struct au_init std_low_alloc;
- struct au_init ll_low_alloc;
-#endif
+ struct au_init literal_alloc;
+ struct au_init test_alloc;
} erts_alc_hndl_args_init_t;
-#define ERTS_AU_INIT__ {0, 0, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}}
+#define ERTS_AU_INIT__ {0, 0, 1, 1, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}}
#define SET_DEFAULT_ALLOC_OPTS(IP) \
do { \
@@ -259,10 +243,6 @@ set_default_sl_alloc_opts(struct au_init *ip)
#endif
ip->init.util.ts = ERTS_ALC_MTA_SHORT_LIVED;
ip->init.util.rsbcst = 80;
-#if HALFWORD_HEAP
- ip->init.util.force = 1;
- ip->init.util.low_mem = 1;
-#endif
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
}
@@ -298,9 +278,9 @@ set_default_ll_alloc_opts(struct au_init *ip)
ip->init.util.name_prefix = "ll_";
ip->init.util.alloc_no = ERTS_ALC_A_LONG_LIVED;
#ifndef SMALL_MEMORY
- ip->init.util.mmbcs = 2*1024*1024 - 40; /* Main carrier size */
+ ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */
#else
- ip->init.util.mmbcs = 1*1024*1024 - 40; /* Main carrier size */
+ ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */
#endif
ip->init.util.ts = ERTS_ALC_MTA_LONG_LIVED;
ip->init.util.asbcst = 0;
@@ -311,6 +291,54 @@ set_default_ll_alloc_opts(struct au_init *ip)
}
static void
+set_default_literal_alloc_opts(struct au_init *ip)
+{
+ SET_DEFAULT_ALLOC_OPTS(ip);
+ ip->enable = 1;
+ ip->thr_spec = 0;
+ ip->disable_allowed = 0;
+ ip->thr_spec_allowed = 0;
+ ip->carrier_migration_allowed = 0;
+ ip->atype = BESTFIT;
+ ip->init.bf.ao = 1;
+ ip->init.util.ramv = 0;
+ ip->init.util.mmsbc = 0;
+ ip->init.util.sbct = ~((UWord) 0);
+ ip->init.util.name_prefix = "literal_";
+ ip->init.util.alloc_no = ERTS_ALC_A_LITERAL;
+#ifndef SMALL_MEMORY
+ ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */
+#else
+ ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */
+#endif
+ ip->init.util.ts = ERTS_ALC_MTA_LITERAL;
+ ip->init.util.asbcst = 0;
+ ip->init.util.rsbcst = 0;
+ ip->init.util.rsbcmt = 0;
+ ip->init.util.rmbcmt = 0;
+ ip->init.util.acul = 0;
+
+#if defined(ARCH_32)
+# if HAVE_ERTS_MSEG
+ ip->init.util.mseg_alloc = &erts_alcu_literal_32_mseg_alloc;
+ ip->init.util.mseg_realloc = &erts_alcu_literal_32_mseg_realloc;
+ ip->init.util.mseg_dealloc = &erts_alcu_literal_32_mseg_dealloc;
+# endif
+ ip->init.util.sys_alloc = &erts_alcu_literal_32_sys_alloc;
+ ip->init.util.sys_realloc = &erts_alcu_literal_32_sys_realloc;
+ ip->init.util.sys_dealloc = &erts_alcu_literal_32_sys_dealloc;
+#elif defined(ARCH_64)
+# ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
+ ip->init.util.mseg_alloc = &erts_alcu_literal_64_mseg_alloc;
+ ip->init.util.mseg_realloc = &erts_alcu_literal_64_mseg_realloc;
+ ip->init.util.mseg_dealloc = &erts_alcu_literal_64_mseg_dealloc;
+# endif
+#else
+# error Unknown architecture
+#endif
+}
+
+static void
set_default_temp_alloc_opts(struct au_init *ip)
{
SET_DEFAULT_ALLOC_OPTS(ip);
@@ -328,10 +356,6 @@ set_default_temp_alloc_opts(struct au_init *ip)
ip->init.util.ts = ERTS_ALC_MTA_TEMPORARY;
ip->init.util.rsbcst = 90;
ip->init.util.rmbcmt = 100;
-#if HALFWORD_HEAP
- ip->init.util.force = 1;
- ip->init.util.low_mem = 1;
-#endif
}
static void
@@ -350,10 +374,6 @@ set_default_eheap_alloc_opts(struct au_init *ip)
#endif
ip->init.util.ts = ERTS_ALC_MTA_EHEAP;
ip->init.util.rsbcst = 50;
-#if HALFWORD_HEAP
- ip->init.util.force = 1;
- ip->init.util.low_mem = 1;
-#endif
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC;
}
@@ -432,6 +452,33 @@ set_default_fix_alloc_opts(struct au_init *ip,
ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
}
+static void
+set_default_test_alloc_opts(struct au_init *ip)
+{
+ SET_DEFAULT_ALLOC_OPTS(ip);
+ ip->enable = 0; /* Disabled by default */
+ ip->thr_spec = -1 * erts_no_schedulers;
+ ip->atype = AOFIRSTFIT;
+ ip->init.aoff.flavor = AOFF_BF;
+ ip->init.util.name_prefix = "test_";
+ ip->init.util.alloc_no = ERTS_ALC_A_TEST;
+ ip->init.util.mmbcs = 0; /* Main carrier size */
+ ip->init.util.ts = ERTS_ALC_MTA_TEST;
+ ip->init.util.acul = ERTS_ALC_DEFAULT_ACUL;
+
+ /* Use a constant minimal MBC size */
+#if ERTS_SA_MB_CARRIERS
+ ip->init.util.smbcs = ERTS_SACRR_UNIT_SZ;
+ ip->init.util.lmbcs = ERTS_SACRR_UNIT_SZ;
+ ip->init.util.sbct = ERTS_SACRR_UNIT_SZ;
+#else
+ ip->init.util.smbcs = 1 << 12;
+ ip->init.util.lmbcs = 1 << 12;
+ ip->init.util.sbct = 1 << 12;
+#endif
+}
+
+
#ifdef ERTS_SMP
static void
@@ -560,18 +607,16 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_PROC)]
= sizeof(Process);
-#if !HALFWORD_HEAP
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MONITOR_SH)]
= ERTS_MONITOR_SH_SIZE * sizeof(Uint);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NLINK_SH)]
= ERTS_LINK_SH_SIZE * sizeof(Uint);
-#endif
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_EV_D_STATE)]
= sizeof(ErtsDrvEventDataState);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)]
= sizeof(ErtsDrvSelectDataState);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MSG_REF)]
- = sizeof(ErlMessage);
+ = sizeof(ErtsMessageRef);
#ifdef ERTS_SMP
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_THR_Q_EL_SL)]
= sizeof(ErtsThrQElement_t);
@@ -613,6 +658,8 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
set_default_driver_alloc_opts(&init.driver_alloc);
set_default_fix_alloc_opts(&init.fix_alloc,
fix_type_sizes);
+ set_default_literal_alloc_opts(&init.literal_alloc);
+ set_default_test_alloc_opts(&init.test_alloc);
if (argc && argv)
handle_args(argc, argv, &init);
@@ -623,11 +670,11 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
if (mlockall(MCL_CURRENT|MCL_FUTURE) != 0) {
int err = errno;
char *errstr = err ? strerror(err) : "unknown";
- erl_exit(-1, "Failed to lock physical memory: %s (%d)\n",
+ erts_exit(1, "Failed to lock physical memory: %s (%d)\n",
errstr, err);
}
#else
- erl_exit(-1, "Failed to lock physical memory: Not supported\n");
+ erts_exit(1, "Failed to lock physical memory: Not supported\n");
#endif
}
@@ -640,6 +687,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.ets_alloc.thr_spec = 0;
init.driver_alloc.thr_spec = 0;
init.fix_alloc.thr_spec = 0;
+ init.literal_alloc.thr_spec = 0;
#endif
/* Make adjustments for carrier migration support */
@@ -652,6 +700,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
adjust_carrier_migration_support(&init.ets_alloc);
adjust_carrier_migration_support(&init.driver_alloc);
adjust_carrier_migration_support(&init.fix_alloc);
+ adjust_carrier_migration_support(&init.literal_alloc);
if (init.erts_alloc_config) {
/* Adjust flags that erts_alloc_config won't like */
@@ -666,6 +715,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.ets_alloc.thr_spec = 0;
init.driver_alloc.thr_spec = 0;
init.fix_alloc.thr_spec = 0;
+ init.literal_alloc.thr_spec = 0;
/* No carrier migration */
init.temp_alloc.init.util.acul = 0;
@@ -677,6 +727,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
init.ets_alloc.init.util.acul = 0;
init.driver_alloc.init.util.acul = 0;
init.fix_alloc.init.util.acul = 0;
+ init.literal_alloc.init.util.acul = 0;
}
#ifdef ERTS_SMP
@@ -693,6 +744,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
adjust_tpref(&init.ets_alloc, erts_no_schedulers);
adjust_tpref(&init.driver_alloc, erts_no_schedulers);
adjust_tpref(&init.fix_alloc, erts_no_schedulers);
+ adjust_tpref(&init.literal_alloc, erts_no_schedulers);
#else
/* No thread specific if not smp */
@@ -711,6 +763,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
refuse_af_strategy(&init.ets_alloc);
refuse_af_strategy(&init.driver_alloc);
refuse_af_strategy(&init.fix_alloc);
+ refuse_af_strategy(&init.literal_alloc);
#ifdef ERTS_SMP
if (!init.temp_alloc.thr_spec)
@@ -745,24 +798,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
erts_allctrs[ERTS_ALC_A_SYSTEM].free = erts_sys_free;
erts_allctrs_info[ERTS_ALC_A_SYSTEM].enabled = 1;
-#if HALFWORD_HEAP
- /* Init low memory variants by cloning */
- init.std_low_alloc = init.std_alloc;
- init.std_low_alloc.init.util.name_prefix = "std_low_";
- init.std_low_alloc.init.util.alloc_no = ERTS_ALC_A_STANDARD_LOW;
- init.std_low_alloc.init.util.force = 1;
- init.std_low_alloc.init.util.low_mem = 1;
-
- init.ll_low_alloc = init.ll_alloc;
- init.ll_low_alloc.init.util.name_prefix = "ll_low_";
- init.ll_low_alloc.init.util.alloc_no = ERTS_ALC_A_LONG_LIVED_LOW;
- init.ll_low_alloc.init.util.force = 1;
- init.ll_low_alloc.init.util.low_mem = 1;
-
- set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc, ncpu);
- set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc, ncpu);
-#endif /* HALFWORD */
-
set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc, ncpu);
@@ -772,16 +807,18 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc, ncpu);
set_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_LITERAL, &init.literal_alloc, ncpu);
+ set_au_allocator(ERTS_ALC_A_TEST, &init.test_alloc, ncpu);
for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) {
if (!erts_allctrs[i].alloc)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Missing alloc function for %s\n", ERTS_ALC_A2AD(i));
if (!erts_allctrs[i].realloc)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Missing realloc function for %s\n", ERTS_ALC_A2AD(i));
if (!erts_allctrs[i].free)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Missing free function for %s\n", ERTS_ALC_A2AD(i));
}
@@ -805,14 +842,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
start_au_allocator(ERTS_ALC_A_LONG_LIVED,
&init.ll_alloc,
&ll_alloc_state);
-#if HALFWORD_HEAP
- start_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW,
- &init.ll_low_alloc,
- &ll_low_alloc_state);
- start_au_allocator(ERTS_ALC_A_STANDARD_LOW,
- &init.std_low_alloc,
- &std_low_alloc_state);
-#endif
start_au_allocator(ERTS_ALC_A_EHEAP,
&init.eheap_alloc,
&eheap_alloc_state);
@@ -832,13 +861,18 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
start_au_allocator(ERTS_ALC_A_FIXED_SIZE,
&init.fix_alloc,
&fix_alloc_state);
+ start_au_allocator(ERTS_ALC_A_LITERAL,
+ &init.literal_alloc,
+ &literal_alloc_state);
+
+ start_au_allocator(ERTS_ALC_A_TEST,
+ &init.test_alloc,
+ &test_alloc_state);
erts_mtrace_install_wrapper_functions();
extra_block_size += erts_instr_init(init.instr.stat, init.instr.map);
-#if !HALFWORD_HEAP
init_aireq_alloc();
-#endif
#ifdef DEBUG
extra_block_size += install_debug_functions();
@@ -855,7 +889,7 @@ erts_alloc_late_init(void)
static void *
erts_realloc_fixed_size(ErtsAlcType_t type, void *extra, void *p, Uint size)
{
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Attempt to reallocate a block of the fixed size type %s\n",
ERTS_ALC_T2TD(type));
}
@@ -936,6 +970,10 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu)
else
#endif
{
+#ifdef ERTS_SMP
+ erts_exit(ERTS_ABORT_EXIT, "%salloc is not thread safe\n",
+ init->init.util.name_prefix);
+#else
af->alloc = erts_alcu_alloc;
if (init->init.util.fix_type_size)
af->realloc = erts_realloc_fixed_size;
@@ -944,6 +982,7 @@ set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init, int ncpu)
else
af->realloc = erts_alcu_realloc;
af->free = erts_alcu_free;
+#endif
}
af->extra = NULL;
ai->alloc_util = 1;
@@ -977,7 +1016,7 @@ start_au_allocator(ErtsAlcType_t alctr_n,
* tspec->size)
+ ERTS_CACHE_LINE_SIZE - 1));
if (!states)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Failed to allocate allocator states for %salloc\n",
init->init.util.name_prefix);
tspec->allctr = (Allctr_t **) states;
@@ -1005,7 +1044,7 @@ start_au_allocator(ErtsAlcType_t alctr_n,
(tot_fix_list_size
+ ERTS_CACHE_LINE_SIZE - 1));
if (!fix_lists)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Failed to allocate fix lists for %salloc\n",
init->init.util.name_prefix);
@@ -1016,7 +1055,7 @@ start_au_allocator(ErtsAlcType_t alctr_n,
}
for (i = 0; i < size; i++) {
- void *as;
+ Allctr_t *as;
atype = init->atype;
if (!init->thr_spec)
@@ -1053,22 +1092,22 @@ start_au_allocator(ErtsAlcType_t alctr_n,
switch (atype) {
case GOODFIT:
- as = (void *) erts_gfalc_start((GFAllctr_t *) as0,
+ as = erts_gfalc_start((GFAllctr_t *) as0,
&init->init.gf,
&init->init.util);
break;
case BESTFIT:
- as = (void *) erts_bfalc_start((BFAllctr_t *) as0,
+ as = erts_bfalc_start((BFAllctr_t *) as0,
&init->init.bf,
&init->init.util);
break;
case AFIT:
- as = (void *) erts_afalc_start((AFAllctr_t *) as0,
+ as = erts_afalc_start((AFAllctr_t *) as0,
&init->init.af,
&init->init.util);
break;
case AOFIRSTFIT:
- as = (void *) erts_aoffalc_start((AOFFAllctr_t *) as0,
+ as = erts_aoffalc_start((AOFFAllctr_t *) as0,
&init->init.aoff,
&init->init.util);
break;
@@ -1079,7 +1118,7 @@ start_au_allocator(ErtsAlcType_t alctr_n,
}
if (!as)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Failed to start %salloc\n", init->init.util.name_prefix);
ASSERT(as == (void *) as0);
@@ -1238,9 +1277,6 @@ get_acul_value(struct au_init *auip, char *param_end, char** argv, int* ip)
if (sys_strcmp(value, "de") == 0) {
switch (auip->init.util.alloc_no) {
case ERTS_ALC_A_LONG_LIVED:
-#if HALFWORD_HEAP
- case ERTS_ALC_A_LONG_LIVED_LOW:
-#endif
return ERTS_ALC_DEFAULT_ENABLED_ACUL_LL_ALLOC;
case ERTS_ALC_A_EHEAP:
return ERTS_ALC_DEFAULT_ENABLED_ACUL_EHEAP_ALLOC;
@@ -1318,9 +1354,17 @@ handle_au_arg(struct au_init *auip,
else
goto bad_switch;
break;
- case 'e':
- auip->enable = get_bool_value(sub_param+1, argv, ip);
+ case 'e': {
+ int e = get_bool_value(sub_param + 1, argv, ip);
+ if (!auip->disable_allowed && !e) {
+ if (!u_switch)
+ bad_value(param, sub_param + 1, "false");
+ else
+ ASSERT(auip->enable); /* ignore */
+ }
+ else auip->enable = e;
break;
+ }
case 'l':
if (has_prefix("lmbcs", sub_param)) {
auip->default_.lmbcs = 0;
@@ -1389,7 +1433,14 @@ handle_au_arg(struct au_init *auip,
case 't': {
int res = get_bool_value(sub_param+1, argv, ip);
if (res > 0) {
- auip->thr_spec = 1;
+ if (!auip->thr_spec_allowed) {
+ if (!u_switch)
+ bad_value(param, sub_param + 1, "true");
+ else
+ ASSERT(!auip->thr_spec); /* ignore */
+ }
+ else
+ auip->thr_spec = 1;
break;
}
else if (res == 0) {
@@ -1418,6 +1469,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
&init->fix_alloc,
&init->sl_alloc,
&init->temp_alloc
+ /* test_alloc not affected by +Mea??? or +Mu??? */
};
int aui_sz = (int) sizeof(aui)/sizeof(aui[0]);
char *arg;
@@ -1437,6 +1489,16 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
case 'B':
handle_au_arg(&init->binary_alloc, &argv[i][3], argv, &i, 0);
break;
+ case 'I':
+ if (has_prefix("scs", argv[i]+3)) {
+#if HAVE_ERTS_MSEG
+ init->mseg.literal_mmap.scs =
+#endif
+ get_mb_value(argv[i]+6, argv, &i);
+ }
+ else
+ handle_au_arg(&init->literal_alloc, &argv[i][3], argv, &i, 0);
+ break;
case 'D':
handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i, 0);
break;
@@ -1473,25 +1535,25 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
}
else if (has_prefix("scs", argv[i]+3)) {
#if HAVE_ERTS_MSEG
- init->mseg.mmap.scs =
+ init->mseg.dflt_mmap.scs =
#endif
get_mb_value(argv[i]+6, argv, &i);
}
else if (has_prefix("sco", argv[i]+3)) {
#if HAVE_ERTS_MSEG
- init->mseg.mmap.sco =
+ init->mseg.dflt_mmap.sco =
#endif
get_bool_value(argv[i]+6, argv, &i);
}
else if (has_prefix("scrpm", argv[i]+3)) {
#if HAVE_ERTS_MSEG
- init->mseg.mmap.scrpm =
+ init->mseg.dflt_mmap.scrpm =
#endif
get_bool_value(argv[i]+8, argv, &i);
}
else if (has_prefix("scrfsd", argv[i]+3)) {
#if HAVE_ERTS_MSEG
- init->mseg.mmap.scrfsd =
+ init->mseg.dflt_mmap.scrfsd =
#endif
get_amount_value(argv[i]+9, argv, &i);
}
@@ -1508,6 +1570,9 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init)
case 'T':
handle_au_arg(&init->temp_alloc, &argv[i][3], argv, &i, 0);
break;
+ case 'Z':
+ handle_au_arg(&init->test_alloc, &argv[i][3], argv, &i, 0);
+ break;
case 'Y': { /* sys_alloc */
if (has_prefix("tt", param+2)) {
/* set trim threshold */
@@ -1870,7 +1935,7 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...)
case ERTS_ALC_O_FREE: op_str = "free"; break;
default: op_str = "UNKNOWN"; break;
}
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s: %s operation not supported (memory type: \"%s\")\n",
allctr_str, op_str, t_str);
break;
@@ -1884,18 +1949,18 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...)
va_start(argp, n);
size = va_arg(argp, Uint);
va_end(argp);
- erl_exit(1,
+ erts_exit(1,
"%s: Cannot %s %lu bytes of memory (of type \"%s\").\n",
allctr_str, op, size, t_str);
break;
}
case ERTS_ALC_E_NOALLCTR:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"erts_alloc: Unknown allocator type: %d\n",
ERTS_ALC_T2A(ERTS_ALC_N2T(n)));
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "erts_alloc: Unknown error: %d\n", error);
+ erts_exit(ERTS_ABORT_EXIT, "erts_alloc: Unknown error: %d\n", error);
break;
}
}
@@ -1957,48 +2022,6 @@ alcu_size(ErtsAlcType_t ai, ErtsAlcUFixInfo_t *fi, int fisz)
return res;
}
-#if HALFWORD_HEAP
-static ERTS_INLINE int
-alcu_is_low(ErtsAlcType_t ai)
-{
- int is_low = 0;
- ASSERT(erts_allctrs_info[ai].enabled);
- ASSERT(erts_allctrs_info[ai].alloc_util);
-
- if (!erts_allctrs_info[ai].thr_spec) {
- Allctr_t *allctr = erts_allctrs_info[ai].extra;
- is_low = allctr->mseg_opt.low_mem;
- }
- else {
- ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[ai];
- int i;
-# ifdef DEBUG
- int found_one = 0;
-# endif
-
- ASSERT(tspec->enabled);
-
- for (i = tspec->size - 1; i >= 0; i--) {
- Allctr_t *allctr = tspec->allctr[i];
- if (allctr) {
-# ifdef DEBUG
- if (!found_one) {
- is_low = allctr->mseg_opt.low_mem;
- found_one = 1;
- }
- else ASSERT(is_low == allctr->mseg_opt.low_mem);
-# else
- is_low = allctr->mseg_opt.low_mem;
- break;
-# endif
- }
- }
- ASSERT(found_one);
- }
- return is_low;
-}
-#endif /* HALFWORD */
-
static ERTS_INLINE void
add_fix_values(UWord *ap, UWord *up, ErtsAlcUFixInfo_t *fi, ErtsAlcType_t type)
{
@@ -2028,9 +2051,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
int code;
int ets;
int maximum;
-#if HALFWORD_HEAP
- int low;
-#endif
} want = {0};
struct {
UWord total;
@@ -2043,9 +2063,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
UWord code;
UWord ets;
UWord maximum;
-#if HALFWORD_HEAP
- UWord low;
-#endif
} size = {0};
Eterm atoms[sizeof(size)/sizeof(UWord)];
UWord *uintps[sizeof(size)/sizeof(UWord)];
@@ -2104,11 +2121,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
atoms[length] = am_maximum;
uintps[length++] = &size.maximum;
}
-#if HALFWORD_HEAP
- want.low = 1;
- atoms[length] = am_low;
- uintps[length++] = &size.low;
-#endif
}
else {
DeclareTmpHeapNoproc(tmp_heap,2);
@@ -2202,15 +2214,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
return am_badarg;
}
break;
-#if HALFWORD_HEAP
- case am_low:
- if (!want.low) {
- want.low = 1;
- atoms[length] = am_low;
- uintps[length++] = &size.low;
- }
- break;
-#endif
default:
UnUseTmpHeapNoproc(2);
return am_badarg;
@@ -2222,11 +2225,12 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
return am_badarg;
}
- /* All alloc_util allocators *have* to be enabled */
+ /* All alloc_util allocators *have* to be enabled, except test_alloc */
for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) {
switch (ai) {
case ERTS_ALC_A_SYSTEM:
+ case ERTS_ALC_A_TEST:
break;
default:
if (!erts_allctrs_info[ai].enabled
@@ -2267,6 +2271,8 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
* contain any allocated memory.
*/
continue;
+ case ERTS_ALC_A_TEST:
+ continue;
case ERTS_ALC_A_EHEAP:
save = &size.processes;
break;
@@ -2288,11 +2294,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
if (save)
*save = asz;
size.total += asz;
-#if HALFWORD_HEAP
- if (alcu_is_low(ai)) {
- size.low += asz;
- }
-#endif
}
}
}
@@ -2319,7 +2320,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
&size.processes_used,
fi,
ERTS_ALC_T_PROC);
-#if !HALFWORD_HEAP
add_fix_values(&size.processes,
&size.processes_used,
fi,
@@ -2329,7 +2329,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
&size.processes_used,
fi,
ERTS_ALC_T_NLINK_SH);
-#endif
add_fix_values(&size.processes,
&size.processes_used,
fi,
@@ -2675,14 +2674,17 @@ erts_alloc_util_allocators(void *proc)
/*
* Currently all allocators except sys_alloc are
* alloc_util allocators.
+ * Also hide test_alloc which is disabled by default
+ * and only intended for our own testing.
*/
- sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 1)*2;
+ sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 2)*2;
ASSERT(sz > 0);
hp = HAlloc((Process *) proc, sz);
res = NIL;
for (i = ERTS_ALC_A_MAX; i >= ERTS_ALC_A_MIN; i--) {
switch (i) {
case ERTS_ALC_A_SYSTEM:
+ case ERTS_ALC_A_TEST:
break;
default: {
char *alc_str = (char *) ERTS_ALC_A2AD(i);
@@ -2765,7 +2767,7 @@ erts_allocator_info(int to, void *arg)
erts_mseg_info(i, &to, arg, 0, NULL, NULL);
}
erts_print(to, arg, "=allocator:mseg_alloc.erts_mmap\n");
- erts_mmap_info(&to, arg, NULL, NULL, &emis);
+ erts_mmap_info(&erts_dflt_mmapper, &to, arg, NULL, NULL, &emis);
}
#endif
@@ -2991,12 +2993,12 @@ reply_alloc_info(void *vair)
int global_instances = air->req_sched == sched_id;
ErtsProcLocks rp_locks;
Process *rp = air->proc;
- Eterm ref_copy = NIL, ai_list, msg;
- Eterm *hp = NULL, *hp_end = NULL, *hp_start = NULL;
+ Eterm ref_copy = NIL, ai_list, msg = NIL;
+ Eterm *hp = NULL, *hp_start = NULL, *hp_end = NULL;
Eterm **hpp;
Uint sz, *szp;
ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErtsMessage *mp = NULL;
struct erts_mmap_info_struct emis;
int i;
Eterm (*info_func)(Allctr_t *,
@@ -3117,7 +3119,8 @@ reply_alloc_info(void *vair)
ai_list = erts_bld_cons(hpp, szp,
ainfo, ai_list);
- ainfo = (air->only_sz ? NIL : erts_mmap_info(NULL, NULL, hpp, szp, &emis));
+ ainfo = (air->only_sz ? NIL :
+ erts_mmap_info(&erts_dflt_mmapper, NULL, NULL, hpp, szp, &emis));
ainfo = erts_bld_tuple3(hpp, szp,
alloc_atom,
erts_bld_atom(hpp,szp,"erts_mmap"),
@@ -3144,7 +3147,7 @@ reply_alloc_info(void *vair)
make_small(0), ainfo);
}
else {
- erl_exit(ERTS_ABORT_EXIT, "%s:%d: internal error\n",
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: internal error\n",
__FILE__, __LINE__);
}
}
@@ -3197,20 +3200,17 @@ reply_alloc_info(void *vair)
if (hpp)
break;
- hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
hp_start = hp;
hp_end = hp + sz;
szp = NULL;
hpp = &hp;
}
- if (bp)
- bp = erts_resize_message_buffer(bp, hp - hp_start, &msg, 1);
- else {
- ASSERT(hp);
- HRelease(rp, hp_end, hp);
- }
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ if (hp != hp_end)
+ erts_shrink_message_heap(&mp, rp, hp_start, hp, hp_end, &msg, 1);
+
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (air->req_sched == sched_id)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -3381,7 +3381,7 @@ void *safe_realloc(void *ptr, Uint sz)
* Keep alloc_SUITE_data/allocator_test.h updated if changes are made *
* to erts_alc_test() *
\* */
-#define ERTS_ALC_TEST_ABORT erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error\n")
+#define ERTS_ALC_TEST_ABORT erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error\n")
UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
{
@@ -3434,8 +3434,11 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
init.enable = 1;
init.atype = GOODFIT;
init.init.util.name_prefix = (char *) a1;
- init.init.util.ts = a2 ? 1 : 0;
-
+#ifdef ERTS_SMP
+ init.init.util.ts = 1;
+#else
+ init.init.util.ts = a2 ? 1 : 0;
+#endif
if ((char **) a3) {
char **argv = (char **) a3;
int i = 0;
@@ -3566,6 +3569,41 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3)
#else
case 0xf13: return (UWord) 0;
#endif
+ case 0xf14: return (UWord) erts_alloc(ERTS_ALC_T_TEST, (Uint)a1);
+
+ case 0xf15: erts_free(ERTS_ALC_T_TEST, (void*)a1); return 0;
+
+ case 0xf16: {
+ Uint extra_hdr_sz = UNIT_CEILING((Uint)a1);
+ ErtsAllocatorThrSpec_t* ts = &erts_allctr_thr_spec[ERTS_ALC_A_TEST];
+ Uint offset = ts->allctr[0]->mbc_header_size;
+ void* orig_creating_mbc = ts->allctr[0]->creating_mbc;
+ void* orig_destroying_mbc = ts->allctr[0]->destroying_mbc;
+ void* new_creating_mbc = *(void**)a2; /* inout arg */
+ void* new_destroying_mbc = *(void**)a3; /* inout arg */
+ int i;
+
+ for (i=0; i < ts->size; i++) {
+ Allctr_t* ap = ts->allctr[i];
+ if (ap->mbc_header_size != offset
+ || ap->creating_mbc != orig_creating_mbc
+ || ap->destroying_mbc != orig_destroying_mbc
+ || ap->mbc_list.first != NULL)
+ return -1;
+ }
+ for (i=0; i < ts->size; i++) {
+ ts->allctr[i]->mbc_header_size += extra_hdr_sz;
+ ts->allctr[i]->creating_mbc = new_creating_mbc;
+ ts->allctr[i]->destroying_mbc = new_destroying_mbc;
+ }
+ *(void**)a2 = orig_creating_mbc;
+ *(void**)a3 = orig_destroying_mbc;
+ return offset;
+ }
+ case 0xf17: {
+ ErtsAllocatorThrSpec_t* ts = &erts_allctr_thr_spec[ERTS_ALC_A_TEST];
+ return ts->allctr[0]->largest_mbc_size;
+ }
default:
break;
}
@@ -3808,7 +3846,7 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func)
found_type = GET_TYPE_OF_PATTERN(pre_pattern);
if (pre_pattern != MK_PATTERN(n)) {
if ((FIXED_FENCE_PATTERN_MASK & pre_pattern) != FIXED_FENCE_PATTERN)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"ERROR: Fence at beginning of memory block (p=0x%u) "
"clobbered.\n",
(UWord) ptr);
@@ -3825,12 +3863,12 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func)
char *op_str;
if ((FIXED_FENCE_PATTERN_MASK & post_pattern) != FIXED_FENCE_PATTERN)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"ERROR: Fence at end of memory block (p=0x%u, sz=%u) "
"clobbered.\n",
(UWord) ptr, (UWord) sz);
if (found_type != GET_TYPE_OF_PATTERN(post_pattern))
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"ERROR: Fence around memory block (p=0x%u, sz=%u) "
"clobbered.\n",
(UWord) ptr, (UWord) sz);
@@ -3853,7 +3891,7 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func)
default: op_str = "???"; break;
}
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"ERROR: Memory block (p=0x%u, sz=%u) allocated as type \"%s\","
" but %s as type \"%s\".\n",
(UWord) ptr, (UWord) sz, ftype, op_str, otype);
diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h
index f540bae20d..71e4713624 100644
--- a/erts/emulator/beam/erl_alloc.h
+++ b/erts/emulator/beam/erl_alloc.h
@@ -30,6 +30,7 @@
#ifdef USE_THREADS
#include "erl_threads.h"
#endif
+#include "erl_mmap.h"
#ifdef DEBUG
# undef ERTS_ALC_WANT_INLINE
@@ -43,9 +44,11 @@
#if ERTS_CAN_INLINE && ERTS_ALC_WANT_INLINE
# define ERTS_ALC_DO_INLINE 1
# define ERTS_ALC_INLINE static ERTS_INLINE
+# define ERTS_ALC_FORCE_INLINE static ERTS_FORCE_INLINE
#else
# define ERTS_ALC_DO_INLINE 0
# define ERTS_ALC_INLINE
+# define ERTS_ALC_FORCE_INLINE
#endif
#define ERTS_ALC_NO_FIXED_SIZES \
@@ -177,6 +180,12 @@ void sys_free(void *) __deprecated; /* erts_free() */
void *sys_alloc(Uint ) __deprecated; /* erts_alloc_fnf() */
void *sys_realloc(void *, Uint) __deprecated; /* erts_realloc_fnf() */
+#undef ERTS_HAVE_IS_IN_LITERAL_RANGE
+#if defined(ARCH_32) || defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+# define ERTS_HAVE_IS_IN_LITERAL_RANGE
+#endif
+
+
/*
* erts_alloc[_fnf](), erts_realloc[_fnf](), erts_free() works as
* malloc(), realloc(), and free() with the following exceptions:
@@ -204,6 +213,9 @@ void erts_free(ErtsAlcType_t type, void *ptr);
void *erts_alloc_fnf(ErtsAlcType_t type, Uint size);
void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size);
int erts_is_allctr_wrapper_prelocked(void);
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+int erts_is_in_literal_range(void* ptr);
+#endif
#endif /* #if !ERTS_ALC_DO_INLINE */
@@ -221,12 +233,14 @@ ERTS_ALC_INLINE
void *erts_alloc(ErtsAlcType_t type, Uint size)
{
void *res;
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
size);
if (!res)
erts_alloc_n_enomem(ERTS_ALC_T2N(type), size);
+ ERTS_MSACC_POP_STATE_X();
return res;
}
@@ -234,6 +248,7 @@ ERTS_ALC_INLINE
void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size)
{
void *res;
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
@@ -241,37 +256,48 @@ void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size)
size);
if (!res)
erts_realloc_n_enomem(ERTS_ALC_T2N(type), ptr, size);
+ ERTS_MSACC_POP_STATE_X();
return res;
}
ERTS_ALC_INLINE
void erts_free(ErtsAlcType_t type, void *ptr)
{
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
(*erts_allctrs[ERTS_ALC_T2A(type)].free)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
ptr);
+ ERTS_MSACC_POP_STATE_X();
}
ERTS_ALC_INLINE
void *erts_alloc_fnf(ErtsAlcType_t type, Uint size)
{
- return (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)(
+ void *res;
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
+ res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
size);
+ ERTS_MSACC_POP_STATE_X();
+ return res;
}
ERTS_ALC_INLINE
void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size)
{
- return (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)(
+ void *res;
+ ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC);
+ res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)(
ERTS_ALC_T2N(type),
erts_allctrs[ERTS_ALC_T2A(type)].extra,
ptr,
size);
+ ERTS_MSACC_POP_STATE_X();
+ return res;
}
ERTS_ALC_INLINE
@@ -281,6 +307,28 @@ int erts_is_allctr_wrapper_prelocked(void)
&& !!erts_tsd_get(erts_allctr_prelock_tsd_key); /* by me */
}
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+
+ERTS_ALC_FORCE_INLINE
+int erts_is_in_literal_range(void* ptr)
+{
+#if defined(ARCH_32)
+ Uint ix = (UWord)ptr >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+ return erts_literal_vspace_map[ix / ERTS_VSPACE_WORD_BITS]
+ & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+
+#elif defined(ARCH_64)
+ extern char* erts_literals_start;
+ extern UWord erts_literals_size;
+ return ErtsInArea(ptr, erts_literals_start, erts_literals_size);
+#else
+# error No ARCH_xx
+#endif
+}
+
+#endif /* ERTS_HAVE_IS_IN_LITERAL_RANGE */
+
#endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */
#define ERTS_ALC_GET_THR_IX() ((int) erts_get_scheduler_id())
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index b1d511ab78..2932adca84 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -86,11 +86,7 @@ allocator LONG_LIVED true ll_alloc
allocator EHEAP true eheap_alloc
allocator ETS true ets_alloc
allocator FIXED_SIZE true fix_alloc
-
-+if halfword
-allocator LONG_LIVED_LOW true ll_low_alloc
-allocator STANDARD_LOW true std_low_alloc
-+endif
+allocator LITERAL true literal_alloc
+else # Non smp build
@@ -101,18 +97,14 @@ allocator LONG_LIVED false ll_alloc
allocator EHEAP false eheap_alloc
allocator ETS false ets_alloc
allocator FIXED_SIZE false fix_alloc
-
-+if halfword
-allocator LONG_LIVED_LOW false ll_low_alloc
-allocator STANDARD_LOW false std_low_alloc
-+endif
+allocator LITERAL false literal_alloc
+endif
allocator BINARY true binary_alloc
allocator DRIVER true driver_alloc
-
+allocator TEST true test_alloc
# --- Class declarations -----------------------------------------------------
#
@@ -160,6 +152,8 @@ type OLD_HEAP EHEAP PROCESSES old_heap
type HEAP_FRAG EHEAP PROCESSES heap_frag
type TMP_HEAP TEMPORARY PROCESSES tmp_heap
type MSG_REF FIXED_SIZE PROCESSES msg_ref
+type MSG EHEAP PROCESSES message
+type MSGQ_CHNG SHORT_LIVED PROCESSES messages_queue_change
type MSG_ROOTS TEMPORARY PROCESSES msg_roots
type ROOTSET TEMPORARY PROCESSES root_set
type LOADER_TMP TEMPORARY CODE loader_tmp
@@ -349,33 +343,11 @@ type SSB SHORT_LIVED PROCESSES ssb
+endif
-
-+if halfword
-
-type DDLL_PROCESS STANDARD_LOW SYSTEM ddll_processes
-type MONITOR_LH STANDARD_LOW PROCESSES monitor_lh
-type NLINK_LH STANDARD_LOW PROCESSES nlink_lh
-type CODE LONG_LIVED_LOW CODE code
-type DB_HEIR_DATA STANDARD_LOW ETS db_heir_data
-type DB_MS_PSDO_PROC LONG_LIVED_LOW ETS db_match_pseudo_proc
-type SCHDLR_DATA LONG_LIVED_LOW SYSTEM scheduler_data
-type LL_TEMP_TERM LONG_LIVED_LOW SYSTEM ll_temp_term
-
-type NIF_TRAP_EXPORT STANDARD_LOW CODE nif_trap_export_entry
-type EXPORT LONG_LIVED_LOW CODE export_entry
-type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh
-type NLINK_SH STANDARD_LOW PROCESSES nlink_sh
-type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request
-type SCHED_WTIME_REQ STANDARD_LOW SYSTEM sched_wall_time_request
-type GC_INFO_REQ STANDARD_LOW SYSTEM gc_info_request
-type PORT_DATA_HEAP STANDARD_LOW SYSTEM port_data_heap
-
-+else # "fullword"
-
type DDLL_PROCESS STANDARD SYSTEM ddll_processes
type MONITOR_LH STANDARD PROCESSES monitor_lh
type NLINK_LH STANDARD PROCESSES nlink_lh
type CODE LONG_LIVED CODE code
+type LITERAL LITERAL CODE literal
type DB_HEIR_DATA STANDARD ETS db_heir_data
type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc
type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data
@@ -389,9 +361,8 @@ type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request
type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request
type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request
type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap
-
-+endif
-
+type MSACC DRIVER SYSTEM microstate_accounting
+type SYS_CHECK_REQ SHORT_LIVED SYSTEM system_check_request
#
# Types used by system specific code
@@ -430,21 +401,6 @@ type SYS_WRITE_BUF BINARY SYSTEM sys_write_buf
+endif
-+if ose
-
-type SYS_READ_BUF TEMPORARY SYSTEM sys_read_buf
-type FD_TAB LONG_LIVED SYSTEM fd_tab
-type FD_ENTRY_BUF STANDARD SYSTEM fd_entry_buf
-type FD_SIG_LIST SHORT_LIVED SYSTEM fd_sig_list
-type DRV_EV STANDARD SYSTEM driver_event
-type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path
-type ENVIRONMENT TEMPORARY SYSTEM environment
-type PUTENV_STR SYSTEM SYSTEM putenv_string
-type PRT_REP_EXIT STANDARD SYSTEM port_report_exit
-
-+endif
-
-
+if win32
type DRV_DATA_BUF SYSTEM SYSTEM drv_data_buf
@@ -456,4 +412,7 @@ type CON_VPRINTF_BUF TEMPORARY SYSTEM con_vprintf_buf
+endif
+# This type should only be used for test
+type TEST TEST SYSTEM testing
+
# ----------------------------------------------------------------------------
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index 236ee35d18..5e7dd7cce8 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -751,12 +751,77 @@ internal_free(void *ptr)
#endif
+#ifdef ARCH_32
+
+/*
+ * Bit vector for the entire 32-bit virtual address space
+ * with one bit for each super aligned memory segment.
+ */
+
+#define VSPACE_MAP_BITS (1 << (32 - ERTS_MMAP_SUPERALIGNED_BITS))
+#define VSPACE_MAP_SZ (VSPACE_MAP_BITS / ERTS_VSPACE_WORD_BITS)
+
+static ERTS_INLINE void set_bit(UWord* map, Uint ix)
+{
+ ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+ map[ix / ERTS_VSPACE_WORD_BITS]
+ |= ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+static ERTS_INLINE void clr_bit(UWord* map, Uint ix)
+{
+ ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+ map[ix / ERTS_VSPACE_WORD_BITS]
+ &= ~((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+static ERTS_INLINE int is_bit_set(UWord* map, Uint ix)
+{
+ ASSERT(ix / ERTS_VSPACE_WORD_BITS < VSPACE_MAP_SZ);
+ return map[ix / ERTS_VSPACE_WORD_BITS]
+ & ((UWord)1 << (ix % ERTS_VSPACE_WORD_BITS));
+}
+
+UWord erts_literal_vspace_map[VSPACE_MAP_SZ];
+
+static void set_literal_range(void* start, Uint size)
+{
+ Uint ix = (UWord)start >> ERTS_MMAP_SUPERALIGNED_BITS;
+ Uint n = size >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+ ASSERT(!((UWord)start & ERTS_INV_SUPERALIGNED_MASK));
+ ASSERT(!((UWord)size & ERTS_INV_SUPERALIGNED_MASK));
+ ASSERT(n);
+ while (n--) {
+ ASSERT(!is_bit_set(erts_literal_vspace_map, ix));
+ set_bit(erts_literal_vspace_map, ix);
+ ix++;
+ }
+}
+
+static void clear_literal_range(void* start, Uint size)
+{
+ Uint ix = (UWord)start >> ERTS_MMAP_SUPERALIGNED_BITS;
+ Uint n = size >> ERTS_MMAP_SUPERALIGNED_BITS;
+
+ ASSERT(!((UWord)start & ERTS_INV_SUPERALIGNED_MASK));
+ ASSERT(!((UWord)size & ERTS_INV_SUPERALIGNED_MASK));
+ ASSERT(n);
+ while (n--) {
+ ASSERT(is_bit_set(erts_literal_vspace_map, ix));
+ clr_bit(erts_literal_vspace_map, ix);
+ ix++;
+ }
+}
+
+#endif /* ARCH_32 */
+
/* mseg ... */
#if HAVE_ERTS_MSEG
-static ERTS_INLINE void *
-alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+void*
+erts_alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
{
void *res;
UWord size = (UWord) *size_p;
@@ -766,8 +831,9 @@ alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
return res;
}
-static ERTS_INLINE void *
-alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p)
+void*
+erts_alcu_mseg_realloc(Allctr_t *allctr, void *seg,
+ Uint old_size, Uint *new_size_p)
{
void *res;
UWord new_size = (UWord) *new_size_p;
@@ -778,17 +844,103 @@ alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p)
return res;
}
-static ERTS_INLINE void
-alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
+void
+erts_alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags)
{
erts_mseg_dealloc_opt(allctr->alloc_no, seg, (UWord) size, flags, &allctr->mseg_opt);
INC_CC(allctr->calls.mseg_dealloc);
}
-#endif
-static ERTS_INLINE void *
-alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
+#if defined(ARCH_32)
+
+void*
+erts_alcu_literal_32_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+{
+ void* res;
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ res = erts_alcu_mseg_alloc(allctr, size_p, flags);
+ if (res)
+ set_literal_range(res, *size_p);
+ return res;
+}
+
+void*
+erts_alcu_literal_32_mseg_realloc(Allctr_t *allctr, void *seg,
+ Uint old_size, Uint *new_size_p)
+{
+ void* res;
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ if (seg && old_size)
+ clear_literal_range(seg, old_size);
+ res = erts_alcu_mseg_realloc(allctr, seg, old_size, new_size_p);
+ if (res)
+ set_literal_range(res, *new_size_p);
+ return res;
+}
+
+void
+erts_alcu_literal_32_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
+ Uint flags)
+{
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ erts_alcu_mseg_dealloc(allctr, seg, size, flags);
+
+ clear_literal_range(seg, size);
+}
+
+#elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+
+void*
+erts_alcu_literal_64_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags)
+{
+ void* res;
+ UWord size = (UWord) *size_p;
+ Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY;
+ if (flags & ERTS_MSEG_FLG_2POW)
+ mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+
+ res = erts_mmap(&erts_literal_mmapper, mmap_flags, &size);
+ *size_p = (Uint)size;
+ INC_CC(allctr->calls.mseg_alloc);
+ return res;
+}
+
+void*
+erts_alcu_literal_64_mseg_realloc(Allctr_t *allctr, void *seg,
+ Uint old_size, Uint *new_size_p)
+{
+ void *res;
+ UWord new_size = (UWord) *new_size_p;
+ res = erts_mremap(&erts_literal_mmapper, ERTS_MSEG_FLG_NONE, seg, old_size, &new_size);
+ *new_size_p = (Uint) new_size;
+ INC_CC(allctr->calls.mseg_realloc);
+ return res;
+}
+
+void
+erts_alcu_literal_64_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size,
+ Uint flags)
+{
+ Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY;
+ if (flags & ERTS_MSEG_FLG_2POW)
+ mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
+
+ erts_munmap(&erts_literal_mmapper, mmap_flags, seg, (UWord)size);
+ INC_CC(allctr->calls.mseg_dealloc);
+}
+#endif /* ARCH_64 && ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */
+
+#endif /* HAVE_ERTS_MSEG */
+
+void*
+erts_alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
{
void *res;
#if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
@@ -803,8 +955,8 @@ alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
return res;
}
-static ERTS_INLINE void *
-alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
+void*
+erts_alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
{
void *res;
@@ -824,8 +976,8 @@ alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int supe
return res;
}
-static ERTS_INLINE void
-alcu_sys_free(Allctr_t *allctr, void *ptr, int superalign)
+void
+erts_alcu_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign)
{
#if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC
if (superalign)
@@ -838,6 +990,49 @@ alcu_sys_free(Allctr_t *allctr, void *ptr, int superalign)
erts_mtrace_crr_free(allctr->alloc_no, ERTS_ALC_A_SYSTEM, ptr);
}
+#ifdef ARCH_32
+
+void*
+erts_alcu_literal_32_sys_alloc(Allctr_t *allctr, Uint size, int superalign)
+{
+ void* res;
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ res = erts_alcu_sys_alloc(allctr, size, 1);
+ if (res)
+ set_literal_range(res, size);
+ return res;
+}
+
+void*
+erts_alcu_literal_32_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign)
+{
+ void* res;
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ if (ptr && old_size)
+ clear_literal_range(ptr, old_size);
+ res = erts_alcu_sys_realloc(allctr, ptr, size, old_size, 1);
+ if (res)
+ set_literal_range(res, size);
+ return res;
+}
+
+void
+erts_alcu_literal_32_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign)
+{
+ ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL
+ && !allctr->t && allctr->thread_safe);
+
+ erts_alcu_sys_dealloc(allctr, ptr, size, 1);
+
+ clear_literal_range(ptr, size);
+}
+
+#endif /* ARCH_32 */
+
static Uint
get_next_mbc_size(Allctr_t *allctr)
{
@@ -1437,6 +1632,16 @@ erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs)
static void dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, int superaligned);
+static ERTS_INLINE void
+dealloc_mbc(Allctr_t *allctr, Carrier_t *crr)
+{
+ ASSERT(IS_MB_CARRIER(crr));
+ if (allctr->destroying_mbc)
+ allctr->destroying_mbc(allctr, crr);
+
+ dealloc_carrier(allctr, crr, 1);
+}
+
#ifdef ERTS_SMP
static ERTS_INLINE Allctr_t*
@@ -2074,7 +2279,7 @@ mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp)
if (!blk) {
blk = create_carrier(allctr, get_blk_sz, CFLG_MBC);
-#if !HALFWORD_HEAP && !ERTS_SUPER_ALIGNED_MSEG_ONLY
+#if !ERTS_SUPER_ALIGNED_MSEG_ONLY
if (!blk) {
/* Emergency! We couldn't create the carrier as we wanted.
Try to place it in a sys_alloced sbc. */
@@ -3149,7 +3354,7 @@ cpool_fetch(Allctr_t *allctr, UWord size)
cpool_entrance = sentinel;
cpdp = cpool_aint2cpd(cpool_read(&cpool_entrance->prev));
if (cpdp == sentinel)
- return NULL;
+ goto check_dc_list;
}
has_passed_sentinel = 0;
@@ -3160,18 +3365,18 @@ cpool_fetch(Allctr_t *allctr, UWord size)
if (cpool_entrance == sentinel) {
cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev));
if (cpdp == sentinel)
- return NULL;
+ break;
}
i = 0; /* Last one to inspect */
}
else if (cpdp == sentinel) {
if (has_passed_sentinel) {
/* We been here before. cpool_entrance must have been removed */
- return NULL;
+ break;
}
cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev));
if (cpdp == sentinel)
- return NULL;
+ break;
has_passed_sentinel = 1;
}
crr = (Carrier_t *)(((char *)cpdp) - offsetof(Carrier_t, cpool));
@@ -3195,10 +3400,12 @@ cpool_fetch(Allctr_t *allctr, UWord size)
return NULL;
}
+check_dc_list:
/* Last; check our own pending dealloc carrier list... */
crr = allctr->cpool.dc_list.last;
while (crr) {
if (erts_atomic_read_nob(&crr->cpool.max_size) >= size) {
+ Block_t* blk;
unlink_carrier(&allctr->cpool.dc_list, crr);
#ifdef ERTS_ALC_CPOOL_DEBUG
ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_xchg_nob(&crr->allctr,
@@ -3207,6 +3414,9 @@ cpool_fetch(Allctr_t *allctr, UWord size)
#else
erts_smp_atomic_set_nob(&crr->allctr, ((erts_aint_t) allctr));
#endif
+ blk = MBC_TO_FIRST_BLK(allctr, crr);
+ ASSERT(FBLK_TO_MBC(blk) == crr);
+ allctr->link_free_block(allctr, blk);
return crr;
}
crr = crr->prev;
@@ -3237,7 +3447,7 @@ check_pending_dealloc_carrier(Allctr_t *allctr,
dcrr = crr;
crr = crr->next;
- dealloc_carrier(allctr, dcrr, 1);
+ dealloc_mbc(allctr, dcrr);
i++;
} while (crr && i < ERTS_ALC_MAX_DEALLOC_CARRIER);
@@ -3268,18 +3478,20 @@ static void
schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
{
Allctr_t *orig_allctr;
+ Block_t *blk;
int check_pending_dealloc;
erts_aint_t max_size;
+ ASSERT(IS_MB_CARRIER(crr));
+
if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) {
- dealloc_carrier(allctr, crr, 1);
+ dealloc_mbc(allctr, crr);
return;
}
orig_allctr = crr->cpool.orig_allctr;
if (allctr != orig_allctr) {
- Block_t *blk = MBC_TO_FIRST_BLK(allctr, crr);
int cinit = orig_allctr->dd.ix - allctr->dd.ix;
/*
@@ -3296,6 +3508,7 @@ schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
* since the block is an mbc block that is free and last
* in the carrier.
*/
+ blk = MBC_TO_FIRST_BLK(allctr, crr);
ERTS_ALC_CPOOL_ASSERT(IS_FREE_LAST_MBC_BLK(blk));
ERTS_ALC_CPOOL_ASSERT(IS_MBC_FIRST_ABLK(allctr, blk));
@@ -3315,11 +3528,13 @@ schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr)
if (crr->cpool.thr_prgr == ERTS_THR_PRGR_INVALID
|| erts_thr_progress_has_reached(crr->cpool.thr_prgr)) {
- dealloc_carrier(allctr, crr, 1);
+ dealloc_mbc(allctr, crr);
return;
}
- max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr);
+ blk = MBC_TO_FIRST_BLK(allctr, crr);
+ ASSERT(IS_FREE_LAST_MBC_BLK(blk));
+ max_size = (erts_aint_t) MBC_FBLK_SZ(blk);
erts_atomic_set_nob(&crr->cpool.max_size, max_size);
crr->next = NULL;
@@ -3511,8 +3726,7 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
int is_mseg = 0;
#endif
- if (HALFWORD_HEAP
- || (ERTS_SUPER_ALIGNED_MSEG_ONLY && (flags & CFLG_MBC))
+ if ((ERTS_SUPER_ALIGNED_MSEG_ONLY && (flags & CFLG_MBC))
|| !allow_sys_alloc_carriers) {
flags |= CFLG_FORCE_MSEG;
flags &= ~CFLG_FORCE_SYS_ALLOC;
@@ -3520,6 +3734,8 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
return NULL;
#endif
}
+ flags |= allctr->crr_set_flgs;
+ flags &= ~allctr->crr_clr_flgs;
ASSERT((flags & CFLG_SBC && !(flags & CFLG_MBC))
|| (flags & CFLG_MBC && !(flags & CFLG_SBC)));
@@ -3535,7 +3751,21 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
return NULL;
}
- blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz);
+ if (flags & CFLG_MAIN_CARRIER) {
+ ASSERT(flags & CFLG_MBC);
+ ASSERT(flags & CFLG_NO_CPOOL);
+ ASSERT(umem_sz == allctr->main_carrier_size);
+ ERTS_UNDEF(blk_sz, 0);
+
+ if (allctr->main_carrier_size < allctr->min_mbc_size)
+ allctr->main_carrier_size = allctr->min_mbc_size;
+ crr_sz = bcrr_sz = allctr->main_carrier_size;
+ }
+ else {
+ ERTS_UNDEF(bcrr_sz, 0);
+ ERTS_UNDEF(crr_sz, 0);
+ blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz);
+ }
#ifdef ERTS_SMP
allctr->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON;
@@ -3581,13 +3811,15 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
mseg_flags = ERTS_MSEG_FLG_NONE;
}
else {
- crr_sz = (*allctr->get_next_mbc_size)(allctr);
- if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz)
- crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz;
- mseg_flags = ERTS_MSEG_FLG_2POW;
+ if (!(flags & CFLG_MAIN_CARRIER)) {
+ crr_sz = (*allctr->get_next_mbc_size)(allctr);
+ if (crr_sz < MBC_HEADER_SIZE(allctr) + blk_sz)
+ crr_sz = MBC_HEADER_SIZE(allctr) + blk_sz;
+ }
+ mseg_flags = ERTS_MSEG_FLG_2POW;
}
- crr = (Carrier_t *) alcu_mseg_alloc(allctr, &crr_sz, mseg_flags);
+ crr = (Carrier_t *) allctr->mseg_alloc(allctr, &crr_sz, mseg_flags);
if (!crr) {
have_tried_mseg = 1;
if (!(have_tried_sys_alloc || flags & CFLG_FORCE_MSEG))
@@ -3619,23 +3851,22 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags)
if (flags & CFLG_SBC) {
bcrr_sz = blk_sz + SBC_HEADER_SIZE;
}
- else {
+ else if (!(flags & CFLG_MAIN_CARRIER)) {
bcrr_sz = MBC_HEADER_SIZE(allctr) + blk_sz;
- if (!(flags & CFLG_MAIN_CARRIER)
- && bcrr_sz < allctr->smallest_mbc_size)
- bcrr_sz = allctr->smallest_mbc_size;
+ if (bcrr_sz < allctr->smallest_mbc_size)
+ bcrr_sz = allctr->smallest_mbc_size;
}
crr_sz = (flags & CFLG_FORCE_SIZE
? UNIT_CEILING(bcrr_sz)
: SYS_ALLOC_CARRIER_CEILING(bcrr_sz));
- crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
+ crr = (Carrier_t *) allctr->sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
if (!crr) {
if (crr_sz > UNIT_CEILING(bcrr_sz)) {
crr_sz = UNIT_CEILING(bcrr_sz);
- crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
+ crr = (Carrier_t *) allctr->sys_alloc(allctr, crr_sz, flags & CFLG_MBC);
}
if (!crr) {
#if HAVE_ERTS_MSEG
@@ -3734,7 +3965,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
new_crr_sz = new_blk_sz + SBC_HEADER_SIZE;
new_crr_sz = ERTS_SACRR_UNIT_CEILING(new_crr_sz);
- new_crr = (Carrier_t *) alcu_mseg_realloc(allctr,
+ new_crr = (Carrier_t *) allctr->mseg_realloc(allctr,
old_crr,
old_crr_sz,
&new_crr_sz);
@@ -3749,11 +3980,6 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
DEBUG_SAVE_ALIGNMENT(new_crr);
return new_blk;
}
-#if HALFWORD_HEAP
- /* Old carrier unchanged; restore stat */
- STAT_MSEG_SBC_ALLOC(allctr, old_crr_sz, old_blk_sz);
- return NULL;
-#endif
create_flags |= CFLG_FORCE_SYS_ALLOC; /* since mseg_realloc()
failed */
}
@@ -3764,7 +3990,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
(void *) BLK2UMEM(old_blk),
MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ);
unlink_carrier(&allctr->sbc_list, old_crr);
- alcu_mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE);
+ allctr->mseg_dealloc(allctr, old_crr, old_crr_sz, ERTS_MSEG_FLG_NONE);
}
else {
/* Old carrier unchanged; restore stat */
@@ -3781,7 +4007,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
? UNIT_CEILING(new_bcrr_sz)
: SYS_ALLOC_CARRIER_CEILING(new_bcrr_sz));
- new_crr = (Carrier_t *) alcu_sys_realloc(allctr,
+ new_crr = (Carrier_t *) allctr->sys_realloc(allctr,
(void *) old_crr,
new_crr_sz,
old_crr_sz,
@@ -3802,7 +4028,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
else if (new_crr_sz > UNIT_CEILING(new_bcrr_sz)) {
new_crr_sz = new_blk_sz + SBC_HEADER_SIZE;
new_crr_sz = UNIT_CEILING(new_crr_sz);
- new_crr = (Carrier_t *) alcu_sys_realloc(allctr,
+ new_crr = (Carrier_t *) allctr->sys_realloc(allctr,
(void *) old_crr,
new_crr_sz,
old_crr_sz,
@@ -3825,7 +4051,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags)
(void *) BLK2UMEM(old_blk),
MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ);
unlink_carrier(&allctr->sbc_list, old_crr);
- alcu_sys_free(allctr, old_crr, 0);
+ allctr->sys_dealloc(allctr, old_crr, CARRIER_SZ(old_crr), 0);
}
else {
/* Old carrier unchanged; restore... */
@@ -3841,13 +4067,13 @@ dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, int superaligned)
{
#if HAVE_ERTS_MSEG
if (IS_MSEG_CARRIER(crr))
- alcu_mseg_dealloc(allctr, crr, CARRIER_SZ(crr),
+ allctr->mseg_dealloc(allctr, crr, CARRIER_SZ(crr),
(superaligned
? ERTS_MSEG_FLG_2POW
: ERTS_MSEG_FLG_NONE));
else
#endif
- alcu_sys_free(allctr, crr, superaligned);
+ allctr->sys_dealloc(allctr, crr, CARRIER_SZ(crr), superaligned);
}
static void
@@ -3894,9 +4120,6 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp)
}
#endif
- if (allctr->destroying_mbc)
- (*allctr->destroying_mbc)(allctr, crr);
-
#ifdef ERTS_SMP
if (busy_pcrr_pp && *busy_pcrr_pp) {
ERTS_ALC_CPOOL_ASSERT(*busy_pcrr_pp == crr);
@@ -3920,12 +4143,15 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp)
else
#endif
STAT_SYS_ALLOC_MBC_FREE(allctr, crr_sz);
+
+ if (allctr->remove_mbc)
+ allctr->remove_mbc(allctr, crr);
}
#ifdef ERTS_SMP
schedule_dealloc_carrier(allctr, crr);
#else
- dealloc_carrier(allctr, crr, 1);
+ dealloc_mbc(allctr, crr);
#endif
}
}
@@ -3942,9 +4168,6 @@ static struct {
Eterm e;
Eterm t;
Eterm ramv;
-#if HALFWORD_HEAP
- Eterm low;
-#endif
Eterm sbct;
#if HAVE_ERTS_MSEG
Eterm asbcst;
@@ -4035,9 +4258,6 @@ init_atoms(Allctr_t *allctr)
AM_INIT(e);
AM_INIT(t);
AM_INIT(ramv);
-#if HALFWORD_HEAP
- AM_INIT(low);
-#endif
AM_INIT(sbct);
#if HAVE_ERTS_MSEG
AM_INIT(asbcst);
@@ -4498,7 +4718,7 @@ make_name_atoms(Allctr_t *allctr)
size_t prefix_len = strlen(allctr->name_prefix);
if (prefix_len > MAX_ATOM_CHARACTERS + sizeof(realloc) - 1)
- erl_exit(1,"Too long allocator name: %salloc\n",allctr->name_prefix);
+ erts_exit(ERTS_ERROR_EXIT,"Too long allocator name: %salloc\n",allctr->name_prefix);
memcpy((void *) buf, (void *) allctr->name_prefix, prefix_len);
@@ -4643,9 +4863,6 @@ info_options(Allctr_t *allctr,
"option e: true\n"
"option t: %s\n"
"option ramv: %s\n"
-#if HALFWORD_HEAP
- "option low: %s\n"
-#endif
"option sbct: %beu\n"
#if HAVE_ERTS_MSEG
"option asbcst: %bpu\n"
@@ -4664,9 +4881,6 @@ info_options(Allctr_t *allctr,
"option acul: %d\n",
topt,
allctr->ramv ? "true" : "false",
-#if HALFWORD_HEAP
- allctr->mseg_opt.low_mem ? "true" : "false",
-#endif
allctr->sbc_threshold,
#if HAVE_ERTS_MSEG
allctr->mseg_opt.abs_shrink_th,
@@ -4729,9 +4943,6 @@ info_options(Allctr_t *allctr,
add_2tup(hpp, szp, &res,
am.sbct,
bld_uint(hpp, szp, allctr->sbc_threshold));
-#if HALFWORD_HEAP
- add_2tup(hpp, szp, &res, am.low, allctr->mseg_opt.low_mem ? am_true : am_false);
-#endif
add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false);
add_2tup(hpp, szp, &res, am.t, (allctr->t ? am_true : am_false));
add_2tup(hpp, szp, &res, am.e, am_true);
@@ -5126,6 +5337,11 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size)
{
void *res;
+#ifdef ERTS_SMP
+ ASSERT(!"This is not thread safe");
+#elif defined(USE_THREADS)
+ ASSERT(erts_equal_tids(erts_main_thread, erts_thr_self()));
+#endif
res = do_erts_alcu_alloc(type, extra, size);
DEBUG_CHECK_ALIGNMENT(res);
return res;
@@ -5416,11 +5632,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type,
Block_t *new_blk;
if(IS_SBC_BLK(blk)) {
do_carrier_resize:
-#if HALFWORD_HEAP
- new_blk = resize_carrier(allctr, blk, size, CFLG_SBC | CFLG_FORCE_MSEG);
-#else
new_blk = resize_carrier(allctr, blk, size, CFLG_SBC);
-#endif
res = new_blk ? BLK2UMEM(new_blk) : NULL;
}
else if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE)
@@ -5700,7 +5912,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
/* erts_alcu_start assumes that allctr has been zeroed */
if (((UWord)allctr & ERTS_CRR_ALCTR_FLG_MASK) != 0) {
- erl_exit(ERTS_ABORT_EXIT, "%s:%d:erts_alcu_start: Alignment error\n",
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d:erts_alcu_start: Alignment error\n",
__FILE__, __LINE__);
}
@@ -5714,11 +5926,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
#ifdef ERTS_SMP
if (init->tspec || init->tpref)
allctr->mseg_opt.sched_spec = 1;
-#endif
-# if HALFWORD_HEAP
- allctr->mseg_opt.low_mem = init->low_mem;
-# endif
-#endif
+#endif /* ERTS_SMP */
+#endif /* HAVE_ERTS_MSEG */
allctr->name_prefix = init->name_prefix;
if (!allctr->name_prefix)
@@ -5867,24 +6076,59 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init)
+ ABLK_HDR_SZ)
- ABLK_HDR_SZ);
+ if (init->sys_alloc) {
+ ASSERT(init->sys_realloc && init->sys_dealloc);
+ allctr->sys_alloc = init->sys_alloc;
+ allctr->sys_realloc = init->sys_realloc;
+ allctr->sys_dealloc = init->sys_dealloc;
+ }
+ else {
+ ASSERT(!init->sys_realloc && !init->sys_dealloc);
+ allctr->sys_alloc = &erts_alcu_sys_alloc;
+ allctr->sys_realloc = &erts_alcu_sys_realloc;
+ allctr->sys_dealloc = &erts_alcu_sys_dealloc;
+ }
+#if HAVE_ERTS_MSEG
+ if (init->mseg_alloc) {
+ ASSERT(init->mseg_realloc && init->mseg_dealloc);
+ allctr->mseg_alloc = init->mseg_alloc;
+ allctr->mseg_realloc = init->mseg_realloc;
+ allctr->mseg_dealloc = init->mseg_dealloc;
+ }
+ else {
+ ASSERT(!init->mseg_realloc && !init->mseg_dealloc);
+ allctr->mseg_alloc = &erts_alcu_mseg_alloc;
+ allctr->mseg_realloc = &erts_alcu_mseg_realloc;
+ allctr->mseg_dealloc = &erts_alcu_mseg_dealloc;
+ }
+ /* If a custom carrier alloc function is specified, make sure it's used */
+ if (init->mseg_alloc && !init->sys_alloc) {
+ allctr->crr_set_flgs = CFLG_FORCE_MSEG;
+ allctr->crr_clr_flgs = CFLG_FORCE_SYS_ALLOC;
+ }
+ else if (!init->mseg_alloc && init->sys_alloc) {
+ allctr->crr_set_flgs = CFLG_FORCE_SYS_ALLOC;
+ allctr->crr_clr_flgs = CFLG_FORCE_MSEG;
+ }
+#endif
+
if (allctr->main_carrier_size) {
Block_t *blk;
blk = create_carrier(allctr,
allctr->main_carrier_size,
- CFLG_MBC
+ (ERTS_SUPER_ALIGNED_MSEG_ONLY
+ ? CFLG_FORCE_MSEG : CFLG_FORCE_SYS_ALLOC)
+ | CFLG_MBC
| CFLG_FORCE_SIZE
| CFLG_NO_CPOOL
-#if !HALFWORD_HEAP && !ERTS_SUPER_ALIGNED_MSEG_ONLY
- | CFLG_FORCE_SYS_ALLOC
-#endif
| CFLG_MAIN_CARRIER);
if (!blk) {
#ifdef USE_THREADS
if (allctr->thread_safe)
erts_mtx_destroy(&allctr->mutex);
#endif
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Failed to create main carrier for %salloc\n",
init->name_prefix);
}
@@ -6029,7 +6273,7 @@ erts_alcu_test(UWord op, UWord a1, UWord a2)
case 0x019: return (UWord) PREV_BLK((Block_t *) a1);
case 0x01a: return (UWord) IS_MBC_FIRST_BLK((Allctr_t*)a1, (Block_t *) a2);
case 0x01b: return (UWord) sizeof(Unit_t);
- case 0x01c: return (unsigned long) BLK_TO_MBC((Block_t*) a1);
+ case 0x01c: return (UWord) BLK_TO_MBC((Block_t*) a1);
case 0x01d: ((Allctr_t*) a1)->add_mbc((Allctr_t*)a1, (Carrier_t*)a2); break;
case 0x01e: ((Allctr_t*) a1)->remove_mbc((Allctr_t*)a1, (Carrier_t*)a2); break;
#ifdef ERTS_SMP
@@ -6054,6 +6298,16 @@ erts_alcu_test(UWord op, UWord a1, UWord a2)
case 0x023: return (UWord) 0;
case 0x024: return (UWord) 0;
#endif
+ case 0x025: /* UMEM2BLK_TEST*/
+#ifdef DEBUG
+# ifdef HARD_DEBUG
+ return (UWord)UMEM2BLK(a1-3*sizeof(UWord));
+# else
+ return (UWord)UMEM2BLK(a1-2*sizeof(UWord));
+# endif
+#else
+ return (UWord)UMEM2BLK(a1);
+#endif
default: ASSERT(0); return ~((UWord) 0);
}
@@ -6090,7 +6344,7 @@ erts_alcu_verify_unused(Allctr_t *allctr)
if (no) {
UWord sz = allctr->sbcs.blocks.curr.size;
sz += allctr->mbcs.blocks.curr.size;
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%salloc() used when expected to be unused!\n"
"Total amount of blocks allocated: %bpu\n"
"Total amount of bytes allocated: %bpu\n",
diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h
index df1f0aa65a..b7d717ed23 100644
--- a/erts/emulator/beam/erl_alloc_util.h
+++ b/erts/emulator/beam/erl_alloc_util.h
@@ -24,6 +24,12 @@
#define ERTS_ALCU_VSN_STR "3.0"
#include "erl_alloc_types.h"
+#ifdef USE_THREADS
+#define ERL_THREADS_EMU_INTERNAL__
+#include "erl_threads.h"
+#endif
+
+#include "erl_mseg.h"
#define ERTS_AU_PREF_ALLOC_BITS 11
#define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS)
@@ -45,7 +51,6 @@ typedef struct {
int tspec;
int tpref;
int ramv;
- int low_mem; /* HALFWORD only */
UWord sbct;
UWord asbcst;
UWord rsbcst;
@@ -61,6 +66,15 @@ typedef struct {
void *fix;
size_t *fix_type_size;
+
+#if HAVE_ERTS_MSEG
+ void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags);
+ void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+ void (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags);
+#endif
+ void* (*sys_alloc)(Allctr_t *allctr, Uint size, int superalign);
+ void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign);
+ void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign);
} AllctrInit_t;
typedef struct {
@@ -90,7 +104,6 @@ typedef struct {
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
0, /* (bool) ramv: realloc always moves */\
- 0, /* (bool) low_mem: HALFWORD only */\
512*1024, /* (bytes) sbct: sbc threshold */\
2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\
20, /* (%) rsbcst: rel sbc shrink threshold */\
@@ -125,7 +138,6 @@ typedef struct {
0, /* (bool) tspec: thread specific */\
0, /* (bool) tpref: thread preferred */\
0, /* (bool) ramv: realloc always moves */\
- 0, /* (bool) low_mem: HALFWORD only */\
64*1024, /* (bytes) sbct: sbc threshold */\
2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\
20, /* (%) rsbcst: rel sbc shrink threshold */\
@@ -176,20 +188,44 @@ void erts_alcu_check_delayed_dealloc(Allctr_t *, int, int *, ErtsThrPrgrVal *
#endif
erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
+#ifdef ARCH_32
+extern UWord erts_literal_vspace_map[];
+# define ERTS_VSPACE_WORD_BITS (sizeof(UWord)*8)
+#endif
+
+void* erts_alcu_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void erts_alcu_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+
+#if HAVE_ERTS_MSEG
+# if defined(ARCH_32)
+void* erts_alcu_literal_32_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_literal_32_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void erts_alcu_literal_32_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+
+# elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+void* erts_alcu_literal_64_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags);
+void* erts_alcu_literal_64_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+void erts_alcu_literal_64_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags);
+# endif
+#endif /* HAVE_ERTS_MSEG */
+
+void* erts_alcu_sys_alloc(Allctr_t*, Uint size, int superalign);
+void* erts_alcu_sys_realloc(Allctr_t*, void *ptr, Uint size, Uint old_size, int superalign);
+void erts_alcu_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign);
+#ifdef ARCH_32
+void* erts_alcu_literal_32_sys_alloc(Allctr_t*, Uint size, int superalign);
+void* erts_alcu_literal_32_sys_realloc(Allctr_t*, void *ptr, Uint size, Uint old_size, int superalign);
+void erts_alcu_literal_32_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign);
#endif
+#endif /* !ERL_ALLOC_UTIL__ */
+
#if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__)
#define ERL_ALLOC_UTIL_IMPL__
#define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE (((Uint32) 1) << 0)
-#ifdef USE_THREADS
-#define ERL_THREADS_EMU_INTERNAL__
-#include "erl_threads.h"
-#endif
-
-#include "erl_mseg.h"
-
#undef ERTS_ALLOC_UTIL_HARD_DEBUG
#ifdef DEBUG
# if 0
@@ -223,7 +259,7 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t);
#if ERTS_HAVE_MSEG_SUPER_ALIGNED \
|| (!HAVE_ERTS_MSEG && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC)
-# ifndef MSEG_ALIGN_BITS
+# ifdef MSEG_ALIGN_BITS
# define ERTS_SUPER_ALIGN_BITS MSEG_ALIGN_BITS
# else
# define ERTS_SUPER_ALIGN_BITS 18
@@ -277,7 +313,7 @@ typedef struct ErtsDoubleLink_t_ {
typedef struct {
erts_atomic_t next;
erts_atomic_t prev;
- Allctr_t *orig_allctr;
+ Allctr_t *orig_allctr; /* read-only while carrier is alive */
ErtsThrPrgrVal thr_prgr;
erts_atomic_t max_size;
UWord abandon_limit;
@@ -501,6 +537,8 @@ struct Allctr_t_ {
Uint min_mbc_size;
Uint min_mbc_first_free_size;
Uint min_block_size;
+ UWord crr_set_flgs;
+ UWord crr_clr_flgs;
/* Carriers */
CarrierList_t mbc_list;
@@ -546,6 +584,15 @@ struct Allctr_t_ {
void (*remove_mbc) (Allctr_t *, Carrier_t *);
UWord (*largest_fblk_in_mbc) (Allctr_t *, Carrier_t *);
+#if HAVE_ERTS_MSEG
+ void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags);
+ void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p);
+ void (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags);
+#endif
+ void* (*sys_alloc)(Allctr_t *allctr, Uint size, int superalign);
+ void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign);
+ void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign);
+
void (*init_atoms) (void);
#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index 7c2a5c3323..5cd067ff54 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -209,7 +209,9 @@ static Block_t* aoff_get_free_block(Allctr_t *, Uint, Block_t *, Uint);
static void aoff_link_free_block(Allctr_t *, Block_t*);
static void aoff_unlink_free_block(Allctr_t *allctr, Block_t *del);
static void aoff_creating_mbc(Allctr_t*, Carrier_t*);
+#ifdef DEBUG
static void aoff_destroying_mbc(Allctr_t*, Carrier_t*);
+#endif
static void aoff_add_mbc(Allctr_t*, Carrier_t*);
static void aoff_remove_mbc(Allctr_t*, Carrier_t*);
static UWord aoff_largest_fblk_in_mbc(Allctr_t*, Carrier_t*);
@@ -271,7 +273,11 @@ erts_aoffalc_start(AOFFAllctr_t *alc,
allctr->get_next_mbc_size = NULL;
allctr->creating_mbc = aoff_creating_mbc;
+#ifdef DEBUG
allctr->destroying_mbc = aoff_destroying_mbc;
+#else
+ allctr->destroying_mbc = NULL;
+#endif
allctr->add_mbc = aoff_add_mbc;
allctr->remove_mbc = aoff_remove_mbc;
allctr->largest_fblk_in_mbc = aoff_largest_fblk_in_mbc;
@@ -885,17 +891,18 @@ static void aoff_creating_mbc(Allctr_t *allctr, Carrier_t *carrier)
HARD_CHECK_TREE(NULL, 0, *root, 0);
}
+#define IS_CRR_IN_TREE(CRR,ROOT) \
+ ((CRR)->rbt_node.parent || (ROOT) == &(CRR)->rbt_node)
+
+#ifdef DEBUG
static void aoff_destroying_mbc(Allctr_t *allctr, Carrier_t *carrier)
{
AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr;
AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier;
- AOFF_RBTree_t *root = alc->mbc_root;
- if (crr->rbt_node.parent || &crr->rbt_node == root) {
- aoff_remove_mbc(allctr, carrier);
- }
- /*else already removed */
+ ASSERT(!IS_CRR_IN_TREE(crr, alc->mbc_root));
}
+#endif
static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier)
{
@@ -903,6 +910,7 @@ static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier)
AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier;
AOFF_RBTree_t **root = &alc->mbc_root;
+ ASSERT(!IS_CRR_IN_TREE(crr, *root));
HARD_CHECK_TREE(NULL, 0, *root, 0);
/* Link carrier in address order tree
@@ -919,6 +927,10 @@ static void aoff_remove_mbc(Allctr_t *allctr, Carrier_t *carrier)
AOFF_RBTree_t **root = &alc->mbc_root;
ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(carrier));
+
+ if (!IS_CRR_IN_TREE(crr,*root))
+ return;
+
HARD_CHECK_TREE(NULL, 0, *root, 0);
rbt_delete(root, &crr->rbt_node);
@@ -1023,7 +1035,7 @@ info_options(Allctr_t *allctr,
if (hpp || szp) {
if (!atoms_initialized)
- erl_exit(1, "%s:%d: Internal error: Atoms not initialized",
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error: Atoms not initialized",
__FILE__, __LINE__);;
res = NIL;
diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c
index b8c5ef9b09..3671025d22 100644
--- a/erts/emulator/beam/erl_arith.c
+++ b/erts/emulator/beam/erl_arith.c
@@ -42,15 +42,8 @@
# define MAX(x, y) (((x) > (y)) ? (x) : (y))
#endif
-#if !HEAP_ON_C_STACK
-# define DECLARE_TMP(VariableName,N,P) \
- Eterm *VariableName = ((ERTS_PROC_GET_SCHDATA(P)->erl_arith_tmp_heap) + (2 * N))
-#else
-# define DECLARE_TMP(VariableName,N,P) \
- Eterm VariableName[2]
-#endif
-# define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp)))
-
+#define DECLARE_TMP(VariableName,N,P) Eterm VariableName[2]
+#define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp)))
static Eterm shift(Process* p, Eterm arg1, Eterm arg2, int right);
diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c
index f071898046..cdeeb5281b 100644
--- a/erts/emulator/beam/erl_async.c
+++ b/erts/emulator/beam/erl_async.c
@@ -167,7 +167,6 @@ async_ready_q(Uint sched_id)
#endif
-
void
erts_init_async(void)
{
@@ -401,13 +400,19 @@ static ERTS_INLINE void call_async_ready(ErtsAsync *a)
ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
#endif
if (!p) {
- if (a->async_free)
+ if (a->async_free) {
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT);
a->async_free(a->async_data);
+ ERTS_MSACC_POP_STATE();
+ }
}
else {
if (async_ready(p, a->async_data)) {
- if (a->async_free)
+ if (a->async_free) {
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_PORT);
a->async_free(a->async_data);
+ ERTS_MSACC_POP_STATE();
+ }
}
#if ERTS_USE_ASYNC_READY_Q
erts_port_release(p);
@@ -461,6 +466,8 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq)
{
ErtsThrQInit_t qinit = ERTS_THR_Q_INIT_DEFAULT;
erts_tse_t *tse = erts_tse_fetch();
+ ERTS_DECLARE_DUMMY(Uint no);
+
#ifdef ERTS_SMP
ErtsThrPrgrCallbacks callbacks;
@@ -484,10 +491,12 @@ static erts_tse_t *async_thread_init(ErtsAsyncQ *aq)
/* Inform main thread that we are done initializing... */
erts_mtx_lock(&async->init.data.mtx);
- async->init.data.no_initialized++;
+ no = async->init.data.no_initialized++;
erts_cnd_signal(&async->init.data.cnd);
erts_mtx_unlock(&async->init.data.mtx);
+ erts_msacc_init_thread("async", no, 0);
+
return tse;
}
@@ -495,6 +504,7 @@ static void *async_main(void* arg)
{
ErtsAsyncQ *aq = (ErtsAsyncQ *) arg;
erts_tse_t *tse = async_thread_init(aq);
+ ERTS_MSACC_DECLARE_CACHE();
while (1) {
ErtsThrQPrepEnQ_t *prep_enq;
@@ -502,11 +512,14 @@ static void *async_main(void* arg)
if (is_nil(a->port))
break; /* Time to die */
+ ERTS_MSACC_UPDATE_CACHE();
+
#if ERTS_ASYNC_PRINT_JOB
erts_fprintf(stderr, "<- %ld\n", a->async_id);
#endif
-
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT);
a->async_invoke(a->async_data);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER);
async_reply(a, prep_enq);
}
@@ -629,10 +642,13 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
unsigned int qix;
#if ERTS_USE_ASYNC_READY_Q
Uint sched_id;
+ ERTS_MSACC_PUSH_STATE();
sched_id = erts_get_scheduler_id();
if (!sched_id)
sched_id = 1;
+#else
+ ERTS_MSACC_PUSH_STATE();
#endif
prt = erts_drvport2port(ix);
@@ -685,12 +701,17 @@ long driver_async(ErlDrvPort ix, unsigned int* key,
return id;
}
#endif
-
+
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT);
(*a->async_invoke)(a->async_data);
+ ERTS_MSACC_POP_STATE();
if (async_ready(prt, a->async_data)) {
- if (a->async_free != NULL)
+ if (a->async_free != NULL) {
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_PORT);
(*a->async_free)(a->async_data);
+ ERTS_MSACC_POP_STATE();
+ }
}
erts_free(ERTS_ALC_T_ASYNC, (void *) a);
diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c
index fb853b65ab..f39a18ac88 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.c
+++ b/erts/emulator/beam/erl_bestfit_alloc.c
@@ -940,7 +940,7 @@ info_options(Allctr_t *allctr,
if (hpp || szp) {
if (!atoms_initialized)
- erl_exit(1, "%s:%d: Internal error: Atoms not initialized",
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error: Atoms not initialized",
__FILE__, __LINE__);;
res = NIL;
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 134aa2d396..aec72bd61a 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -55,10 +55,8 @@
/* Init and local variables */
-static Export binary_match_trap_export;
-static BIF_RETTYPE binary_match_trap(BIF_ALIST_3);
-static Export binary_matches_trap_export;
-static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3);
+static Export binary_find_trap_export;
+static BIF_RETTYPE binary_find_trap(BIF_ALIST_3);
static Export binary_longest_prefix_trap_export;
static BIF_RETTYPE binary_longest_prefix_trap(BIF_ALIST_3);
static Export binary_longest_suffix_trap_export;
@@ -70,19 +68,15 @@ static BIF_RETTYPE binary_copy_trap(BIF_ALIST_2);
static Uint max_loop_limit;
static BIF_RETTYPE
-binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags);
static BIF_RETTYPE
-binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
+binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3);
void erts_init_bif_binary(void)
{
- erts_init_trap_export(&binary_match_trap_export,
- am_erlang, am_binary_match_trap, 3,
- &binary_match_trap);
-
- erts_init_trap_export(&binary_matches_trap_export,
- am_erlang, am_binary_matches_trap, 3,
- &binary_matches_trap);
+ erts_init_trap_export(&binary_find_trap_export,
+ am_erlang, am_binary_find_trap, 3,
+ &binary_find_trap);
erts_init_trap_export(&binary_longest_prefix_trap_export,
am_erlang, am_binary_longest_prefix_trap, 3,
@@ -314,8 +308,8 @@ static BMData *create_bmdata(MyAllocator *my, byte *x, Uint len,
/*
* Aho Corasick - Build a Trie and fill in the failure functions
* when all strings are added.
- * The algorithm is nicely described by Dieter B�hler of University of
- * T�bingen:
+ * The algorithm is nicely described by Dieter Bühler of University of
+ * Tübingen:
* http://www-sr.informatik.uni-tuebingen.de/~buehler/AC/AC.html
*/
@@ -537,21 +531,23 @@ static void ac_init_find_all(ACFindAllState *state, ACTrie *act, Sint startpos,
state->out = NULL;
}
-static void ac_restore_find_all(ACFindAllState *state, char *buff)
+static void ac_restore_find_all(ACFindAllState *state,
+ const ACFindAllState *src)
{
- memcpy(state,buff,sizeof(ACFindAllState));
+ memcpy(state, src, sizeof(ACFindAllState));
if (state->allocated > 0) {
state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) * (state->allocated));
- memcpy(state->out,buff+sizeof(ACFindAllState),sizeof(FindallData)*state->m);
+ memcpy(state->out, src+1, sizeof(FindallData)*state->m);
} else {
state->out = NULL;
}
}
-static void ac_serialize_find_all(ACFindAllState *state, char *buff)
+static void ac_serialize_find_all(const ACFindAllState *state,
+ ACFindAllState *dst)
{
- memcpy(buff,state,sizeof(ACFindAllState));
- memcpy(buff+sizeof(ACFindAllState),state->out,sizeof(FindallData)*state->m);
+ memcpy(dst, state, sizeof(ACFindAllState));
+ memcpy(dst+1, state->out, sizeof(FindallData)*state->m);
}
static void ac_clean_find_all(ACFindAllState *state)
@@ -565,9 +561,6 @@ static void ac_clean_find_all(ACFindAllState *state)
#endif
}
-#define SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(S) \
- (sizeof(ACFindAllState)+(sizeof(FindallData)*(S).m))
-
/*
* Differs to the find_first function in that it stores all matches and the values
* arte returned only in the state.
@@ -814,24 +807,24 @@ static void bm_init_find_all(BMFindAllState *state, Sint startpos, Uint len)
state->out = NULL;
}
-static void bm_restore_find_all(BMFindAllState *state, char *buff)
+static void bm_restore_find_all(BMFindAllState *state,
+ const BMFindAllState *src)
{
- memcpy(state,buff,sizeof(BMFindAllState));
+ memcpy(state, src, sizeof(BMFindAllState));
if (state->allocated > 0) {
state->out = erts_alloc(ERTS_ALC_T_TMP, sizeof(FindallData) *
(state->allocated));
- memcpy(state->out,buff+sizeof(BMFindAllState),
- sizeof(FindallData)*state->m);
+ memcpy(state->out, src+1, sizeof(FindallData)*state->m);
} else {
state->out = NULL;
}
}
-static void bm_serialize_find_all(BMFindAllState *state, char *buff)
+static void bm_serialize_find_all(const BMFindAllState *state,
+ BMFindAllState *dst)
{
- memcpy(buff,state,sizeof(BMFindAllState));
- memcpy(buff+sizeof(BMFindAllState),state->out,
- sizeof(FindallData)*state->m);
+ memcpy(dst, state, sizeof(BMFindAllState));
+ memcpy(dst+1, state->out, sizeof(FindallData)*state->m);
}
static void bm_clean_find_all(BMFindAllState *state)
@@ -845,9 +838,6 @@ static void bm_clean_find_all(BMFindAllState *state)
#endif
}
-#define SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(S) \
- (sizeof(BMFindAllState)+(sizeof(FindallData)*(S).m))
-
/*
* Differs to the find_first function in that it stores all matches and the
* values are returned only in the state.
@@ -1030,283 +1020,142 @@ BIF_RETTYPE binary_compile_pattern_1(BIF_ALIST_1)
#define DO_BIN_MATCH_BADARG -1
#define DO_BIN_MATCH_RESTART -2
-static int do_binary_match(Process *p, Eterm subject, Uint hsstart, Uint hsend,
- Eterm type, Binary *bin, Eterm state_term,
- Eterm *res_term)
-{
- byte *bytes;
- Uint bitoffs, bitsize;
- byte *temp_alloc = NULL;
-
- ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
- if (bitsize != 0) {
- goto badarg;
- }
- if (bitoffs != 0) {
- bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
- }
- if (state_term != NIL) {
- Eterm *ptr = big_val(state_term);
- type = ptr[1];
- }
-
- if (type == am_bm) {
- BMData *bm;
- Sint pos;
- Eterm ret;
- Eterm *hp;
- BMFindFirstState state;
- Uint reds = get_reds(p, BM_LOOP_FACTOR);
- Uint save_reds = reds;
-
- bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
- dump_bm_data(bm);
-#endif
- if (state_term == NIL) {
- bm_init_find_first_match(&state, hsstart, hsend);
- } else {
- Eterm *ptr = big_val(state_term);
- memcpy(&state,ptr+2,sizeof(state));
- }
-#ifdef HARDDEBUG
- erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
- state.len);
-#endif
- pos = bm_find_first_match(&state, bm, bytes, &reds);
- if (pos == BM_NOT_FOUND) {
- ret = am_nomatch;
- } else if (pos == BM_RESTART) {
- int x = (sizeof(BMFindFirstState) / sizeof(Eterm)) +
- !!(sizeof(BMFindFirstState) % sizeof(Eterm));
-#ifdef HARDDEBUG
- erts_printf("Trap bm!\n");
-#endif
- hp = HAlloc(p,x+2);
- hp[0] = make_pos_bignum_header(x+1);
- hp[1] = type;
- memcpy(hp+2,&state,sizeof(state));
- *res_term = make_big(hp);
- erts_free_aligned_binary_bytes(temp_alloc);
- return DO_BIN_MATCH_RESTART;
- } else {
- Eterm erlen = erts_make_integer((Uint) bm->len, p);
- ret = erts_make_integer(pos,p);
- hp = HAlloc(p,3);
- ret = TUPLE2(hp, ret, erlen);
- }
- erts_free_aligned_binary_bytes(temp_alloc);
- BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
- *res_term = ret;
- return DO_BIN_MATCH_OK;
- } else if (type == am_ac) {
- ACTrie *act;
- Uint pos, rlen;
- int acr;
- ACFindFirstState state;
- Eterm ret;
- Eterm *hp;
- Uint reds = get_reds(p, AC_LOOP_FACTOR);
- Uint save_reds = reds;
+#define BINARY_FIND_ALL 0x01
+#define BINARY_SPLIT_TRIM 0x02
+#define BINARY_SPLIT_TRIM_ALL 0x04
- act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
- dump_ac_trie(act);
-#endif
- if (state_term == NIL) {
- ac_init_find_first_match(&state, act, hsstart, hsend);
- } else {
- Eterm *ptr = big_val(state_term);
- memcpy(&state,ptr+2,sizeof(state));
- }
- acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
- if (acr == AC_NOT_FOUND) {
- ret = am_nomatch;
- } else if (acr == AC_RESTART) {
- int x = (sizeof(state) / sizeof(Eterm)) +
- !!(sizeof(ACFindFirstState) % sizeof(Eterm));
-#ifdef HARDDEBUG
- erts_printf("Trap ac!\n");
-#endif
- hp = HAlloc(p,x+2);
- hp[0] = make_pos_bignum_header(x+1);
- hp[1] = type;
- memcpy(hp+2,&state,sizeof(state));
- *res_term = make_big(hp);
- erts_free_aligned_binary_bytes(temp_alloc);
- return DO_BIN_MATCH_RESTART;
- } else {
- Eterm epos = erts_make_integer(pos,p);
- Eterm erlen = erts_make_integer(rlen,p);
- hp = HAlloc(p,3);
- ret = TUPLE2(hp, epos, erlen);
- }
- erts_free_aligned_binary_bytes(temp_alloc);
- BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
- *res_term = ret;
- return DO_BIN_MATCH_OK;
- }
- badarg:
- return DO_BIN_MATCH_BADARG;
-}
+typedef struct BinaryFindState {
+ Eterm type;
+ Uint flags;
+ Uint hsstart;
+ Uint hsend;
+ Eterm (*not_found_result) (Process *, Eterm, struct BinaryFindState *);
+ Eterm (*single_result) (Process *, Eterm, struct BinaryFindState *, Sint, Sint);
+ Eterm (*global_result) (Process *, Eterm, struct BinaryFindState *, FindallData *, Uint);
+} BinaryFindState;
+
+typedef struct BinaryFindState_bignum {
+ Eterm bignum_hdr;
+ BinaryFindState bfs;
+ union {
+ BMFindFirstState bmffs;
+ BMFindAllState bmfas;
+ ACFindFirstState acffs;
+ ACFindAllState acfas;
+ } data;
+} BinaryFindState_bignum;
+
+#define SIZEOF_BINARY_FIND_STATE(S) \
+ (sizeof(BinaryFindState)+sizeof(S))
+
+#define SIZEOF_BINARY_FIND_ALL_STATE(S) \
+ (sizeof(BinaryFindState)+sizeof(S)+(sizeof(FindallData)*(S).m))
+
+static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs);
+static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ Sint pos, Sint len);
+static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ FindallData *fad, Uint fad_sz);
+static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs);
+static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ Sint pos, Sint len);
+static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ FindallData *fad, Uint fad_sz);
-static int do_binary_matches(Process *p, Eterm subject, Uint hsstart,
- Uint hsend, Eterm type, Binary *bin,
- Eterm state_term, Eterm *res_term)
+static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
{
- byte *bytes;
- Uint bitoffs, bitsize;
- byte *temp_alloc = NULL;
-
- ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
- if (bitsize != 0) {
- goto badarg;
- }
- if (bitoffs != 0) {
- bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
- }
- if (state_term != NIL) {
- Eterm *ptr = big_val(state_term);
- type = ptr[1];
- }
-
- if (type == am_bm) {
- BMData *bm;
- Sint pos;
- Eterm ret,tpl;
- Eterm *hp;
- BMFindAllState state;
- Uint reds = get_reds(p, BM_LOOP_FACTOR);
- Uint save_reds = reds;
-
- bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
- dump_bm_data(bm);
-#endif
- if (state_term == NIL) {
- bm_init_find_all(&state, hsstart, hsend);
- } else {
- Eterm *ptr = big_val(state_term);
- bm_restore_find_all(&state,(char *) (ptr+2));
- }
-
- pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
- if (pos == BM_NOT_FOUND) {
- ret = NIL;
- } else if (pos == BM_RESTART) {
- int x =
- (SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
- !!(SIZEOF_BM_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
- erts_printf("Trap bm!\n");
-#endif
- hp = HAlloc(p,x+2);
- hp[0] = make_pos_bignum_header(x+1);
- hp[1] = type;
- bm_serialize_find_all(&state, (char *) (hp+2));
- *res_term = make_big(hp);
- erts_free_aligned_binary_bytes(temp_alloc);
- bm_clean_find_all(&state);
- return DO_BIN_MATCH_RESTART;
- } else {
- FindallData *fad = state.out;
- int i;
- for (i = 0; i < state.m; ++i) {
- fad[i].epos = erts_make_integer(fad[i].pos,p);
- fad[i].elen = erts_make_integer(fad[i].len,p);
+ Eterm *tp;
+ Uint pos;
+ Sint len;
+ if (l == THE_NON_VALUE || l == NIL) {
+ /* Invalid term or NIL, we're called from binary_match(es)_2 or
+ have no options*/
+ *posp = 0;
+ *endp = binary_size(bin);
+ return 0;
+ } else if (is_list(l)) {
+ while(is_list(l)) {
+ Eterm t = CAR(list_val(l));
+ Uint orig_size;
+ if (!is_tuple(t)) {
+ goto badarg;
}
- hp = HAlloc(p,state.m * (3 + 2));
- ret = NIL;
- for (i = state.m - 1; i >= 0; --i) {
- tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
- hp +=3;
- ret = CONS(hp,tpl,ret);
- hp += 2;
+ tp = tuple_val(t);
+ if (arityval(*tp) != 2) {
+ goto badarg;
}
- }
- erts_free_aligned_binary_bytes(temp_alloc);
- bm_clean_find_all(&state);
- BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
- *res_term = ret;
- return DO_BIN_MATCH_OK;
- } else if (type == am_ac) {
- ACTrie *act;
- int acr;
- ACFindAllState state;
- Eterm ret,tpl;
- Eterm *hp;
- Uint reds = get_reds(p, AC_LOOP_FACTOR);
- Uint save_reds = reds;
-
- act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
-#ifdef HARDDEBUG
- dump_ac_trie(act);
-#endif
- if (state_term == NIL) {
- ac_init_find_all(&state, act, hsstart, hsend);
- } else {
- Eterm *ptr = big_val(state_term);
- ac_restore_find_all(&state,(char *) (ptr+2));
- }
- acr = ac_find_all_non_overlapping(&state, bytes, &reds);
- if (acr == AC_NOT_FOUND) {
- ret = NIL;
- } else if (acr == AC_RESTART) {
- int x =
- (SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) / sizeof(Eterm)) +
- !!(SIZEOF_AC_SERIALIZED_FIND_ALL_STATE(state) % sizeof(Eterm));
-#ifdef HARDDEBUG
- erts_printf("Trap ac!\n");
-#endif
- hp = HAlloc(p,x+2);
- hp[0] = make_pos_bignum_header(x+1);
- hp[1] = type;
- ac_serialize_find_all(&state, (char *) (hp+2));
- *res_term = make_big(hp);
- erts_free_aligned_binary_bytes(temp_alloc);
- ac_clean_find_all(&state);
- return DO_BIN_MATCH_RESTART;
- } else {
- FindallData *fad = state.out;
- int i;
- for (i = 0; i < state.m; ++i) {
- fad[i].epos = erts_make_integer(fad[i].pos,p);
- fad[i].elen = erts_make_integer(fad[i].len,p);
+ if (tp[1] != am_scope || is_not_tuple(tp[2])) {
+ goto badarg;
}
- hp = HAlloc(p,state.m * (3 + 2));
- ret = NIL;
- for (i = state.m - 1; i >= 0; --i) {
- tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
- hp +=3;
- ret = CONS(hp,tpl,ret);
- hp += 2;
+ tp = tuple_val(tp[2]);
+ if (arityval(*tp) != 2) {
+ goto badarg;
+ }
+ if (!term_to_Uint(tp[1], &pos)) {
+ goto badarg;
}
+ if (!term_to_Sint(tp[2], &len)) {
+ goto badarg;
+ }
+ if (len < 0) {
+ Uint lentmp = -(Uint)len;
+ /* overflow */
+ if ((Sint)lentmp < 0) {
+ goto badarg;
+ }
+ len = lentmp;
+ pos -= len;
+ }
+ /* overflow */
+ if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
+ goto badarg;
+ }
+ *endp = len + pos;
+ *posp = pos;
+ if ((orig_size = binary_size(bin)) < pos ||
+ orig_size < (*endp)) {
+ goto badarg;
+ }
+ l = CDR(list_val(l));
}
- erts_free_aligned_binary_bytes(temp_alloc);
- ac_clean_find_all(&state);
- BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
- *res_term = ret;
- return DO_BIN_MATCH_OK;
+ return 0;
+ } else {
+ badarg:
+ return 1;
}
- badarg:
- return DO_BIN_MATCH_BADARG;
}
-static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
+static int parse_split_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp, Uint *optp)
{
Eterm *tp;
Uint pos;
Sint len;
- if (l == ((Eterm) 0) || l == NIL) {
- /* Invalid term or NIL, we're called from binary_match(es)_2 or
- have no options*/
- *posp = 0;
- *endp = binary_size(bin);
+ *optp = 0;
+ *posp = 0;
+ *endp = binary_size(bin);
+ if (l == THE_NON_VALUE || l == NIL) {
return 0;
} else if (is_list(l)) {
while(is_list(l)) {
Eterm t = CAR(list_val(l));
Uint orig_size;
+ if (is_atom(t)) {
+ if (t == am_global) {
+ *optp |= BINARY_FIND_ALL;
+ l = CDR(list_val(l));
+ continue;
+ }
+ if (t == am_trim) {
+ *optp |= BINARY_SPLIT_TRIM;
+ l = CDR(list_val(l));
+ continue;
+ }
+ if (t == am_trim_all) {
+ *optp |= BINARY_SPLIT_TRIM_ALL;
+ l = CDR(list_val(l));
+ continue;
+ }
+ }
if (!is_tuple(t)) {
goto badarg;
}
@@ -1355,48 +1204,207 @@ static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp)
}
}
-static BIF_RETTYPE binary_match_trap(BIF_ALIST_3)
+static int do_binary_find(Process *p, Eterm subject, BinaryFindState *bfs, Binary *bin,
+ Eterm state_term, Eterm *res_term)
{
- int runres;
- Eterm result;
- Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
- runres = do_binary_match(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result);
- if (runres == DO_BIN_MATCH_OK) {
- BIF_RET(result);
- } else {
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_match_trap_export, BIF_P, BIF_ARG_1, result,
- BIF_ARG_3);
+ byte *bytes;
+ Uint bitoffs, bitsize;
+ byte *temp_alloc = NULL;
+ BinaryFindState_bignum *state_ptr = NULL;
+
+ ERTS_GET_BINARY_BYTES(subject, bytes, bitoffs, bitsize);
+ if (bitsize != 0) {
+ goto badarg;
+ }
+ if (bitoffs != 0) {
+ bytes = erts_get_aligned_binary_bytes(subject, &temp_alloc);
+ }
+ if (state_term != NIL) {
+ state_ptr = (BinaryFindState_bignum *)(big_val(state_term));
+ bfs = &(state_ptr->bfs);
}
-}
-static BIF_RETTYPE binary_matches_trap(BIF_ALIST_3)
-{
- int runres;
- Eterm result;
- Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
- runres = do_binary_matches(BIF_P,BIF_ARG_1,0,0,NIL,bin,BIF_ARG_2,&result);
- if (runres == DO_BIN_MATCH_OK) {
- BIF_RET(result);
+ if (bfs->flags & BINARY_FIND_ALL) {
+ if (bfs->type == am_bm) {
+ BMData *bm;
+ Sint pos;
+ BMFindAllState state;
+ Uint reds = get_reds(p, BM_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_bm_data(bm);
+#endif
+ if (state_term == NIL) {
+ bm_init_find_all(&state, bfs->hsstart, bfs->hsend);
+ } else {
+ bm_restore_find_all(&state, &(state_ptr->data.bmfas));
+ }
+
+ pos = bm_find_all_non_overlapping(&state, bm, bytes, &reds);
+ if (pos == BM_NOT_FOUND) {
+ *res_term = bfs->not_found_result(p, subject, bfs);
+ } else if (pos == BM_RESTART) {
+ int x =
+ (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap bm!\n");
+#endif
+ state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+ state_ptr->bignum_hdr = make_pos_bignum_header(x);
+ memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+ bm_serialize_find_all(&state, &state_ptr->data.bmfas);
+ *res_term = make_big(&state_ptr->bignum_hdr);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ bm_clean_find_all(&state);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ *res_term = bfs->global_result(p, subject, bfs, state.out, state.m);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ bm_clean_find_all(&state);
+ BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+ return DO_BIN_MATCH_OK;
+ } else if (bfs->type == am_ac) {
+ ACTrie *act;
+ int acr;
+ ACFindAllState state;
+ Uint reds = get_reds(p, AC_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_ac_trie(act);
+#endif
+ if (state_term == NIL) {
+ ac_init_find_all(&state, act, bfs->hsstart, bfs->hsend);
+ } else {
+ ac_restore_find_all(&state, &(state_ptr->data.acfas));
+ }
+ acr = ac_find_all_non_overlapping(&state, bytes, &reds);
+ if (acr == AC_NOT_FOUND) {
+ *res_term = bfs->not_found_result(p, subject, bfs);
+ } else if (acr == AC_RESTART) {
+ int x =
+ (SIZEOF_BINARY_FIND_ALL_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BINARY_FIND_ALL_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap ac!\n");
+#endif
+ state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+ state_ptr->bignum_hdr = make_pos_bignum_header(x);
+ memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+ ac_serialize_find_all(&state, &state_ptr->data.acfas);
+ *res_term = make_big(&state_ptr->bignum_hdr);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ ac_clean_find_all(&state);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ *res_term = bfs->global_result(p, subject, bfs, state.out, state.m);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ ac_clean_find_all(&state);
+ BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+ return DO_BIN_MATCH_OK;
+ }
} else {
- BUMP_ALL_REDS(BIF_P);
- BIF_TRAP3(&binary_matches_trap_export, BIF_P, BIF_ARG_1, result,
- BIF_ARG_3);
- }
-}
+ if (bfs->type == am_bm) {
+ BMData *bm;
+ Sint pos;
+ BMFindFirstState state;
+ Uint reds = get_reds(p, BM_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ bm = (BMData *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_bm_data(bm);
+#endif
+ if (state_term == NIL) {
+ bm_init_find_first_match(&state, bfs->hsstart, bfs->hsend);
+ } else {
+ memcpy(&state, &state_ptr->data.bmffs, sizeof(BMFindFirstState));
+ }
-BIF_RETTYPE binary_match_3(BIF_ALIST_3)
-{
- return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+#ifdef HARDDEBUG
+ erts_printf("(bm) state->pos = %ld, state->len = %lu\n",state.pos,
+ state.len);
+#endif
+ pos = bm_find_first_match(&state, bm, bytes, &reds);
+ if (pos == BM_NOT_FOUND) {
+ *res_term = bfs->not_found_result(p, subject, bfs);
+ } else if (pos == BM_RESTART) {
+ int x =
+ (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap bm!\n");
+#endif
+ state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+ state_ptr->bignum_hdr = make_pos_bignum_header(x);
+ memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+ memcpy(&state_ptr->data.acffs, &state, sizeof(BMFindFirstState));
+ *res_term = make_big(&state_ptr->bignum_hdr);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ *res_term = bfs->single_result(p, subject, bfs, pos, bm->len);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BUMP_REDS(p, (save_reds - reds) / BM_LOOP_FACTOR);
+ return DO_BIN_MATCH_OK;
+ } else if (bfs->type == am_ac) {
+ ACTrie *act;
+ Uint pos, rlen;
+ int acr;
+ ACFindFirstState state;
+ Uint reds = get_reds(p, AC_LOOP_FACTOR);
+ Uint save_reds = reds;
+
+ act = (ACTrie *) ERTS_MAGIC_BIN_DATA(bin);
+#ifdef HARDDEBUG
+ dump_ac_trie(act);
+#endif
+ if (state_term == NIL) {
+ ac_init_find_first_match(&state, act, bfs->hsstart, bfs->hsend);
+ } else {
+ memcpy(&state, &state_ptr->data.acffs, sizeof(ACFindFirstState));
+ }
+ acr = ac_find_first_match(&state, bytes, &pos, &rlen, &reds);
+ if (acr == AC_NOT_FOUND) {
+ *res_term = bfs->not_found_result(p, subject, bfs);
+ } else if (acr == AC_RESTART) {
+ int x =
+ (SIZEOF_BINARY_FIND_STATE(state) / sizeof(Eterm)) +
+ !!(SIZEOF_BINARY_FIND_STATE(state) % sizeof(Eterm));
+#ifdef HARDDEBUG
+ erts_printf("Trap ac!\n");
+#endif
+ state_ptr = (BinaryFindState_bignum*) HAlloc(p, x+1);
+ state_ptr->bignum_hdr = make_pos_bignum_header(x);
+ memcpy(&state_ptr->bfs, bfs, sizeof(BinaryFindState));
+ memcpy(&state_ptr->data.acffs, &state, sizeof(ACFindFirstState));
+ *res_term = make_big(&state_ptr->bignum_hdr);
+ erts_free_aligned_binary_bytes(temp_alloc);
+ return DO_BIN_MATCH_RESTART;
+ } else {
+ *res_term = bfs->single_result(p, subject, bfs, pos, rlen);
+ }
+ erts_free_aligned_binary_bytes(temp_alloc);
+ BUMP_REDS(p, (save_reds - reds) / AC_LOOP_FACTOR);
+ return DO_BIN_MATCH_OK;
+ }
+ }
+ badarg:
+ return DO_BIN_MATCH_BADARG;
}
static BIF_RETTYPE
-binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3, Uint flags)
{
- Uint hsstart;
- Uint hsend;
+ BinaryFindState bfs;
Eterm *tp;
- Eterm type;
Binary *bin;
Eterm bin_term = NIL;
int runres;
@@ -1405,11 +1413,12 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
if (is_not_binary(arg1)) {
goto badarg;
}
- if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
+ bfs.flags = flags;
+ if (parse_match_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend))) {
goto badarg;
}
- if (hsend == 0) {
- BIF_RET(am_nomatch);
+ if (bfs.hsend == 0) {
+ BIF_RET(do_match_not_found_result(p, arg1, &bfs));
}
if (is_tuple(arg2)) {
tp = tuple_val(arg2);
@@ -1420,21 +1429,24 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
!ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
goto badarg;
}
- type = tp[1];
+ bfs.type = tp[1];
bin = ((ProcBin *) binary_val(tp[2]))->val;
- if (type == am_bm &&
+ if (bfs.type == am_bm &&
ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
goto badarg;
}
- if (type == am_ac &&
+ if (bfs.type == am_ac &&
ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
goto badarg;
}
bin_term = tp[2];
- } else if (do_binary_match_compile(arg2,&type,&bin)) {
+ } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) {
goto badarg;
}
- runres = do_binary_match(p,arg1,hsstart,hsend,type,bin,NIL,&result);
+ bfs.not_found_result = &do_match_not_found_result;
+ bfs.single_result = &do_match_single_result;
+ bfs.global_result = &do_match_global_result;
+ runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result);
if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
@@ -1446,7 +1458,7 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
BIF_RET(result);
case DO_BIN_MATCH_RESTART:
BUMP_ALL_REDS(p);
- BIF_TRAP3(&binary_match_trap_export, p, arg1, result, bin_term);
+ BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term);
default:
goto badarg;
}
@@ -1454,17 +1466,31 @@ binary_match(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
BIF_ERROR(p,BADARG);
}
+BIF_RETTYPE binary_match_2(BIF_ALIST_2)
+{
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, 0);
+}
+
+BIF_RETTYPE binary_match_3(BIF_ALIST_3)
+{
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, 0);
+}
+
+BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
+{
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE, BINARY_FIND_ALL);
+}
+
BIF_RETTYPE binary_matches_3(BIF_ALIST_3)
{
- return binary_matches(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+ return binary_match(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, BINARY_FIND_ALL);
}
static BIF_RETTYPE
-binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
+binary_split(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
{
- Uint hsstart, hsend;
+ BinaryFindState bfs;
Eterm *tp;
- Eterm type;
Binary *bin;
Eterm bin_term = NIL;
int runres;
@@ -1473,11 +1499,12 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
if (is_not_binary(arg1)) {
goto badarg;
}
- if (parse_match_opts_list(arg3,arg1,&hsstart,&hsend)) {
+ if (parse_split_opts_list(arg3, arg1, &(bfs.hsstart), &(bfs.hsend), &(bfs.flags))) {
goto badarg;
}
- if (hsend == 0) {
- BIF_RET(NIL);
+ if (bfs.hsend == 0) {
+ result = do_split_not_found_result(p, arg1, &bfs);
+ BIF_RET(result);
}
if (is_tuple(arg2)) {
tp = tuple_val(arg2);
@@ -1488,54 +1515,267 @@ binary_matches(Process *p, Eterm arg1, Eterm arg2, Eterm arg3)
!ERTS_TERM_IS_MAGIC_BINARY(tp[2])) {
goto badarg;
}
- type = tp[1];
+ bfs.type = tp[1];
bin = ((ProcBin *) binary_val(tp[2]))->val;
- if (type == am_bm &&
+ if (bfs.type == am_bm &&
ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_bm) {
goto badarg;
}
- if (type == am_ac &&
+ if (bfs.type == am_ac &&
ERTS_MAGIC_BIN_DESTRUCTOR(bin) != cleanup_my_data_ac) {
goto badarg;
}
bin_term = tp[2];
- } else if (do_binary_match_compile(arg2,&type,&bin)) {
+ } else if (do_binary_match_compile(arg2, &(bfs.type), &bin)) {
goto badarg;
}
- runres = do_binary_matches(p,arg1,hsstart,hsend,type,bin,
- NIL,&result);
+ bfs.not_found_result = &do_split_not_found_result;
+ bfs.single_result = &do_split_single_result;
+ bfs.global_result = &do_split_global_result;
+ runres = do_binary_find(p, arg1, &bfs, bin, NIL, &result);
if (runres == DO_BIN_MATCH_RESTART && bin_term == NIL) {
Eterm *hp = HAlloc(p, PROC_BIN_SIZE);
bin_term = erts_mk_magic_binary_term(&hp, &MSO(p), bin);
} else if (bin_term == NIL) {
erts_bin_free(bin);
}
- switch (runres) {
+ switch(runres) {
case DO_BIN_MATCH_OK:
BIF_RET(result);
case DO_BIN_MATCH_RESTART:
- BUMP_ALL_REDS(p);
- BIF_TRAP3(&binary_matches_trap_export, p, arg1, result,
- bin_term);
+ BIF_TRAP3(&binary_find_trap_export, p, arg1, result, bin_term);
default:
goto badarg;
}
badarg:
- BIF_ERROR(p,BADARG);
+ BIF_ERROR(p, BADARG);
}
+BIF_RETTYPE binary_split_2(BIF_ALIST_2)
+{
+ return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, THE_NON_VALUE);
+}
-BIF_RETTYPE binary_match_2(BIF_ALIST_2)
+BIF_RETTYPE binary_split_3(BIF_ALIST_3)
{
- return binary_match(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ return binary_split(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);
+}
+
+static Eterm do_match_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs)
+{
+ if (bfs->flags & BINARY_FIND_ALL) {
+ return NIL;
+ } else {
+ return am_nomatch;
+ }
}
+static Eterm do_match_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ Sint pos, Sint len)
+{
+ Eterm erlen;
+ Eterm *hp;
+ Eterm ret;
-BIF_RETTYPE binary_matches_2(BIF_ALIST_2)
+ erlen = erts_make_integer((Uint)(len), p);
+ ret = erts_make_integer(pos, p);
+ hp = HAlloc(p, 3);
+ ret = TUPLE2(hp, ret, erlen);
+
+ return ret;
+}
+
+static Eterm do_match_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ FindallData *fad, Uint fad_sz)
+{
+ Sint i;
+ Eterm tpl;
+ Eterm *hp;
+ Eterm ret;
+
+ for (i = 0; i < fad_sz; ++i) {
+ fad[i].epos = erts_make_integer(fad[i].pos, p);
+ fad[i].elen = erts_make_integer(fad[i].len, p);
+ }
+ hp = HAlloc(p, fad_sz * (3 + 2));
+ ret = NIL;
+ for (i = fad_sz - 1; i >= 0; --i) {
+ tpl = TUPLE2(hp, fad[i].epos, fad[i].elen);
+ hp += 3;
+ ret = CONS(hp, tpl, ret);
+ hp += 2;
+ }
+
+ return ret;
+}
+
+static Eterm do_split_not_found_result(Process *p, Eterm subject, BinaryFindState *bfs)
{
- return binary_matches(BIF_P,BIF_ARG_1,BIF_ARG_2,((Eterm) 0));
+ Eterm *hp;
+ Eterm ret;
+
+ if (bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)
+ && binary_size(subject) == 0) {
+ return NIL;
+ }
+ hp = HAlloc(p, 2);
+ ret = CONS(hp, subject, NIL);
+
+ return ret;
}
+static Eterm do_split_single_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ Sint pos, Sint len)
+{
+ size_t orig_size;
+ Eterm orig;
+ Uint offset;
+ Uint bit_offset;
+ Uint bit_size;
+ ErlSubBin *sb1;
+ ErlSubBin *sb2;
+ Eterm *hp;
+ Eterm ret;
+
+ orig_size = binary_size(subject);
+
+ if ((bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL)) &&
+ (orig_size - pos - len) == 0) {
+ if (pos == 0) {
+ ret = NIL;
+ } else {
+ hp = HAlloc(p, (ERL_SUB_BIN_SIZE + 2));
+ ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+ sb1 = (ErlSubBin *) hp;
+ sb1->thing_word = HEADER_SUB_BIN;
+ sb1->size = pos;
+ sb1->offs = offset;
+ sb1->orig = orig;
+ sb1->bitoffs = bit_offset;
+ sb1->bitsize = bit_size;
+ sb1->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+
+ ret = CONS(hp, make_binary(sb1), NIL);
+ hp += 2;
+ }
+ } else {
+ if ((bfs->flags & BINARY_SPLIT_TRIM_ALL) && (pos == 0)) {
+ hp = HAlloc(p, 1 * (ERL_SUB_BIN_SIZE + 2));
+ ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+ sb1 = NULL;
+ } else {
+ hp = HAlloc(p, 2 * (ERL_SUB_BIN_SIZE + 2));
+ ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+ sb1 = (ErlSubBin *) hp;
+ sb1->thing_word = HEADER_SUB_BIN;
+ sb1->size = pos;
+ sb1->offs = offset;
+ sb1->orig = orig;
+ sb1->bitoffs = bit_offset;
+ sb1->bitsize = 0;
+ sb1->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+ }
+
+ sb2 = (ErlSubBin *) hp;
+ sb2->thing_word = HEADER_SUB_BIN;
+ sb2->size = orig_size - pos - len;
+ sb2->offs = offset + pos + len;
+ sb2->orig = orig;
+ sb2->bitoffs = bit_offset;
+ sb2->bitsize = bit_size;
+ sb2->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+
+ ret = CONS(hp, make_binary(sb2), NIL);
+ hp += 2;
+ if (sb1 != NULL) {
+ ret = CONS(hp, make_binary(sb1), ret);
+ hp += 2;
+ }
+ }
+ return ret;
+}
+
+static Eterm do_split_global_result(Process *p, Eterm subject, BinaryFindState *bfs,
+ FindallData *fad, Uint fad_sz)
+{
+ size_t orig_size;
+ Eterm orig;
+ Uint offset;
+ Uint bit_offset;
+ Uint bit_size;
+ ErlSubBin *sb;
+ Sint i;
+ Sint tail;
+ Uint list_size;
+ Uint end_pos;
+ Uint do_trim = bfs->flags & (BINARY_SPLIT_TRIM | BINARY_SPLIT_TRIM_ALL);
+ Eterm *hp;
+ Eterm *hendp;
+ Eterm ret;
+
+ tail = fad_sz - 1;
+ list_size = fad_sz + 1;
+ orig_size = binary_size(subject);
+ end_pos = (Uint)(orig_size);
+
+ hp = HAlloc(p, list_size * (ERL_SUB_BIN_SIZE + 2));
+ hendp = hp + list_size * (ERL_SUB_BIN_SIZE + 2);
+ ERTS_GET_REAL_BIN(subject, orig, offset, bit_offset, bit_size);
+ ASSERT(bit_size == 0);
+
+ ret = NIL;
+
+ for (i = tail; i >= 0; --i) {
+ sb = (ErlSubBin *)(hp);
+ sb->size = end_pos - (fad[i].pos + fad[i].len);
+ if (!(sb->size == 0 && do_trim)) {
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->offs = offset + fad[i].pos + fad[i].len;
+ sb->orig = orig;
+ sb->bitoffs = bit_offset;
+ sb->bitsize = 0;
+ sb->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+ ret = CONS(hp, make_binary(sb), ret);
+ hp += 2;
+ do_trim &= ~BINARY_SPLIT_TRIM;
+ }
+ end_pos = fad[i].pos;
+ }
+
+ sb = (ErlSubBin *)(hp);
+ sb->size = fad[0].pos;
+ if (!(sb->size == 0 && do_trim)) {
+ sb->thing_word = HEADER_SUB_BIN;
+ sb->offs = offset;
+ sb->orig = orig;
+ sb->bitoffs = bit_offset;
+ sb->bitsize = 0;
+ sb->is_writable = 0;
+ hp += ERL_SUB_BIN_SIZE;
+ ret = CONS(hp, make_binary(sb), ret);
+ hp += 2;
+ }
+ HRelease(p, hendp, hp);
+ return ret;
+}
+
+static BIF_RETTYPE binary_find_trap(BIF_ALIST_3)
+{
+ int runres;
+ Eterm result;
+ Binary *bin = ((ProcBin *) binary_val(BIF_ARG_3))->val;
+ runres = do_binary_find(BIF_P, BIF_ARG_1, NULL, bin, BIF_ARG_2, &result);
+ if (runres == DO_BIN_MATCH_OK) {
+ BIF_RET(result);
+ } else {
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP3(&binary_find_trap_export, BIF_P, BIF_ARG_1, result, BIF_ARG_3);
+ }
+}
BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen)
{
@@ -2550,7 +2790,6 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1)
}
pb = (ProcBin *) binary_val(bin);
if (pb->thing_word == HEADER_PROC_BIN) {
- /* XXX:PaN - Halfword - orig_size is a long, we should handle that */
res = erts_make_integer((Uint) pb->val->orig_size, BIF_P);
} else { /* heap binary */
res = erts_make_integer((Uint) ((ErlHeapBin *) pb)->size, BIF_P);
@@ -2568,7 +2807,7 @@ BIF_RETTYPE binary_referenced_byte_size_1(BIF_ALIST_1)
#endif
static int get_need(Uint u) {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (u > 0xFFFFFFFFUL) {
if (u > 0xFFFFFFFFFFFFUL) {
if (u > 0xFFFFFFFFFFFFFFUL) {
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index 28bec6325c..f006856b6a 100644
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -1309,7 +1309,7 @@ static Eterm notify_when_loaded(Process *p, Eterm name_term, char *name, ErtsPro
case ERL_DE_FORCE_RELOAD:
break;
default:
- erl_exit(1,"Internal error, unknown state %u in dynamic driver.", drv->handle->status);
+ erts_exit(ERTS_ERROR_EXIT,"Internal error, unknown state %u in dynamic driver.", drv->handle->status);
}
p->flags |= F_USING_DDLL;
r = add_monitor(p, drv->handle, ERL_DE_PROC_AWAIT_LOAD);
@@ -1707,18 +1707,19 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type,
Eterm mess;
Eterm r;
Eterm *hp;
- ErlHeapFragment *bp;
- ErlOffHeap *ohp;
+ ErtsMessage *mp;
ErtsProcLocks rp_locks = 0;
+ ErlOffHeap *ohp;
ERTS_SMP_CHK_NO_PROC_LOCKS;
assert_drv_list_rwlocked();
if (errcode != 0) {
int need = load_error_need(errcode);
Eterm e;
- hp = erts_alloc_message_heap(6 /* tuple */ + 3 /* Error tuple */ +
- REF_THING_SIZE + need, &bp, &ohp,
- proc, &rp_locks);
+ mp = erts_alloc_message_heap(proc, &rp_locks,
+ (6 /* tuple */ + 3 /* Error tuple */ +
+ REF_THING_SIZE + need),
+ &hp, &ohp);
r = copy_ref(ref,hp);
hp += REF_THING_SIZE;
e = build_load_error_hp(hp, errcode);
@@ -1727,12 +1728,14 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type,
hp += 3;
mess = TUPLE5(hp,type,r,am_driver,driver_name,mess);
} else {
- hp = erts_alloc_message_heap(6 /* tuple */ + REF_THING_SIZE, &bp, &ohp, proc, &rp_locks);
+ mp = erts_alloc_message_heap(proc, &rp_locks,
+ 6 /* tuple */ + REF_THING_SIZE,
+ &hp, &ohp);
r = copy_ref(ref,hp);
hp += REF_THING_SIZE;
mess = TUPLE5(hp,type,r,am_driver,driver_name,tag);
}
- erts_queue_message(proc, &rp_locks, bp, mess, am_undefined);
+ erts_queue_message(proc, &rp_locks, mp, mess, am_undefined);
erts_smp_proc_unlock(proc, rp_locks);
ERTS_SMP_CHK_NO_PROC_LOCKS;
}
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index b44382cde8..8c748c9bf7 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -64,7 +64,9 @@ static Export* alloc_sizes_trap = NULL;
static Export* gather_io_bytes_trap = NULL;
static Export *gather_sched_wall_time_res_trap;
+static Export *gather_msacc_res_trap;
static Export *gather_gc_info_res_trap;
+static Export *gather_system_check_res_trap;
#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1)
@@ -73,9 +75,6 @@ static char otp_version[] = ERLANG_OTP_VERSION;
static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
"%s"
" [erts-" ERLANG_VERSION "]"
-#if !HEAP_ON_C_STACK && !HALFWORD_HEAP
- " [no-c-stack-objects]"
-#endif
#ifndef OTP_RELEASE
#ifdef ERLANG_GIT_VERSION
" [source-" ERLANG_GIT_VERSION "]"
@@ -84,12 +83,8 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
#endif
#endif
#ifdef ARCH_64
-#if HALFWORD_HEAP
- " [64-bit halfword]"
-#else
" [64-bit]"
#endif
-#endif
#ifdef ERTS_SMP
" [smp:%beu:%beu]"
#endif
@@ -137,6 +132,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
#ifdef USE_SYSTEMTAP
" [systemtap]"
#endif
+#ifdef SHCOPY
+ " [sharing-preserving]"
+#endif
"\n");
#define ASIZE(a) (sizeof(a)/sizeof(a[0]))
@@ -322,13 +320,11 @@ erts_print_system_version(int to, void *arg, Process *c_p)
char *ov = otp_version;
#ifdef ERTS_SMP
Uint total, online, active;
-#ifdef ERTS_DIRTY_SCHEDULERS
Uint dirty_cpu, dirty_cpu_onln, dirty_io;
- (void) erts_schedulers_state(&total, &online, &active, &dirty_cpu, &dirty_cpu_onln, &dirty_io, 0);
-#else
- (void) erts_schedulers_state(&total, &online, &active, NULL, NULL, NULL, 0);
-#endif
+ erts_schedulers_state(&total, &online, &active,
+ &dirty_cpu, &dirty_cpu_onln, NULL,
+ &dirty_io, NULL);
#endif
for (i = 0; i < sizeof(otp_version)-4; i++) {
if (ov[i] == '-' && ov[i+1] == 'r' && ov[i+2] == 'c')
@@ -596,6 +592,8 @@ static Eterm pi_args[] = {
am_min_bin_vheap_size,
am_current_location,
am_current_stacktrace,
+ am_message_queue_data,
+ am_garbage_collection_info
};
#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm)))
@@ -643,6 +641,8 @@ pi_arg2ix(Eterm arg)
case am_min_bin_vheap_size: return 28;
case am_current_location: return 29;
case am_current_stacktrace: return 30;
+ case am_message_queue_data: return 31;
+ case am_garbage_collection_info: return 32;
default: return -1;
}
}
@@ -671,18 +671,12 @@ static Eterm pi_1_keys[] = {
#define ERTS_PI_1_NO_OF_KEYS (sizeof(pi_1_keys)/sizeof(Eterm))
static Eterm pi_1_keys_list;
-#if HEAP_ON_C_STACK
static Eterm pi_1_keys_list_heap[2*ERTS_PI_1_NO_OF_KEYS];
-#endif
static void
process_info_init(void)
{
-#if HEAP_ON_C_STACK
Eterm *hp = &pi_1_keys_list_heap[0];
-#else
- Eterm *hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM,sizeof(Eterm)*2*ERTS_PI_1_NO_OF_KEYS);
-#endif
int i;
pi_1_keys_list = NIL;
@@ -731,9 +725,10 @@ pi_pid2proc(Process *c_p, Eterm pid, ErtsProcLocks info_locks)
-BIF_RETTYPE
+static BIF_RETTYPE
process_info_aux(Process *BIF_P,
Process *rp,
+ ErtsProcLocks rp_locks,
Eterm rpid,
Eterm item,
int always_wrap);
@@ -824,10 +819,31 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
*fail_type = ERTS_PI_FAIL_TYPE_AWAIT_EXIT;
goto done;
}
- else if (!(locks & ERTS_PROC_LOCK_STATUS)) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+ else {
+ ErtsProcLocks unlock_locks = 0;
+
+ if (c_p == rp)
+ locks |= ERTS_PROC_LOCK_MAIN;
+
+ if (!(locks & ERTS_PROC_LOCK_STATUS))
+ unlock_locks |= ERTS_PROC_LOCK_STATUS;
+
+ if (locks & ERTS_PROC_LOCK_MSGQ) {
+ /*
+ * Move in queue into private queue and
+ * release msgq lock, enabling others to
+ * send messages to the process while it
+ * is being inspected...
+ */
+ ASSERT(locks & ERTS_PROC_LOCK_MAIN);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
+ locks &= ~ERTS_PROC_LOCK_MSGQ;
+ unlock_locks |= ERTS_PROC_LOCK_MSGQ;
+ }
+
+ if (unlock_locks)
+ erts_smp_proc_unlock(rp, unlock_locks);
}
-
/*
* We always handle 'messages' first if it should be part
@@ -839,7 +855,7 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
if (want_messages) {
ix = pi_arg2ix(am_messages);
ASSERT(part_res[ix] == THE_NON_VALUE);
- part_res[ix] = process_info_aux(c_p, rp, pid, am_messages, always_wrap);
+ part_res[ix] = process_info_aux(c_p, rp, locks, pid, am_messages, always_wrap);
ASSERT(part_res[ix] != THE_NON_VALUE);
}
@@ -847,7 +863,7 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap,
ix = res_elem_ix[res_elem_ix_ix];
if (part_res[ix] == THE_NON_VALUE) {
arg = pi_ix2arg(ix);
- part_res[ix] = process_info_aux(c_p, rp, pid, arg, always_wrap);
+ part_res[ix] = process_info_aux(c_p, rp, locks, pid, arg, always_wrap);
ASSERT(part_res[ix] != THE_NON_VALUE);
}
}
@@ -914,7 +930,7 @@ BIF_RETTYPE process_info_1(BIF_ALIST_1)
case ERTS_PI_FAIL_TYPE_AWAIT_EXIT:
ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
default:
- erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error", __FILE__, __LINE__);
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error", __FILE__, __LINE__);
}
}
@@ -954,7 +970,7 @@ BIF_RETTYPE process_info_2(BIF_ALIST_2)
case ERTS_PI_FAIL_TYPE_AWAIT_EXIT:
ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
default:
- erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error",
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error",
__FILE__, __LINE__);
}
}
@@ -978,9 +994,31 @@ BIF_RETTYPE process_info_2(BIF_ALIST_2)
ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined);
}
else {
+ ErtsProcLocks unlock_locks = 0;
+
+ if (BIF_P == rp)
+ info_locks |= ERTS_PROC_LOCK_MAIN;
+
if (!(info_locks & ERTS_PROC_LOCK_STATUS))
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- res = process_info_aux(BIF_P, rp, pid, BIF_ARG_2, 0);
+ unlock_locks |= ERTS_PROC_LOCK_STATUS;
+
+ if (info_locks & ERTS_PROC_LOCK_MSGQ) {
+ /*
+ * Move in queue into private queue and
+ * release msgq lock, enabling others to
+ * send messages to the process while it
+ * is being inspected...
+ */
+ ASSERT(info_locks & ERTS_PROC_LOCK_MAIN);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
+ info_locks &= ~ERTS_PROC_LOCK_MSGQ;
+ unlock_locks |= ERTS_PROC_LOCK_MSGQ;
+ }
+
+ if (unlock_locks)
+ erts_smp_proc_unlock(rp, unlock_locks);
+
+ res = process_info_aux(BIF_P, rp, info_locks, pid, BIF_ARG_2, 0);
}
ASSERT(is_value(res));
@@ -998,6 +1036,7 @@ BIF_RETTYPE process_info_2(BIF_ALIST_2)
Eterm
process_info_aux(Process *BIF_P,
Process *rp,
+ ErtsProcLocks rp_locks,
Eterm rpid,
Eterm item,
int always_wrap)
@@ -1069,171 +1108,55 @@ process_info_aux(Process *BIF_P,
break;
case am_messages: {
- ErlMessage* mp;
- int n;
-
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
- n = rp->msg.len;
- if (n == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) {
+ if (rp->msg.len == 0 || ERTS_TRACE_FLAGS(rp) & F_SENSITIVE) {
hp = HAlloc(BIF_P, 3);
} else {
- int remove_bad_messages = 0;
- struct {
- Uint copy_struct_size;
- ErlMessage* msgp;
- } *mq = erts_alloc(ERTS_ALC_T_TMP, n*sizeof(*mq));
- Sint i = 0;
- Uint heap_need = 3;
+ ErtsMessageInfo *mip;
+ Sint i;
+ Uint heap_need;
+#ifdef DEBUG
Eterm *hp_end;
+#endif
- for (mp = rp->msg.first; mp; mp = mp->next) {
- heap_need += 2;
- mq[i].msgp = mp;
- if (rp != BIF_P) {
- Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
- if (is_value(msg)) {
- mq[i].copy_struct_size = (is_immed(msg)? 0 :
- size_object(msg));
- }
- else if (mq[i].msgp->data.attached) {
- mq[i].copy_struct_size
- = erts_msg_attached_data_size(mq[i].msgp);
- }
- else {
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- mq[i].copy_struct_size = 0;
- }
- heap_need += mq[i].copy_struct_size;
- }
- else {
- mq[i].copy_struct_size = mp->data.attached ?
- erts_msg_attached_data_size(mp) : 0;
- }
- i++;
- }
+ mip = erts_alloc(ERTS_ALC_T_TMP,
+ rp->msg.len*sizeof(ErtsMessageInfo));
- if (rp != BIF_P) {
- hp = HAlloc(BIF_P, heap_need);
- hp_end = hp + heap_need;
- ASSERT(i == n);
- for (i--; i >= 0; i--) {
- Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
- if (is_value(msg)) {
- if (mq[i].copy_struct_size)
- msg = copy_struct(msg,
- mq[i].copy_struct_size,
- &hp,
- &MSO(BIF_P));
- }
- else if (mq[i].msgp->data.attached) {
- ErlHeapFragment *hfp;
- /*
- * Decode it into a message buffer and attach it
- * to the message instead of the attached external
- * term.
- *
- * Note that we may not pass a process pointer
- * to erts_msg_distext2heap(), since it would then
- * try to alter locks on that process.
- */
- msg = erts_msg_distext2heap(
- NULL, NULL, &hfp, &ERL_MESSAGE_TOKEN(mq[i].msgp),
- mq[i].msgp->data.dist_ext);
-
- ERL_MESSAGE_TERM(mq[i].msgp) = msg;
- mq[i].msgp->data.heap_frag = hfp;
-
- if (is_non_value(msg)) {
- ASSERT(!mq[i].msgp->data.heap_frag);
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- continue;
- }
- else {
- /* Make our copy of the message */
- ASSERT(size_object(msg) == erts_used_frag_sz(hfp));
- msg = copy_struct(msg,
- erts_used_frag_sz(hfp),
- &hp,
- &MSO(BIF_P));
- }
- }
- else {
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- continue;
- }
- res = CONS(hp, msg, res);
- hp += 2;
- }
- HRelease(BIF_P, hp_end, hp+3);
- }
- else {
- for (i--; i >= 0; i--) {
- ErtsHeapFactory factory;
- Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp);
-
- erts_factory_proc_prealloc_init(&factory, BIF_P,
- mq[i].copy_struct_size+2);
- if (mq[i].msgp->data.attached) {
- /* Decode it on the heap */
- erts_move_msg_attached_data_to_heap(&factory,
- mq[i].msgp);
- msg = ERL_MESSAGE_TERM(mq[i].msgp);
- ASSERT(!mq[i].msgp->data.attached);
- }
- if (is_value(msg)) {
- hp = erts_produce_heap(&factory, 2, 0);
- res = CONS(hp, msg, res);
- }
- else {
- /* Bad distribution message; ignore */
- remove_bad_messages = 1;
- continue;
- }
- erts_factory_close(&factory);
- }
- hp = HAlloc(BIF_P, 3);
- }
- erts_free(ERTS_ALC_T_TMP, mq);
- if (remove_bad_messages) {
- ErlMessage **mpp;
- /*
- * We need to remove bad distribution messages from
- * the queue, so that the value returned for
- * 'message_queue_len' is consistent with the value
- * returned for 'messages'.
- */
- mpp = &rp->msg.first;
- mp = rp->msg.first;
- while (mp) {
- if (is_value(ERL_MESSAGE_TERM(mp))) {
- mpp = &mp->next;
- mp = mp->next;
- }
- else {
- ErlMessage* bad_mp = mp;
- ASSERT(!mp->data.attached);
- if (rp->msg.save == &mp->next)
- rp->msg.save = mpp;
- if (rp->msg.last == &mp->next)
- rp->msg.last = mpp;
- *mpp = mp->next;
- mp = mp->next;
- rp->msg.len--;
- free_message(bad_mp);
- }
- }
+ /*
+ * Note that message queue may shrink when calling
+ * erts_prep_msgq_for_inspection() since it removes
+ * corrupt distribution messages.
+ */
+ heap_need = erts_prep_msgq_for_inspection(BIF_P, rp, rp_locks, mip);
+ heap_need += 3; /* top 2-tuple */
+ heap_need += rp->msg.len*2; /* Cons cells */
+
+ hp = HAlloc(BIF_P, heap_need); /* heap_need is exact */
+#ifdef DEBUG
+ hp_end = hp + heap_need;
+#endif
+
+ /* Build list of messages... */
+ for (i = rp->msg.len - 1, res = NIL; i >= 0; i--) {
+ Eterm msg = ERL_MESSAGE_TERM(mip[i].msgp);
+ Uint sz = mip[i].size;
+
+ if (sz != 0)
+ msg = copy_struct(msg, sz, &hp, &BIF_P->off_heap);
+
+ res = CONS(hp, msg, res);
+ hp += 2;
}
+
+ ASSERT(hp_end == hp + 3);
+
+ erts_free(ERTS_ALC_T_TMP, mip);
}
break;
}
case am_message_queue_len:
hp = HAlloc(BIF_P, 3);
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
res = make_small(rp->msg.len);
break;
@@ -1421,7 +1344,7 @@ process_info_aux(Process *BIF_P,
}
case am_total_heap_size: {
- ErlMessage *mp;
+ ErtsMessage *mp;
Uint total_heap_size;
Uint hsz = 3;
@@ -1431,8 +1354,6 @@ process_info_aux(Process *BIF_P,
total_heap_size += rp->mbuf_sz;
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp);
-
for (mp = rp->msg.first; mp; mp = mp->next)
if (mp->data.attached)
total_heap_size += erts_msg_attached_data_size(mp);
@@ -1454,7 +1375,7 @@ process_info_aux(Process *BIF_P,
case am_memory: { /* Memory consumed in bytes */
Uint hsz = 3;
- Uint size = erts_process_memory(rp);
+ Uint size = erts_process_memory(rp, 0);
(void) erts_bld_uint(NULL, &hsz, size);
hp = HAlloc(BIF_P, hsz);
res = erts_bld_uint(&hp, NULL, size);
@@ -1479,6 +1400,32 @@ process_info_aux(Process *BIF_P,
break;
}
+ case am_garbage_collection_info: {
+ Uint sz = 0, actual_sz = 0;
+
+ if (rp == BIF_P) {
+ sz += ERTS_PROCESS_GC_INFO_MAX_SIZE;
+ } else {
+ erts_process_gc_info(rp, &sz, NULL);
+ sz += 3;
+ }
+
+ hp = HAlloc(BIF_P, sz);
+ res = erts_process_gc_info(rp, &actual_sz, &hp);
+
+ /* We may have some extra space, fill with 0 tuples */
+ if (actual_sz <= sz - 3) {
+ for (; actual_sz < sz - 3; hp++, actual_sz++)
+ hp[0] = make_arityval(0);
+ } else {
+ for (; actual_sz < sz; hp++, actual_sz++)
+ hp[0] = make_arityval(0);
+ hp = HAlloc(BIF_P, 3);
+ }
+
+ break;
+ }
+
case am_group_leader: {
int sz = NC_HEAP_SIZE(rp->group_leader);
hp = HAlloc(BIF_P, 3 + sz);
@@ -1580,6 +1527,25 @@ process_info_aux(Process *BIF_P,
break;
}
+ case am_message_queue_data:
+ switch (rp->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) {
+ case F_OFF_HEAP_MSGQ:
+ res = am_off_heap;
+ break;
+ case F_ON_HEAP_MSGQ:
+ res = am_on_heap;
+ break;
+ case 0:
+ res = am_mixed;
+ break;
+ default:
+ res = am_error;
+ ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
+ break;
+ }
+ hp = HAlloc(BIF_P, 3);
+ break;
+
default:
return THE_NON_VALUE; /* will produce badarg */
@@ -1754,12 +1720,12 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */
if (arity == 2) {
Eterm res = THE_NON_VALUE;
char *buf;
- int len = is_string(*tp);
+ Sint len = is_string(*tp);
if (len <= 0)
return res;
buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1);
if (intlist_to_buf(*tp, buf, len) != len)
- erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__);
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
buf[len] = '\0';
res = erts_instr_dump_memory_map(buf) ? am_true : am_false;
erts_free(ERTS_ALC_T_TMP, (void *) buf);
@@ -1773,12 +1739,12 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */
else {
Eterm res = THE_NON_VALUE;
char *buf;
- int len = is_string(tp[1]);
+ Sint len = is_string(tp[1]);
if (len <= 0)
return res;
buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1);
if (intlist_to_buf(tp[1], buf, len) != len)
- erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__);
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
buf[len] = '\0';
res = erts_instr_dump_stat(buf, 1) ? am_true : am_false;
erts_free(ERTS_ALC_T_TMP, (void *) buf);
@@ -2076,12 +2042,18 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
#ifndef ERTS_SMP
BIF_RET(am_disabled);
#else
+#ifndef ERTS_DIRTY_SCHEDULERS
if (erts_no_schedulers == 1)
BIF_RET(am_disabled);
- else {
- BIF_RET(erts_is_multi_scheduling_blocked()
- ? am_blocked
- : am_enabled);
+ else
+#endif
+ {
+ int msb = erts_is_multi_scheduling_blocked();
+ BIF_RET(!msb
+ ? am_enabled
+ : (msb > 0
+ ? am_blocked
+ : am_blocked_normal));
}
#endif
} else if (BIF_ARG_1 == am_build_type) {
@@ -2550,77 +2522,120 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
res = TUPLE3(hp, make_small(1), make_small(1), make_small(1));
BIF_RET(res);
#else
+ Eterm *hp;
Uint total, online, active;
- switch (erts_schedulers_state(&total,
- &online,
- &active,
- NULL,
- NULL,
- NULL,
- 1)) {
- case ERTS_SCHDLR_SSPND_DONE: {
- Eterm *hp = HAlloc(BIF_P, 4);
- res = TUPLE3(hp,
- make_small(total),
- make_small(online),
- make_small(active));
- BIF_RET(res);
+ erts_schedulers_state(&total, &online, &active,
+ NULL, NULL, NULL, NULL, NULL);
+ hp = HAlloc(BIF_P, 4);
+ res = TUPLE3(hp,
+ make_small(total),
+ make_small(online),
+ make_small(active));
+ BIF_RET(res);
+#endif
+ } else if (ERTS_IS_ATOM_STR("schedulers_state", BIF_ARG_1)) {
+#ifndef ERTS_SMP
+ Eterm *hp = HAlloc(BIF_P, 4);
+ res = TUPLE3(hp, make_small(1), make_small(1), make_small(1));
+ BIF_RET(res);
+#else
+ Eterm *hp;
+ Uint total, online, active;
+ erts_schedulers_state(&total, &online, &active,
+ NULL, NULL, NULL, NULL, NULL);
+ hp = HAlloc(BIF_P, 4);
+ res = TUPLE3(hp,
+ make_small(total),
+ make_small(online),
+ make_small(active));
+ BIF_RET(res);
+#endif
+ } else if (ERTS_IS_ATOM_STR("all_schedulers_state", BIF_ARG_1)) {
+#ifndef ERTS_SMP
+ Eterm *hp = HAlloc(BIF_P, 2+5);
+ res = CONS(hp+5,
+ TUPLE4(hp,
+ am_normal,
+ make_small(1),
+ make_small(1),
+ make_small(1)),
+ NIL);
+ BIF_RET(res);
+#else
+ Eterm *hp, tpl;
+ Uint sz, total, online, active,
+ dirty_cpu_total, dirty_cpu_online, dirty_cpu_active,
+ dirty_io_total, dirty_io_active;
+ erts_schedulers_state(&total, &online, &active,
+ &dirty_cpu_total, &dirty_cpu_online, &dirty_cpu_active,
+ &dirty_io_total, &dirty_io_active);
+
+ sz = 2+5;
+ if (dirty_cpu_total)
+ sz += 2+5;
+ if (dirty_io_total)
+ sz += 2+5;
+
+ hp = HAlloc(BIF_P, sz);
+
+ res = NIL;
+ if (dirty_io_total) {
+ tpl = TUPLE4(hp,
+ am_dirty_io,
+ make_small(dirty_io_total),
+ make_small(dirty_io_total),
+ make_small(dirty_io_active));
+ hp += 5;
+ res = CONS(hp, tpl, res);
+ hp += 2;
}
- case ERTS_SCHDLR_SSPND_YIELD_RESTART:
- ERTS_VBUMP_ALL_REDS(BIF_P);
- BIF_TRAP1(bif_export[BIF_system_info_1],
- BIF_P, BIF_ARG_1);
- default:
- ASSERT(0);
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
+ if (dirty_cpu_total) {
+ tpl = TUPLE4(hp,
+ am_dirty_cpu,
+ make_small(dirty_cpu_total),
+ make_small(dirty_cpu_online),
+ make_small(dirty_cpu_active));
+ hp += 5;
+ res = CONS(hp, tpl, res);
+ hp += 2;
}
+ tpl = TUPLE4(hp,
+ am_normal,
+ make_small(total),
+ make_small(online),
+ make_small(active));
+ hp += 5;
+ res = CONS(hp, tpl, res);
+ BIF_RET(res);
#endif
} else if (ERTS_IS_ATOM_STR("schedulers_online", BIF_ARG_1)) {
#ifndef ERTS_SMP
BIF_RET(make_small(1));
#else
- Uint total, online, active;
- switch (erts_schedulers_state(&total, &online, &active, NULL, NULL, NULL, 1)) {
- case ERTS_SCHDLR_SSPND_DONE:
- BIF_RET(make_small(online));
- case ERTS_SCHDLR_SSPND_YIELD_RESTART:
- ERTS_VBUMP_ALL_REDS(BIF_P);
- BIF_TRAP1(bif_export[BIF_system_info_1],
- BIF_P, BIF_ARG_1);
- default:
- ASSERT(0);
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
- }
+ Uint online;
+ erts_schedulers_state(NULL, &online, NULL, NULL, NULL, NULL, NULL, NULL);
+ BIF_RET(make_small(online));
#endif
} else if (ERTS_IS_ATOM_STR("schedulers_active", BIF_ARG_1)) {
#ifndef ERTS_SMP
BIF_RET(make_small(1));
#else
- Uint total, online, active;
- switch (erts_schedulers_state(&total, &online, &active, NULL, NULL, NULL, 1)) {
- case ERTS_SCHDLR_SSPND_DONE:
- BIF_RET(make_small(active));
- case ERTS_SCHDLR_SSPND_YIELD_RESTART:
- ERTS_VBUMP_ALL_REDS(BIF_P);
- BIF_TRAP1(bif_export[BIF_system_info_1],
- BIF_P, BIF_ARG_1);
- default:
- ASSERT(0);
- BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
- }
+ Uint active;
+ erts_schedulers_state(NULL, NULL, &active, NULL, NULL, NULL, NULL, NULL);
+ BIF_RET(make_small(active));
#endif
#if defined(ERTS_SMP) && defined(ERTS_DIRTY_SCHEDULERS)
} else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers", BIF_ARG_1)) {
Uint dirty_cpu;
- erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, 1);
+ erts_schedulers_state(NULL, NULL, NULL, &dirty_cpu, NULL, NULL, NULL, NULL);
BIF_RET(make_small(dirty_cpu));
} else if (ERTS_IS_ATOM_STR("dirty_cpu_schedulers_online", BIF_ARG_1)) {
Uint dirty_cpu_onln;
- erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, 1);
+ erts_schedulers_state(NULL, NULL, NULL, NULL, &dirty_cpu_onln, NULL, NULL, NULL);
BIF_RET(make_small(dirty_cpu_onln));
} else if (ERTS_IS_ATOM_STR("dirty_io_schedulers", BIF_ARG_1)) {
Uint dirty_io;
- erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, &dirty_io, 1);
+ erts_schedulers_state(NULL, NULL, NULL, NULL, NULL, NULL, &dirty_io, NULL);
BIF_RET(make_small(dirty_io));
#endif
} else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) {
@@ -2674,7 +2689,16 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
if (erts_no_schedulers == 1)
BIF_RET(NIL);
else
- BIF_RET(erts_multi_scheduling_blockers(BIF_P));
+ BIF_RET(erts_multi_scheduling_blockers(BIF_P, 0));
+#endif
+ } else if (ERTS_IS_ATOM_STR("normal_multi_scheduling_blockers", BIF_ARG_1)) {
+#ifndef ERTS_SMP
+ BIF_RET(NIL);
+#else
+ if (erts_no_schedulers == 1)
+ BIF_RET(NIL);
+ else
+ BIF_RET(erts_multi_scheduling_blockers(BIF_P, 1));
#endif
} else if (ERTS_IS_ATOM_STR("modified_timing_level", BIF_ARG_1)) {
BIF_RET(ERTS_USE_MODIFIED_TIMING()
@@ -2741,6 +2765,19 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_RET(am_true);
}
#endif
+ else if (BIF_ARG_1 == am_message_queue_data) {
+ switch (erts_default_spo_flags & (SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ)) {
+ case SPO_OFF_HEAP_MSGQ:
+ BIF_RET(am_off_heap);
+ case SPO_ON_HEAP_MSGQ:
+ BIF_RET(am_on_heap);
+ case 0:
+ BIF_RET(am_mixed);
+ default:
+ ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
+ BIF_RET(am_error);
+ }
+ }
else if (ERTS_IS_ATOM_STR("compile_info",BIF_ARG_1)) {
Uint sz;
Eterm res = NIL, tup, text;
@@ -2779,6 +2816,20 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
else if (ERTS_IS_ATOM_STR("eager_check_io",BIF_ARG_1)) {
BIF_RET(erts_eager_check_io ? am_true : am_false);
}
+ else if (ERTS_IS_ATOM_STR("literal_test",BIF_ARG_1)) {
+#ifdef ERTS_HAVE_IS_IN_LITERAL_RANGE
+#ifdef ARCH_64
+ DECL_AM(range);
+ BIF_RET(AM_range);
+#else /* ARCH_32 */
+ DECL_AM(range_bitmask);
+ BIF_RET(AM_range_bitmask);
+#endif /* ARCH_32 */
+#else /* ! ERTS_HAVE_IS_IN_LITERAL_RANGE */
+ DECL_AM(tag);
+ BIF_RET(AM_tag);
+#endif
+ }
BIF_ERROR(BIF_P, BADARG);
}
@@ -3234,6 +3285,47 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1)
if (is_non_value(res))
BIF_RET(am_undefined);
BIF_TRAP1(gather_sched_wall_time_res_trap, BIF_P, res);
+ } else if (BIF_ARG_1 == am_total_active_tasks
+ || BIF_ARG_1 == am_total_run_queue_lengths) {
+ Uint no = erts_run_queues_len(NULL, 0, BIF_ARG_1 == am_total_active_tasks);
+ if (IS_USMALL(0, no))
+ res = make_small(no);
+ else {
+ Eterm *hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
+ res = uint_to_big(no, hp);
+ }
+ BIF_RET(res);
+ } else if (BIF_ARG_1 == am_active_tasks
+ || BIF_ARG_1 == am_run_queue_lengths) {
+ Eterm res, *hp, **hpp;
+ Uint sz, *szp;
+ int no_qs = erts_no_run_queues;
+ Uint *qszs = erts_alloc(ERTS_ALC_T_TMP,sizeof(Uint)*no_qs*2);
+ (void) erts_run_queues_len(qszs, 0, BIF_ARG_1 == am_active_tasks);
+ sz = 0;
+ szp = &sz;
+ hpp = NULL;
+ while (1) {
+ int i;
+ for (i = 0; i < no_qs; i++)
+ qszs[no_qs+i] = erts_bld_uint(hpp, szp, qszs[i]);
+ res = erts_bld_list(hpp, szp, no_qs, &qszs[no_qs]);
+ if (hpp) {
+ erts_free(ERTS_ALC_T_TMP, qszs);
+ BIF_RET(res);
+ }
+ hp = HAlloc(BIF_P, sz);
+ szp = NULL;
+ hpp = &hp;
+ }
+#ifdef ERTS_ENABLE_MSACC
+ } else if (BIF_ARG_1 == am_microstate_accounting) {
+ Eterm threads;
+ res = erts_msacc_request(BIF_P, ERTS_MSACC_GATHER, &threads);
+ if (is_non_value(res))
+ BIF_RET(am_undefined);
+ BIF_TRAP2(gather_msacc_res_trap, BIF_P, res, threads);
+#endif
} else if (BIF_ARG_1 == am_context_switches) {
Eterm cs = erts_make_integer(erts_get_total_context_switches(), BIF_P);
hp = HAlloc(BIF_P, 3);
@@ -3282,7 +3374,7 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1)
res = TUPLE2(hp, b1, b2);
BIF_RET(res);
} else if (BIF_ARG_1 == am_run_queue) {
- res = erts_run_queues_len(NULL);
+ res = erts_run_queues_len(NULL, 1, 0);
BIF_RET(make_small(res));
} else if (BIF_ARG_1 == am_wall_clock) {
UWord w1, w2;
@@ -3302,7 +3394,7 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1)
Uint sz, *szp;
int no_qs = erts_no_run_queues;
Uint *qszs = erts_alloc(ERTS_ALC_T_TMP,sizeof(Uint)*no_qs*2);
- (void) erts_run_queues_len(qszs);
+ (void) erts_run_queues_len(qszs, 0, 0);
sz = 0;
szp = &sz;
hpp = NULL;
@@ -3454,7 +3546,7 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1)
BIF_RET(res);
}
else if (ERTS_IS_ATOM_STR("mmap", BIF_ARG_1)) {
- BIF_RET(erts_mmap_debug_info(BIF_P));
+ BIF_RET(erts_mmap_debug_info(&erts_dflt_mmapper, BIF_P));
}
else if (ERTS_IS_ATOM_STR("unique_monotonic_integer_state", BIF_ARG_1)) {
BIF_RET(erts_debug_get_unique_monotonic_integer_state(BIF_P));
@@ -3751,6 +3843,18 @@ BIF_RETTYPE erts_internal_is_system_process_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+BIF_RETTYPE erts_internal_system_check_1(BIF_ALIST_1)
+{
+ Eterm res;
+ if (ERTS_IS_ATOM_STR("schedulers", BIF_ARG_1)) {
+ res = erts_system_check_request(BIF_P);
+ if (is_non_value(res))
+ BIF_RET(am_undefined);
+ BIF_TRAP1(gather_system_check_res_trap, BIF_P, res);
+ }
+
+ BIF_ERROR(BIF_P, BADARG);
+}
static erts_smp_atomic_t hipe_test_reschedule_flag;
@@ -3765,7 +3869,7 @@ static void broken_halt_test(Eterm bif_arg_2)
#if defined(ERTS_HAVE_TRY_CATCH)
erts_get_scheduler_data()->run_queue = NULL;
#endif
- erl_exit(ERTS_DUMP_EXIT, "%T", bif_arg_2);
+ erts_exit(ERTS_DUMP_EXIT, "%T", bif_arg_2);
}
@@ -3864,9 +3968,7 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
BIF_RET(am_false);
}
else {
- FLAGS(rp) |= F_FORCE_GC;
- if (BIF_P != rp)
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);
+ ERTS_FORCE_GC(BIF_P);
BIF_RET(am_true);
}
}
@@ -4012,7 +4114,7 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
BIF_RET(am_true);
}
else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) {
- erl_exit(ERTS_ABORT_EXIT, "%T\n", BIF_ARG_2);
+ erts_exit(ERTS_ABORT_EXIT, "%T\n", BIF_ARG_2);
}
else if (ERTS_IS_ATOM_STR("kill_dist_connection", BIF_ARG_1)) {
DistEntry *dep = erts_sysname_to_connected_dist_entry(BIF_ARG_2);
@@ -4085,6 +4187,17 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
BIF_RET(am_ok);
}
}
+ else if (ERTS_IS_ATOM_STR("fill_heap", BIF_ARG_1)) {
+ UWord left = HeapWordsLeft(BIF_P);
+ if (left > 1) {
+ Eterm* hp = HAlloc(BIF_P, left);
+ *hp = make_pos_bignum_header(left - 1);
+ }
+ if (BIF_ARG_2 == am_true) {
+ FLAGS(BIF_P) |= F_NEED_FULLSWEEP;
+ }
+ BIF_RET(am_ok);
+ }
}
BIF_ERROR(BIF_P, BADARG);
@@ -4334,14 +4447,17 @@ static void os_info_init(void)
os_flavor(buf, 1024);
flav = erts_atom_put((byte *) buf, strlen(buf), ERTS_ATOM_ENC_LATIN1, 1);
erts_free(ERTS_ALC_T_TMP, (void *) buf);
- hp = erts_alloc(ERTS_ALC_T_LL_TEMP_TERM, (3+4)*sizeof(Eterm));
+ hp = erts_alloc(ERTS_ALC_T_LITERAL, (3+4)*sizeof(Eterm));
os_type_tuple = TUPLE2(hp, type, flav);
+ erts_set_literal_tag(&os_type_tuple, hp, 3);
+
hp += 3;
os_version(&major, &minor, &build);
os_version_tuple = TUPLE3(hp,
make_small(major),
make_small(minor),
make_small(build));
+ erts_set_literal_tag(&os_version_tuple, hp, 4);
}
void
@@ -4358,6 +4474,10 @@ erts_bif_info_init(void)
= erts_export_put(am_erlang, am_gather_gc_info_result, 1);
gather_io_bytes_trap
= erts_export_put(am_erts_internal, am_gather_io_bytes, 2);
+ gather_msacc_res_trap
+ = erts_export_put(am_erts_internal, am_gather_microstate_accounting_result, 2);
+ gather_system_check_res_trap
+ = erts_export_put(am_erts_internal, am_gather_system_check_result, 1);
process_info_init();
os_info_init();
}
diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c
index 5583dcb371..fe64e76575 100644
--- a/erts/emulator/beam/erl_bif_lists.c
+++ b/erts/emulator/beam/erl_bif_lists.c
@@ -42,7 +42,7 @@ static BIF_RETTYPE append(Process* p, Eterm A, Eterm B)
Eterm last;
size_t need;
Eterm* hp;
- int i;
+ Sint i;
if ((i = erts_list_length(A)) < 0) {
BIF_ERROR(p, BADARG);
@@ -99,9 +99,9 @@ static Eterm subtract(Process* p, Eterm A, Eterm B)
Eterm small_vec[SMALL_VEC_SIZE]; /* Preallocated memory for small lists */
Eterm* vec_p;
Eterm* vp;
- int i;
- int n;
- int m;
+ Sint i;
+ Sint n;
+ Sint m;
if ((n = erts_list_length(A)) < 0) {
BIF_ERROR(p, BADARG);
diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c
index c9192fc420..0f20ded1d6 100644
--- a/erts/emulator/beam/erl_bif_op.c
+++ b/erts/emulator/beam/erl_bif_op.c
@@ -89,22 +89,22 @@ BIF_RETTYPE not_1(BIF_ALIST_1)
BIF_RETTYPE sgt_2(BIF_ALIST_2)
{
- BIF_RET(cmp_gt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_GT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE sge_2(BIF_ALIST_2)
{
- BIF_RET(cmp_ge(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_GE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE slt_2(BIF_ALIST_2)
{
- BIF_RET(cmp_lt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_LT(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE sle_2(BIF_ALIST_2)
{
- BIF_RET(cmp_le(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_LE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE seq_2(BIF_ALIST_2)
@@ -114,7 +114,7 @@ BIF_RETTYPE seq_2(BIF_ALIST_2)
BIF_RETTYPE seqeq_2(BIF_ALIST_2)
{
- BIF_RET(cmp_eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_EQ(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE sneq_2(BIF_ALIST_2)
@@ -124,7 +124,7 @@ BIF_RETTYPE sneq_2(BIF_ALIST_2)
BIF_RETTYPE sneqeq_2(BIF_ALIST_2)
{
- BIF_RET(cmp_ne(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
+ BIF_RET(CMP_NE(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false);
}
BIF_RETTYPE is_atom_1(BIF_ALIST_1)
@@ -258,7 +258,7 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2)
BIF_RET(am_true);
}
} else if (is_export(arg1)) {
- Export* exp = (Export *) EXPAND_POINTER((export_val(arg1))[1]);
+ Export* exp = (Export *) (export_val(arg1)[1]);
if (exp->code[2] == (Uint) arity) {
BIF_RET(am_true);
diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c
index e47d7bcbbb..86bcf43678 100644
--- a/erts/emulator/beam/erl_bif_port.c
+++ b/erts/emulator/beam/erl_bif_port.c
@@ -41,6 +41,7 @@
#include "external.h"
#include "packet_parser.h"
#include "erl_bits.h"
+#include "erl_bif_unique.h"
#include "dtrace-wrapper.h"
static Port *open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump);
@@ -50,10 +51,10 @@ static void free_args(char **);
char *erts_default_arg0 = "default";
-BIF_RETTYPE open_port_2(BIF_ALIST_2)
+BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2)
{
Port *port;
- Eterm port_id;
+ Eterm res;
char *str;
int err_type, err_num;
@@ -61,27 +62,58 @@ BIF_RETTYPE open_port_2(BIF_ALIST_2)
if (!port) {
if (err_type == -3) {
ASSERT(err_num == BADARG || err_num == SYSTEM_LIMIT);
- BIF_ERROR(BIF_P, err_num);
+ if (err_num == BADARG)
+ res = am_badarg;
+ else if (err_num == SYSTEM_LIMIT)
+ res = am_system_limit;
+ else
+ /* this is only here to silence gcc, it should not happen */
+ BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR);
} else if (err_type == -2) {
str = erl_errno_id(err_num);
+ res = erts_atom_put((byte *) str, strlen(str), ERTS_ATOM_ENC_LATIN1, 1);
} else {
- str = "einval";
+ res = am_einval;
}
- BIF_P->fvalue = erts_atom_put((byte *) str, strlen(str), ERTS_ATOM_ENC_LATIN1, 1);
- BIF_ERROR(BIF_P, EXC_ERROR);
- }
+ BIF_RET(res);
+ }
+
+ if (port->drv_ptr->flags & ERL_DRV_FLAG_USE_INIT_ACK) {
+ /* Copied from erl_port_task.c */
+ port->async_open_port = erts_alloc(ERTS_ALC_T_PRTSD,
+ sizeof(*port->async_open_port));
+ erts_make_ref_in_array(port->async_open_port->ref);
+ port->async_open_port->to = BIF_P->common.id;
+
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK);
+ if (ERTS_PROC_PENDING_EXIT(BIF_P)) {
+ /* need to exit caller instead */
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE | ERTS_PROC_LOCK_LINK);
+ KILL_CATCHES(BIF_P);
+ BIF_P->freason = EXC_EXIT;
+ erts_port_release(port);
+ BIF_RET(am_badarg);
+ }
+
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(BIF_P);
+ BIF_P->msg.save = BIF_P->msg.last;
- erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
+ erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_MSG_RECEIVE);
+
+ res = erts_proc_store_ref(BIF_P, port->async_open_port->ref);
+ } else {
+ res = port->common.id;
+ erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK);
+ }
- port_id = port->common.id;
erts_add_link(&ERTS_P_LINKS(port), LINK_PID, BIF_P->common.id);
- erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port_id);
+ erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port->common.id);
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK);
erts_port_release(port);
- BIF_RET(port_id);
+ BIF_RET(res);
}
static ERTS_INLINE Port *
@@ -617,7 +649,7 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1)
static Port *
open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
{
- int i;
+ Sint i;
Eterm option;
Uint arity;
Eterm* tp;
@@ -791,7 +823,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump)
} else {
name_buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1);
if (intlist_to_buf(name, name_buf, i) != i)
- erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__);
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error\n", __FILE__, __LINE__);
name_buf[i] = '\0';
}
driver = &vanilla_driver;
@@ -945,8 +977,8 @@ static char **convert_args(Eterm l)
{
char **pp;
char *b;
- int n;
- int i = 0;
+ Sint n;
+ Sint i = 0;
Eterm str;
if (is_not_list(l) && is_not_nil(l)) {
return NULL;
@@ -992,7 +1024,7 @@ static byte* convert_environment(Process* p, Eterm env)
Eterm* temp_heap;
Eterm* hp;
Uint heap_size;
- int n;
+ Sint n;
Sint size;
byte* bytes;
int encoding = erts_get_native_filename_encoding();
@@ -1169,7 +1201,7 @@ static Eterm http_bld_uri(struct packet_callback_args* pca,
return erts_bld_tuple(hpp, szp, 3, am_scheme, s1, s2);
default:
- erl_exit(1, "%s, line %d: type=%u\n", __FILE__, __LINE__, uri->type);
+ erts_exit(ERTS_ERROR_EXIT, "%s, line %d: type=%u\n", __FILE__, __LINE__, uri->type);
}
}
diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c
index 86951f32b0..7f7cd376ac 100644
--- a/erts/emulator/beam/erl_bif_re.c
+++ b/erts/emulator/beam/erl_bif_re.c
@@ -100,7 +100,7 @@ Sint erts_re_set_loop_limit(Sint limit)
static int term_to_int(Eterm term, int *sp)
{
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (is_small(term)) {
Uint x = signed_val(term);
@@ -151,7 +151,7 @@ static int term_to_int(Eterm term, int *sp)
static Eterm make_signed_integer(int x, Process *p)
{
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
return make_small(x);
#else
Eterm* hp;
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 03f51132b1..71a7079b09 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -431,6 +431,9 @@ Uint
erts_trace_flag2bit(Eterm flag)
{
switch (flag) {
+ case am_timestamp: return F_NOW_TS;
+ case am_strict_monotonic_timestamp: return F_STRICT_MON_TS;
+ case am_monotonic_timestamp: return F_MON_TS;
case am_all: return TRACEE_FLAGS;
case am_send: return F_TRACE_SEND;
case am_receive: return F_TRACE_RECEIVE;
@@ -439,7 +442,6 @@ erts_trace_flag2bit(Eterm flag)
case am_set_on_first_spawn: return F_TRACE_SOS1;
case am_set_on_link: return F_TRACE_SOL;
case am_set_on_first_link: return F_TRACE_SOL1;
- case am_timestamp: return F_TIMESTAMP;
case am_running: return F_TRACE_SCHED;
case am_exiting: return F_TRACE_SCHED_EXIT;
case am_garbage_collection: return F_TRACE_GC;
@@ -592,7 +594,7 @@ Eterm trace_3(BIF_ALIST_3)
ERTS_TRACE_FLAGS(tracee_port) |= mask;
else
ERTS_TRACE_FLAGS(tracee_port) &= ~mask;
-
+
if (!ERTS_TRACE_FLAGS(tracee_port))
ERTS_TRACER_PROC(tracee_port) = NIL;
else if (tracer != NIL)
@@ -978,7 +980,7 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
}
if (key == am_flags) {
- int num_flags = 19; /* MAXIMUM number of flags. */
+ int num_flags = 21; /* MAXIMUM number of flags. */
Uint needed = 3+2*num_flags;
Eterm flag_list = NIL;
Eterm* limit;
@@ -996,6 +998,9 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
#endif
hp = HAlloc(p, needed);
limit = hp+needed;
+ FLAG(F_NOW_TS, am_timestamp);
+ FLAG(F_STRICT_MON_TS, am_strict_monotonic_timestamp);
+ FLAG(F_MON_TS, am_monotonic_timestamp);
FLAG(F_TRACE_SEND, am_send);
FLAG(F_TRACE_RECEIVE, am_receive);
FLAG(F_TRACE_SOS, am_set_on_spawn);
@@ -1007,7 +1012,6 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key)
FLAG(F_TRACE_SCHED, am_running);
FLAG(F_TRACE_SCHED_EXIT, am_exiting);
FLAG(F_TRACE_GC, am_garbage_collection);
- FLAG(F_TIMESTAMP, am_timestamp);
FLAG(F_TRACE_ARITY_ONLY, am_arity);
FLAG(F_TRACE_RETURN_TO, am_return_to);
FLAG(F_TRACE_SILENT, am_silent);
@@ -1798,7 +1802,11 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2,
} else if (arg1 == am_print) {
current_flag = SEQ_TRACE_PRINT;
} else if (arg1 == am_timestamp) {
- current_flag = SEQ_TRACE_TIMESTAMP;
+ current_flag = SEQ_TRACE_NOW_TS;
+ } else if (arg1 == am_strict_monotonic_timestamp) {
+ current_flag = SEQ_TRACE_STRICT_MON_TS;
+ } else if (arg1 == am_monotonic_timestamp) {
+ current_flag = SEQ_TRACE_MON_TS;
}
else
current_flag = 0;
@@ -1879,11 +1887,7 @@ new_seq_trace_token(Process* p)
{
Eterm* hp;
- if (SEQ_TRACE_TOKEN(p) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(p) == am_have_dt_utag
-#endif
- ) {
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) {
hp = HAlloc(p, 6);
SEQ_TRACE_TOKEN(p) = TUPLE5(hp, make_small(0), /* Flags */
make_small(0), /* Label */
@@ -1903,13 +1907,11 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item)
BIF_ERROR(p, BADARG);
}
- if (SEQ_TRACE_TOKEN(p) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(p) == am_have_dt_utag
-#endif
- ) {
- if ((item == am_send) || (item == am_receive) ||
- (item == am_print) || (item == am_timestamp)) {
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) {
+ if ((item == am_send) || (item == am_receive) ||
+ (item == am_print) || (item == am_timestamp)
+ || (item == am_monotonic_timestamp)
+ || (item == am_strict_monotonic_timestamp)) {
hp = HAlloc(p,3);
res = TUPLE2(hp, item, am_false);
BIF_RET(res);
@@ -1927,7 +1929,11 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item)
} else if (item == am_print) {
current_flag = SEQ_TRACE_PRINT;
} else if (item == am_timestamp) {
- current_flag = SEQ_TRACE_TIMESTAMP;
+ current_flag = SEQ_TRACE_NOW_TS;
+ } else if (item == am_strict_monotonic_timestamp) {
+ current_flag = SEQ_TRACE_STRICT_MON_TS;
+ } else if (item == am_monotonic_timestamp) {
+ current_flag = SEQ_TRACE_MON_TS;
} else {
current_flag = 0;
}
@@ -1964,11 +1970,7 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
*/
BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1)
{
- if (SEQ_TRACE_TOKEN(BIF_P) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag
-#endif
- ) {
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) {
BIF_RET(am_false);
}
seq_trace_update_send(BIF_P);
@@ -1987,11 +1989,7 @@ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1)
*/
BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2)
{
- if (SEQ_TRACE_TOKEN(BIF_P) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag
-#endif
- ) {
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) {
BIF_RET(am_false);
}
if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) {
@@ -2237,6 +2235,7 @@ static Eterm system_profile_get(Process *p) {
if (erts_system_profile_flags.exclusive) {
res = CONS(hp, am_exclusive, res); hp += 2;
}
+
return TUPLE2(hp, system_profile, res);
}
}
@@ -2255,6 +2254,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
int system_blocked = 0;
Process *profiler_p = NULL;
Port *profiler_port = NULL;
+ int ts;
if (profiler == am_undefined || list == NIL) {
prev = system_profile_get(p);
@@ -2286,7 +2286,8 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
goto error;
}
- for (scheduler = 0, runnable_ports = 0, runnable_procs = 0, exclusive = 0;
+ for (ts = ERTS_TRACE_FLG_NOW_TIMESTAMP, scheduler = 0,
+ runnable_ports = 0, runnable_procs = 0, exclusive = 0;
is_list(list);
list = CDR(list_val(list))) {
@@ -2299,6 +2300,12 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
exclusive = !0;
} else if (t == am_scheduler) {
scheduler = !0;
+ } else if (t == am_timestamp) {
+ ts = ERTS_TRACE_FLG_NOW_TIMESTAMP;
+ } else if (t == am_strict_monotonic_timestamp) {
+ ts = ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP;
+ } else if (t == am_monotonic_timestamp) {
+ ts = ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP;
} else goto error;
}
if (is_not_nil(list)) goto error;
@@ -2311,7 +2318,7 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2)
erts_system_profile_flags.runnable_ports = !!runnable_ports;
erts_system_profile_flags.runnable_procs = !!runnable_procs;
erts_system_profile_flags.exclusive = !!exclusive;
-
+ erts_system_profile_ts_type = ts;
erts_smp_thr_progress_unblock();
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN);
diff --git a/erts/emulator/beam/erl_bif_unique.c b/erts/emulator/beam/erl_bif_unique.c
index 5eca09c5a6..c4a39b8897 100644
--- a/erts/emulator/beam/erl_bif_unique.c
+++ b/erts/emulator/beam/erl_bif_unique.c
@@ -338,7 +338,7 @@ static struct {
} w;
} raw_unique_monotonic_integer erts_align_attribute(ERTS_CACHE_LINE_SIZE);
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
# define ERTS_UNIQUE_MONOTONIC_OFFSET ERTS_SINT64_MIN
#else
# define ERTS_UNIQUE_MONOTONIC_OFFSET MIN_SMALL
@@ -368,7 +368,7 @@ get_unique_monotonic_integer_heap_size(Uint64 raw, int positive)
Sint64 value = ((Sint64) raw) + ERTS_UNIQUE_MONOTONIC_OFFSET;
if (IS_SSMALL(value))
return 0;
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
return ERTS_SINT64_HEAP_SIZE(value);
#else
return ERTS_UINT64_HEAP_SIZE((Uint64) value);
@@ -393,7 +393,7 @@ make_unique_monotonic_integer_value(Eterm *hp, Uint hsz, Uint64 raw, int positiv
if (hsz == 0)
res = make_small(value);
else {
-#if defined(ARCH_32) || HALFWORD_HEAP
+#if defined(ARCH_32)
res = erts_sint64_to_big(value, &hp);
#else
res = erts_uint64_to_big((Uint64) value, &hp);
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index ea01bf08f0..e181b5555d 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -72,7 +72,6 @@ typedef struct erl_heap_bin {
*/
#define binary_size(Bin) (binary_val(Bin)[1])
-#define binary_size_rel(Bin,BasePtr) (binary_val_rel(Bin,BasePtr)[1])
#define binary_bitsize(Bin) \
((*binary_val(Bin) == HEADER_SUB_BIN) ? \
@@ -95,12 +94,9 @@ typedef struct erl_heap_bin {
* Bitsize: output variable (Uint)
*/
-#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \
- ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,NULL)
-
-#define ERTS_GET_BINARY_BYTES_REL(Bin,Bytep,Bitoffs,Bitsize,BasePtr) \
+#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \
do { \
- Eterm* _real_bin = binary_val_rel(Bin,BasePtr); \
+ Eterm* _real_bin = binary_val(Bin); \
Uint _offs = 0; \
Bitoffs = Bitsize = 0; \
if (*_real_bin == HEADER_SUB_BIN) { \
@@ -108,7 +104,7 @@ do { \
_offs = _sb->offs; \
Bitoffs = _sb->bitoffs; \
Bitsize = _sb->bitsize; \
- _real_bin = binary_val_rel(_sb->orig,BasePtr); \
+ _real_bin = binary_val(_sb->orig); \
} \
if (*_real_bin == HEADER_PROC_BIN) { \
Bytep = ((ProcBin *) _real_bin)->bytes + _offs; \
@@ -131,11 +127,8 @@ do { \
*/
#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \
- ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, NULL)
-
-#define ERTS_GET_REAL_BIN_REL(Bin, RealBin, ByteOffset, BitOffset, BitSize, BasePtr) \
do { \
- ErlSubBin* _sb = (ErlSubBin *) binary_val_rel(Bin,BasePtr); \
+ ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \
if (_sb->thing_word == HEADER_SUB_BIN) { \
RealBin = _sb->orig; \
ByteOffset = _sb->offs; \
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 01734c55d7..11d83686a3 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -282,7 +282,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
* Simply shift whole bytes into the result.
*/
switch (BYTE_OFFSET(n)) {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
case 7: w = (w << 8) | *bp++;
case 6: w = (w << 8) | *bp++;
case 5: w = (w << 8) | *bp++;
@@ -387,7 +387,7 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
case 3:
v32 = LSB[0] + (LSB[1]<<8) + (LSB[2]<<16);
goto big_small;
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
case 4:
v32 = (LSB[0] + (LSB[1]<<8) + (LSB[2]<<16) + (LSB[3]<<24));
if (!IS_USMALL(sgn, v32)) {
diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c
index 8395f6ecc6..c263eebfcc 100644
--- a/erts/emulator/beam/erl_cpu_topology.c
+++ b/erts/emulator/beam/erl_cpu_topology.c
@@ -402,7 +402,7 @@ cpu_bind_order_sort(erts_cpu_topology_t *cpudata,
break;
default:
cmp_func = NULL;
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Bad cpu bind type: %d\n",
(int) cpu_bind_order);
break;
@@ -1590,7 +1590,7 @@ get_cpu_topology_term(Process *c_p, int type)
}
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "Bad cpu topology type: %d\n", type);
+ erts_exit(ERTS_ABORT_EXIT, "Bad cpu topology type: %d\n", type);
break;
}
@@ -1967,7 +1967,7 @@ cpu_group_insert(erts_cpu_groups_map_t *map,
ix = 0;
} while (ix != start);
- erl_exit(ERTS_ABORT_EXIT, "Reader groups map full\n");
+ erts_exit(ERTS_ABORT_EXIT, "Reader groups map full\n");
}
@@ -2290,7 +2290,7 @@ remove_cpu_groups(erts_cpu_groups_callback_t callback, void *arg)
prev_cgm = cgm;
}
- erl_exit(ERTS_ABORT_EXIT, "Cpu groups not found\n");
+ erts_exit(ERTS_ABORT_EXIT, "Cpu groups not found\n");
}
static int
@@ -2320,7 +2320,7 @@ cpu_groups_lookup(erts_cpu_groups_map_t *map,
ix = 0;
} while (ix != start);
- erl_exit(ERTS_ABORT_EXIT, "Logical cpu id %d not found\n", logical);
+ erts_exit(ERTS_ABORT_EXIT, "Logical cpu id %d not found\n", logical);
}
static void
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 878ee32b47..441dbdde4f 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -1295,7 +1295,7 @@ BIF_RETTYPE ets_rename_2(BIF_ALIST_2)
goto badarg;
if (!remove_named_tab(tb, 1))
- erl_exit(1,"Could not find named tab %s", tb->common.id);
+ erts_exit(ERTS_ERROR_EXIT,"Could not find named tab %s", tb->common.id);
tb->common.id = tb->common.the_name = BIF_ARG_2;
@@ -1376,7 +1376,6 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
status |= DB_ORDERED_SET;
status &= ~(DB_SET | DB_BAG | DB_DUPLICATE_BAG);
}
- /*TT*/
else if (is_tuple(val)) {
Eterm *tp = tuple_val(val);
if (arityval(tp[0]) == 2) {
@@ -1581,7 +1580,7 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2)
BIF_P->common.id,
make_small(slot)),
0) != DB_ERROR_NONE) {
- erl_exit(1,"Could not update ets metadata.");
+ erts_exit(ERTS_ERROR_EXIT,"Could not update ets metadata.");
}
db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC);
@@ -1774,15 +1773,9 @@ BIF_RETTYPE ets_delete_1(BIF_ALIST_1)
* (it looks like an continuation pointer), but that is will crash the
* emulator if this BIF is call traced.
*/
-#if HALFWORD_HEAP
- Eterm *hp = HAlloc(BIF_P, 3);
- hp[0] = make_pos_bignum_header(2);
- *((UWord *) (UWord) (hp+1)) = (UWord) tb;
-#else
Eterm *hp = HAlloc(BIF_P, 2);
hp[0] = make_pos_bignum_header(1);
hp[1] = (Eterm) tb;
-#endif
BIF_TRAP1(&ets_delete_continue_exp, BIF_P, make_big(hp));
}
else {
@@ -1838,7 +1831,7 @@ BIF_RETTYPE ets_give_away_3(BIF_ALIST_3)
tb->common.id,
from_pid,
BIF_ARG_3),
- 0);
+ 0);
erts_smp_proc_unlock(to_proc, to_locks);
UnUseTmpHeap(5,BIF_P);
BIF_RET(am_true);
@@ -2840,7 +2833,7 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3)
BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3],
BIF_P,lst,BIF_ARG_2,ret);
}
- res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, NULL, 0,
+ res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, 0,
ERTS_PAM_COPY_RESULT, &dummy);
if (is_value(res)) {
hp = HAlloc(BIF_P, 2);
@@ -2940,7 +2933,7 @@ void init_db(ErtsDbSpinCount db_spin_count)
bits = erts_fit_in_bits_int32(db_max_tabs-1);
if (bits > SMALL_BITS) {
- erl_exit(1,"Max limit for ets tabled too high %u (max %u).",
+ erts_exit(ERTS_ERROR_EXIT,"Max limit for ets tabled too high %u (max %u).",
db_max_tabs, ((Uint)1)<<SMALL_BITS);
}
meta_main_tab_slot_mask = (((Uint)1)<<bits) - 1;
@@ -3001,7 +2994,7 @@ void init_db(ErtsDbSpinCount db_spin_count)
db_init_lock(meta_pid_to_tab, "meta_pid_to_tab", "meta_pid_to_tab_FIX");*/
if (db_create_hash(NULL, meta_pid_to_tab) != DB_ERROR_NONE) {
- erl_exit(1,"Unable to create ets metadata tables.");
+ erts_exit(ERTS_ERROR_EXIT,"Unable to create ets metadata tables.");
}
erts_smp_atomic_set_nob(&init_tb.common.memory_size, 0);
@@ -3032,7 +3025,7 @@ void init_db(ErtsDbSpinCount db_spin_count)
db_init_lock(meta_pid_to_fixed_tab, "meta_pid_to_fixed_tab", "meta_pid_to_fixed_tab_FIX");*/
if (db_create_hash(NULL, meta_pid_to_fixed_tab) != DB_ERROR_NONE) {
- erl_exit(1,"Unable to create ets metadata tables.");
+ erts_exit(ERTS_ERROR_EXIT,"Unable to create ets metadata tables.");
}
/* Non visual BIF to trap to. */
@@ -3217,7 +3210,7 @@ retry:
tb->common.id,
p->common.id,
heir_data),
- 0);
+ 0);
erts_smp_proc_unlock(to_proc, to_locks);
return !0;
}
@@ -3229,7 +3222,7 @@ retry:
* yielding.
*/
#define ERTS_DB_INTERNAL_ERROR(LSTR) \
- erl_exit(ERTS_ABORT_EXIT, "%s:%d:erts_db_process_exiting(): " LSTR "\n", \
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d:erts_db_process_exiting(): " LSTR "\n", \
__FILE__, __LINE__)
int
@@ -3466,10 +3459,10 @@ static void fix_table_locked(Process* p, DbTable* tb)
#endif
erts_refc_inc(&tb->common.ref,1);
fix = tb->common.fixations;
- if (fix == NULL) {
- get_now(&(tb->common.megasec),
- &(tb->common.sec),
- &(tb->common.microsec));
+ if (fix == NULL) {
+ tb->common.time.monotonic
+ = erts_get_monotonic_time(ERTS_PROC_GET_SCHDATA(p));
+ tb->common.time.offset = erts_get_time_offset();
}
else {
for (; fix != NULL; fix = fix->next) {
@@ -3501,7 +3494,7 @@ static void fix_table_locked(Process* p, DbTable* tb)
make_small(tb->common.slot)),
0) != DB_ERROR_NONE) {
UnUseTmpHeap(3,p);
- erl_exit(1,"Could not insert ets metadata in safe_fixtable.");
+ erts_exit(ERTS_ERROR_EXIT,"Could not insert ets metadata in safe_fixtable.");
}
UnUseTmpHeap(3,p);
db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC);
@@ -3652,11 +3645,8 @@ static BIF_RETTYPE ets_delete_trap(BIF_ALIST_1)
Eterm* ptr = big_val(cont);
DbTable *tb = *((DbTable **) (UWord) (ptr + 1));
-#if HALFWORD_HEAP
- ASSERT(*ptr == make_pos_bignum_header(2));
-#else
ASSERT(*ptr == make_pos_bignum_header(1));
-#endif
+
db_lock(tb, LCK_WRITE);
trap = free_table_cont(p, tb, 0, 1);
db_unlock(tb, LCK_WRITE);
@@ -3731,6 +3721,7 @@ static int free_table_cont(Process *p,
static Eterm table_info(Process* p, DbTable* tb, Eterm What)
{
Eterm ret = THE_NON_VALUE;
+ int use_monotonic;
if (What == am_size) {
ret = make_small(erts_smp_atomic_read_nob(&tb->common.nitems));
@@ -3788,7 +3779,10 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
ret = am_true;
else
ret = am_false;
- } else if (What == am_atom_put("safe_fixed",10)) {
+ } else if ((use_monotonic
+ = ERTS_IS_ATOM_STR("safe_fixed_monotonic_time",
+ What))
+ || ERTS_IS_ATOM_STR("safe_fixed", What)) {
#ifdef ERTS_SMP
erts_smp_mtx_lock(&tb->common.fixlock);
#endif
@@ -3797,7 +3791,19 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
Eterm *hp;
Eterm tpl, lst;
DbFixation *fix;
- need = 7;
+ Sint64 mtime;
+
+ need = 3;
+ if (use_monotonic) {
+ mtime = (Sint64) tb->common.time.monotonic;
+ mtime += ERTS_MONOTONIC_OFFSET_NATIVE;
+ if (!IS_SSMALL(mtime))
+ need += ERTS_SINT64_HEAP_SIZE(mtime);
+ }
+ else {
+ mtime = 0;
+ need += 4;
+ }
for (fix = tb->common.fixations; fix != NULL; fix = fix->next) {
need += 5;
}
@@ -3809,11 +3815,18 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What)
lst = CONS(hp,tpl,lst);
hp += 2;
}
- tpl = TUPLE3(hp,
- make_small(tb->common.megasec),
- make_small(tb->common.sec),
- make_small(tb->common.microsec));
- hp += 4;
+ if (use_monotonic)
+ tpl = (IS_SSMALL(mtime)
+ ? make_small(mtime)
+ : erts_sint64_to_big(mtime, &hp));
+ else {
+ Uint ms, s, us;
+ erts_make_timestamp_value(&ms, &s, &us,
+ tb->common.time.monotonic,
+ tb->common.time.offset);
+ tpl = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
+ hp += 4;
+ }
ret = TUPLE2(hp, tpl, lst);
} else {
ret = am_false;
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 98a2e2842a..240b79fc60 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -469,9 +469,6 @@ static ERTS_INLINE void try_shrink(DbTableHash* tb)
}
}
-#define EQ_REL(x,y,y_base) \
- (is_same(x,NULL,y,y_base) || (is_not_both_immed((x),(y)) && eq_rel((x),NULL,(y),y_base)))
-
/* Is this a live object (not pseodo-deleted) with the specified key?
*/
static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b,
@@ -481,7 +478,7 @@ static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b,
else {
Eterm itemKey = GETKEY(tb, b->dbterm.tpl);
ASSERT(!is_header(itemKey));
- return EQ_REL(key, itemKey, b->dbterm.tpl);
+ return EQ(key, itemKey);
}
}
@@ -494,7 +491,7 @@ static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b,
else {
Eterm itemKey = GETKEY(tb, b->dbterm.tpl);
ASSERT(!is_header(itemKey));
- return EQ_REL(key, itemKey, b->dbterm.tpl);
+ return EQ(key, itemKey);
}
}
@@ -2204,11 +2201,11 @@ static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl)
erts_print(to, to_arg, "*");
if (tb->common.compress) {
Eterm key = GETKEY(tb, list->dbterm.tpl);
- erts_print(to, to_arg, "key=%R", key, list->dbterm.tpl);
+ erts_print(to, to_arg, "key=%T", key);
}
else {
- Eterm obj = make_tuple_rel(list->dbterm.tpl,list->dbterm.tpl);
- erts_print(to, to_arg, "%R", obj, list->dbterm.tpl);
+ Eterm obj = make_tuple(list->dbterm.tpl);
+ erts_print(to, to_arg, "%T", obj);
}
if (list->next != 0)
erts_print(to, to_arg, ",");
@@ -2899,9 +2896,6 @@ Ldone:
handle->dbterm = &b->dbterm;
handle->flags = flags;
handle->new_size = b->dbterm.size;
-#if HALFWORD_HEAP
- handle->abs_vec = NULL;
-#endif
handle->lck = lck;
return 1;
}
@@ -3028,7 +3022,7 @@ void db_check_table_hash(DbTable *tbl)
if ((list = BUCKET(tb,j)) != 0) {
while (list != 0) {
if (!is_tuple(make_tuple(list->dbterm.tpl))) {
- erl_exit(1, "Bad term in slot %d of ets table", j);
+ erts_exit(ERTS_ERROR_EXIT, "Bad term in slot %d of ets table", j);
}
list = list->next;
}
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index 465aa566ad..0f642f0867 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -280,7 +280,7 @@ struct select_delete_context {
/*
** Forward declarations
*/
-static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key, Eterm* key_base);
+static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key);
static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
Eterm object);
static int do_free_tree_cont(DbTableTree *tb, int num_left);
@@ -291,15 +291,15 @@ static int delsub(TreeDbTerm **this);
static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot);
static TreeDbTerm *find_node(DbTableTree *tb, Eterm key);
static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key);
-static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase);
-static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key, Eterm* kbase);
+static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key);
+static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key);
static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*,
Eterm key);
static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack*,
Eterm key);
static void traverse_backwards(DbTableTree *tb,
DbTreeStack*,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *tb,
TreeDbTerm *,
void *,
@@ -307,7 +307,7 @@ static void traverse_backwards(DbTableTree *tb,
void *context);
static void traverse_forward(DbTableTree *tb,
DbTreeStack*,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *tb,
TreeDbTerm *,
void *,
@@ -315,8 +315,8 @@ static void traverse_forward(DbTableTree *tb,
void *context);
static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
Eterm *partly_bound_key);
-static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base);
-static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done);
+static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key);
+static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done);
static int analyze_pattern(DbTableTree *tb, Eterm pattern,
struct mp_info *mpi);
@@ -517,7 +517,7 @@ static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
if (is_atom(key) && key == am_EOT)
return DB_ERROR_BADKEY;
stack = get_any_stack(tb);
- this = find_next(tb, stack, key, NULL);
+ this = find_next(tb, stack, key);
release_stack(tb,stack);
if (this == NULL) {
*ret = am_EOT;
@@ -563,7 +563,7 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
if (is_atom(key) && key == am_EOT)
return DB_ERROR_BADKEY;
stack = get_any_stack(tb);
- this = find_prev(tb, stack, key, NULL);
+ this = find_prev(tb, stack, key);
release_stack(tb,stack);
if (this == NULL) {
*ret = am_EOT;
@@ -573,19 +573,13 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
return DB_ERROR_NONE;
}
-static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base,
- TreeDbTerm* obj)
-{
- return cmp_rel(key, key_base,
- GETKEY(tb,obj->dbterm.tpl), obj->dbterm.tpl);
+static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, TreeDbTerm* obj) {
+ return CMP(key, GETKEY(tb,obj->dbterm.tpl));
}
-static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, Eterm* key_base,
- TreeDbTerm* obj)
-{
+static ERTS_INLINE int cmp_key_eq(DbTableTree* tb, Eterm key, TreeDbTerm* obj) {
Eterm obj_key = GETKEY(tb,obj->dbterm.tpl);
- return is_same(key, key_base, obj_key, obj->dbterm.tpl)
- || cmp_rel(key, key_base, obj_key, obj->dbterm.tpl) == 0;
+ return is_same(key, obj_key) || CMP(key, obj_key) == 0;
}
static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail)
@@ -619,7 +613,7 @@ static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail)
(*this)->balance = 0;
(*this)->left = (*this)->right = NULL;
break;
- } else if ((c = cmp_key(tb, key, NULL, *this)) < 0) {
+ } else if ((c = cmp_key(tb, key, *this)) < 0) {
/* go lefts */
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
@@ -774,7 +768,7 @@ static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret)
*ret = am_true;
- if ((res = linkout_tree(tb, key, NULL)) != NULL) {
+ if ((res = linkout_tree(tb, key)) != NULL) {
free_term(tb, res);
}
return DB_ERROR_NONE;
@@ -970,15 +964,15 @@ static int db_select_continue_tree(Process *p,
stack = get_any_stack(tb);
if (chunk_size) {
if (reverse) {
- traverse_backwards(tb, stack, lastkey, NULL, &doit_select_chunk, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc);
} else {
- traverse_forward(tb, stack, lastkey, NULL, &doit_select_chunk, &sc);
+ traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc);
}
} else {
if (reverse) {
- traverse_forward(tb, stack, lastkey, NULL, &doit_select, &sc);
+ traverse_forward(tb, stack, lastkey, &doit_select, &sc);
} else {
- traverse_backwards(tb, stack, lastkey, NULL, &doit_select, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select, &sc);
}
}
release_stack(tb,stack);
@@ -1003,9 +997,9 @@ static int db_select_continue_tree(Process *p,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key,sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
continuation = TUPLE8
(hp,
tptr[1],
@@ -1026,8 +1020,8 @@ static int db_select_continue_tree(Process *p,
key = GETKEY(tb, sc.lastobj);
if (chunk_size) {
if (end_condition != NIL &&
- ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0) ||
- (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0))) {
+ ((!reverse && cmp_partly_bound(end_condition,key) < 0) ||
+ (reverse && cmp_partly_bound(end_condition,key) > 0))) {
/* done anyway */
if (!sc.got) {
RET_TO_BIF(am_EOT, DB_ERROR_NONE);
@@ -1039,16 +1033,16 @@ static int db_select_continue_tree(Process *p,
}
} else {
if (end_condition != NIL &&
- ((!reverse && cmp_partly_bound(end_condition,key,sc.lastobj) > 0) ||
- (reverse && cmp_partly_bound(end_condition,key,sc.lastobj) < 0))) {
+ ((!reverse && cmp_partly_bound(end_condition,key) > 0) ||
+ (reverse && cmp_partly_bound(end_condition,key) < 0))) {
/* done anyway */
RET_TO_BIF(sc.accum,DB_ERROR_NONE);
}
}
/* Not done yet, let's trap. */
- sz = size_object_rel(key,sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
continuation = TUPLE8
(hp,
tptr[1],
@@ -1075,7 +1069,6 @@ static int db_select_tree(Process *p, DbTable *tbl,
struct select_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1127,20 +1120,18 @@ static int db_select_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.most;
}
- traverse_forward(tb, stack, lastkey, lk_base, &doit_select, &sc);
+ traverse_forward(tb, stack, lastkey, &doit_select, &sc);
} else {
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, stack, lastkey, lk_base, &doit_select, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select, &sc);
}
release_stack(tb,stack);
#ifdef HARDDEBUG
@@ -1153,9 +1144,9 @@ static int db_select_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb=db_make_mp_binary(p,mpi.mp,&hp);
@@ -1213,7 +1204,7 @@ static int db_select_count_continue_tree(Process *p,
tptr = tuple_val(continuation);
if (arityval(*tptr) != 5)
- erl_exit(1,"Internal error in ets:select_count/1");
+ erts_exit(ERTS_ERROR_EXIT,"Internal error in ets:select_count/1");
lastkey = tptr[2];
end_condition = tptr[3];
@@ -1236,7 +1227,7 @@ static int db_select_count_continue_tree(Process *p,
}
stack = get_any_stack(tb);
- traverse_backwards(tb, stack, lastkey, NULL, &doit_select_count, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc);
release_stack(tb,stack);
BUMP_REDS(p, 1000 - sc.max);
@@ -1246,12 +1237,12 @@ static int db_select_count_continue_tree(Process *p,
}
key = GETKEY(tb, sc.lastobj);
if (end_condition != NIL &&
- (cmp_partly_bound(end_condition,key,sc.lastobj) > 0)) {
+ (cmp_partly_bound(end_condition,key) > 0)) {
/* done anyway */
RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE);
}
/* Not done yet, let's trap. */
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
if (IS_USMALL(0, sc.got)) {
hp = HAlloc(p, sz + 6);
egot = make_small(sc.got);
@@ -1261,7 +1252,7 @@ static int db_select_count_continue_tree(Process *p,
egot = uint_to_big(sc.got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
continuation = TUPLE5
(hp,
tptr[1],
@@ -1284,7 +1275,6 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
struct select_count_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1334,12 +1324,11 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_count, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc);
release_stack(tb,stack);
BUMP_REDS(p, 1000 - sc.max);
if (sc.max > 0) {
@@ -1347,7 +1336,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
if (IS_USMALL(0, sc.got)) {
hp = HAlloc(p, sz + PROC_BIN_SIZE + 6);
egot = make_small(sc.got);
@@ -1357,7 +1346,7 @@ static int db_select_count_tree(Process *p, DbTable *tbl,
egot = uint_to_big(sc.got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb = db_make_mp_binary(p,mpi.mp,&hp);
@@ -1388,7 +1377,6 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
struct select_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1445,20 +1433,18 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc);
+ traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc);
} else {
if (mpi.some_limitation) {
if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.most;
}
- traverse_forward(tb, stack, lastkey, lk_base, &doit_select_chunk, &sc);
+ traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc);
}
release_stack(tb,stack);
@@ -1483,9 +1469,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
mpb = db_make_mp_binary(p,mpi.mp,&hp);
@@ -1508,9 +1494,9 @@ static int db_select_chunk_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, sc.lastobj);
- sz = size_object_rel(key, sc.lastobj);
+ sz = size_object(key);
hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE);
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastobj, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
if (mpi.all_objects)
(mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS;
@@ -1586,7 +1572,7 @@ static int db_select_delete_continue_tree(Process *p,
sc.keypos = tb->common.keypos;
ASSERT(!erts_smp_atomic_read_nob(&tb->is_stack_busy));
- traverse_backwards(tb, &tb->static_stack, lastkey, NULL, &doit_select_delete, &sc);
+ traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc);
BUMP_REDS(p, 1000 - sc.max);
@@ -1595,11 +1581,11 @@ static int db_select_delete_continue_tree(Process *p,
}
key = GETKEY(tb, (sc.lastterm)->dbterm.tpl);
if (end_condition != NIL &&
- cmp_partly_bound(end_condition,key,sc.lastterm->dbterm.tpl) > 0) { /* done anyway */
+ cmp_partly_bound(end_condition,key) > 0) { /* done anyway */
RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE);
}
/* Not done yet, let's trap. */
- sz = size_object_rel(key, sc.lastterm->dbterm.tpl);
+ sz = size_object(key);
if (IS_USMALL(0, sc.accum)) {
hp = HAlloc(p, sz + 6);
eaccsum = make_small(sc.accum);
@@ -1609,7 +1595,7 @@ static int db_select_delete_continue_tree(Process *p,
eaccsum = uint_to_big(sc.accum, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
continuation = TUPLE5
(hp,
tptr[1],
@@ -1630,7 +1616,6 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
struct select_delete_context sc;
struct mp_info mpi;
Eterm lastkey = THE_NON_VALUE;
- Eterm* lk_base = NULL;
Eterm key;
Eterm continuation;
unsigned sz;
@@ -1683,12 +1668,11 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
if (mpi.some_limitation) {
if ((this = find_next_from_pb_key(tb, &tb->static_stack, mpi.most)) != NULL) {
lastkey = GETKEY(tb, this->dbterm.tpl);
- lk_base = this->dbterm.tpl;
}
sc.end_condition = mpi.least;
}
- traverse_backwards(tb, &tb->static_stack, lastkey, lk_base, &doit_select_delete, &sc);
+ traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc);
BUMP_REDS(p, 1000 - sc.max);
if (sc.max > 0) {
@@ -1696,7 +1680,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
}
key = GETKEY(tb, (sc.lastterm)->dbterm.tpl);
- sz = size_object_rel(key, sc.lastterm->dbterm.tpl);
+ sz = size_object(key);
if (IS_USMALL(0, sc.accum)) {
hp = HAlloc(p, sz + PROC_BIN_SIZE + 6);
eaccsum = make_small(sc.accum);
@@ -1706,7 +1690,7 @@ static int db_select_delete_tree(Process *p, DbTable *tbl,
eaccsum = uint_to_big(sc.accum, hp);
hp += BIG_UINT_HEAP_SIZE;
}
- key = copy_struct_rel(key, sz, &hp, &MSO(p), sc.lastterm->dbterm.tpl, NULL);
+ key = copy_struct(key, sz, &hp, &MSO(p));
mpb = db_make_mp_binary(p,mpi.mp,&hp);
continuation = TUPLE5
@@ -1734,7 +1718,7 @@ static int db_take_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
TreeDbTerm *this;
*ret = NIL;
- this = linkout_tree(tb, key, NULL);
+ this = linkout_tree(tb, key);
if (this) {
Eterm copy, *hp, *hend;
@@ -1845,9 +1829,7 @@ do_db_tree_foreach_offheap(TreeDbTerm *tdbt,
do_db_tree_foreach_offheap(tdbt->right, func, arg);
}
-static TreeDbTerm *linkout_tree(DbTableTree *tb,
- Eterm key, Eterm* key_base)
-{
+static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key) {
TreeDbTerm **tstack[STACK_NEED];
int tpos = 0;
int dstack[STACK_NEED+1];
@@ -1869,7 +1851,7 @@ static TreeDbTerm *linkout_tree(DbTableTree *tb,
for (;;) {
if (!*this) { /* Failure */
return NULL;
- } else if ((c = cmp_key(tb, key, key_base, *this)) < 0) {
+ } else if ((c = cmp_key(tb, key, *this)) < 0) {
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -1933,7 +1915,7 @@ static TreeDbTerm *linkout_object_tree(DbTableTree *tb,
for (;;) {
if (!*this) { /* Failure */
return NULL;
- } else if ((c = cmp_key(tb,key,NULL,*this)) < 0) {
+ } else if ((c = cmp_key(tb,key,*this)) < 0) {
dstack[dpos++] = DIR_LEFT;
tstack[tpos++] = this;
this = &((*this)->left);
@@ -2319,15 +2301,13 @@ done:
* Find next and previous in sort order
*/
-static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack,
- Eterm key, Eterm* key_base)
-{
+static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) {
TreeDbTerm *this;
TreeDbTerm *tmp;
Sint c;
if(( this = TOP_NODE(stack)) != NULL) {
- if (!cmp_key_eq(tb,key,key_base,this)) {
+ if (!cmp_key_eq(tb,key,this)) {
/* Start from the beginning */
stack->pos = stack->slot = 0;
}
@@ -2337,7 +2317,7 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_key(tb,key,key_base,this) ) > 0) {
+ if (( c = cmp_key(tb,key,this) ) > 0) {
if (this->right == NULL) /* We are at the previos
and the element does
not exist */
@@ -2377,15 +2357,13 @@ static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack,
return this;
}
-static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack,
- Eterm key, Eterm* key_base)
-{
+static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) {
TreeDbTerm *this;
TreeDbTerm *tmp;
Sint c;
if(( this = TOP_NODE(stack)) != NULL) {
- if (!cmp_key_eq(tb,key,key_base,this)) {
+ if (!cmp_key_eq(tb,key,this)) {
/* Start from the beginning */
stack->pos = stack->slot = 0;
}
@@ -2395,7 +2373,7 @@ static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_key(tb,key,key_base,this) ) < 0) {
+ if (( c = cmp_key(tb,key,this) ) < 0) {
if (this->left == NULL) /* We are at the next
and the element does
not exist */
@@ -2448,8 +2426,7 @@ static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl),
- this->dbterm.tpl) ) >= 0) {
+ if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl))) >= 0) {
if (this->right == NULL) {
do {
tmp = POP_NODE(stack);
@@ -2482,8 +2459,7 @@ static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack* stack,
return NULL;
for (;;) {
PUSH_NODE(stack, this);
- if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl),
- this->dbterm.tpl) ) <= 0) {
+ if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl))) <= 0) {
if (this->left == NULL) {
do {
tmp = POP_NODE(stack);
@@ -2514,10 +2490,10 @@ static TreeDbTerm *find_node(DbTableTree *tb, Eterm key)
DbTreeStack* stack = get_static_stack(tb);
if(!stack || EMPTY_NODE(stack)
- || !cmp_key_eq(tb, key, NULL, (this=TOP_NODE(stack)))) {
+ || !cmp_key_eq(tb, key, (this=TOP_NODE(stack)))) {
this = tb->root;
- while (this != NULL && (res = cmp_key(tb,key,NULL,this)) != 0) {
+ while (this != NULL && (res = cmp_key(tb,key,this)) != 0) {
if (res < 0)
this = this->left;
else
@@ -2539,7 +2515,7 @@ static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key)
Sint res;
this = &tb->root;
- while ((*this) != NULL && (res = cmp_key(tb, key, NULL, *this)) != 0) {
+ while ((*this) != NULL && (res = cmp_key(tb, key, *this)) != 0) {
if (res < 0)
this = &((*this)->left);
else
@@ -2589,9 +2565,6 @@ db_lookup_dbterm_tree(Process *p, DbTable *tbl, Eterm key, Eterm obj,
handle->flags = flags;
handle->bp = (void**) pp;
handle->new_size = (*pp)->dbterm.size;
-#if HALFWORD_HEAP
- handle->abs_vec = NULL;
-#endif
return 1;
}
@@ -2622,7 +2595,7 @@ db_finalize_dbterm_tree(int cret, DbUpdateHandle *handle)
*/
static void traverse_backwards(DbTableTree *tb,
DbTreeStack* stack,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *,
TreeDbTerm *,
void *,
@@ -2641,16 +2614,15 @@ static void traverse_backwards(DbTableTree *tb,
this = this->right;
}
this = TOP_NODE(stack);
- next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl),
- this->dbterm.tpl);
+ next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl));
if (!((*doit)(tb, this, context, 0)))
return;
} else {
- next = find_prev(tb, stack, lastkey, lk_base);
+ next = find_prev(tb, stack, lastkey);
}
while ((this = next) != NULL) {
- next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
+ next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl));
if (!((*doit)(tb, this, context, 0)))
return;
}
@@ -2661,7 +2633,7 @@ static void traverse_backwards(DbTableTree *tb,
*/
static void traverse_forward(DbTableTree *tb,
DbTreeStack* stack,
- Eterm lastkey, Eterm* lk_base,
+ Eterm lastkey,
int (*doit)(DbTableTree *,
TreeDbTerm *,
void *,
@@ -2680,15 +2652,15 @@ static void traverse_forward(DbTableTree *tb,
this = this->left;
}
this = TOP_NODE(stack);
- next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
+ next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl));
if (!((*doit)(tb, this, context, 1)))
return;
} else {
- next = find_next(tb, stack, lastkey, lk_base);
+ next = find_next(tb, stack, lastkey);
}
while ((this = next) != NULL) {
- next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl), this->dbterm.tpl);
+ next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl));
if (!((*doit)(tb, this, context, 1)))
return;
}
@@ -2725,7 +2697,7 @@ static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret,
-static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done)
+static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done)
{
Eterm* aa;
Eterm* bb;
@@ -2739,44 +2711,44 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done)
*done = 1;
return 0;
}
- if (is_same(a,NULL,b,b_base))
+ if (is_same(a,b))
return 0;
switch (a & _TAG_PRIMARY_MASK) {
case TAG_PRIMARY_LIST:
if (!is_list(b)) {
- return cmp_rel(a,NULL,b,b_base);
+ return CMP(a,b);
}
aa = list_val(a);
- bb = list_val_rel(b,b_base);
+ bb = list_val(b);
while (1) {
- if ((j = do_cmp_partly_bound(*aa++, *bb++, b_base, done)) != 0 || *done)
+ if ((j = do_cmp_partly_bound(*aa++, *bb++, done)) != 0 || *done)
return j;
- if (is_same(*aa, NULL, *bb, b_base))
+ if (is_same(*aa, *bb))
return 0;
if (is_not_list(*aa) || is_not_list(*bb))
- return do_cmp_partly_bound(*aa, *bb, b_base, done);
+ return do_cmp_partly_bound(*aa, *bb, done);
aa = list_val(*aa);
- bb = list_val_rel(*bb,b_base);
+ bb = list_val(*bb);
}
case TAG_PRIMARY_BOXED:
if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) {
- return cmp_rel(a,NULL,b,b_base);
+ return CMP(a,b);
}
a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
- b_hdr = ((*boxed_val_rel(b,b_base)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
+ b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE;
if (a_hdr != b_hdr) {
- return cmp_rel(a, NULL, b, b_base);
+ return CMP(a,b);
}
if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) {
aa = tuple_val(a);
- bb = tuple_val_rel(b, b_base);
+ bb = tuple_val(b);
/* compare the arities */
i = arityval(*aa); /* get the arity*/
if (i < arityval(*bb)) return(-1);
if (i > arityval(*bb)) return(1);
while (i--) {
- if ((j = do_cmp_partly_bound(*++aa, *++bb, b_base, done)) != 0
+ if ((j = do_cmp_partly_bound(*++aa, *++bb, done)) != 0
|| *done)
return j;
}
@@ -2784,14 +2756,13 @@ static Sint do_cmp_partly_bound(Eterm a, Eterm b, Eterm* b_base, int *done)
}
/* Drop through */
default:
- return cmp_rel(a, NULL, b, b_base);
+ return CMP(a,b);
}
}
-static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_base)
-{
+static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) {
int done = 0;
- Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, bk_base, &done);
+ Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, &done);
#ifdef HARDDEBUG
erts_fprintf(stderr,"\ncmp_partly_bound: %T", partly_bound_key);
if (ret < 0)
@@ -2800,7 +2771,7 @@ static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key, Eterm* bk_
erts_fprintf(stderr," > ");
else
erts_fprintf(stderr," == ");
- erts_fprintf(stderr,"%R\n", bound_key, bk_base);
+ erts_fprintf(stderr,"%T\n", bound_key);
#endif
return ret;
}
@@ -3017,12 +2988,10 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
((forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) < 0) ||
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) < 0) ||
(!forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) > 0))) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) {
return 0;
}
ret = db_match_dbterm(&tb->common,sc->p,sc->mp,sc->all_objects,
@@ -3054,8 +3023,7 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr,
/* Always backwards traversing */
if (sc->end_condition != NIL &&
(cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) > 0)) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0)) {
return 0;
}
ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0,
@@ -3081,12 +3049,10 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
((forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) < 0) ||
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) < 0) ||
(!forward &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) > 0))) {
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0))) {
return 0;
}
@@ -3124,14 +3090,13 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr,
if (sc->end_condition != NIL &&
cmp_partly_bound(sc->end_condition,
- GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl),
- this->dbterm.tpl) > 0)
+ GETKEY_WITH_POS(sc->keypos, this->dbterm.tpl)) > 0)
return 0;
ret = db_match_dbterm(&tb->common, sc->p, sc->mp, 0,
&this->dbterm, NULL, 0);
if (ret == am_true) {
key = GETKEY(sc->tb, this->dbterm.tpl);
- linkout_tree(sc->tb, key, this->dbterm.tpl);
+ linkout_tree(sc->tb, key);
sc->erase_lastterm = 1;
++sc->accum;
}
@@ -3157,11 +3122,10 @@ static void do_dump_tree2(DbTableTree* tb, int to, void *to_arg, int show,
}
else {
prefix = "";
- term = make_tuple_rel(t->dbterm.tpl,t->dbterm.tpl);
+ term = make_tuple(t->dbterm.tpl);
}
- erts_print(to, to_arg, "%*s%s%R (addr = %p, bal = %d)\n",
- offset, "", prefix, term, t->dbterm.tpl,
- t, t->balance);
+ erts_print(to, to_arg, "%*s%s%T (addr = %p, bal = %d)\n",
+ offset, "", prefix, term, t, t->balance);
}
do_dump_tree2(tb, to, to_arg, show, t->left, offset + 4);
}
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index dab357a079..973be58420 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -239,11 +239,7 @@ typedef enum {
matchCall2,
matchCall3,
matchPushV,
-#if HALFWORD_HEAP
- matchPushVGuard, /* First guard-only variable reference */
-#endif
- matchPushVResult, /* First variable reference in result, or (if HALFWORD)
- in guard if also referenced in result */
+ matchPushVResult, /* First variable reference in result */
matchPushExpr, /* Push the whole expression we're matching ('$_') */
matchPushArrayAsList, /* Only when parameter is an Array and
not an erlang term (DCOMP_TRACE) */
@@ -310,9 +306,6 @@ DMC_DECLARE_STACK_TYPE(unsigned);
typedef struct DMCVariable {
int is_bound;
int is_in_body;
-#if HALFWORD_HEAP
- int first_guard_label; /* to maybe change from PushVGuard to PushVResult */
-#endif
} DMCVariable;
typedef struct DMCHeap {
@@ -374,7 +367,6 @@ typedef struct MatchVariable {
Eterm term;
#ifdef DEBUG
Process* proc;
- Eterm* base;
#endif
} MatchVariable;
@@ -415,7 +407,7 @@ cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap)
else {
int i;
for (i = 0; i < ERTS_DEFAULT_MS_HEAP_SIZE; i++) {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
mpsp->default_heap[i] = (Eterm) 0xdeadbeefdeadbeef;
#else
mpsp->default_heap[i] = (Eterm) 0xdeadbeef;
@@ -1240,7 +1232,7 @@ Eterm erts_match_set_run(Process *p, Binary *mpsp,
{
Eterm ret;
- ret = db_prog_match(p, mpsp, NIL, NULL, args, num_args,
+ ret = db_prog_match(p, mpsp, NIL, args, num_args,
in_flags, return_flags);
#if defined(HARDDEBUG)
if (is_non_value(ret)) {
@@ -1265,7 +1257,7 @@ static Eterm erts_match_set_run_ets(Process *p, Binary *mpsp,
{
Eterm ret;
- ret = db_prog_match(p, mpsp, args, NULL, NULL, num_args,
+ ret = db_prog_match(p, mpsp, args, NULL, num_args,
ERTS_PAM_COPY_RESULT,
return_flags);
#if defined(HARDDEBUG)
@@ -1755,71 +1747,6 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity)
return ret;
}
-
-#if HALFWORD_HEAP
-struct heap_checkpoint_t
-{
- Process *p;
- Eterm* htop;
- ErlHeapFragment* mbuf;
- unsigned used_size;
- ErlOffHeap off_heap;
-};
-
-static void heap_checkpoint_init(Process* p, struct heap_checkpoint_t* hcp)
-{
- hcp->p = p;
- hcp->htop = HEAP_TOP(p);
- hcp->mbuf = MBUF(p);
- hcp->used_size = hcp->mbuf ? hcp->mbuf->used_size : 0;
- hcp->off_heap = MSO(p);
-}
-
-static void heap_checkpoint_revert(struct heap_checkpoint_t* hcp)
-{
- struct erl_off_heap_header* oh = MSO(hcp->p).first;
-
- if (oh != hcp->off_heap.first) {
- ASSERT(oh != NULL);
- if (hcp->off_heap.first) {
- while (oh->next != hcp->off_heap.first) {
- oh = oh->next;
- }
- oh->next = NULL;
- }
- erts_cleanup_offheap(&MSO(hcp->p));
- MSO(hcp->p) = hcp->off_heap;
- }
- if (MBUF(hcp->p) != hcp->mbuf) {
- ErlHeapFragment* hf = MBUF(hcp->p);
- ASSERT(hf != NULL);
- if (hcp->mbuf) {
- while (hf->next != hcp->mbuf) {
- hf = hf->next;
- }
- hf->next = NULL;
- }
- free_message_buffer(MBUF(hcp->p));
- MBUF(hcp->p) = hcp->mbuf;
- }
- if (hcp->mbuf != NULL && hcp->mbuf->used_size != hcp->used_size) {
- hcp->mbuf->used_size = hcp->used_size;
- }
- HEAP_TOP(hcp->p) = hcp->htop;
-}
-#endif /* HALFWORD_HEAP */
-
-static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base)
-{
- if (!is_immed(term)) {
- Uint sz = size_object_rel(term, base);
- Eterm* top = HAllocX(p, sz, HEAP_XTRA);
- return copy_struct_rel(term, sz, &top, &MSO(p), base, NULL);
- }
- return term;
-}
-
-
/*
** Execution of the match program, this is Pam.
** May return THE_NON_VALUE, which is a bailout.
@@ -1827,7 +1754,7 @@ static ERTS_INLINE Eterm copy_object_rel(Process* p, Eterm term, Eterm* base)
** i.e. 'DCOMP_TRACE' was specified
*/
Eterm db_prog_match(Process *c_p, Binary *bprog,
- Eterm term, Eterm* base,
+ Eterm term,
Eterm *termp,
int arity,
enum erts_pam_run_flags in_flags,
@@ -1855,17 +1782,12 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
Eterm bif_args[3];
int fail_label;
int atomic_trace;
-#if HALFWORD_HEAP
- struct heap_checkpoint_t c_p_checkpoint = {};
-#endif
#ifdef DMC_DEBUG
Uint *heap_fence;
Uint *stack_fence;
Uint save_op;
#endif /* DMC_DEBUG */
- ASSERT(base==NULL || HALFWORD_HEAP);
-
mpsp = get_match_pseudo_process(c_p, prog->heap_size);
psp = &mpsp->process;
@@ -1916,11 +1838,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog,
do_catch != 0 */
*return_flags = 0U;
-
variables = mpsp->u.variables;
-#if HALFWORD_HEAP
- c_p_checkpoint.p = NULL;
-#endif
restart:
ep = &term;
@@ -1931,14 +1849,12 @@ restart:
fail_label = -1;
build_proc = psp;
esdp->current_process = psp;
- ASSERT_HALFWORD(!c_p_checkpoint.p);
#ifdef DEBUG
ASSERT(variables == mpsp->u.variables);
for (i=0; i<prog->num_bindings; i++) {
variables[i].term = THE_NON_VALUE;
variables[i].proc = NULL;
- variables[i].base = base;
}
#endif
@@ -1946,11 +1862,11 @@ restart:
#ifdef DMC_DEBUG
if (*heap_fence != FENCE_PATTERN) {
- erl_exit(1, "Heap fence overwritten in db_prog_match after op "
+ erts_exit(ERTS_ERROR_EXIT, "Heap fence overwritten in db_prog_match after op "
"0x%08x, overwritten with 0x%08x.", save_op, *heap_fence);
}
if (*stack_fence != FENCE_PATTERN) {
- erl_exit(1, "Stack fence overwritten in db_prog_match after op "
+ erts_exit(ERTS_ERROR_EXIT, "Stack fence overwritten in db_prog_match after op "
"0x%08x, overwritten with 0x%08x.", save_op,
*stack_fence);
}
@@ -1974,9 +1890,9 @@ restart:
variables[n].term = dpm_array_to_list(psp, termp, arity);
break;
case matchTuple: /* *ep is a tuple of arity n */
- if (!is_tuple_rel(*ep,base))
+ if (!is_tuple(*ep))
FAIL();
- ep = tuple_val_rel(*ep,base);
+ ep = tuple_val(*ep);
n = *pc++;
if (arityval(*ep) != n)
FAIL();
@@ -1984,9 +1900,9 @@ restart:
break;
case matchPushT: /* *ep is a tuple of arity n,
push ptr to first element */
- if (!is_tuple_rel(*ep,base))
+ if (!is_tuple(*ep))
FAIL();
- tp = tuple_val_rel(*ep,base);
+ tp = tuple_val(*ep);
n = *pc++;
if (arityval(*tp) != n)
FAIL();
@@ -1996,51 +1912,51 @@ restart:
case matchList:
if (!is_list(*ep))
FAIL();
- ep = list_val_rel(*ep,base);
+ ep = list_val(*ep);
break;
case matchPushL:
if (!is_list(*ep))
FAIL();
- *sp++ = list_val_rel(*ep,base);
+ *sp++ = list_val(*ep);
++ep;
break;
case matchMap:
- if (!is_map_rel(*ep, base)) {
+ if (!is_map(*ep)) {
FAIL();
}
n = *pc++;
- if (is_flatmap_rel(*ep,base)) {
- if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) {
+ if (is_flatmap(*ep)) {
+ if (flatmap_get_size(flatmap_val(*ep)) < n) {
FAIL();
}
} else {
- ASSERT(is_hashmap_rel(*ep,base));
- if (hashmap_size_rel(*ep, base) < n) {
+ ASSERT(is_hashmap(*ep));
+ if (hashmap_size(*ep) < n) {
FAIL();
}
}
- ep = flatmap_val_rel(*ep, base);
+ ep = flatmap_val(*ep);
break;
case matchPushM:
- if (!is_map_rel(*ep, base)) {
+ if (!is_map(*ep)) {
FAIL();
}
n = *pc++;
- if (is_flatmap_rel(*ep,base)) {
- if (flatmap_get_size(flatmap_val_rel(*ep, base)) < n) {
+ if (is_flatmap(*ep)) {
+ if (flatmap_get_size(flatmap_val(*ep)) < n) {
FAIL();
}
} else {
- ASSERT(is_hashmap_rel(*ep,base));
- if (hashmap_size_rel(*ep, base) < n) {
+ ASSERT(is_hashmap(*ep));
+ if (hashmap_size(*ep) < n) {
FAIL();
}
}
- *sp++ = flatmap_val_rel(*ep++, base);
+ *sp++ = flatmap_val(*ep++);
break;
case matchKey:
t = (Eterm) *pc++;
- tp = erts_maps_get_rel(t, make_boxed_rel(ep, base), base);
+ tp = erts_maps_get(t, make_boxed(ep));
if (!tp) {
FAIL();
}
@@ -2061,29 +1977,29 @@ restart:
break;
case matchCmp:
n = *pc++;
- if (!eq_rel(variables[n].term, base, *ep, base))
+ if (!EQ(variables[n].term, *ep))
FAIL();
++ep;
break;
case matchEqBin:
t = (Eterm) *pc++;
- if (!eq_rel(t,NULL,*ep,base))
+ if (!EQ(t,*ep))
FAIL();
++ep;
break;
case matchEqFloat:
- if (!is_float_rel(*ep,base))
+ if (!is_float(*ep))
FAIL();
- if (memcmp(float_val_rel(*ep,base) + 1, pc, sizeof(double)))
+ if (memcmp(float_val(*ep) + 1, pc, sizeof(double)))
FAIL();
pc += TermWords(2);
++ep;
break;
case matchEqRef: {
Eterm* epc = (Eterm*)pc;
- if (!is_ref_rel(*ep,base))
+ if (!is_ref(*ep))
FAIL();
- if (!eq_rel(make_internal_ref_rel(epc, epc), epc, *ep, base)) {
+ if (!EQ(make_internal_ref(epc), *ep)) {
FAIL();
}
i = thing_arityval(*epc);
@@ -2092,9 +2008,9 @@ restart:
break;
}
case matchEqBig:
- if (!is_big_rel(*ep,base))
+ if (!is_big(*ep))
FAIL();
- tp = big_val_rel(*ep,base);
+ tp = big_val(*ep);
{
Eterm *epc = (Eterm *) pc;
if (*tp != *epc)
@@ -2236,62 +2152,36 @@ restart:
esp -= 2;
esp[-1] = t;
break;
-
- #if HALFWORD_HEAP
- case matchPushVGuard:
- if (!base) goto case_matchPushV;
- /* Build NULL-based copy on pseudo heap for easy disposal */
- n = *pc++;
- ASSERT(is_value(variables[n].term));
- ASSERT(!variables[n].proc);
- variables[n].term = copy_object_rel(psp, variables[n].term, base);
- *esp++ = variables[n].term;
- #ifdef DEBUG
- variables[n].proc = psp;
- variables[n].base = NULL;
- #endif
- break;
- #endif
case matchPushVResult:
if (!(in_flags & ERTS_PAM_COPY_RESULT)) goto case_matchPushV;
-
- /* Build (NULL-based) copy on callers heap */
- #if HALFWORD_HEAP
- if (!do_catch && !c_p_checkpoint.p) {
- heap_checkpoint_init(c_p, &c_p_checkpoint);
- }
- #endif
+ /* Build copy on callers heap */
n = *pc++;
ASSERT(is_value(variables[n].term));
ASSERT(!variables[n].proc);
- variables[n].term = copy_object_rel(c_p, variables[n].term, base);
+ variables[n].term = copy_object_x(variables[n].term, c_p, HEAP_XTRA);
*esp++ = variables[n].term;
#ifdef DEBUG
variables[n].proc = c_p;
- variables[n].base = NULL;
#endif
break;
case matchPushV:
case_matchPushV:
n = *pc++;
ASSERT(is_value(variables[n].term));
- ASSERT(!variables[n].base);
*esp++ = variables[n].term;
break;
case matchPushExpr:
if (in_flags & ERTS_PAM_COPY_RESULT) {
Uint sz;
Eterm* top;
- sz = size_object_rel(term, base);
+ sz = size_object(term);
top = HAllocX(build_proc, sz, HEAP_XTRA);
if (in_flags & ERTS_PAM_CONTIGUOUS_TUPLE) {
- ASSERT(is_tuple_rel(term,base));
- *esp++ = copy_shallow_rel(tuple_val_rel(term,base), sz,
- &top, &MSO(build_proc), base);
+ ASSERT(is_tuple(term));
+ *esp++ = copy_shallow(tuple_val(term), sz, &top, &MSO(build_proc));
}
else {
- *esp++ = copy_struct_rel(term, sz, &top, &MSO(build_proc),
- base, NULL);
+ *esp++ = copy_struct(term, sz, &top, &MSO(build_proc));
}
}
else {
@@ -2299,7 +2189,6 @@ restart:
}
break;
case matchPushArrayAsList:
- ASSERT_HALFWORD(base == NULL);
n = arity; /* Only happens when 'term' is an array */
tp = termp;
ehp = HAllocX(build_proc, n*2, HEAP_XTRA);
@@ -2315,7 +2204,6 @@ restart:
break;
case matchPushArrayAsListU:
/* This instruction is NOT efficient. */
- ASSERT_HALFWORD(base == NULL);
*esp++ = dpm_array_to_list(build_proc, termp, arity);
break;
case matchTrue:
@@ -2420,11 +2308,7 @@ restart:
*esp++ = am_true;
break;
case matchIsSeqTrace:
- if (SEQ_TRACE_TOKEN(c_p) != NIL
-#ifdef USE_VM_PROBES
- && SEQ_TRACE_TOKEN(c_p) != am_have_dt_utag
-#endif
- )
+ if (have_seqtrace(SEQ_TRACE_TOKEN(c_p)))
*esp++ = am_true;
else
*esp++ = am_false;
@@ -2448,11 +2332,7 @@ restart:
--esp;
break;
case matchGetSeqToken:
- if (SEQ_TRACE_TOKEN(c_p) == NIL
-#ifdef USE_VM_PROBES
- || SEQ_TRACE_TOKEN(c_p) == am_have_dt_utag
-#endif
- )
+ if (have_no_seqtrace(SEQ_TRACE_TOKEN(c_p)))
*esp++ = NIL;
else {
Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p);
@@ -2615,17 +2495,10 @@ restart:
case matchHalt:
goto success;
default:
- erl_exit(1, "Internal error: unexpected opcode in match program.");
+ erts_exit(ERTS_ERROR_EXIT, "Internal error: unexpected opcode in match program.");
}
}
fail:
-#if HALFWORD_HEAP
- if (c_p_checkpoint.p) {
- /* Dispose garbage built by guards on caller heap */
- heap_checkpoint_revert(&c_p_checkpoint);
- c_p_checkpoint.p = NULL;
- }
-#endif
*return_flags = 0U;
if (fail_label >= 0) { /* We failed during a "TryMeElse",
lets restart, with the next match
@@ -2639,11 +2512,11 @@ success:
#ifdef DMC_DEBUG
if (*heap_fence != FENCE_PATTERN) {
- erl_exit(1, "Heap fence overwritten in db_prog_match after op "
+ erts_exit(ERTS_ERROR_EXIT, "Heap fence overwritten in db_prog_match after op "
"0x%08x, overwritten with 0x%08x.", save_op, *heap_fence);
}
if (*stack_fence != FENCE_PATTERN) {
- erl_exit(1, "Stack fence overwritten in db_prog_match after op "
+ erts_exit(ERTS_ERROR_EXIT, "Stack fence overwritten in db_prog_match after op "
"0x%08x, overwritten with 0x%08x.", save_op,
*stack_fence);
}
@@ -2788,13 +2661,6 @@ Wterm db_do_read_element(DbUpdateHandle* handle, Sint position)
{
Eterm elem = handle->dbterm->tpl[position];
if (!is_header(elem)) {
-#if HALFWORD_HEAP
- if (!is_immed(elem)
- && !handle->tb->common.compress
- && !(handle->abs_vec && handle->abs_vec[position])) {
- return rterm2wterm(elem, handle->dbterm->tpl);
- }
-#endif
return elem;
}
@@ -2822,9 +2688,6 @@ void db_do_update_element(DbUpdateHandle* handle,
Eterm* oldp;
Uint newval_sz;
Uint oldval_sz;
-#if HALFWORD_HEAP
- Eterm* old_base;
-#endif
if (is_both_immed(newval,oldval)) {
handle->dbterm->tpl[position] = newval;
@@ -2841,15 +2704,8 @@ void db_do_update_element(DbUpdateHandle* handle,
handle->dbterm);
handle->flags |= DB_MUST_RESIZE;
oldval = handle->dbterm->tpl[position];
- #if HALFWORD_HEAP
- old_base = NULL;
- #endif
}
else {
- #if HALFWORD_HEAP
- ASSERT(!handle->abs_vec);
- old_base = handle->dbterm->tpl;
- #endif
if (is_boxed(newval)) {
newp = boxed_val(newval);
switch (*newp & _TAG_HEADER_MASK) {
@@ -2859,7 +2715,7 @@ void db_do_update_element(DbUpdateHandle* handle,
case _TAG_HEADER_HEAP_BIN:
newval_sz = header_arity(*newp) + 1;
if (is_boxed(oldval)) {
- oldp = boxed_val_rel(oldval,old_base);
+ oldp = boxed_val(oldval);
switch (*oldp & _TAG_HEADER_MASK) {
case _TAG_HEADER_POS_BIG:
case _TAG_HEADER_NEG_BIG:
@@ -2879,20 +2735,13 @@ void db_do_update_element(DbUpdateHandle* handle,
}
}
}
-#if HALFWORD_HEAP
- else {
- old_base = (handle->tb->common.compress
- || (handle->abs_vec && handle->abs_vec[position])) ?
- NULL : handle->dbterm->tpl;
- }
-#endif
/* Not possible for simple memcpy or dbterm is already non-contiguous, */
/* need to realloc... */
newval_sz = is_immed(newval) ? 0 : size_object(newval);
new_size_set:
- oldval_sz = is_immed(oldval) ? 0 : size_object_rel(oldval,old_base);
+ oldval_sz = is_immed(oldval) ? 0 : size_object(oldval);
both_size_set:
handle->new_size = handle->new_size - oldval_sz + newval_sz;
@@ -2900,19 +2749,6 @@ both_size_set:
/* write new value in old dbterm, finalize will make a flat copy */
handle->dbterm->tpl[position] = newval;
handle->flags |= DB_MUST_RESIZE;
-
-#if HALFWORD_HEAP
- if (old_base && newval_sz > 0) {
- ASSERT(!handle->tb->common.compress);
- if (!handle->abs_vec) {
- int i = header_arity(handle->dbterm->tpl[0]);
- handle->abs_vec = erts_alloc(ERTS_ALC_T_TMP, (i+1)*sizeof(char));
- sys_memset(handle->abs_vec, 0, i+1);
- /* abs_vec[0] not used */
- }
- handle->abs_vec[position] = 1;
- }
-#endif
}
static ERTS_INLINE byte* db_realloc_term(DbTableCommon* tb, void* old,
@@ -3011,7 +2847,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest,
tpl[arity + 1] = alloc_size;
tmp_offheap.first = NULL;
- tpl[tb->keypos] = copy_struct_rel(key, size_object(key), &top.ep, &tmp_offheap, NULL, tpl);
+ tpl[tb->keypos] = copy_struct(key, size_object(key), &top.ep, &tmp_offheap);
dest->first_oh = tmp_offheap.first;
for (i=1; i<=arity; i++) {
if (i != tb->keypos) {
@@ -3030,7 +2866,7 @@ static void* copy_to_comp(DbTableCommon* tb, Eterm obj, DbTerm* dest,
Eterm* dbg_top = erts_alloc(ERTS_ALC_T_DB_TERM, dest->size * sizeof(Eterm));
dest->debug_clone = dbg_top;
tmp_offheap.first = dest->first_oh;
- copy_struct_rel(obj, dest->size, &dbg_top, &tmp_offheap, NULL, dbg_top);
+ copy_struct(obj, dest->size, &dbg_top, &tmp_offheap);
dest->first_oh = tmp_offheap.first;
ASSERT(dbg_top == dest->debug_clone + dest->size);
}
@@ -3077,7 +2913,7 @@ void* db_store_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
newp->size = size;
top = newp->tpl;
tmp_offheap.first = NULL;
- copy_struct_rel(obj, size, &top, &tmp_offheap, NULL, top);
+ copy_struct(obj, size, &top, &tmp_offheap);
newp->first_oh = tmp_offheap.first;
#ifdef DEBUG_CLONE
newp->debug_clone = NULL;
@@ -3160,29 +2996,8 @@ void db_finalize_resize(DbUpdateHandle* handle, Uint offset)
tmp_offheap.first = NULL;
- #if HALFWORD_HEAP
- if (handle->abs_vec) {
- int i, arity = header_arity(handle->dbterm->tpl[0]);
-
- top[0] = tpl[0];
- top += arity + 1;
- for (i=1; i<=arity; i++) {
- Eterm* src_base = handle->abs_vec[i] ? NULL : tpl;
-
- newDbTerm->tpl[i] = copy_struct_rel(tpl[i],
- size_object_rel(tpl[i],src_base),
- &top, &tmp_offheap, src_base,
- newDbTerm->tpl);
- }
- newDbTerm->first_oh = tmp_offheap.first;
- ASSERT((byte*)top <= (newp + alloc_sz));
- erts_free(ERTS_ALC_T_TMP, handle->abs_vec);
- }
- else
- #endif /* HALFWORD_HEAP */
{
- copy_struct_rel(make_tuple_rel(tpl,tpl), handle->new_size, &top,
- &tmp_offheap, tpl, top);
+ copy_struct(make_tuple(tpl), handle->new_size, &top, &tmp_offheap);
newDbTerm->first_oh = tmp_offheap.first;
ASSERT((byte*)top == (newp + alloc_sz));
}
@@ -3199,9 +3014,9 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp,
hp[0] = bp->tpl[0];
*hpp += arity + 1;
- hp[tb->keypos] = copy_struct_rel(bp->tpl[tb->keypos],
- size_object_rel(bp->tpl[tb->keypos], bp->tpl),
- hpp, off_heap, bp->tpl, NULL);
+ hp[tb->keypos] = copy_struct(bp->tpl[tb->keypos],
+ size_object(bp->tpl[tb->keypos]),
+ hpp, off_heap);
erts_factory_static_init(&factory, *hpp, bp->size - (arity+1), off_heap);
@@ -3221,7 +3036,7 @@ Eterm db_copy_from_comp(DbTableCommon* tb, DbTerm* bp, Eterm** hpp,
ASSERT((*hpp - hp) <= bp->size);
#ifdef DEBUG_CLONE
- ASSERT(eq_rel(make_tuple(hp),NULL,make_tuple(bp->debug_clone),bp->debug_clone));
+ ASSERT(EQ(make_tuple(hp),make_tuple(bp->debug_clone)));
#endif
return make_tuple(hp);
}
@@ -3245,14 +3060,14 @@ Eterm db_copy_element_from_ets(DbTableCommon* tb, Process* p,
*hpp = erts_produce_heap(&factory, extra, 0);
erts_factory_close(&factory);
#ifdef DEBUG_CLONE
- ASSERT(eq_rel(copy, NULL, obj->debug_clone[pos], obj->debug_clone));
+ ASSERT(EQ(copy, obj->debug_clone[pos]));
#endif
return copy;
}
else {
- Uint sz = size_object_rel(obj->tpl[pos], obj->tpl);
+ Uint sz = size_object(obj->tpl[pos]);
*hpp = HAlloc(p, sz + extra);
- return copy_struct_rel(obj->tpl[pos], sz, hpp, &MSO(p), obj->tpl, NULL);
+ return copy_struct(obj->tpl[pos], sz, hpp, &MSO(p));
}
}
@@ -3599,26 +3414,10 @@ static DMCRet dmc_one_term(DMCContext *context,
{
Eterm* ref_val = internal_ref_val(c);
DMC_PUSH(*text, matchEqRef);
-#if HALFWORD_HEAP
- {
- union {
- UWord u;
- Uint t[2];
- } fiddle;
- ASSERT(thing_arityval(ref_val[0]) == 3);
- fiddle.t[0] = ref_val[0];
- fiddle.t[1] = ref_val[1];
- DMC_PUSH(*text, fiddle.u);
- fiddle.t[0] = ref_val[2];
- fiddle.t[1] = ref_val[3];
- DMC_PUSH(*text, fiddle.u);
- }
-#else
n = thing_arityval(ref_val[0]);
for (i = 0; i <= n; ++i) {
DMC_PUSH(*text, ref_val[i]);
}
-#endif
break;
}
case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
@@ -3627,53 +3426,19 @@ static DMCRet dmc_one_term(DMCContext *context,
Eterm* bval = big_val(c);
n = thing_arityval(bval[0]);
DMC_PUSH(*text, matchEqBig);
-#if HALFWORD_HEAP
- {
- union {
- UWord u;
- Uint t[2];
- } fiddle;
- ASSERT(n >= 1);
- fiddle.t[0] = bval[0];
- fiddle.t[1] = bval[1];
- DMC_PUSH(*text, fiddle.u);
- for (i = 2; i <= n; ++i) {
- fiddle.t[0] = bval[i];
- if (++i <= n) {
- fiddle.t[1] = bval[i];
- } else {
- fiddle.t[1] = (Uint) 0;
- }
- DMC_PUSH(*text, fiddle.u);
- }
- }
-#else
for (i = 0; i <= n; ++i) {
DMC_PUSH(*text, (Uint) bval[i]);
}
-#endif
break;
}
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
DMC_PUSH(*text,matchEqFloat);
-#if HALFWORD_HEAP
- {
- union {
- UWord u;
- Uint t[2];
- } fiddle;
- fiddle.t[0] = float_val(c)[1];
- fiddle.t[1] = float_val(c)[2];
- DMC_PUSH(*text, fiddle.u);
- }
-#else
DMC_PUSH(*text, (Uint) float_val(c)[1]);
#ifdef ARCH_64
DMC_PUSH(*text, (Uint) 0);
#else
DMC_PUSH(*text, (Uint) float_val(c)[2]);
#endif
-#endif
break;
default: /* BINARY, FUN, VECTOR, or EXTERNAL */
DMC_PUSH(*text, matchEqBin);
@@ -3683,7 +3448,7 @@ static DMCRet dmc_one_term(DMCContext *context,
break;
}
default:
- erl_exit(1, "db_match_compile: "
+ erts_exit(ERTS_ERROR_EXIT, "db_match_compile: "
"Bad object on heap: 0x%bex\n", c);
}
return retOk;
@@ -3997,24 +3762,8 @@ static void dmc_add_pushv_variant(DMCContext *context, DMCHeap *heap,
MatchOps instr = matchPushV;
ASSERT(n < heap->vars_used && v->is_bound);
- if (context->is_guard) {
- #if HALFWORD_HEAP
- if (!v->first_guard_label) {
- v->first_guard_label = DMC_STACK_NUM(*text);
- ASSERT(v->first_guard_label);
- instr = matchPushVGuard; /* may be changed to PushVResult below */
- }
- #endif
- }
- else { /* body */
- #if HALFWORD_HEAP
- if (v->first_guard_label) {
- /* Avoid double-copy, copy to result heap at first encounter in guard */
- DMC_POKE(*text, v->first_guard_label, matchPushVResult);
- v->is_in_body = 1;
- }
- #endif
- if (!v->is_in_body) {
+ if (!context->is_guard) {
+ if(!v->is_in_body) {
instr = matchPushVResult;
v->is_in_body = 1;
}
@@ -4930,7 +4679,7 @@ static DMCRet dmc_fun(DMCContext *context,
DMC_PUSH(*text, matchCall3);
break;
default:
- erl_exit(1,"ets:match() internal error, "
+ erts_exit(ERTS_ERROR_EXIT,"ets:match() internal error, "
"guard with more than 3 arguments.");
}
DMC_PUSH(*text, (UWord) b->biff);
@@ -5210,7 +4959,7 @@ static Uint my_size_object(Eterm t)
tmp == am_const) {
sum += size_object(tuple_val(t)[2]);
} else {
- erl_exit(1,"Internal error, sizing unrecognized object in "
+ erts_exit(ERTS_ERROR_EXIT,"Internal error, sizing unrecognized object in "
"(d)ets:match compilation.");
}
break;
@@ -5255,7 +5004,7 @@ static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap)
sz = size_object(b);
ret = copy_struct(b,sz,hp,off_heap);
} else {
- erl_exit(1, "Trying to constant-copy non constant expression "
+ erts_exit(ERTS_ERROR_EXIT, "Trying to constant-copy non constant expression "
"0x%bex in (d)ets:match compilation.", t);
}
} else {
@@ -5443,16 +5192,13 @@ Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
int all, DbTerm* obj, Eterm** hpp, Uint extra)
{
Uint32 dummy;
- Eterm* base;
Eterm res;
if (tb->compress) {
obj = db_alloc_tmp_uncompressed(tb, obj);
- base = NULL;
}
- else base = HALFWORD_HEAP ? obj->tpl : NULL;
- res = db_prog_match(c_p, bprog, make_tuple_rel(obj->tpl,base), base, NULL, 0,
+ res = db_prog_match(c_p, bprog, make_tuple(obj->tpl), NULL, 0,
ERTS_PAM_COPY_RESULT|ERTS_PAM_CONTIGUOUS_TUPLE, &dummy);
if (is_value(res) && hpp!=NULL) {
@@ -5573,7 +5319,7 @@ void db_match_dis(Binary *bp)
first = 0;
else
erts_printf(", ");
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
erts_printf("0x%016bex", rt->data.ui[ri]);
#else
erts_printf("0x%08bex", rt->data.ui[ri]);
@@ -5597,7 +5343,7 @@ void db_match_dis(Binary *bp)
first = 0;
else
erts_printf(", ");
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
erts_printf("0x%016bex", *et);
#else
erts_printf("0x%08bex", *et);
@@ -5720,13 +5466,6 @@ void db_match_dis(Binary *bp)
++t;
erts_printf("PushV\t%beu\n", n);
break;
- #if HALFWORD_HEAP
- case matchPushVGuard:
- n = (Uint) *++t;
- ++t;
- erts_printf("PushVGuard\t%beu\n", n);
- break;
- #endif
case matchPushVResult:
n = (Uint) *++t;
++t;
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 1ccdc0305b..911ed37aef 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -90,9 +90,6 @@ typedef struct {
Uint new_size;
int flags;
void* lck;
-#if HALFWORD_HEAP
- unsigned char* abs_vec; /* [i] true if dbterm->tpl[i] is absolute Eterm */
-#endif
} DbUpdateHandle;
@@ -229,7 +226,10 @@ typedef struct db_table_common {
DbTableMethod* meth; /* table methods */
erts_smp_atomic_t nitems; /* Total number of items in table */
erts_smp_atomic_t memory_size;/* Total memory size. NOTE: in bytes! */
- Uint megasec,sec,microsec; /* Last fixation time */
+ struct { /* Last fixation time */
+ ErtsMonotonicTime monotonic;
+ ErtsMonotonicTime offset;
+ } time;
DbFixation* fixations; /* List of processes who have done safe_fixtable,
"local" fixations not included. */
/* All 32-bit fields */
@@ -287,10 +287,10 @@ ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj)
Eterm key = GETKEY(tb, obj->tpl);
if IS_CONST(key) return key;
else {
- Uint size = size_object_rel(key, obj->tpl);
+ Uint size = size_object(key);
Eterm* hp = HAlloc(p, size);
- Eterm res = copy_struct_rel(key, size, &hp, &MSO(p), obj->tpl, NULL);
- ASSERT(eq_rel(res,NULL,key,obj->tpl));
+ Eterm res = copy_struct(key, size, &hp, &MSO(p));
+ ASSERT(EQ(res,key));
return res;
}
}
@@ -302,14 +302,14 @@ ERTS_GLB_INLINE Eterm db_copy_object_from_ets(DbTableCommon* tb, DbTerm* bp,
return db_copy_from_comp(tb, bp, hpp, off_heap);
}
else {
- return copy_shallow_rel(bp->tpl, bp->size, hpp, off_heap, bp->tpl);
+ return copy_shallow(bp->tpl, bp->size, hpp, off_heap);
}
}
ERTS_GLB_INLINE int db_eq(DbTableCommon* tb, Eterm a, DbTerm* b)
{
if (!tb->compress) {
- return eq_rel(a, NULL, make_tuple_rel(b->tpl,b->tpl), b->tpl);
+ return EQ(a, make_tuple(b->tpl));
}
else {
return db_eq_comp(tb, a, b);
@@ -435,7 +435,7 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards,
Eterm db_match_dbterm(DbTableCommon* tb, Process* c_p, Binary* bprog,
int all, DbTerm* obj, Eterm** hpp, Uint extra);
-Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm* base,
+Eterm db_prog_match(Process *p, Binary *prog, Eterm term,
Eterm *termp, int arity,
enum erts_pam_run_flags in_flags,
Uint32 *return_flags /* Zeroed on enter */);
diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c
index 2dcfb79f00..2902c98864 100644
--- a/erts/emulator/beam/erl_debug.c
+++ b/erts/emulator/beam/erl_debug.c
@@ -255,14 +255,14 @@ void erts_check_stack(Process *p)
Eterm *stack_end = p->htop;
if (p->stop > stack_start)
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"<%lu.%lu.%lu>: Stack underflow\n",
internal_pid_channel_no(p->common.id),
internal_pid_number(p->common.id),
internal_pid_serial(p->common.id));
if (p->stop < stack_end)
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"<%lu.%lu.%lu>: Stack overflow\n",
internal_pid_channel_no(p->common.id),
internal_pid_number(p->common.id),
@@ -287,7 +287,7 @@ void erts_check_stack(Process *p)
if (in_mbuf)
continue;
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"<%lu.%lu.%lu>: Wild stack pointer\n",
internal_pid_channel_no(p->common.id),
internal_pid_number(p->common.id),
@@ -312,6 +312,8 @@ void erts_check_for_holes(Process* p)
p->last_htop = HEAP_TOP(p);
for (hf = MBUF(p); hf != 0; hf = hf->next) {
+ if (hf == p->heap_hfrag)
+ continue;
if (hf == p->last_mbuf) {
break;
}
@@ -372,7 +374,7 @@ void erts_check_memory(Process *p, Eterm *start, Eterm *end)
#ifdef DEBUG
if (hval == DEBUG_BAD_WORD) {
print_untagged_memory(start, end);
- erl_exit(1, "Uninitialized HAlloc'ed memory found @ 0x%0*lx!\n",
+ erts_exit(ERTS_ERROR_EXIT, "Uninitialized HAlloc'ed memory found @ 0x%0*lx!\n",
PTR_SIZE,(unsigned long)(pos - 1));
}
#endif
@@ -385,7 +387,7 @@ void erts_check_memory(Process *p, Eterm *start, Eterm *end)
if (verify_eterm(p,hval))
continue;
- erl_exit(1, "Wild pointer found @ 0x%0*lx!\n",
+ erts_exit(ERTS_ERROR_EXIT, "Wild pointer found @ 0x%0*lx!\n",
PTR_SIZE,(unsigned long)(pos - 1));
}
}
@@ -395,14 +397,14 @@ void verify_process(Process *p)
#define VERIFY_AREA(name,ptr,sz) { \
int n = (sz); \
while (n--) if(!verify_eterm(p,*(ptr+n))) \
- erl_exit(1,"Wild pointer found in " name " of %T!\n",p->common.id); }
+ erts_exit(ERTS_ERROR_EXIT,"Wild pointer found in " name " of %T!\n",p->common.id); }
#define VERIFY_ETERM(name,eterm) { \
if(!verify_eterm(p,eterm)) \
- erl_exit(1,"Wild pointer found in " name " of %T!\n",p->common.id); }
+ erts_exit(ERTS_ERROR_EXIT,"Wild pointer found in " name " of %T!\n",p->common.id); }
- ErlMessage* mp = p->msg.first;
+ ErtsMessage* mp = p->msg.first;
VERBOSE(DEBUG_MEMORY,("Verify process: %T...\n",p->common.id));
@@ -416,7 +418,7 @@ void verify_process(Process *p)
erts_check_heap(p);
if (p->dictionary)
- VERIFY_AREA("dictionary",p->dictionary->data, p->dictionary->used);
+ VERIFY_AREA("dictionary", ERTS_PD_START(p->dictionary), ERTS_PD_SIZE(p->dictionary));
VERIFY_ETERM("seq trace token",p->seq_trace_token);
VERIFY_ETERM("group leader",p->group_leader);
VERIFY_ETERM("fvalue",p->fvalue);
@@ -531,7 +533,7 @@ static void print_process_memory(Process *p)
PTR_SIZE, "PCB", dashes, dashes, dashes, dashes);
if (p->msg.first != NULL) {
- ErlMessage* mp;
+ ErtsMessage* mp;
erts_printf(" Message Queue:\n");
mp = p->msg.first;
while (mp != NULL) {
@@ -542,8 +544,8 @@ static void print_process_memory(Process *p)
}
if (p->dictionary != NULL) {
- int n = p->dictionary->used;
- Eterm *ptr = p->dictionary->data;
+ int n = ERTS_PD_SIZE(p->dictionary);
+ Eterm *ptr = ERTS_PD_START(p->dictionary);
erts_printf(" Dictionary: ");
while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)ptr++);
erts_printf("\n");
@@ -631,29 +633,4 @@ void print_memory_info(Process *p)
}
erts_printf("+-----------------%s-%s-%s-%s-+\n",dashes,dashes,dashes,dashes);
}
-#if !HEAP_ON_C_STACK && defined(DEBUG)
-Eterm *erts_debug_allocate_tmp_heap(int size, Process *p)
-{
- ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p));
- int offset = sd->num_tmp_heap_used;
-
- ASSERT(offset+size <= TMP_HEAP_SIZE);
- return (sd->tmp_heap)+offset;
-}
-void erts_debug_use_tmp_heap(int size, Process *p)
-{
- ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p));
-
- sd->num_tmp_heap_used += size;
- ASSERT(sd->num_tmp_heap_used <= TMP_HEAP_SIZE);
-}
-void erts_debug_unuse_tmp_heap(int size, Process *p)
-{
- ErtsSchedulerData *sd = ((p == NULL) ? erts_get_scheduler_data() : ERTS_PROC_GET_SCHDATA(p));
-
- sd->num_tmp_heap_used -= size;
- ASSERT(sd->num_tmp_heap_used >= 0);
-}
-#endif
#endif
-
diff --git a/erts/emulator/beam/erl_debug.h b/erts/emulator/beam/erl_debug.h
index 4905e64f07..029320691d 100644
--- a/erts/emulator/beam/erl_debug.h
+++ b/erts/emulator/beam/erl_debug.h
@@ -48,6 +48,7 @@
#define DEBUG_THREADS 0x0010 /* Thread-related stuff */
#define DEBUG_PROCESSES 0x0020 /* Process creation and removal */
#define DEBUG_MEMORY 0x0040 /* Display results of memory checks */
+#define DEBUG_SHCOPY 0x0080 /* Sharing-preserving copying of terms */
extern Uint32 verbose;
@@ -92,10 +93,4 @@ extern void print_tagged_memory(Eterm *start, Eterm *end);
extern void print_untagged_memory(Eterm *start, Eterm *end);
extern void print_memory(Process *p);
extern void print_memory_info(Process *p);
-#if defined(DEBUG) && !HEAP_ON_C_STACK
-extern Eterm *erts_debug_allocate_tmp_heap(int, Process *);
-extern void erts_debug_use_tmp_heap(int, Process *);
-extern void erts_debug_unuse_tmp_heap(int, Process *);
-#endif
-
#endif /* _ERL_DEBUG_H_ */
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index 6b406d069c..0234b9b0e4 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -37,52 +37,6 @@
# endif
#endif
-#ifdef SIZEOF_CHAR
-# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR
-# undef SIZEOF_CHAR
-#endif
-#ifdef SIZEOF_SHORT
-# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT
-# undef SIZEOF_SHORT
-#endif
-#ifdef SIZEOF_INT
-# define SIZEOF_INT_SAVED__ SIZEOF_INT
-# undef SIZEOF_INT
-#endif
-#ifdef SIZEOF_LONG
-# define SIZEOF_LONG_SAVED__ SIZEOF_LONG
-# undef SIZEOF_LONG
-#endif
-#ifdef SIZEOF_LONG_LONG
-# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG
-# undef SIZEOF_LONG_LONG
-#endif
-#ifdef HALFWORD_HEAP_EMULATOR
-# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR
-# undef HALFWORD_HEAP_EMULATOR
-#endif
-#include "erl_int_sizes_config.h"
-#if defined(SIZEOF_CHAR_SAVED__) && SIZEOF_CHAR_SAVED__ != SIZEOF_CHAR
-# error SIZEOF_CHAR mismatch
-#endif
-#if defined(SIZEOF_SHORT_SAVED__) && SIZEOF_SHORT_SAVED__ != SIZEOF_SHORT
-# error SIZEOF_SHORT mismatch
-#endif
-#if defined(SIZEOF_INT_SAVED__) && SIZEOF_INT_SAVED__ != SIZEOF_INT
-# error SIZEOF_INT mismatch
-#endif
-#if defined(SIZEOF_LONG_SAVED__) && SIZEOF_LONG_SAVED__ != SIZEOF_LONG
-# error SIZEOF_LONG mismatch
-#endif
-#if defined(SIZEOF_LONG_LONG_SAVED__) && SIZEOF_LONG_LONG_SAVED__ != SIZEOF_LONG_LONG
-# error SIZEOF_LONG_LONG mismatch
-#endif
-
-/* This is OK to override by the NIF/driver implementor */
-#if defined(HALFWORD_HEAP_EMULATOR_SAVED__) && !defined(HALFWORD_HEAP_EMULATOR)
-#define HALFWORD_HEAP_EMULATOR HALFWORD_HEAP_EMULATOR_SAVED__
-#endif
-
#include "erl_drv_nif.h"
#include <stdlib.h>
@@ -134,7 +88,7 @@ typedef struct {
#define ERL_DRV_EXTENDED_MARKER (0xfeeeeeed)
#define ERL_DRV_EXTENDED_MAJOR_VERSION 3
-#define ERL_DRV_EXTENDED_MINOR_VERSION 2
+#define ERL_DRV_EXTENDED_MINOR_VERSION 3
/*
* The emulator will refuse to load a driver with a major version
@@ -172,32 +126,17 @@ typedef struct {
#define ERL_DRV_FLAG_USE_PORT_LOCKING (1 << 0)
#define ERL_DRV_FLAG_SOFT_BUSY (1 << 1)
#define ERL_DRV_FLAG_NO_BUSY_MSGQ (1 << 2)
+#define ERL_DRV_FLAG_USE_INIT_ACK (1 << 3)
/*
* Integer types
*/
-#if defined(__WIN32__) && (SIZEOF_VOID_P == 8)
-typedef unsigned __int64 ErlDrvTermData;
-typedef unsigned __int64 ErlDrvUInt;
-typedef signed __int64 ErlDrvSInt;
-#else
-typedef unsigned long ErlDrvTermData;
-typedef unsigned long ErlDrvUInt;
-typedef signed long ErlDrvSInt;
-#endif
-#if defined(__WIN32__)
-typedef unsigned __int64 ErlDrvUInt64;
-typedef __int64 ErlDrvSInt64;
-#elif SIZEOF_LONG == 8
-typedef unsigned long ErlDrvUInt64;
-typedef long ErlDrvSInt64;
-#elif SIZEOF_LONG_LONG == 8
-typedef unsigned long long ErlDrvUInt64;
-typedef long long ErlDrvSInt64;
-#else
-#error No 64-bit integer type
-#endif
+typedef ErlNapiUInt64 ErlDrvUInt64;
+typedef ErlNapiSInt64 ErlDrvSInt64;
+typedef ErlNapiUInt ErlDrvUInt;
+typedef ErlNapiSInt ErlDrvSInt;
+typedef ErlNapiUInt ErlDrvTermData;
#if defined(__WIN32__) || defined(_WIN32)
typedef ErlDrvUInt ErlDrvSizeT;
@@ -250,6 +189,17 @@ typedef struct {
unsigned long microsecs;
} ErlDrvNowData;
+typedef ErlDrvSInt64 ErlDrvTime;
+
+#define ERL_DRV_TIME_ERROR ((ErlDrvSInt64) ERTS_NAPI_TIME_ERROR__)
+
+typedef enum {
+ ERL_DRV_SEC = ERTS_NAPI_SEC__,
+ ERL_DRV_MSEC = ERTS_NAPI_MSEC__,
+ ERL_DRV_USEC = ERTS_NAPI_USEC__,
+ ERL_DRV_NSEC = ERTS_NAPI_NSEC__
+} ErlDrvTimeUnit;
+
/*
* Error codes that can be return from driver.
*/
@@ -386,22 +336,23 @@ typedef struct erl_drv_entry {
#ifdef STATIC_ERLANG_DRIVER
# define ERLANG_DRIVER_NAME(NAME) NAME ## _driver_init
+# define ERL_DRIVER_EXPORT
#else
# define ERLANG_DRIVER_NAME(NAME) driver_init
+# if defined(__GNUC__) && __GNUC__ >= 4
+# define ERL_DRIVER_EXPORT __attribute__ ((visibility("default")))
+# elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550)
+# define ERL_DRIVER_EXPORT __global
+# else
+# define ERL_DRIVER_EXPORT
+# endif
#endif
-/* For windows dynamic drivers */
#ifndef ERL_DRIVER_TYPES_ONLY
-#if defined(__WIN32__)
-# define DRIVER_INIT(DRIVER_NAME) \
- __declspec(dllexport) ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \
- __declspec(dllexport) ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void)
-#else
-# define DRIVER_INIT(DRIVER_NAME) \
- ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \
- ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void)
-#endif
+#define DRIVER_INIT(DRIVER_NAME) \
+ ERL_DRIVER_EXPORT ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void); \
+ ERL_DRIVER_EXPORT ErlDrvEntry* ERLANG_DRIVER_NAME(DRIVER_NAME)(void)
#define ERL_DRV_BUSY_MSGQ_DISABLED (~((ErlDrvSizeT) 0))
#define ERL_DRV_BUSY_MSGQ_READ_ONLY ((ErlDrvSizeT) 0)
@@ -685,8 +636,16 @@ EXTERN long driver_async(ErlDrvPort ix,
EXTERN int driver_lock_driver(ErlDrvPort ix);
/* Get the current 'now' timestamp (analogue to erlang:now()) */
-EXTERN int driver_get_now(ErlDrvNowData *now);
+EXTERN int driver_get_now(ErlDrvNowData *now) ERL_DRV_DEPRECATED_FUNC;
+/* Erlang Monotonic Time */
+EXTERN ErlDrvTime erl_drv_monotonic_time(ErlDrvTimeUnit time_unit);
+/* Time offset between Erlang Monotonic Time and Erlang System Time */
+EXTERN ErlDrvTime erl_drv_time_offset(ErlDrvTimeUnit time_unit);
+/* Time unit conversion */
+EXTERN ErlDrvTime erl_drv_convert_time_unit(ErlDrvTime val,
+ ErlDrvTimeUnit from,
+ ErlDrvTimeUnit to);
/* These were removed from the ANSI version, now they're back. */
@@ -696,18 +655,14 @@ EXTERN int driver_dl_close(void *);
EXTERN char *driver_dl_error(void);
/* environment */
-EXTERN int erl_drv_putenv(char *key, char *value);
-EXTERN int erl_drv_getenv(char *key, char *value, size_t *value_size);
-
-#ifdef __OSE__
-typedef ErlDrvUInt ErlDrvOseEventId;
-EXTERN union SIGNAL *erl_drv_ose_get_signal(ErlDrvEvent ev);
-EXTERN ErlDrvEvent erl_drv_ose_event_alloc(SIGSELECT sig, ErlDrvOseEventId handle,
- ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig), void *extra);
-EXTERN void erl_drv_ose_event_free(ErlDrvEvent ev);
-EXTERN void erl_drv_ose_event_fetch(ErlDrvEvent ev, SIGSELECT *sig,
- ErlDrvOseEventId *handle, void **extra);
-#endif
+EXTERN int erl_drv_putenv(const char *key, char *value);
+EXTERN int erl_drv_getenv(const char *key, char *value, size_t *value_size);
+
+/* spawn start init ack */
+EXTERN void erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res);
+
+/* set the pid seen in port_info */
+EXTERN void erl_drv_set_os_pid(ErlDrvPort ix, ErlDrvSInt pid);
#endif /* !ERL_DRIVER_TYPES_ONLY */
diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h
index e2385f63f4..f6b946ae82 100644
--- a/erts/emulator/beam/erl_drv_nif.h
+++ b/erts/emulator/beam/erl_drv_nif.h
@@ -50,6 +50,90 @@ typedef enum {
} ErlDrvDirtyJobFlags;
#endif
+#ifdef SIZEOF_CHAR
+# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR
+# undef SIZEOF_CHAR
+#endif
+#ifdef SIZEOF_SHORT
+# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT
+# undef SIZEOF_SHORT
+#endif
+#ifdef SIZEOF_INT
+# define SIZEOF_INT_SAVED__ SIZEOF_INT
+# undef SIZEOF_INT
+#endif
+#ifdef SIZEOF_LONG
+# define SIZEOF_LONG_SAVED__ SIZEOF_LONG
+# undef SIZEOF_LONG
+#endif
+#ifdef SIZEOF_LONG_LONG
+# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG
+# undef SIZEOF_LONG_LONG
+#endif
+#ifdef HALFWORD_HEAP_EMULATOR
+# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR
+# undef HALFWORD_HEAP_EMULATOR
+#endif
+#include "erl_int_sizes_config.h"
+#if defined(SIZEOF_CHAR_SAVED__) && SIZEOF_CHAR_SAVED__ != SIZEOF_CHAR
+# error SIZEOF_CHAR mismatch
+#endif
+#if defined(SIZEOF_SHORT_SAVED__) && SIZEOF_SHORT_SAVED__ != SIZEOF_SHORT
+# error SIZEOF_SHORT mismatch
+#endif
+#if defined(SIZEOF_INT_SAVED__) && SIZEOF_INT_SAVED__ != SIZEOF_INT
+# error SIZEOF_INT mismatch
+#endif
+#if defined(SIZEOF_LONG_SAVED__) && SIZEOF_LONG_SAVED__ != SIZEOF_LONG
+# error SIZEOF_LONG mismatch
+#endif
+#if defined(SIZEOF_LONG_LONG_SAVED__) && SIZEOF_LONG_LONG_SAVED__ != SIZEOF_LONG_LONG
+# error SIZEOF_LONG_LONG mismatch
+#endif
+
+#if !defined(__GNUC__) && (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+typedef unsigned __int64 ErlNapiUInt64;
+typedef signed __int64 ErlNapiSInt64;
+#define ERL_NAPI_SINT64_MAX__ 9223372036854775807i64
+#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1i64)
+#elif SIZEOF_LONG == 8
+typedef unsigned long ErlNapiUInt64;
+typedef signed long ErlNapiSInt64;
+#define ERL_NAPI_SINT64_MAX__ 9223372036854775807L
+#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1L)
+#elif SIZEOF_LONG_LONG == 8
+typedef unsigned long long ErlNapiUInt64;
+typedef signed long long ErlNapiSInt64;
+#define ERL_NAPI_SINT64_MAX__ 9223372036854775807LL
+#define ERL_NAPI_SINT64_MIN__ (-ERL_NAPI_SINT64_MAX__ - 1LL)
+#else
+# error No 64-bit integer type
+#endif
+
+#if SIZEOF_VOID_P == 8
+typedef ErlNapiUInt64 ErlNapiUInt;
+typedef ErlNapiSInt64 ErlNapiSInt;
+#elif SIZEOF_VOID_P == 4
+# if SIZEOF_LONG == SIZEOF_VOID_P
+typedef unsigned long ErlNapiUInt;
+typedef signed long ErlNapiSInt;
+# elif SIZEOF_INT == SIZEOF_VOID_P
+typedef unsigned int ErlNapiUInt;
+typedef signed int ErlNapiSInt;
+# else
+# error No 32-bit integer type
+# endif
+#else
+# error Not support arch
+#endif
+
+#define ERTS_NAPI_TIME_ERROR__ ERL_NAPI_SINT64_MIN__
+
+#define ERTS_NAPI_SEC__ 0
+#define ERTS_NAPI_MSEC__ 1
+#define ERTS_NAPI_USEC__ 2
+#define ERTS_NAPI_NSEC__ 3
+
#endif /* __ERL_DRV_NIF_H__ */
diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c
index e0404eb5c9..184f8e8931 100644
--- a/erts/emulator/beam/erl_drv_thread.c
+++ b/erts/emulator/beam/erl_drv_thread.c
@@ -43,7 +43,7 @@ fatal_error(int err, char *func)
else
estr = "Unknown error";
}
- erl_exit(ERTS_ABORT_EXIT, "Fatal error in %s: %s [%d]\n", func, estr, err);
+ erts_exit(ERTS_ABORT_EXIT, "Fatal error in %s: %s [%d]\n", func, estr, err);
}
#define ERL_DRV_TSD_KEYS_INC 10
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index 4268e2d40a..ed555aa92f 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -66,6 +66,9 @@ erts_init_fun_table(void)
f.cmp = (HCMP_FUN) fun_cmp;
f.alloc = (HALLOC_FUN) fun_alloc;
f.free = (HFREE_FUN) fun_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_FUN_TABLE, &erts_fun_table, "fun_table", 16, f);
}
@@ -185,7 +188,7 @@ erts_erase_fun_entry(ErlFunEntry* fe)
#endif
{
if (fe->address != unloaded_fun)
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"Internal error: "
"Invalid reference count found on #Fun<%T.%d.%d>: "
" About to erase fun still referred by code.\n",
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index d2604f1595..0d125c5598 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -47,6 +47,17 @@
#define ERTS_INACT_WR_PB_LEAVE_LIMIT 10
#define ERTS_INACT_WR_PB_LEAVE_PERCENTAGE 10
+#if defined(DEBUG) || 0
+#define ERTS_GC_DEBUG
+#else
+#undef ERTS_GC_DEBUG
+#endif
+#ifdef ERTS_GC_DEBUG
+# define ERTS_GC_ASSERT ASSERT
+#else
+# define ERTS_GC_ASSERT(B) ((void) 1)
+#endif
+
/*
* Returns number of elements in an array.
*/
@@ -59,7 +70,7 @@
erts_fprintf(stderr, "stop=%p\n", (p)->stop); \
erts_fprintf(stderr, "htop=%p\n", (p)->htop); \
erts_fprintf(stderr, "heap=%p\n", (p)->heap); \
- erl_exit(ERTS_ABORT_EXIT, "%s, line %d: %T: Overrun stack and heap\n", \
+ erts_exit(ERTS_ABORT_EXIT, "%s, line %d: %T: Overrun stack and heap\n", \
__FILE__,__LINE__,(P)->common.id); \
}
@@ -67,10 +78,10 @@
#define ErtsGcQuickSanityCheck(P) \
do { \
ASSERT((P)->heap < (P)->hend); \
- ASSERT((P)->heap_sz == (P)->hend - (P)->heap); \
+ ASSERT((p)->abandoned_heap || (P)->heap_sz == (P)->hend - (P)->heap); \
ASSERT((P)->heap <= (P)->htop && (P)->htop <= (P)->hend); \
ASSERT((P)->heap <= (P)->stop && (P)->stop <= (P)->hend); \
- ASSERT((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend);\
+ ASSERT((p)->abandoned_heap || ((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend)); \
OverRunCheck((P)); \
} while (0)
#else
@@ -98,18 +109,33 @@ typedef struct {
static Uint setup_rootset(Process*, Eterm*, int, Rootset*);
static void cleanup_rootset(Rootset *rootset);
-static Uint combined_message_size(Process* p);
static void remove_message_buffers(Process* p);
-static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl);
-static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl);
-static void do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj);
-static Eterm* sweep_rootset(Rootset *rootset, Eterm* htop, char* src, Uint src_size);
-static Eterm* sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size);
-static Eterm* sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
- char* src, Uint src_size);
-static Eterm* collect_heap_frags(Process* p, Eterm* heap,
- Eterm* htop, Eterm* objv, int nobj);
-static void adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj);
+static Eterm *full_sweep_heaps(Process *p,
+ int hibernate,
+ Eterm *n_heap, Eterm* n_htop,
+ char *oh, Uint oh_size,
+ Eterm *objv, int nobj);
+static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj);
+static int major_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj, Uint *recl);
+static int minor_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj, Uint *recl);
+static void do_minor(Process *p, ErlHeapFragment *live_hf_end,
+ char *mature, Uint mature_size,
+ Uint new_sz, Eterm* objv, int nobj);
+static Eterm *sweep_new_heap(Eterm *n_hp, Eterm *n_htop,
+ char* old_heap, Uint old_heap_size);
+static Eterm *sweep_heaps(Eterm *n_hp, Eterm *n_htop,
+ char* old_heap, Uint old_heap_size);
+static Eterm* sweep_literal_area(Eterm* n_hp, Eterm* n_htop,
+ char* old_heap, Uint old_heap_size,
+ char* src, Uint src_size);
+static Eterm* sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
+ char* src, Uint src_size);
+static Eterm* collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end,
+ Eterm* heap, Eterm* htop, Eterm* objv, int nobj);
+static int adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj);
static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj);
static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj);
static void sweep_off_heap(Process *p, int fullsweep);
@@ -119,16 +145,16 @@ static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size,
Eterm* objv, int nobj);
static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size);
static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size);
+static void move_msgq_to_heap(Process *p);
static void init_gc_info(ErtsGCInfo *gcip);
#ifdef HARDDEBUG
static void disallow_heap_frag_ref_in_heap(Process* p);
static void disallow_heap_frag_ref_in_old_heap(Process* p);
-static void disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj);
#endif
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
# define MAX_HEAP_SIZES 154
#else
# define MAX_HEAP_SIZES 59
@@ -147,26 +173,24 @@ typedef struct {
erts_smp_atomic32_t refc;
} ErtsGCInfoReq;
-#if !HALFWORD_HEAP
-ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq,
- ErtsGCInfoReq,
- 5,
- ERTS_ALC_T_GC_INFO_REQ)
-#else
-static ERTS_INLINE ErtsGCInfoReq *
-gcireq_alloc(void)
+static ERTS_INLINE int
+gc_cost(Uint gc_moved_live_words, Uint resize_moved_words)
{
- return erts_alloc(ERTS_ALC_T_GC_INFO_REQ,
- sizeof(ErtsGCInfoReq));
-}
+ Sint reds;
-static ERTS_INLINE void
-gcireq_free(ErtsGCInfoReq *ptr)
-{
- erts_free(ERTS_ALC_T_GC_INFO_REQ, ptr);
+ reds = gc_moved_live_words/10;
+ reds += resize_moved_words/100;
+ if (reds < 1)
+ return 1;
+ if (reds > INT_MAX)
+ return INT_MAX;
+ return (int) reds;
}
-#endif
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq,
+ ErtsGCInfoReq,
+ 5,
+ ERTS_ALC_T_GC_INFO_REQ)
/*
* Initialize GC global data.
*/
@@ -208,7 +232,7 @@ erts_init_gc(void)
}
- /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words] (and halfword)
+ /* for 32 bit we want max_heap_size to be MAX(32bit) / 4 [words]
* for 64 bit we want max_heap_size to be MAX(52bit) / 8 [words]
*/
@@ -232,10 +256,7 @@ erts_init_gc(void)
init_gc_info(&esdp->gc_info);
}
-#if !HALFWORD_HEAP
init_gcireq_alloc();
-#endif
-
}
/*
@@ -268,7 +289,7 @@ erts_next_heap_size(Uint size, Uint offset)
low = mid + 1;
}
}
- erl_exit(1, "no next heap size found: %beu, offset %beu\n", size, offset);
+ erts_exit(ERTS_ERROR_EXIT, "no next heap size found: %beu, offset %beu\n", size, offset);
}
return 0;
}
@@ -351,10 +372,19 @@ erts_offset_off_heap(ErlOffHeap *ohp, Sint offs, Eterm* low, Eterm* high)
#undef ptr_within
Eterm
-erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity)
+erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end,
+ Eterm result, Eterm* regs, Uint arity)
{
int cost;
+ if (p->flags & F_HIBERNATE_SCHED) {
+ /*
+ * We just hibernated. We do *not* want to mess
+ * up the hibernation by an ordinary GC...
+ */
+ return result;
+ }
+
if (is_non_value(result)) {
if (p->freason == TRAP) {
#if HIPE
@@ -362,21 +392,28 @@ erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity)
regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array;
}
#endif
- cost = erts_garbage_collect(p, 0, regs, p->arity);
+ cost = garbage_collect(p, live_hf_end, 0, regs, p->arity);
} else {
- cost = erts_garbage_collect(p, 0, regs, arity);
+ cost = garbage_collect(p, live_hf_end, 0, regs, arity);
}
} else {
Eterm val[1];
val[0] = result;
- cost = erts_garbage_collect(p, 0, val, 1);
+ cost = garbage_collect(p, live_hf_end, 0, val, 1);
result = val[0];
}
BUMP_REDS(p, cost);
return result;
}
+Eterm
+erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity)
+{
+ return erts_gc_after_bif_call_lhf(p, ERTS_INVALID_HFRAG_PTR,
+ result, regs, arity);
+}
+
static ERTS_INLINE void reset_active_writer(Process *p)
{
struct erl_off_heap_header* ptr;
@@ -390,6 +427,139 @@ static ERTS_INLINE void reset_active_writer(Process *p)
}
}
+#define ERTS_DELAY_GC_EXTRA_FREE 40
+#define ERTS_ABANDON_HEAP_COST 10
+
+static int
+delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need)
+{
+ ErlHeapFragment *hfrag;
+ Eterm *orig_heap, *orig_hend, *orig_htop, *orig_stop;
+ Eterm *stop, *hend;
+ Uint hsz, ssz;
+ int reds_left;
+
+ ERTS_HOLE_CHECK(p);
+
+ if ((p->flags & F_DISABLE_GC)
+ && p->live_hf_end == ERTS_INVALID_HFRAG_PTR) {
+ /*
+ * A BIF yielded with disabled GC. Remember
+ * heap fragments created by the BIF until we
+ * do next GC.
+ */
+ p->live_hf_end = live_hf_end;
+ }
+
+ if (need == 0)
+ return 1;
+
+ /*
+ * Satisfy need in a heap fragment...
+ */
+ ASSERT(need > 0);
+
+ orig_heap = p->heap;
+ orig_hend = p->hend;
+ orig_htop = p->htop;
+ orig_stop = p->stop;
+
+ ssz = orig_hend - orig_stop;
+ hsz = ssz + need + ERTS_DELAY_GC_EXTRA_FREE;
+
+ hfrag = new_message_buffer(hsz);
+ hfrag->next = p->mbuf;
+ p->mbuf = hfrag;
+ p->mbuf_sz += hsz;
+ p->heap = p->htop = &hfrag->mem[0];
+ p->hend = hend = &hfrag->mem[hsz];
+ p->stop = stop = hend - ssz;
+ sys_memcpy((void *) stop, (void *) orig_stop, ssz * sizeof(Eterm));
+
+ if (p->abandoned_heap) {
+ /* Active heap already in a fragment; adjust it... */
+ ErlHeapFragment *hfrag = ((ErlHeapFragment *)
+ (((char *) orig_heap)
+ - offsetof(ErlHeapFragment, mem)));
+ Uint unused = orig_hend - orig_htop;
+ ASSERT(hfrag->used_size == hfrag->alloc_size);
+ ASSERT(hfrag->used_size >= unused);
+ hfrag->used_size -= unused;
+ p->mbuf_sz -= unused;
+ }
+ else {
+ /* Do not leave a hole in the abandoned heap... */
+ if (orig_htop < orig_hend) {
+ *orig_htop = make_pos_bignum_header(orig_hend-orig_htop-1);
+ if (orig_htop + 1 < orig_hend) {
+ orig_hend[-1] = (Uint) (orig_htop - orig_heap);
+ p->flags |= F_ABANDONED_HEAP_USE;
+ }
+ }
+ p->abandoned_heap = orig_heap;
+ }
+
+#ifdef CHECK_FOR_HOLES
+ p->last_htop = p->htop;
+ p->heap_hfrag = hfrag;
+#endif
+
+ /* Make sure that we do a proper GC as soon as possible... */
+ p->flags |= F_FORCE_GC;
+ reds_left = ERTS_BIF_REDS_LEFT(p);
+ if (reds_left > ERTS_ABANDON_HEAP_COST) {
+ int vreds = reds_left - ERTS_ABANDON_HEAP_COST;
+ ERTS_VBUMP_REDS(p, vreds);
+ }
+ return ERTS_ABANDON_HEAP_COST;
+}
+
+static ERTS_FORCE_INLINE Uint
+young_gen_usage(Process *p)
+{
+ Uint hsz;
+ Eterm *aheap;
+
+ hsz = p->mbuf_sz;
+
+ if (p->flags & F_ON_HEAP_MSGQ) {
+ ErtsMessage *mp;
+ for (mp = p->msg.first; mp; mp = mp->next)
+ if (mp->data.attached)
+ hsz += erts_msg_attached_data_size(mp);
+ }
+
+ aheap = p->abandoned_heap;
+ if (!aheap)
+ hsz += p->htop - p->heap;
+ else {
+ /* used in orig heap */
+ if (p->flags & F_ABANDONED_HEAP_USE)
+ hsz += aheap[p->heap_sz-1];
+ else
+ hsz += p->heap_sz;
+ /* Remove unused part in latest fragment */
+ hsz -= p->hend - p->htop;
+ }
+ return hsz;
+}
+
+#define ERTS_GET_ORIG_HEAP(Proc, Heap, HTop) \
+ do { \
+ Eterm *aheap__ = (Proc)->abandoned_heap; \
+ if (!aheap__) { \
+ (Heap) = (Proc)->heap; \
+ (HTop) = (Proc)->htop; \
+ } \
+ else { \
+ (Heap) = aheap__; \
+ if ((Proc)->flags & F_ABANDONED_HEAP_USE) \
+ (HTop) = aheap__ + aheap__[(Proc)->heap_sz-1]; \
+ else \
+ (HTop) = aheap__ + (Proc)->heap_sz; \
+ } \
+ } while (0)
+
/*
* Garbage collect a process.
*
@@ -398,21 +568,28 @@ static ERTS_INLINE void reset_active_writer(Process *p)
* objv: Array of terms to add to rootset; that is to preserve.
* nobj: Number of objects in objv.
*/
-int
-erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
+static int
+garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj)
{
Uint reclaimed_now = 0;
- int done = 0;
+ int reds;
ErtsMonotonicTime start_time = 0; /* Shut up faulty warning... */
ErtsSchedulerData *esdp;
+ ERTS_MSACC_PUSH_STATE_M();
#ifdef USE_VM_PROBES
DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
#endif
- if (p->flags & F_DISABLE_GC) {
- ASSERT(need == 0);
- return 1;
- }
+ if (p->flags & (F_DISABLE_GC|F_DELAY_GC))
+ return delay_garbage_collection(p, live_hf_end, need);
+
+ if (p->abandoned_heap)
+ live_hf_end = ERTS_INVALID_HFRAG_PTR;
+ else if (p->live_hf_end != ERTS_INVALID_HFRAG_PTR)
+ live_hf_end = p->live_hf_end;
+
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_GC);
esdp = erts_get_scheduler_data();
@@ -420,16 +597,14 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
trace_gc(p, am_gc_start);
}
- (void) erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
+ erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
if (erts_system_monitor_long_gc != 0)
start_time = erts_get_monotonic_time(esdp);
ERTS_CHK_OFFHEAP(p);
ErtsGcQuickSanityCheck(p);
- if (GEN_GCS(p) >= MAX_GEN_GCS(p)) {
- FLAGS(p) |= F_NEED_FULLSWEEP;
- }
+
#ifdef USE_VM_PROBES
*pidbuf = '\0';
if (DTRACE_ENABLED(gc_major_start)
@@ -442,17 +617,23 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
/*
* Test which type of GC to do.
*/
- while (!done) {
- if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) {
- DTRACE2(gc_major_start, pidbuf, need);
- done = major_collection(p, need, objv, nobj, &reclaimed_now);
- DTRACE2(gc_major_end, pidbuf, reclaimed_now);
- } else {
- DTRACE2(gc_minor_start, pidbuf, need);
- done = minor_collection(p, need, objv, nobj, &reclaimed_now);
- DTRACE2(gc_minor_end, pidbuf, reclaimed_now);
- }
+
+ if (GEN_GCS(p) < MAX_GEN_GCS(p) && !(FLAGS(p) & F_NEED_FULLSWEEP)) {
+ DTRACE2(gc_minor_start, pidbuf, need);
+ reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now);
+ DTRACE2(gc_minor_end, pidbuf, reclaimed_now);
+ if (reds < 0)
+ goto do_major_collection;
+ }
+ else {
+ do_major_collection:
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC_FULL);
+ DTRACE2(gc_major_start, pidbuf, need);
+ reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now);
+ DTRACE2(gc_major_end, pidbuf, reclaimed_now);
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC);
}
+
reset_active_writer(p);
/*
@@ -491,6 +672,9 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
esdp->gc_info.reclaimed += reclaimed_now;
FLAGS(p) &= ~F_FORCE_GC;
+ p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
+
+ ERTS_MSACC_POP_STATE_M();
#ifdef CHECK_FOR_HOLES
/*
@@ -512,15 +696,20 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
p->last_old_htop = p->old_htop;
#endif
- /* FIXME: This function should really return an Sint, i.e., a possibly
- 64 bit wide signed integer, but that requires updating all the code
- that calls it. For now, we just return INT_MAX if the result is too
- large for an int. */
- {
- Sint result = (HEAP_TOP(p) - HEAP_START(p)) / 10;
- if (result >= INT_MAX) return INT_MAX;
- else return (int) result;
- }
+ return reds;
+}
+
+int
+erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj)
+{
+ return garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj);
+}
+
+void
+erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj)
+{
+ int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj);
+ BUMP_REDS(p, reds);
}
/*
@@ -533,13 +722,11 @@ erts_garbage_collect_hibernate(Process* p)
Uint heap_size;
Eterm* heap;
Eterm* htop;
- Rootset rootset;
- char* src;
- Uint src_size;
Uint actual_size;
char* area;
Uint area_size;
Sint offs;
+ int reds;
if (p->flags & F_DISABLE_GC)
ERTS_INTERNAL_ERROR("GC disabled");
@@ -549,8 +736,6 @@ erts_garbage_collect_hibernate(Process* p)
*/
erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC);
ErtsGcQuickSanityCheck(p);
- ASSERT(p->mbuf_sz == 0);
- ASSERT(p->mbuf == 0);
ASSERT(p->stop == p->hend); /* Stack must be empty. */
/*
@@ -558,46 +743,25 @@ erts_garbage_collect_hibernate(Process* p)
*/
- heap_size = p->heap_sz + (p->old_htop - p->old_heap);
+ heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz;
heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP,
sizeof(Eterm)*heap_size);
htop = heap;
- (void) setup_rootset(p, p->arg_reg, p->arity, &rootset);
-#if HIPE
- hipe_empty_nstack(p);
-#endif
-
- src = (char *) p->heap;
- src_size = (char *) p->htop - src;
- htop = sweep_rootset(&rootset, htop, src, src_size);
- htop = sweep_one_area(heap, htop, src, src_size);
+ htop = full_sweep_heaps(p,
+ 1,
+ heap,
+ htop,
+ (char *) p->old_heap,
+ (char *) p->old_htop - (char *) p->old_heap,
+ p->arg_reg,
+ p->arity);
- if (p->old_heap) {
- src = (char *) p->old_heap;
- src_size = (char *) p->old_htop - src;
- htop = sweep_rootset(&rootset, htop, src, src_size);
- htop = sweep_one_area(heap, htop, src, src_size);
- }
-
- cleanup_rootset(&rootset);
-
- if (MSO(p).first) {
- sweep_off_heap(p, 1);
- }
-
- /*
- * Update all pointers.
- */
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (void*)HEAP_START(p),
- HEAP_SIZE(p) * sizeof(Eterm));
- if (p->old_heap) {
- ERTS_HEAP_FREE(ERTS_ALC_T_OLD_HEAP,
- (void*)p->old_heap,
- (p->old_hend - p->old_heap) * sizeof(Eterm));
- p->old_heap = p->old_htop = p->old_hend = 0;
- }
+ (p->abandoned_heap
+ ? p->abandoned_heap
+ : p->heap),
+ p->heap_sz * sizeof(Eterm));
p->heap = heap;
p->high_water = htop;
@@ -612,6 +776,7 @@ erts_garbage_collect_hibernate(Process* p)
}
FLAGS(p) &= ~F_FORCE_GC;
+ p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
/*
* Move the heap to its final destination.
@@ -631,6 +796,8 @@ erts_garbage_collect_hibernate(Process* p)
sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm));
ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm));
+ remove_message_buffers(p);
+
p->stop = p->hend = heap + heap_size;
offs = heap - p->heap;
@@ -659,15 +826,18 @@ erts_garbage_collect_hibernate(Process* p)
ErtsGcQuickSanityCheck(p);
erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC);
+
+ reds = gc_cost(actual_size, actual_size);
+ BUMP_REDS(p, reds);
}
void
erts_garbage_collect_literals(Process* p, Eterm* literals,
- Uint lit_size,
+ Uint byte_lit_size,
struct erl_off_heap_header* oh)
{
- Uint byte_lit_size = sizeof(Eterm)*lit_size;
+ Uint lit_size = byte_lit_size / sizeof(Eterm);
Uint old_heap_size;
Eterm* temp_lit;
Sint offs;
@@ -743,7 +913,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
- } else if (in_area(ptr, area, area_size)) {
+ } else if (ErtsInArea(ptr, area, area_size)) {
MOVE_BOXED(ptr,val,old_htop,g_ptr++);
} else {
g_ptr++;
@@ -754,7 +924,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
val = *ptr;
if (IS_MOVED_CONS(val)) { /* Moved */
*g_ptr++ = ptr[1];
- } else if (in_area(ptr, area, area_size)) {
+ } else if (ErtsInArea(ptr, area, area_size)) {
MOVE_CONS(ptr,val,old_htop,g_ptr++);
} else {
g_ptr++;
@@ -774,8 +944,10 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
* Now we'll have to go through all heaps updating all other references.
*/
- old_htop = sweep_one_heap(p->heap, p->htop, old_htop, area, area_size);
- old_htop = sweep_one_area(p->old_heap, old_htop, area, area_size);
+ old_htop = sweep_literals_to_old_heap(p->heap, p->htop, old_htop, area, area_size);
+ old_htop = sweep_literal_area(p->old_heap, old_htop,
+ (char *) p->old_heap, sizeof(Eterm)*old_heap_size,
+ area, area_size);
ASSERT(p->old_htop <= old_htop && old_htop <= p->old_hend);
p->old_htop = old_htop;
@@ -834,15 +1006,18 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
}
static int
-minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
+minor_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj, Uint *recl)
{
- Uint mature = HIGH_WATER(p) - HEAP_START(p);
+ Eterm *mature = p->abandoned_heap ? p->abandoned_heap : p->heap;
+ Uint mature_size = p->high_water - mature;
+ Uint size_before = young_gen_usage(p);
/*
* Allocate an old heap if we don't have one and if we'll need one.
*/
- if (OLD_HEAP(p) == NULL && mature != 0) {
+ if (OLD_HEAP(p) == NULL && mature_size != 0) {
Eterm* n_old;
/* Note: We choose a larger heap size than strictly needed,
@@ -850,7 +1025,7 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
* This improved Estone by more than 1200 estones on my computer
* (Ultra Sparc 10).
*/
- Uint new_sz = erts_next_heap_size(HEAP_TOP(p) - HEAP_START(p), 1);
+ Uint new_sz = erts_next_heap_size(size_before, 1);
/* Create new, empty old_heap */
n_old = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_OLD_HEAP,
@@ -866,41 +1041,32 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
*/
if (OLD_HEAP(p) &&
- ((mature <= OLD_HEND(p) - OLD_HTOP(p)) &&
- ((BIN_VHEAP_MATURE(p) < ( BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)))) &&
- ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) {
- ErlMessage *msgp;
- Uint size_after;
- Uint need_after;
- const Uint stack_size = STACK_SZ_ON_HEAP(p);
- const Uint size_before = MBUF_SIZE(p) + (HEAP_TOP(p) - HEAP_START(p));
- Uint new_sz = HEAP_SIZE(p) + MBUF_SIZE(p) + combined_message_size(p);
+ ((mature_size <= OLD_HEND(p) - OLD_HTOP(p)) &&
+ ((BIN_OLD_VHEAP_SZ(p) > BIN_OLD_VHEAP(p))) ) ) {
+ Eterm *prev_old_htop;
+ Uint stack_size, size_after, adjust_size, need_after, new_sz, new_mature;
+
+ stack_size = p->hend - p->stop;
+ new_sz = stack_size + size_before;
new_sz = next_heap_size(p, new_sz, 0);
- do_minor(p, new_sz, objv, nobj);
+ prev_old_htop = p->old_htop;
+ do_minor(p, live_hf_end, (char *) mature, mature_size*sizeof(Eterm),
+ new_sz, objv, nobj);
+
+ if (p->flags & F_ON_HEAP_MSGQ)
+ move_msgq_to_heap(p);
- size_after = HEAP_TOP(p) - HEAP_START(p);
+ new_mature = p->old_htop - prev_old_htop;
+
+ size_after = new_mature;
+ size_after += HEAP_TOP(p) - HEAP_START(p) + p->mbuf_sz;
*recl += (size_before - size_after);
- /*
- * Copy newly received message onto the end of the new heap.
- */
- ErtsGcQuickSanityCheck(p);
- for (msgp = p->msg.first; msgp; msgp = msgp->next) {
- if (msgp->data.attached) {
- ErtsHeapFactory factory;
- erts_factory_proc_prealloc_init(&factory, p,
- erts_msg_attached_data_size(msgp));
- erts_move_msg_attached_data_to_heap(&factory, msgp);
- erts_factory_close(&factory);
- ErtsGcQuickSanityCheck(p);
- }
- }
ErtsGcQuickSanityCheck(p);
GEN_GCS(p)++;
need_after = ((HEAP_TOP(p) - HEAP_START(p))
- + erts_used_frag_sz(MBUF(p))
+ need
+ stack_size);
@@ -913,6 +1079,8 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
* the heap size is substantial, we don't want to shrink.
*/
+ adjust_size = 0;
+
if ((HEAP_SIZE(p) > 3000) && (4 * need_after < HEAP_SIZE(p)) &&
((HEAP_SIZE(p) > 8000) ||
(HEAP_SIZE(p) > (OLD_HEND(p) - OLD_HEAP(p))))) {
@@ -934,28 +1102,33 @@ minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
: next_heap_size(p, wanted, 0);
if (wanted < HEAP_SIZE(p)) {
shrink_new_heap(p, wanted, objv, nobj);
+ adjust_size = p->htop - p->heap;
}
- ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0));
- ASSERT(MBUF(p) == NULL);
- return 1; /* We are done. */
+ goto done;
}
if (HEAP_SIZE(p) >= need_after) {
/*
* The heap size turned out to be just right. We are done.
*/
- ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0));
- ASSERT(MBUF(p) == NULL);
- return 1;
+ goto done;
}
+
+ grow_new_heap(p, next_heap_size(p, need_after, 0), objv, nobj);
+ adjust_size = p->htop - p->heap;
+
+ done:
+ ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0));
+ ASSERT(MBUF(p) == NULL);
+
+ return gc_cost(size_after, adjust_size);
}
/*
- * Still not enough room after minor collection. Must force a major collection.
+ * Not enough room for a minor collection. Must force a major collection.
*/
- FLAGS(p) |= F_NEED_FULLSWEEP;
- return 0;
+ return -1;
}
/*
@@ -1009,7 +1182,9 @@ static ERTS_INLINE void offset_nstack(Process* p, Sint offs,
#endif /* HIPE */
static void
-do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
+do_minor(Process *p, ErlHeapFragment *live_hf_end,
+ char *mature, Uint mature_size,
+ Uint new_sz, Eterm* objv, int nobj)
{
Rootset rootset; /* Rootset for GC (stack, dictionary, etc). */
Roots* roots;
@@ -1018,17 +1193,24 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
Eterm* ptr;
Eterm val;
Eterm gval;
- char* heap = (char *) HEAP_START(p);
- Uint heap_size = (char *) HEAP_TOP(p) - heap;
- Uint mature_size = (char *) HIGH_WATER(p) - heap;
Eterm* old_htop = OLD_HTOP(p);
Eterm* n_heap;
+ char* oh = (char *) OLD_HEAP(p);
+ Uint oh_size = (char *) OLD_HTOP(p) - oh;
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MINOR GC: %p %p %p %p\n", p->common.id,
+ HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)));
n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP,
sizeof(Eterm)*new_sz);
- if (MBUF(p) != NULL) {
- n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj);
+ if (live_hf_end != ERTS_INVALID_HFRAG_PTR) {
+ /*
+ * Move heap frags that we know are completely live
+ * directly into the new young heap generation.
+ */
+ n_htop = collect_live_heap_frags(p, live_hf_end, n_heap, n_htop,
+ objv, nobj);
}
n = setup_rootset(p, objv, nobj, &rootset);
@@ -1051,9 +1233,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_BOXED(ptr,val,old_htop,g_ptr++);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
MOVE_BOXED(ptr,val,n_htop,g_ptr++);
} else {
g_ptr++;
@@ -1066,9 +1248,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
val = *ptr;
if (IS_MOVED_CONS(val)) { /* Moved */
*g_ptr++ = ptr[1];
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_CONS(ptr,val,old_htop,g_ptr++);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
MOVE_CONS(ptr,val,n_htop,g_ptr++);
} else {
g_ptr++;
@@ -1093,7 +1275,7 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
*/
if (mature_size == 0) {
- n_htop = sweep_one_area(n_heap, n_htop, heap, heap_size);
+ n_htop = sweep_new_heap(n_heap, n_htop, oh, oh_size);
} else {
Eterm* n_hp = n_heap;
Eterm* ptr;
@@ -1110,9 +1292,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*n_hp++ = val;
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_BOXED(ptr,val,old_htop,n_hp++);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
MOVE_BOXED(ptr,val,n_htop,n_hp++);
} else {
n_hp++;
@@ -1124,9 +1306,9 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
val = *ptr;
if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_CONS(ptr,val,old_htop,n_hp++);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
MOVE_CONS(ptr,val,n_htop,n_hp++);
} else {
n_hp++;
@@ -1146,10 +1328,10 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(val);
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_BOXED(ptr,val,old_htop,origptr);
mb->base = binary_bytes(mb->orig);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(*origptr, ptr, oh, oh_size)) {
MOVE_BOXED(ptr,val,n_htop,origptr);
mb->base = binary_bytes(mb->orig);
}
@@ -1170,9 +1352,8 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
* may point to the old (soon to be deleted) new_heap.
*/
- if (OLD_HTOP(p) < old_htop) {
- old_htop = sweep_one_area(OLD_HTOP(p), old_htop, heap, heap_size);
- }
+ if (OLD_HTOP(p) < old_htop)
+ old_htop = sweep_new_heap(OLD_HTOP(p), old_htop, oh, oh_size);
OLD_HTOP(p) = old_htop;
HIGH_WATER(p) = n_htop;
@@ -1204,8 +1385,12 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
#endif
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (void*)HEAP_START(p),
+ (p->abandoned_heap
+ ? p->abandoned_heap
+ : HEAP_START(p)),
HEAP_SIZE(p) * sizeof(Eterm));
+ p->abandoned_heap = NULL;
+ p->flags &= ~F_ABANDONED_HEAP_USE;
HEAP_START(p) = n_heap;
HEAP_TOP(p) = n_htop;
HEAP_SIZE(p) = new_sz;
@@ -1222,30 +1407,30 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj)
*/
static int
-major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
+major_collection(Process* p, ErlHeapFragment *live_hf_end,
+ int need, Eterm* objv, int nobj, Uint *recl)
{
- Rootset rootset;
- Roots* roots;
- const Uint size_before = ((HEAP_TOP(p) - HEAP_START(p))
- + (OLD_HTOP(p) - OLD_HEAP(p))
- + MBUF_SIZE(p));
+ Uint size_before, size_after, stack_size;
Eterm* n_heap;
Eterm* n_htop;
- char* src = (char *) HEAP_START(p);
- Uint src_size = (char *) HEAP_TOP(p) - src;
char* oh = (char *) OLD_HEAP(p);
Uint oh_size = (char *) OLD_HTOP(p) - oh;
- Uint n;
- Uint new_sz;
+ Uint new_sz, stk_sz;
+ int adjusted;
+
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] MAJOR GC: %p %p %p %p\n", p->common.id,
+ HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)));
/*
* Do a fullsweep GC. First figure out the size of the heap
* to receive all live data.
*/
- new_sz = (HEAP_SIZE(p) + MBUF_SIZE(p)
- + combined_message_size(p)
- + (OLD_HTOP(p) - OLD_HEAP(p)));
+ size_before = young_gen_usage(p);
+ size_before += p->old_htop - p->old_heap;
+ stack_size = p->hend - p->stop;
+
+ new_sz = stack_size + size_before;
new_sz = next_heap_size(p, new_sz, 0);
/*
@@ -1259,13 +1444,76 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
n_htop = n_heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP,
sizeof(Eterm)*new_sz);
- /*
- * Get rid of heap fragments.
- */
+ if (live_hf_end != ERTS_INVALID_HFRAG_PTR) {
+ /*
+ * Move heap frags that we know are completely live
+ * directly into the heap.
+ */
+ n_htop = collect_live_heap_frags(p, live_hf_end, n_heap, n_htop,
+ objv, nobj);
+ }
- if (MBUF(p) != NULL) {
- n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj);
+ n_htop = full_sweep_heaps(p, 0, n_heap, n_htop, oh, oh_size, objv, nobj);
+
+ /* Move the stack to the end of the heap */
+ stk_sz = HEAP_END(p) - p->stop;
+ sys_memcpy(n_heap + new_sz - stk_sz, p->stop, stk_sz * sizeof(Eterm));
+ p->stop = n_heap + new_sz - stk_sz;
+
+#ifdef USE_VM_PROBES
+ if (HEAP_SIZE(p) != new_sz && DTRACE_ENABLED(process_heap_grow)) {
+ DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
+
+ dtrace_proc_str(p, pidbuf);
+ DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz);
}
+#endif
+
+ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
+ (p->abandoned_heap
+ ? p->abandoned_heap
+ : HEAP_START(p)),
+ p->heap_sz * sizeof(Eterm));
+ p->abandoned_heap = NULL;
+ p->flags &= ~F_ABANDONED_HEAP_USE;
+ HEAP_START(p) = n_heap;
+ HEAP_TOP(p) = n_htop;
+ HEAP_SIZE(p) = new_sz;
+ HEAP_END(p) = n_heap + new_sz;
+ GEN_GCS(p) = 0;
+
+ HIGH_WATER(p) = HEAP_TOP(p);
+
+ remove_message_buffers(p);
+
+ if (p->flags & F_ON_HEAP_MSGQ)
+ move_msgq_to_heap(p);
+
+ ErtsGcQuickSanityCheck(p);
+
+ size_after = HEAP_TOP(p) - HEAP_START(p) + p->mbuf_sz;
+ *recl += size_before - size_after;
+
+ adjusted = adjust_after_fullsweep(p, need, objv, nobj);
+
+#ifdef HARDDEBUG
+ disallow_heap_frag_ref_in_heap(p);
+#endif
+ ErtsGcQuickSanityCheck(p);
+
+ return gc_cost(size_after, adjusted ? size_after : 0);
+}
+
+static Eterm *
+full_sweep_heaps(Process *p,
+ int hibernate,
+ Eterm *n_heap, Eterm* n_htop,
+ char *oh, Uint oh_size,
+ Eterm *objv, int nobj)
+{
+ Rootset rootset;
+ Roots *roots;
+ Uint n;
/*
* Copy all top-level terms directly referenced by the rootset to
@@ -1273,7 +1521,14 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
*/
n = setup_rootset(p, objv, nobj, &rootset);
- n_htop = fullsweep_nstack(p, n_htop);
+
+#ifdef HIPE
+ if (hibernate)
+ hipe_empty_nstack(p);
+ else
+ n_htop = fullsweep_nstack(p, n_htop);
+#endif
+
roots = rootset.roots;
while (n--) {
Eterm* g_ptr = roots->v;
@@ -1293,7 +1548,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*g_ptr++ = val;
- } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
+ } else if (!erts_is_literal(gval, ptr)) {
MOVE_BOXED(ptr,val,n_htop,g_ptr++);
} else {
g_ptr++;
@@ -1306,7 +1561,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
val = *ptr;
if (IS_MOVED_CONS(val)) {
*g_ptr++ = ptr[1];
- } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
+ } else if (!erts_is_literal(gval, ptr)) {
MOVE_CONS(ptr,val,n_htop,g_ptr++);
} else {
g_ptr++;
@@ -1331,74 +1586,7 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
* until all is copied.
*/
- if (oh_size == 0) {
- n_htop = sweep_one_area(n_heap, n_htop, src, src_size);
- } else {
- Eterm* n_hp = n_heap;
-
- while (n_hp != n_htop) {
- Eterm* ptr;
- Eterm val;
- Eterm gval = *n_hp;
-
- switch (primary_tag(gval)) {
- case TAG_PRIMARY_BOXED: {
- ptr = boxed_val(gval);
- val = *ptr;
- if (IS_MOVED_BOXED(val)) {
- ASSERT(is_boxed(val));
- *n_hp++ = val;
- } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
- MOVE_BOXED(ptr,val,n_htop,n_hp++);
- } else {
- n_hp++;
- }
- break;
- }
- case TAG_PRIMARY_LIST: {
- ptr = list_val(gval);
- val = *ptr;
- if (IS_MOVED_CONS(val)) {
- *n_hp++ = ptr[1];
- } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) {
- MOVE_CONS(ptr,val,n_htop,n_hp++);
- } else {
- n_hp++;
- }
- break;
- }
- case TAG_PRIMARY_HEADER: {
- if (!header_is_thing(gval))
- n_hp++;
- else {
- if (header_is_bin_matchstate(gval)) {
- ErlBinMatchState *ms = (ErlBinMatchState*) n_hp;
- ErlBinMatchBuffer *mb = &(ms->mb);
- Eterm* origptr;
- origptr = &(mb->orig);
- ptr = boxed_val(*origptr);
- val = *ptr;
- if (IS_MOVED_BOXED(val)) {
- *origptr = val;
- mb->base = binary_bytes(*origptr);
- } else if (in_area(ptr, src, src_size) ||
- in_area(ptr, oh, oh_size)) {
- MOVE_BOXED(ptr,val,n_htop,origptr);
- mb->base = binary_bytes(*origptr);
- ptr = boxed_val(*origptr);
- val = *ptr;
- }
- }
- n_hp += (thing_arityval(gval)+1);
- }
- break;
- }
- default:
- n_hp++;
- break;
- }
- }
- }
+ n_htop = sweep_heaps(n_heap, n_htop, oh, oh_size);
if (MSO(p).first) {
sweep_off_heap(p, 1);
@@ -1411,67 +1599,13 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl)
OLD_HEAP(p) = OLD_HTOP(p) = OLD_HEND(p) = NULL;
}
- /* Move the stack to the end of the heap */
- n = HEAP_END(p) - p->stop;
- sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm));
- p->stop = n_heap + new_sz - n;
-
-#ifdef USE_VM_PROBES
- if (HEAP_SIZE(p) != new_sz && DTRACE_ENABLED(process_heap_grow)) {
- DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
-
- dtrace_proc_str(p, pidbuf);
- DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz);
- }
-#endif
-
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP,
- (void *) HEAP_START(p),
- (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm));
- HEAP_START(p) = n_heap;
- HEAP_TOP(p) = n_htop;
- HEAP_SIZE(p) = new_sz;
- HEAP_END(p) = n_heap + new_sz;
- GEN_GCS(p) = 0;
-
- HIGH_WATER(p) = HEAP_TOP(p);
-
- ErtsGcQuickSanityCheck(p);
-
- *recl += size_before - (HEAP_TOP(p) - HEAP_START(p));
-
- {
- ErlMessage *msgp;
-
- /*
- * Copy newly received message onto the end of the new heap.
- */
- for (msgp = p->msg.first; msgp; msgp = msgp->next) {
- if (msgp->data.attached) {
- ErtsHeapFactory factory;
- erts_factory_proc_prealloc_init(&factory, p,
- erts_msg_attached_data_size(msgp));
- erts_move_msg_attached_data_to_heap(&factory, msgp);
- erts_factory_close(&factory);
- ErtsGcQuickSanityCheck(p);
- }
- }
- }
-
- adjust_after_fullsweep(p, need, objv, nobj);
-
-#ifdef HARDDEBUG
- disallow_heap_frag_ref_in_heap(p);
-#endif
- remove_message_buffers(p);
-
- ErtsGcQuickSanityCheck(p);
- return 1; /* We are done. */
+ return n_htop;
}
-static void
+static int
adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj)
{
+ int adjusted = 0;
Uint wanted, sz, need_after;
Uint stack_size = STACK_SZ_ON_HEAP(p);
@@ -1484,6 +1618,7 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj)
/* Too small - grow to match requested need */
sz = next_heap_size(p, need_after, 0);
grow_new_heap(p, sz, objv, nobj);
+ adjusted = 1;
} else if (3 * HEAP_SIZE(p) < 4 * need_after){
/* Need more than 75% of current, postpone to next GC.*/
FLAGS(p) |= F_HEAP_GROW;
@@ -1500,25 +1635,10 @@ adjust_after_fullsweep(Process *p, int need, Eterm *objv, int nobj)
if (sz < HEAP_SIZE(p)) {
shrink_new_heap(p, sz, objv, nobj);
+ adjusted = 1;
}
}
-}
-
-/*
- * Return the size of all message buffers that are NOT linked in the
- * mbuf list.
- */
-static Uint
-combined_message_size(Process* p)
-{
- Uint sz;
- ErlMessage *msgp;
-
- for (sz = 0, msgp = p->msg.first; msgp; msgp = msgp->next) {
- if (msgp->data.attached)
- sz += erts_msg_attached_data_size(msgp);
- }
- return sz;
+ return adjusted;
}
/*
@@ -1531,6 +1651,10 @@ remove_message_buffers(Process* p)
free_message_buffer(MBUF(p));
MBUF(p) = NULL;
}
+ if (p->msg_frag) {
+ erts_cleanup_messages(p->msg_frag);
+ p->msg_frag = NULL;
+ }
MBUF_SIZE(p) = 0;
}
#ifdef HARDDEBUG
@@ -1542,64 +1666,6 @@ remove_message_buffers(Process* p)
* For performance reasons, we use _unchecked_list_val(), _unchecked_boxed_val(),
* and so on to avoid a function call.
*/
-
-static void
-disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj)
-{
- ErlHeapFragment* mbuf;
- ErlHeapFragment* qb;
- Eterm gval;
- Eterm* ptr;
- Eterm val;
-
- ASSERT(p->htop != NULL);
- mbuf = MBUF(p);
-
- while (nobj--) {
- gval = *objv;
-
- switch (primary_tag(gval)) {
-
- case TAG_PRIMARY_BOXED: {
- ptr = _unchecked_boxed_val(gval);
- val = *ptr;
- if (IS_MOVED_BOXED(val)) {
- ASSERT(is_boxed(val));
- objv++;
- } else {
- for (qb = mbuf; qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
- abort();
- }
- }
- objv++;
- }
- break;
- }
-
- case TAG_PRIMARY_LIST: {
- ptr = _unchecked_list_val(gval);
- val = *ptr;
- if (IS_MOVED_CONS(val)) {
- objv++;
- } else {
- for (qb = mbuf; qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
- abort();
- }
- }
- objv++;
- }
- break;
- }
-
- default: {
- objv++;
- break;
- }
- }
- }
-}
static void
disallow_heap_frag_ref_in_heap(Process* p)
@@ -1627,9 +1693,9 @@ disallow_heap_frag_ref_in_heap(Process* p)
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
ptr = _unchecked_boxed_val(val);
- if (!in_area(ptr, heap, heap_size)) {
+ if (!ErtsInArea(ptr, heap, heap_size)) {
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+ if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1637,9 +1703,9 @@ disallow_heap_frag_ref_in_heap(Process* p)
break;
case TAG_PRIMARY_LIST:
ptr = _unchecked_list_val(val);
- if (!in_area(ptr, heap, heap_size)) {
+ if (!ErtsInArea(ptr, heap, heap_size)) {
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+ if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1681,26 +1747,26 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
val = *hp++;
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
- ptr = (Eterm *) EXPAND_POINTER(val);
- if (!in_area(ptr, old_heap, old_heap_size)) {
- if (in_area(ptr, new_heap, new_heap_size)) {
+ ptr = (Eterm *) val;
+ if (!ErtsInArea(ptr, old_heap, old_heap_size)) {
+ if (ErtsInArea(ptr, new_heap, new_heap_size)) {
abort();
}
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+ if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
}
break;
case TAG_PRIMARY_LIST:
- ptr = (Eterm *) EXPAND_POINTER(val);
- if (!in_area(ptr, old_heap, old_heap_size)) {
- if (in_area(ptr, new_heap, new_heap_size)) {
+ ptr = (Eterm *) val;
+ if (!ErtsInArea(ptr, old_heap, old_heap_size)) {
+ if (ErtsInArea(ptr, new_heap, new_heap_size)) {
abort();
}
for (qb = MBUF(p); qb != NULL; qb = qb->next) {
- if (in_area(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
+ if (ErtsInArea(ptr, qb->mem, qb->alloc_size*sizeof(Eterm))) {
abort();
}
}
@@ -1709,7 +1775,7 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
case TAG_PRIMARY_HEADER:
if (header_is_thing(val)) {
hp += _unchecked_thing_arityval(val);
- if (!in_area(hp, old_heap, old_heap_size+1)) {
+ if (!ErtsInArea(hp, old_heap, old_heap_size+1)) {
abort();
}
}
@@ -1719,66 +1785,30 @@ disallow_heap_frag_ref_in_old_heap(Process* p)
}
#endif
-static Eterm*
-sweep_rootset(Rootset* rootset, Eterm* htop, char* src, Uint src_size)
+typedef enum {
+ ErtsSweepNewHeap,
+ ErtsSweepHeaps,
+ ErtsSweepLiteralArea
+} ErtsSweepType;
+
+static ERTS_FORCE_INLINE Eterm *
+sweep(Eterm *n_hp, Eterm *n_htop,
+ ErtsSweepType type,
+ char *oh, Uint ohsz,
+ char *src, Uint src_size)
{
- Roots* roots = rootset->roots;
- Uint n = rootset->num_roots;
Eterm* ptr;
- Eterm gval;
Eterm val;
+ Eterm gval;
- while (n--) {
- Eterm* g_ptr = roots->v;
- Uint g_sz = roots->sz;
-
- roots++;
- while (g_sz--) {
- gval = *g_ptr;
-
- switch (primary_tag(gval)) {
- case TAG_PRIMARY_BOXED: {
- ptr = boxed_val(gval);
- val = *ptr;
- if (IS_MOVED_BOXED(val)) {
- ASSERT(is_boxed(val));
- *g_ptr++ = val;
- } else if (in_area(ptr, src, src_size)) {
- MOVE_BOXED(ptr,val,htop,g_ptr++);
- } else {
- g_ptr++;
- }
- break;
- }
- case TAG_PRIMARY_LIST: {
- ptr = list_val(gval);
- val = *ptr;
- if (IS_MOVED_CONS(val)) {
- *g_ptr++ = ptr[1];
- } else if (in_area(ptr, src, src_size)) {
- MOVE_CONS(ptr,val,htop,g_ptr++);
- } else {
- g_ptr++;
- }
- break;
- }
-
- default:
- g_ptr++;
- break;
- }
- }
- }
- return htop;
-}
-
+#undef ERTS_IS_IN_SWEEP_AREA
-static Eterm*
-sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
-{
- Eterm* ptr;
- Eterm val;
- Eterm gval;
+#define ERTS_IS_IN_SWEEP_AREA(TPtr, Ptr) \
+ (type == ErtsSweepHeaps \
+ ? !erts_is_literal((TPtr), (Ptr)) \
+ : (type == ErtsSweepNewHeap \
+ ? ErtsInYoungGen((TPtr), (Ptr), oh, ohsz) \
+ : ErtsInArea((Ptr), src, src_size)))
while (n_hp != n_htop) {
ASSERT(n_hp < n_htop);
@@ -1790,7 +1820,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*n_hp++ = val;
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
MOVE_BOXED(ptr,val,n_htop,n_hp++);
} else {
n_hp++;
@@ -1802,7 +1832,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
val = *ptr;
if (IS_MOVED_CONS(val)) {
*n_hp++ = ptr[1];
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ERTS_IS_IN_SWEEP_AREA(gval, ptr)) {
MOVE_CONS(ptr,val,n_htop,n_hp++);
} else {
n_hp++;
@@ -1823,7 +1853,7 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(*origptr);
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ERTS_IS_IN_SWEEP_AREA(*origptr, ptr)) {
MOVE_BOXED(ptr,val,n_htop,origptr);
mb->base = binary_bytes(*origptr);
}
@@ -1838,10 +1868,41 @@ sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size)
}
}
return n_htop;
+#undef ERTS_IS_IN_SWEEP_AREA
+}
+
+static Eterm *
+sweep_new_heap(Eterm *n_hp, Eterm *n_htop, char* old_heap, Uint old_heap_size)
+{
+ return sweep(n_hp, n_htop,
+ ErtsSweepNewHeap,
+ old_heap, old_heap_size,
+ NULL, 0);
+}
+
+static Eterm *
+sweep_heaps(Eterm *n_hp, Eterm *n_htop, char* old_heap, Uint old_heap_size)
+{
+ return sweep(n_hp, n_htop,
+ ErtsSweepHeaps,
+ old_heap, old_heap_size,
+ NULL, 0);
+}
+
+static Eterm *
+sweep_literal_area(Eterm *n_hp, Eterm *n_htop,
+ char* old_heap, Uint old_heap_size,
+ char* src, Uint src_size)
+{
+ return sweep(n_hp, n_htop,
+ ErtsSweepLiteralArea,
+ old_heap, old_heap_size,
+ src, src_size);
}
static Eterm*
-sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint src_size)
+sweep_literals_to_old_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop,
+ char* src, Uint src_size)
{
while (heap_ptr < heap_end) {
Eterm* ptr;
@@ -1855,7 +1916,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*heap_ptr++ = val;
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ErtsInArea(ptr, src, src_size)) {
MOVE_BOXED(ptr,val,htop,heap_ptr++);
} else {
heap_ptr++;
@@ -1867,7 +1928,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
val = *ptr;
if (IS_MOVED_CONS(val)) {
*heap_ptr++ = ptr[1];
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ErtsInArea(ptr, src, src_size)) {
MOVE_CONS(ptr,val,htop,heap_ptr++);
} else {
heap_ptr++;
@@ -1888,7 +1949,7 @@ sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint sr
if (IS_MOVED_BOXED(val)) {
*origptr = val;
mb->base = binary_bytes(*origptr);
- } else if (in_area(ptr, src, src_size)) {
+ } else if (ErtsInArea(ptr, src, src_size)) {
MOVE_BOXED(ptr,val,htop,origptr);
mb->base = binary_bytes(*origptr);
}
@@ -1939,32 +2000,21 @@ move_one_area(Eterm* n_htop, char* src, Uint src_size)
*/
static Eterm*
-collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop,
- Eterm* objv, int nobj)
+collect_live_heap_frags(Process* p, ErlHeapFragment *live_hf_end,
+ Eterm* n_hstart, Eterm* n_htop,
+ Eterm* objv, int nobj)
{
ErlHeapFragment* qb;
char* frag_begin;
Uint frag_size;
/*
- * We don't allow references to a heap fragments from the stack, heap,
- * or process dictionary.
- */
-#ifdef HARDDEBUG
- disallow_heap_frag_ref(p, n_htop, p->stop, STACK_START(p) - p->stop);
- if (p->dictionary != NULL) {
- disallow_heap_frag_ref(p, n_htop, p->dictionary->data, p->dictionary->used);
- }
- disallow_heap_frag_ref_in_heap(p);
-#endif
-
- /*
* Move the heap fragments to the new heap. Note that no GC is done on
* the heap fragments. Any garbage will thus be moved as well and survive
* until next GC.
*/
qb = MBUF(p);
- while (qb != NULL) {
+ while (qb != live_hf_end) {
ASSERT(!qb->off_heap.first); /* process fragments use the MSO(p) list */
frag_size = qb->used_size * sizeof(Eterm);
if (frag_size != 0) {
@@ -1976,12 +2026,177 @@ collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop,
return n_htop;
}
+static ERTS_INLINE void
+copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap,
+ ErlHeapFragment *bp, Eterm *refs, int nrefs)
+{
+ Uint sz;
+ int i;
+ Sint offs;
+ struct erl_off_heap_header* oh;
+ Eterm *fhp, *hp;
+
+ OH_OVERHEAD(off_heap, bp->off_heap.overhead);
+ sz = bp->used_size;
+
+ fhp = bp->mem;
+ hp = *hpp;
+ offs = hp - fhp;
+
+ oh = NULL;
+ while (sz--) {
+ Uint cpy_sz;
+ Eterm val = *fhp++;
+
+ switch (primary_tag(val)) {
+ case TAG_PRIMARY_IMMED1:
+ *hp++ = val;
+ break;
+ case TAG_PRIMARY_LIST:
+ case TAG_PRIMARY_BOXED:
+ *hp++ = offset_ptr(val, offs);
+ break;
+ case TAG_PRIMARY_HEADER:
+ *hp++ = val;
+ switch (val & _HEADER_SUBTAG_MASK) {
+ case ARITYVAL_SUBTAG:
+ break;
+ case REFC_BINARY_SUBTAG:
+ case FUN_SUBTAG:
+ case EXTERNAL_PID_SUBTAG:
+ case EXTERNAL_PORT_SUBTAG:
+ case EXTERNAL_REF_SUBTAG:
+ oh = (struct erl_off_heap_header*) (hp-1);
+ cpy_sz = thing_arityval(val);
+ goto cpy_words;
+ default:
+ cpy_sz = header_arity(val);
+
+ cpy_words:
+ ASSERT(sz >= cpy_sz);
+ sz -= cpy_sz;
+ while (cpy_sz >= 8) {
+ cpy_sz -= 8;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ *hp++ = *fhp++;
+ }
+ switch (cpy_sz) {
+ case 7: *hp++ = *fhp++;
+ case 6: *hp++ = *fhp++;
+ case 5: *hp++ = *fhp++;
+ case 4: *hp++ = *fhp++;
+ case 3: *hp++ = *fhp++;
+ case 2: *hp++ = *fhp++;
+ case 1: *hp++ = *fhp++;
+ default: break;
+ }
+ if (oh) {
+ /* Add to offheap list */
+ oh->next = off_heap->first;
+ off_heap->first = oh;
+ ASSERT(*hpp <= (Eterm*)oh);
+ ASSERT(hp > (Eterm*)oh);
+ oh = NULL;
+ }
+ break;
+ }
+ break;
+ }
+ }
+
+ ASSERT(bp->used_size == hp - *hpp);
+ *hpp = hp;
+
+ for (i = 0; i < nrefs; i++) {
+ if (is_not_immed(refs[i]))
+ refs[i] = offset_ptr(refs[i], offs);
+ }
+ bp->off_heap.first = NULL;
+}
+
+static void
+move_msgq_to_heap(Process *p)
+{
+ ErtsMessage **mpp = &p->msg.first;
+
+ while (*mpp) {
+ ErtsMessage *mp = *mpp;
+
+ if (mp->data.attached) {
+ ErlHeapFragment *bp;
+ ErtsHeapFactory factory;
+
+ erts_factory_proc_prealloc_init(&factory, p,
+ erts_msg_attached_data_size(mp));
+
+ if (is_non_value(ERL_MESSAGE_TERM(mp))) {
+ if (mp->data.dist_ext) {
+ ASSERT(mp->data.dist_ext->heap_size >= 0);
+ if (is_not_nil(ERL_MESSAGE_TOKEN(mp))) {
+ bp = erts_dist_ext_trailer(mp->data.dist_ext);
+ ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp),
+ bp->used_size,
+ &factory.hp,
+ factory.off_heap);
+ erts_cleanup_offheap(&bp->off_heap);
+ }
+ ERL_MESSAGE_TERM(mp) = erts_decode_dist_ext(&factory,
+ mp->data.dist_ext);
+ erts_free_dist_ext_copy(mp->data.dist_ext);
+ mp->data.dist_ext = NULL;
+ }
+ }
+ else {
+
+ if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ bp = &mp->hfrag;
+ else
+ bp = mp->data.heap_frag;
+
+ if (bp->next)
+ erts_move_multi_frags(&factory.hp, factory.off_heap, bp,
+ mp->m, ERL_MESSAGE_REF_ARRAY_SZ, 0);
+ else
+ copy_one_frag(&factory.hp, factory.off_heap, bp,
+ mp->m, ERL_MESSAGE_REF_ARRAY_SZ);
+
+ if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
+ mp->data.heap_frag = NULL;
+ free_message_buffer(bp);
+ }
+ else {
+ ErtsMessage *tmp = erts_alloc_message(0, NULL);
+ sys_memcpy((void *) tmp->m, (void *) mp->m,
+ sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ);
+ tmp->next = mp->next;
+ if (p->msg.save == &mp->next)
+ p->msg.save = &tmp->next;
+ if (p->msg.last == &mp->next)
+ p->msg.last = &tmp->next;
+ *mpp = tmp;
+ mp->next = NULL;
+ erts_cleanup_messages(mp);
+ mp = tmp;
+ }
+ }
+
+ erts_factory_close(&factory);
+ }
+
+ mpp = &(*mpp)->next;
+ }
+}
+
static Uint
setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
{
- Uint avail;
Roots* roots;
- ErlMessage* mp;
Uint n;
n = 0;
@@ -1993,8 +2208,8 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
++n;
if (p->dictionary != NULL) {
- roots[n].v = p->dictionary->data;
- roots[n].sz = p->dictionary->used;
+ roots[n].v = ERTS_PD_START(p->dictionary);
+ roots[n].sz = ERTS_PD_SIZE(p->dictionary);
++n;
}
if (nobj > 0) {
@@ -2004,7 +2219,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
}
ASSERT((is_nil(p->seq_trace_token) ||
- is_tuple(follow_moved(p->seq_trace_token)) ||
+ is_tuple(follow_moved(p->seq_trace_token, (Eterm) 0)) ||
is_atom(p->seq_trace_token)));
if (is_not_immed(p->seq_trace_token)) {
roots[n].v = &p->seq_trace_token;
@@ -2022,7 +2237,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
is_internal_pid(ERTS_TRACER_PROC(p)) ||
is_internal_port(ERTS_TRACER_PROC(p)));
- ASSERT(is_pid(follow_moved(p->group_leader)));
+ ASSERT(is_pid(follow_moved(p->group_leader, (Eterm) 0)));
if (is_not_immed(p->group_leader)) {
roots[n].v = &p->group_leader;
roots[n].sz = 1;
@@ -2059,31 +2274,47 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
ASSERT(n <= rootset->size);
- mp = p->msg.first;
- avail = rootset->size - n;
- while (mp != NULL) {
- if (avail == 0) {
- Uint new_size = 2*rootset->size;
- if (roots == rootset->def) {
- roots = erts_alloc(ERTS_ALC_T_ROOTSET,
- new_size*sizeof(Roots));
- sys_memcpy(roots, rootset->def, sizeof(rootset->def));
- } else {
- roots = erts_realloc(ERTS_ALC_T_ROOTSET,
- (void *) roots,
- new_size*sizeof(Roots));
- }
+ switch (p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) {
+ case F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG:
+ (void) erts_move_messages_off_heap(p);
+ case F_OFF_HEAP_MSGQ:
+ break;
+ case F_OFF_HEAP_MSGQ_CHNG:
+ case 0: {
+ /*
+ * We do not have off heap message queue enabled, i.e. we
+ * need to add message queue to rootset...
+ */
+ ErtsMessage *mp;
+
+ /* Ensure large enough rootset... */
+ if (n + p->msg.len > rootset->size) {
+ Uint new_size = n + p->msg.len;
+ ERTS_GC_ASSERT(roots == rootset->def);
+ roots = erts_alloc(ERTS_ALC_T_ROOTSET,
+ new_size*sizeof(Roots));
+ sys_memcpy(roots, rootset->def, n*sizeof(Roots));
rootset->size = new_size;
- avail = new_size - n;
}
- if (mp->data.attached == NULL) {
- roots[n].v = mp->m;
- roots[n].sz = 2;
- n++;
- avail--;
+
+ for (mp = p->msg.first; mp; mp = mp->next) {
+
+ if (!mp->data.attached) {
+ /*
+ * Message may refer data on heap;
+ * add it to rootset...
+ */
+ roots[n].v = mp->m;
+ roots[n].sz = ERL_MESSAGE_REF_ARRAY_SZ;
+ n++;
+ }
}
- mp = mp->next;
+ break;
}
+ }
+
+ ASSERT(rootset->size >= n);
+
rootset->roots = roots;
rootset->num_roots = n;
return n;
@@ -2323,11 +2554,11 @@ sweep_off_heap(Process *p, int fullsweep)
*/
while (ptr) {
if (IS_MOVED_BOXED(ptr->thing_word)) {
- ASSERT(!in_area(ptr, oheap, oheap_sz));
+ ASSERT(!ErtsInArea(ptr, oheap, oheap_sz));
*prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word);
ASSERT(!IS_MOVED_BOXED(ptr->thing_word));
if (ptr->thing_word == HEADER_PROC_BIN) {
- int to_new_heap = !in_area(ptr, oheap, oheap_sz);
+ int to_new_heap = !ErtsInArea(ptr, oheap, oheap_sz);
ASSERT(to_new_heap == !seen_mature || (!to_new_heap && (seen_mature=1)));
if (to_new_heap) {
bin_vheap += ptr->size / sizeof(Eterm);
@@ -2341,7 +2572,7 @@ sweep_off_heap(Process *p, int fullsweep)
ptr = ptr->next;
}
}
- else if (!in_area(ptr, oheap, oheap_sz)) {
+ else if (!ErtsInArea(ptr, oheap, oheap_sz)) {
/* garbage */
switch (thing_subtag(ptr->thing_word)) {
case REFC_BINARY_SUBTAG:
@@ -2373,7 +2604,7 @@ sweep_off_heap(Process *p, int fullsweep)
* generational collection - keep objects in list.
*/
while (ptr) {
- ASSERT(in_area(ptr, oheap, oheap_sz));
+ ASSERT(ErtsInArea(ptr, oheap, oheap_sz));
ASSERT(!IS_MOVED_BOXED(ptr->thing_word));
if (ptr->thing_word == HEADER_PROC_BIN) {
BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/
@@ -2392,7 +2623,6 @@ sweep_off_heap(Process *p, int fullsweep)
}
BIN_VHEAP_SZ(p) = next_vheap_size(p, bin_vheap, BIN_VHEAP_SZ(p));
MSO(p).overhead = bin_vheap;
- BIN_VHEAP_MATURE(p) = bin_vheap;
/*
* If we got any shrink candidates, check them out.
@@ -2463,7 +2693,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
switch (primary_tag(val)) {
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
- if (in_area(ptr_val(val), area, area_size)) {
+ if (ErtsInArea(ptr_val(val), area, area_size)) {
*hp = offset_ptr(val, offs);
}
hp++;
@@ -2485,7 +2715,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
{
struct erl_off_heap_header* oh = (struct erl_off_heap_header*) hp;
- if (in_area(oh->next, area, area_size)) {
+ if (ErtsInArea(oh->next, area, area_size)) {
Eterm** uptr = (Eterm **) (void *) &oh->next;
*uptr += offs; /* Patch the mso chain */
}
@@ -2495,7 +2725,7 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
{
ErlBinMatchState *ms = (ErlBinMatchState*) hp;
ErlBinMatchBuffer *mb = &(ms->mb);
- if (in_area(ptr_val(mb->orig), area, area_size)) {
+ if (ErtsInArea(ptr_val(mb->orig), area, area_size)) {
mb->orig = offset_ptr(mb->orig, offs);
mb->base = binary_bytes(mb->orig);
}
@@ -2525,7 +2755,7 @@ offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
switch (primary_tag(val)) {
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
- if (in_area(ptr_val(val), area, area_size)) {
+ if (ErtsInArea(ptr_val(val), area, area_size)) {
*hp = offset_ptr(val, offs);
}
hp++;
@@ -2540,7 +2770,7 @@ offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
static void
offset_off_heap(Process* p, Sint offs, char* area, Uint area_size)
{
- if (MSO(p).first && in_area((Eterm *)MSO(p).first, area, area_size)) {
+ if (MSO(p).first && ErtsInArea((Eterm *)MSO(p).first, area, area_size)) {
Eterm** uptr = (Eterm**) (void *) &MSO(p).first;
*uptr += offs;
}
@@ -2552,35 +2782,39 @@ offset_off_heap(Process* p, Sint offs, char* area, Uint area_size)
static void
offset_mqueue(Process *p, Sint offs, char* area, Uint area_size)
{
- ErlMessage* mp = p->msg.first;
-
- while (mp != NULL) {
- Eterm mesg = ERL_MESSAGE_TERM(mp);
- if (is_value(mesg)) {
- switch (primary_tag(mesg)) {
- case TAG_PRIMARY_LIST:
- case TAG_PRIMARY_BOXED:
- if (in_area(ptr_val(mesg), area, area_size)) {
- ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs);
+ ErtsMessage* mp = p->msg.first;
+
+ if ((p->flags & (F_OFF_HEAP_MSGQ|F_OFF_HEAP_MSGQ_CHNG)) != F_OFF_HEAP_MSGQ) {
+
+ while (mp != NULL) {
+ Eterm mesg = ERL_MESSAGE_TERM(mp);
+ if (is_value(mesg)) {
+ switch (primary_tag(mesg)) {
+ case TAG_PRIMARY_LIST:
+ case TAG_PRIMARY_BOXED:
+ if (ErtsInArea(ptr_val(mesg), area, area_size)) {
+ ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs);
+ }
+ break;
}
- break;
}
- }
- mesg = ERL_MESSAGE_TOKEN(mp);
- if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) {
- ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs);
- }
+ mesg = ERL_MESSAGE_TOKEN(mp);
+ if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) {
+ ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs);
+ }
#ifdef USE_VM_PROBES
- mesg = ERL_MESSAGE_DT_UTAG(mp);
- if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) {
- ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs);
- }
+ mesg = ERL_MESSAGE_DT_UTAG(mp);
+ if (is_boxed(mesg) && ErtsInArea(ptr_val(mesg), area, area_size)) {
+ ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs);
+ }
#endif
- ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) ||
- is_tuple(ERL_MESSAGE_TOKEN(mp)) ||
- is_atom(ERL_MESSAGE_TOKEN(mp))));
- mp = mp->next;
+ ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) ||
+ is_tuple(ERL_MESSAGE_TOKEN(mp)) ||
+ is_atom(ERL_MESSAGE_TOKEN(mp))));
+ mp = mp->next;
+ }
+
}
}
@@ -2589,8 +2823,8 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size,
Eterm* objv, int nobj)
{
if (p->dictionary) {
- offset_heap(p->dictionary->data,
- p->dictionary->used,
+ offset_heap(ERTS_PD_START(p->dictionary),
+ ERTS_PD_SIZE(p->dictionary),
offs, area, area_size);
}
@@ -2639,7 +2873,7 @@ reply_gc_info(void *vgcirp)
Eterm **hpp;
Uint sz, *szp;
ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErtsMessage *mp = NULL;
ASSERT(esdp);
@@ -2665,12 +2899,13 @@ reply_gc_info(void *vgcirp)
if (hpp)
break;
- hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
+
szp = NULL;
hpp = &hp;
}
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (gcirp->req_sched == esdp->no)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -2717,41 +2952,105 @@ erts_gc_info_request(Process *c_p)
return ref;
}
+Eterm
+erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp)
+{
+ ERTS_DECL_AM(bin_vheap_size);
+ ERTS_DECL_AM(bin_vheap_block_size);
+ ERTS_DECL_AM(bin_old_vheap_size);
+ ERTS_DECL_AM(bin_old_vheap_block_size);
+ Eterm tags[] = {
+ /* If you increase the number of elements here, make sure to update
+ any call sites as they may have stack allocations that depend
+ on the number of elements here. */
+ am_old_heap_block_size,
+ am_heap_block_size,
+ am_mbuf_size,
+ am_recent_size,
+ am_stack_size,
+ am_old_heap_size,
+ am_heap_size,
+ AM_bin_vheap_size,
+ AM_bin_vheap_block_size,
+ AM_bin_old_vheap_size,
+ AM_bin_old_vheap_block_size
+ };
+ UWord values[] = {
+ OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
+ HEAP_SIZE(p),
+ MBUF_SIZE(p),
+ HIGH_WATER(p) - HEAP_START(p),
+ STACK_START(p) - p->stop,
+ OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0,
+ HEAP_TOP(p) - HEAP_START(p),
+ MSO(p).overhead,
+ BIN_VHEAP_SZ(p),
+ BIN_OLD_VHEAP(p),
+ BIN_OLD_VHEAP_SZ(p)
+ };
+
+ Eterm res = THE_NON_VALUE;
+
+ ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags));
+ ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS);
+
+ res = erts_bld_atom_uword_2tup_list(hpp,
+ sizep,
+ sizeof(values)/sizeof(*values),
+ tags,
+ values);
+
+ return res;
+}
+
#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
static int
within2(Eterm *ptr, Process *p, Eterm *real_htop)
{
- ErlHeapFragment* bp = MBUF(p);
- ErlMessage* mp = p->msg.first;
- Eterm *htop = real_htop ? real_htop : HEAP_TOP(p);
+ ErlHeapFragment* bp;
+ ErtsMessage* mp;
+ Eterm *htop, *heap;
+
+ if (p->abandoned_heap)
+ ERTS_GET_ORIG_HEAP(p, heap, htop);
+ else {
+ heap = p->heap;
+ htop = real_htop ? real_htop : HEAP_TOP(p);
+ }
if (OLD_HEAP(p) && (OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p))) {
return 1;
}
- if (HEAP_START(p) <= ptr && ptr < htop) {
+ if (heap <= ptr && ptr < htop) {
return 1;
}
- while (bp != NULL) {
- if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) {
- return 1;
- }
- bp = bp->next;
- }
+
+ mp = p->msg_frag;
+ bp = p->mbuf;
+
+ if (bp)
+ goto search_heap_frags;
+
while (mp) {
- if (mp->data.attached) {
- ErlHeapFragment *hfp;
- if (is_value(ERL_MESSAGE_TERM(mp)))
- hfp = mp->data.heap_frag;
- else if (is_not_nil(ERL_MESSAGE_TOKEN(mp)))
- hfp = erts_dist_ext_trailer(mp->data.dist_ext);
- else
- hfp = NULL;
- if (hfp && hfp->mem <= ptr && ptr < hfp->mem + hfp->used_size)
+
+ if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ bp = &mp->hfrag;
+ else
+ bp = mp->data.heap_frag;
+
+ mp = mp->next;
+
+ search_heap_frags:
+
+ while (bp) {
+ if (bp->mem <= ptr && ptr < bp->mem + bp->used_size) {
return 1;
+ }
+ bp = bp->next;
}
- mp = mp->next;
}
+
return 0;
}
@@ -2768,16 +3067,16 @@ within(Eterm *ptr, Process *p)
#define ERTS_CHK_OFFHEAP_ASSERT(EXP) \
do { \
if (!(EXP)) \
- erl_exit(ERTS_ABORT_EXIT, \
+ erts_exit(ERTS_ABORT_EXIT, \
"%s:%d: Assertion failed: %s\n", \
__FILE__, __LINE__, #EXP); \
} while (0)
+
#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST
# define ERTS_OFFHEAP_VISITED_BIT ((Eterm) 1 << 31)
#endif
-
void
erts_check_off_heap2(Process *p, Eterm *htop)
{
@@ -2806,7 +3105,7 @@ erts_check_off_heap2(Process *p, Eterm *htop)
}
ERTS_CHK_OFFHEAP_ASSERT(refc >= 1);
#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST
- ERTS_CHK_OFFHEAP_ASSERT(!(u.hdr->thing_word & ERTS_EXTERNAL_VISITED_BIT));
+ ERTS_CHK_OFFHEAP_ASSERT(!(u.hdr->thing_word & ERTS_OFFHEAP_VISITED_BIT));
u.hdr->thing_word |= ERTS_OFFHEAP_VISITED_BIT;
#endif
if (old) {
@@ -2819,7 +3118,7 @@ erts_check_off_heap2(Process *p, Eterm *htop)
}
}
-#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_EXTERNAL_LIST
+#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_LIST
for (u.hdr = MSO(p).first; u.hdr; u.hdr = u.hdr->next)
u.hdr->thing_word &= ~ERTS_OFFHEAP_VISITED_BIT;
#endif
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index ecd1bf4d22..2cedd9361f 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -69,17 +69,18 @@ do { \
while (nelts--) *HTOP++ = *PTR++; \
} while(0)
-#define in_area(ptr,start,nbytes) \
- ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
-
#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
int within(Eterm *ptr, Process *p);
#endif
-ERTS_GLB_INLINE Eterm follow_moved(Eterm term);
+#define ErtsInYoungGen(TPtr, Ptr, OldHeap, OldHeapSz) \
+ (!erts_is_literal((TPtr), (Ptr)) \
+ & !ErtsInArea((Ptr), (OldHeap), (OldHeapSz)))
+
+ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
+ERTS_GLB_INLINE Eterm follow_moved(Eterm term, Eterm xptr_tag)
{
Eterm* ptr;
switch (primary_tag(term)) {
@@ -87,17 +88,18 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
break;
case TAG_PRIMARY_BOXED:
ptr = boxed_val(term);
- if (IS_MOVED_BOXED(*ptr)) term = *ptr;
+ if (IS_MOVED_BOXED(*ptr)) term = (*ptr) | xptr_tag;
break;
case TAG_PRIMARY_LIST:
ptr = list_val(term);
- if (IS_MOVED_CONS(ptr[0])) term = ptr[1];
+ if (IS_MOVED_CONS(ptr[0])) term = (ptr[1]) | xptr_tag;
break;
default:
ASSERT(!"strange tag in follow_moved");
}
return term;
}
+
#endif
#endif /* ERL_GC_C__ || HIPE_GC_C__ */
@@ -106,6 +108,23 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
* Global exported
*/
+#define ERTS_IS_GC_DESIRED_INTERNAL(Proc, HTop, STop) \
+ ((((STop) - (HTop) < (Proc)->mbuf_sz)) \
+ | ((Proc)->off_heap.overhead > (Proc)->bin_vheap_sz) \
+ | !!((Proc)->flags & F_FORCE_GC))
+
+#define ERTS_IS_GC_DESIRED(Proc) \
+ ERTS_IS_GC_DESIRED_INTERNAL((Proc), (Proc)->htop, (Proc)->stop)
+
+#define ERTS_FORCE_GC_INTERNAL(Proc, FCalls) \
+ do { \
+ (Proc)->flags |= F_FORCE_GC; \
+ ERTS_VBUMP_ALL_REDS_INTERNAL((Proc), (FCalls)); \
+ } while (0)
+
+#define ERTS_FORCE_GC(Proc) \
+ ERTS_FORCE_GC_INTERNAL((Proc), (Proc)->fcalls)
+
extern Uint erts_test_long_gc_sleep;
typedef struct {
@@ -113,10 +132,18 @@ typedef struct {
Uint64 garbage_cols;
} ErtsGCInfo;
+#define ERTS_PROCESS_GC_INFO_MAX_TERMS (11) /* number of elements in process_gc_info*/
+#define ERTS_PROCESS_GC_INFO_MAX_SIZE \
+ (ERTS_PROCESS_GC_INFO_MAX_TERMS * (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE))
+Eterm erts_process_gc_info(struct process*, Uint *, Eterm **);
+
void erts_gc_info(ErtsGCInfo *gcip);
void erts_init_gc(void);
-int erts_garbage_collect(struct process*, int, Eterm*, int);
+int erts_garbage_collect_nobump(struct process*, int, Eterm*, int);
+void erts_garbage_collect(struct process*, int, Eterm*, int);
void erts_garbage_collect_hibernate(struct process* p);
+Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end,
+ Eterm result, Eterm* regs, Uint arity);
Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity);
void erts_garbage_collect_literals(struct process* p, Eterm* literals,
Uint lit_size,
diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c
index f89f8723d9..9b4aad9d91 100644
--- a/erts/emulator/beam/erl_goodfit_alloc.c
+++ b/erts/emulator/beam/erl_goodfit_alloc.c
@@ -571,8 +571,8 @@ info_options(Allctr_t *allctr,
if (hpp || szp) {
if (!atoms_initialized)
- erl_exit(1, "%s:%d: Internal error: Atoms not initialized",
- __FILE__, __LINE__);;
+ erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error: Atoms not initialized",
+ __FILE__, __LINE__);
res = NIL;
add_2tup(hpp, szp, &res, am.as, am.gf);
diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c
index 51a0d68247..491d2f8c84 100644
--- a/erts/emulator/beam/erl_hl_timer.c
+++ b/erts/emulator/beam/erl_hl_timer.c
@@ -1055,6 +1055,8 @@ create_hl_timer(ErtsSchedulerData *esdp,
erts_aint32_t refc;
Uint32 roflgs;
+ ERTS_HLT_HDBG_CHK_SRV(srv);
+
check_canceled_queue(esdp, srv);
ERTS_HLT_ASSERT((esdp->no & ~ERTS_TMR_ROFLG_SID_MASK) == 0);
@@ -1179,8 +1181,6 @@ create_hl_timer(ErtsSchedulerData *esdp,
erts_smp_atomic32_init_nob(&tmr->head.refc, refc);
erts_smp_atomic32_init_nob(&tmr->state, ERTS_TMR_STATE_ACTIVE);
- ERTS_HLT_HDBG_CHK_SRV(srv);
-
if (!srv->next_timeout
|| tmr->timeout < srv->next_timeout->timeout) {
if (srv->next_timeout)
@@ -1245,7 +1245,9 @@ hlt_bif_timer_timeout(ErtsHLTimer *tmr, Uint32 roflgs)
* the middle of tree destruction).
*/
if (!ERTS_PROC_IS_EXITING(proc)) {
- erts_queue_message(proc, &proc_locks, tmr->btm.bp,
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = tmr->btm.bp;
+ erts_queue_message(proc, &proc_locks, mp,
tmr->btm.message, NIL);
erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_SEND);
queued_message = 1;
@@ -1926,36 +1928,31 @@ access_sched_local_btm(Process *c_p, Eterm pid,
if (proc) {
Uint hsz;
- ErlOffHeap *ohp;
- ErlHeapFragment* bp;
+ ErtsMessage *mp;
Eterm *hp, msg, ref, result;
+ ErlOffHeap *ohp;
+ Uint32 *refn;
#ifdef ERTS_HLT_DEBUG
Eterm *hp_end;
#endif
- hsz = 3; /* 2-tuple */
- if (!async)
- hsz += REF_THING_SIZE;
+ hsz = REF_THING_SIZE;
+ if (async) {
+ refn = trefn; /* timer ref */
+ hsz += 4; /* 3-tuple */
+ }
else {
- if (is_non_value(tref) || proc != c_p)
- hsz += REF_THING_SIZE;
- hsz += 1; /* upgrade to 3-tuple */
+ refn = rrefn; /* request ref */
+ hsz += 3; /* 2-tuple */
}
+
+ ERTS_HLT_ASSERT(refn);
+
if (time_left > (Sint64) MAX_SMALL)
hsz += ERTS_SINT64_HEAP_SIZE(time_left);
- if (proc == c_p) {
- bp = NULL;
- ohp = NULL;
- hp = HAlloc(c_p, hsz);
- }
- else {
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- proc,
- &proc_locks);
- }
+ mp = erts_alloc_message_heap(proc, &proc_locks,
+ hsz, &hp, &ohp);
#ifdef ERTS_HLT_DEBUG
hp_end = hp + hsz;
@@ -1968,35 +1965,22 @@ access_sched_local_btm(Process *c_p, Eterm pid,
else
result = erts_sint64_to_big(time_left, &hp);
- if (!async) {
- write_ref_thing(hp,
- rrefn[0],
- rrefn[1],
- rrefn[2]);
- ref = make_internal_ref(hp);
- hp += REF_THING_SIZE;
- msg = TUPLE2(hp, ref, result);
+ write_ref_thing(hp,
+ refn[0],
+ refn[1],
+ refn[2]);
+ ref = make_internal_ref(hp);
+ hp += REF_THING_SIZE;
- ERTS_HLT_ASSERT(hp + 3 == hp_end);
- }
- else {
- Eterm tag = cancel ? am_cancel_timer : am_read_timer;
- if (is_value(tref) && proc == c_p)
- ref = tref;
- else {
- write_ref_thing(hp,
- trefn[0],
- trefn[1],
- trefn[2]);
- ref = make_internal_ref(hp);
- hp += REF_THING_SIZE;
- }
- msg = TUPLE3(hp, tag, ref, result);
+ msg = (async
+ ? TUPLE3(hp, (cancel
+ ? am_cancel_timer
+ : am_read_timer), ref, result)
+ : TUPLE2(hp, ref, result));
- ERTS_HLT_ASSERT(hp + 4 == hp_end);
+ ERTS_HLT_ASSERT(hp + (async ? 4 : 3) == hp_end);
- }
- erts_queue_message(proc, &proc_locks, bp, msg, NIL);
+ erts_queue_message(proc, &proc_locks, mp, msg, NIL);
if (c_p)
proc_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -2034,7 +2018,7 @@ bif_timer_access_request(void *vreq)
static int
try_access_sched_remote_btm(ErtsSchedulerData *esdp,
Process *c_p, Uint32 sid,
- Eterm tref, Uint32 *trefn,
+ Uint32 *trefn,
int async, int cancel,
int info, Eterm *resp)
{
@@ -2093,21 +2077,31 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp,
}
}
else {
- Eterm tag, res, msg;
+ ErtsMessage *mp;
+ Eterm tag, res, msg, tref;
Uint hsz;
Eterm *hp;
ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN;
+ ErlOffHeap *ohp;
- hsz = 4;
+ hsz = 4 + REF_THING_SIZE;
if (time_left > (Sint64) MAX_SMALL)
hsz += ERTS_SINT64_HEAP_SIZE(time_left);
- hp = HAlloc(c_p, hsz);
+ mp = erts_alloc_message_heap(c_p, &proc_locks,
+ hsz, &hp, &ohp);
if (cancel)
tag = am_cancel_timer;
else
tag = am_read_timer;
+ write_ref_thing(hp,
+ trefn[0],
+ trefn[1],
+ trefn[2]);
+ tref = make_internal_ref(hp);
+ hp += REF_THING_SIZE;
+
if (time_left < 0)
res = am_false;
else if (time_left <= (Sint64) MAX_SMALL)
@@ -2117,7 +2111,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp,
msg = TUPLE3(hp, tag, tref, res);
- erts_queue_message(c_p, &proc_locks, NULL, msg, NIL);
+ erts_queue_message(c_p, &proc_locks, mp, msg, NIL);
proc_locks &= ~ERTS_PROC_LOCK_MAIN;
if (proc_locks)
@@ -2158,8 +2152,8 @@ access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info)
info);
ERTS_BIF_PREP_RET(ret, res);
}
- else if (try_access_sched_remote_btm(esdp, c_p, sid,
- tref, trefn,
+ else if (try_access_sched_remote_btm(esdp, c_p,
+ sid, trefn,
async, cancel,
info, &res)) {
ERTS_BIF_PREP_RET(ret, res);
@@ -3099,7 +3093,8 @@ tt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg)
& ~ERTS_HLT_PFLGS_MASK);
ERTS_HLT_ASSERT(tmr == prnt);
}
- ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, tmr->btm.refn) == tmr);
+ if (tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR)
+ ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, tmr->btm.refn) == tmr);
if (tmr->time.tree.same_time) {
ErtsHdbgHLT st_hdbg;
st_hdbg.srv = hdbg->srv;
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index bcc54491bd..0c81a95705 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -91,11 +91,6 @@ const int etp_arch_bits = 32;
#else
# error "Not 64-bit, nor 32-bit arch"
#endif
-#if HALFWORD_HEAP
-const int etp_halfword = 1;
-#else
-const int etp_halfword = 0;
-#endif
#ifdef HIPE
const int etp_hipe = 1;
#else
@@ -157,7 +152,7 @@ volatile int erts_writing_erl_crash_dump = 0;
int erts_initialized = 0;
#if defined(USE_THREADS) && !defined(ERTS_SMP)
-static erts_tid_t main_thread;
+erts_tid_t erts_main_thread;
#endif
int erts_use_sender_punish;
@@ -197,7 +192,7 @@ Uint32 verbose; /* See erl_debug.h for information about verbose */
int erts_atom_table_size = ATOM_LIMIT; /* Maximum number of atoms */
-int erts_pd_initial_size = 10;
+int erts_pd_initial_size = 8; /* must be power of 2 */
int erts_modified_timing_level;
@@ -269,7 +264,7 @@ this_rel_num(void)
i++;
this_rel = atoi(&this_rel_str[i]);
if (this_rel < 1)
- erl_exit(-1, "Unexpected ERLANG_OTP_RELEASE format\n");
+ erts_exit(1, "Unexpected ERLANG_OTP_RELEASE format\n");
}
return this_rel;
}
@@ -393,11 +388,13 @@ erl_init(int ncpu,
erts_mseg_late_init(); /* Must be after timer (erts_init_time()) and thread
initializations */
#endif
+ erl_sys_late_init();
#ifdef HIPE
hipe_mode_switch_init(); /* Must be after init_load/beam_catches/init */
#endif
packet_parser_init();
erl_nif_init();
+ erts_msacc_init();
}
static Eterm
@@ -415,7 +412,7 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char**
start_mod = erts_atom_put((byte *) modname, sys_strlen(modname), ERTS_ATOM_ENC_LATIN1, 1);
if (erts_find_function(start_mod, am_start, 2,
erts_active_code_ix()) == NULL) {
- erl_exit(5, "No function %s:start/2\n", modname);
+ erts_exit(ERTS_ERROR_EXIT, "No function %s:start/2\n", modname);
}
/*
@@ -436,13 +433,36 @@ erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char**
hp += 2;
args = CONS(hp, env, args);
- so.flags = SPO_SYSTEM_PROC;
+ so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC;
res = erl_create_process(&parent, start_mod, am_start, args, &so);
erts_smp_proc_unlock(&parent, ERTS_PROC_LOCK_MAIN);
erts_cleanup_empty_process(&parent);
return res;
}
+static Eterm
+erl_system_process_otp(Eterm parent_pid, char* modname)
+{
+ Eterm start_mod;
+ Process* parent;
+ ErlSpawnOpts so;
+ Eterm res;
+
+ start_mod = erts_atom_put((byte *) modname, sys_strlen(modname), ERTS_ATOM_ENC_LATIN1, 1);
+ if (erts_find_function(start_mod, am_start, 0,
+ erts_active_code_ix()) == NULL) {
+ erts_exit(ERTS_ERROR_EXIT, "No function %s:start/0\n", modname);
+ }
+
+ parent = erts_pid2proc(NULL, 0, parent_pid, ERTS_PROC_LOCK_MAIN);
+
+ so.flags = erts_default_spo_flags|SPO_SYSTEM_PROC;
+ res = erl_create_process(parent, start_mod, am_start, NIL, &so);
+ erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_MAIN);
+ return res;
+}
+
+
Eterm
erts_preloaded(Process* p)
{
@@ -512,12 +532,12 @@ load_preloaded(void)
length = preload_p[i].size;
module_name = erts_atom_put((byte *) name, sys_strlen(name), ERTS_ATOM_ENC_LATIN1, 1);
if ((code = sys_preload_begin(&preload_p[i])) == 0)
- erl_exit(1, "Failed to find preloaded code for module %s\n",
+ erts_exit(ERTS_ERROR_EXIT, "Failed to find preloaded code for module %s\n",
name);
res = erts_preload_module(NULL, 0, NIL, &module_name, code, length);
sys_preload_end(&preload_p[i]);
if (res != NIL)
- erl_exit(1,"Failed loading preloaded module %s (%T)\n",
+ erts_exit(ERTS_ERROR_EXIT,"Failed loading preloaded module %s (%T)\n",
name, res);
i++;
}
@@ -635,6 +655,8 @@ void erts_usage(void)
erts_fprintf(stderr, "-W<i|w|e> set error logger warnings mapping,\n");
erts_fprintf(stderr, " see error_logger documentation for details\n");
+ erts_fprintf(stderr, "-xmqd val set default message queue data flag for processes,\n");
+ erts_fprintf(stderr, " valid values are: off_heap | on_heap | mixed\n");
erts_fprintf(stderr, "-zdbbl size set the distribution buffer busy limit in kilobytes\n");
erts_fprintf(stderr, " valid range is [1-%d]\n", INT_MAX/1024);
erts_fprintf(stderr, "-zdntgc time set delayed node table gc in seconds\n");
@@ -648,7 +670,7 @@ void erts_usage(void)
erts_fprintf(stderr, "Note that if the emulator is started with erlexec (typically\n");
erts_fprintf(stderr, "from the erl script), these flags should be specified with +.\n");
erts_fprintf(stderr, "\n\n");
- erl_exit(-1, "");
+ erts_exit(1, "");
}
#ifdef USE_THREADS
@@ -723,6 +745,10 @@ early_init(int *argc, char **argv) /*
char envbuf[21]; /* enough for any 64-bit integer */
size_t envbufsz;
+#if defined(USE_THREADS) && !defined(ERTS_SMP)
+ erts_main_thread = erts_thr_self();
+#endif
+
erts_save_emu_args(*argc, argv);
erts_sched_compact_load = 1;
@@ -776,9 +802,6 @@ early_init(int *argc, char **argv) /*
(erts_aint32_t) ((Uint16) -1));
erts_pre_init_process();
-#if defined(USE_THREADS) && !defined(ERTS_SMP)
- main_thread = erts_thr_self();
-#endif
/*
* We need to know the number of schedulers to use before we
@@ -1172,6 +1195,7 @@ early_init(int *argc, char **argv) /*
erts_thr_late_init(&elid);
}
#endif
+ erts_msacc_early_init();
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_late_init();
@@ -1236,6 +1260,7 @@ erl_start(int argc, char **argv)
ErtsTimeWarpMode time_warp_mode;
int node_tab_delete_delay = ERTS_NODE_TAB_DELAY_GC_DEFAULT;
ErtsDbSpinCount db_spin_count = ERTS_DB_SPNCNT_NORMAL;
+ Eterm otp_ring0_pid;
set_default_time_adj(&time_correction,
&time_warp_mode);
@@ -1405,6 +1430,7 @@ erl_start(int argc, char **argv)
case 't': verbose |= DEBUG_THREADS; break;
case 'p': verbose |= DEBUG_PROCESSES; break;
case 'm': verbose |= DEBUG_MESSAGES; break;
+ case 'c': verbose |= DEBUG_SHCOPY; break;
default : erts_fprintf(stderr,"Unknown verbose option: %c\n",*ch);
}
}
@@ -1417,6 +1443,7 @@ erl_start(int argc, char **argv)
if (verbose & DEBUG_THREADS) erts_printf("THREADS ");
if (verbose & DEBUG_PROCESSES) erts_printf("PROCESSES ");
if (verbose & DEBUG_MESSAGES) erts_printf("MESSAGES ");
+ if (verbose & DEBUG_SHCOPY) erts_printf("SHCOPY ");
erts_printf("\n");
#else
erts_fprintf(stderr, "warning: -v (only in debug compiled code)\n");
@@ -1445,7 +1472,7 @@ erl_start(int argc, char **argv)
}
erts_fprintf(stderr, "(" EMULATOR ") emulator version "
ERLANG_VERSION "\n");
- erl_exit(0, "");
+ erts_exit(0, "");
}
break;
@@ -1479,7 +1506,7 @@ erl_start(int argc, char **argv)
VERBOSE(DEBUG_SYSTEM, ("using minimum heap size %d\n", H_MIN_SIZE));
} else if (has_prefix("pds", sub_param)) {
arg = get_arg(sub_param+3, argv[i+1], &i);
- if ((erts_pd_initial_size = atoi(arg)) <= 0) {
+ if (!erts_pd_set_initial_size(atoi(arg))) {
erts_fprintf(stderr, "bad initial process dictionary size %s\n", arg);
erts_usage();
}
@@ -2020,6 +2047,32 @@ erl_start(int argc, char **argv)
}
break;
+ case 'x': {
+ char *sub_param = argv[i]+2;
+ if (has_prefix("mqd", sub_param)) {
+ arg = get_arg(sub_param+3, argv[i+1], &i);
+ if (sys_strcmp(arg, "mixed") == 0)
+ erts_default_spo_flags &= ~(SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ);
+ else if (sys_strcmp(arg, "on_heap") == 0) {
+ erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ;
+ erts_default_spo_flags |= SPO_ON_HEAP_MSGQ;
+ }
+ else if (sys_strcmp(arg, "off_heap") == 0) {
+ erts_default_spo_flags &= ~SPO_ON_HEAP_MSGQ;
+ erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ;
+ }
+ else {
+ erts_fprintf(stderr,
+ "Invalid message_queue_data flag: %s\n", arg);
+ erts_usage();
+ }
+ } else {
+ erts_fprintf(stderr, "bad -x option %s\n", argv[i]);
+ erts_usage();
+ }
+ break;
+ }
+
case 'z': {
char *sub_param = argv[i]+2;
@@ -2073,7 +2126,8 @@ erl_start(int argc, char **argv)
"Invalid ets busy wait threshold: %s\n", arg);
erts_usage();
}
- } else {
+ }
+ else {
erts_fprintf(stderr, "bad -z option %s\n", argv[i]);
erts_usage();
}
@@ -2157,8 +2211,10 @@ erl_start(int argc, char **argv)
erts_initialized = 1;
- (void) erl_first_process_otp("otp_ring0", NULL, 0,
- boot_argc, boot_argv);
+ otp_ring0_pid = erl_first_process_otp("otp_ring0", NULL, 0,
+ boot_argc, boot_argv);
+
+ (void) erl_system_process_otp(otp_ring0_pid, "erts_code_purger");
#ifdef ERTS_SMP
erts_start_schedulers();
@@ -2168,6 +2224,7 @@ erl_start(int argc, char **argv)
#else
{
ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ erts_msacc_init_thread("scheduler", 1, 1);
erts_thr_set_main_status(1, 1);
#if ERTS_USE_ASYNC_READY_Q
esdp->aux_work_data.async_ready.queue
@@ -2233,7 +2290,7 @@ system_cleanup(int flush_async)
if (!flush_async
|| !erts_initialized
#if defined(USE_THREADS) && !defined(ERTS_SMP)
- || !erts_equal_tids(main_thread, erts_thr_self())
+ || !erts_equal_tids(erts_main_thread, erts_thr_self())
#endif
)
return;
@@ -2248,23 +2305,17 @@ system_cleanup(int flush_async)
}
static __decl_noreturn void __noreturn
-erl_exit_vv(int n, int flush_async, char *fmt, va_list args1, va_list args2)
+erts_exit_vv(int n, int flush_async, char *fmt, va_list args1, va_list args2)
{
- unsigned int an;
-
system_cleanup(flush_async);
save_statistics();
- if (n < 0)
- an = -(unsigned int)n;
- else
- an = n;
if (erts_mtrace_enabled)
- erts_mtrace_exit((Uint32) an);
+ erts_mtrace_exit((Uint32) n);
/* Produce an Erlang core dump if error */
- if (((n > 0 && erts_no_crash_dump == 0) || n == ERTS_DUMP_EXIT)
+ if (((n == ERTS_ERROR_EXIT && erts_no_crash_dump == 0) || n == ERTS_DUMP_EXIT)
&& erts_initialized) {
erl_crash_dump_v((char*) NULL, 0, fmt, args1);
}
@@ -2277,29 +2328,29 @@ erl_exit_vv(int n, int flush_async, char *fmt, va_list args1, va_list args2)
exit(0);
else if (n == ERTS_DUMP_EXIT)
ERTS_EXIT_AFTER_DUMP(1);
- else if (n > 0 || n == ERTS_ABORT_EXIT)
+ else if (n == ERTS_ERROR_EXIT || n == ERTS_ABORT_EXIT)
abort();
- exit(an);
+ exit(n);
}
/* Exit without flushing async threads */
-__decl_noreturn void __noreturn erl_exit(int n, char *fmt, ...)
+__decl_noreturn void __noreturn erts_exit(int n, char *fmt, ...)
{
va_list args1, args2;
va_start(args1, fmt);
va_start(args2, fmt);
- erl_exit_vv(n, 0, fmt, args1, args2);
+ erts_exit_vv(n, 0, fmt, args1, args2);
va_end(args2);
va_end(args1);
}
/* Exit after flushing async threads */
-__decl_noreturn void __noreturn erl_exit_flush_async(int n, char *fmt, ...)
+__decl_noreturn void __noreturn erts_flush_async_exit(int n, char *fmt, ...)
{
va_list args1, args2;
va_start(args1, fmt);
va_start(args2, fmt);
- erl_exit_vv(n, 1, fmt, args1, args2);
+ erts_exit_vv(n, 1, fmt, args1, args2);
va_end(args2);
va_end(args1);
}
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 3b3b247020..598bf84c0b 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -113,9 +113,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "environ", NULL },
#endif
{ "efile_drv", "address" },
-#if defined(ENABLE_CHILD_WAITER_THREAD) || defined(ERTS_SMP)
- { "child_status", NULL },
-#endif
{ "drv_ev_state_grow", NULL, },
{ "drv_ev_state", "address" },
{ "safe_hash", "address" },
@@ -140,6 +137,8 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "mmap_init_atoms", NULL },
{ "drv_tsd", NULL },
{ "async_enq_mtx", NULL },
+ { "msacc_list_mutex", NULL },
+ { "msacc_unmanaged_mutex", NULL },
#ifdef ERTS_SMP
{ "atom_tab", NULL },
{ "misc_op_list_pre_alloc_lock", "address" },
@@ -156,9 +155,6 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "instr", NULL },
{ "alcu_allocator", "index" },
{ "mseg", NULL },
-#if HALFWORD_HEAP
- { "pmmap", NULL },
-#endif
#ifdef ERTS_SMP
{ "port_task_pre_alloc_lock", "address" },
{ "proclist_pre_alloc_lock", "address" },
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
index ff2a355309..4b6931f848 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -172,26 +172,22 @@ BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) {
*/
const Eterm *
-#if HALFWORD_HEAP
-erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base)
-#else
erts_maps_get(Eterm key, Eterm map)
-#endif
{
Uint32 hx;
- if (is_flatmap_rel(map, map_base)) {
+ if (is_flatmap(map)) {
Eterm *ks, *vs;
flatmap_t *mp;
Uint n, i;
- mp = (flatmap_t *)flatmap_val_rel(map, map_base);
+ mp = (flatmap_t *)flatmap_val(map);
n = flatmap_get_size(mp);
if (n == 0) {
return NULL;
}
- ks = (Eterm *)tuple_val_rel(mp->keys, map_base) + 1;
+ ks = (Eterm *)tuple_val(mp->keys) + 1;
vs = flatmap_get_values(mp);
if (is_immed(key)) {
@@ -203,16 +199,16 @@ erts_maps_get(Eterm key, Eterm map)
}
for (i = 0; i < n; i++) {
- if (eq_rel(ks[i], map_base, key, NULL)) {
+ if (EQ(ks[i], key)) {
return &vs[i];
}
}
return NULL;
}
- ASSERT(is_hashmap_rel(map, map_base));
+ ASSERT(is_hashmap(map));
hx = hashmap_make_hash(key);
- return erts_hashmap_get_rel(hx, key, map, map_base);
+ return erts_hashmap_get(hx, key, map);
}
BIF_RETTYPE maps_find_2(BIF_ALIST_2) {
@@ -1274,7 +1270,7 @@ recurse:
break;
}
default:
- erl_exit(ERTS_ABORT_EXIT, "bad header %ld\r\n", hdrA);
+ erts_exit(ERTS_ABORT_EXIT, "bad header %ld\r\n", hdrA);
}
}
@@ -1301,7 +1297,7 @@ recurse:
break;
}
default:
- erl_exit(ERTS_ABORT_EXIT, "bad header %ld\r\n", hdrB);
+ erts_exit(ERTS_ABORT_EXIT, "bad header %ld\r\n", hdrB);
}
}
}
@@ -1391,7 +1387,7 @@ resume_from_trap:
res = make_boxed(nhp);
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "strange mix %d\r\n", sp->mix);
+ erts_exit(ERTS_ABORT_EXIT, "strange mix %d\r\n", sp->mix);
}
}
@@ -1886,7 +1882,7 @@ void hashmap_iterator_init(ErtsWStack* s, Eterm node, int reverse) {
sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "bad header");
+ erts_exit(ERTS_ABORT_EXIT, "bad header");
}
WSTACK_PUSH3((*s), (UWord)THE_NON_VALUE, /* end marker */
@@ -1923,7 +1919,7 @@ Eterm* hashmap_iterator_next(ErtsWStack* s) {
ASSERT(sz < 17);
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "bad header");
+ erts_exit(ERTS_ABORT_EXIT, "bad header");
}
idx++;
@@ -1973,7 +1969,7 @@ Eterm* hashmap_iterator_prev(ErtsWStack* s) {
ASSERT(sz < 17);
break;
default:
- erl_exit(1, "bad header");
+ erts_exit(ERTS_ERROR_EXIT, "bad header");
}
if (idx > sz)
@@ -1998,11 +1994,7 @@ Eterm* hashmap_iterator_prev(ErtsWStack* s) {
}
const Eterm *
-#if HALFWORD_HEAP
-erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base)
-#else
erts_hashmap_get(Uint32 hx, Eterm key, Eterm node)
-#endif
{
Eterm *ptr, hdr, *res;
Uint ix, lvl = 0;
@@ -2011,7 +2003,7 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node)
UseTmpHeapNoproc(2);
ASSERT(is_boxed(node));
- ptr = boxed_val_rel(node, map_base);
+ ptr = boxed_val(node);
hdr = *ptr;
ASSERT(is_header(hdr));
ASSERT(is_hashmap_header_head(hdr));
@@ -2032,15 +2024,15 @@ erts_hashmap_get(Uint32 hx, Eterm key, Eterm node)
node = ptr[ix+1];
if (is_list(node)) { /* LEAF NODE [K|V] */
- ptr = list_val_rel(node,map_base);
- res = eq_rel(CAR(ptr), map_base, key, NULL) ? &(CDR(ptr)) : NULL;
+ ptr = list_val(node);
+ res = EQ(CAR(ptr), key) ? &(CDR(ptr)) : NULL;
break;
}
hx = hashmap_shift_hash(th,hx,lvl,key);
ASSERT(is_boxed(node));
- ptr = boxed_val_rel(node, map_base);
+ ptr = boxed_val(node);
hdr = *ptr;
ASSERT(is_header(hdr));
ASSERT(!is_hashmap_header_head(hdr));
@@ -2161,12 +2153,12 @@ int erts_hashmap_insert_down(Uint32 hx, Eterm key, Eterm node, Uint *sz,
size += HAMT_HEAD_BITMAP_SZ(n+1);
goto unroll;
default:
- erl_exit(1, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ erts_exit(ERTS_ERROR_EXIT, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
break;
}
break;
default:
- erl_exit(1, "bad primary tag %p\r\n", node);
+ erts_exit(ERTS_ERROR_EXIT, "bad primary tag %p\r\n", node);
break;
}
}
@@ -2281,12 +2273,12 @@ Eterm erts_hashmap_insert_up(Eterm *hp, Eterm key, Eterm value,
res = make_hashmap(nhp);
break;
default:
- erl_exit(1, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ erts_exit(ERTS_ERROR_EXIT, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
break;
}
break;
default:
- erl_exit(1, "bad primary tag %x\r\n", primary_tag(node));
+ erts_exit(ERTS_ERROR_EXIT, "bad primary tag %x\r\n", primary_tag(node));
break;
}
@@ -2404,12 +2396,12 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) {
/* not occupied */
goto not_found;
default:
- erl_exit(1, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ erts_exit(ERTS_ERROR_EXIT, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
break;
}
break;
default:
- erl_exit(1, "bad primary tag %p\r\n", node);
+ erts_exit(ERTS_ERROR_EXIT, "bad primary tag %p\r\n", node);
break;
}
}
@@ -2586,7 +2578,7 @@ unroll:
res = make_hashmap(nhp);
break;
default:
- erl_exit(1, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
+ erts_exit(ERTS_ERROR_EXIT, "bad header tag %x\r\n", hdr & _HEADER_MAP_SUBTAG_MASK);
break;
}
} while(!ESTACK_ISEMPTY(stack));
@@ -2706,32 +2698,88 @@ BIF_RETTYPE erts_internal_map_to_tuple_keys_1(BIF_ALIST_1) {
}
/*
- * erts_internal:map_type/1
+ * erts_internal:term_type/1
*
* Used in erts_debug:size/1
*/
-BIF_RETTYPE erts_internal_map_type_1(BIF_ALIST_1) {
- DECL_AM(hashmap);
- DECL_AM(hashmap_node);
- DECL_AM(flatmap);
- if (is_map(BIF_ARG_1)) {
- Eterm hdr = *(boxed_val(BIF_ARG_1));
- ASSERT(is_header(hdr));
- switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
- case HAMT_SUBTAG_HEAD_FLATMAP:
- BIF_RET(AM_flatmap);
- case HAMT_SUBTAG_HEAD_ARRAY:
- case HAMT_SUBTAG_HEAD_BITMAP:
- BIF_RET(AM_hashmap);
- case HAMT_SUBTAG_NODE_BITMAP:
- BIF_RET(AM_hashmap_node);
- default:
- erl_exit(1, "bad header");
+BIF_RETTYPE erts_internal_term_type_1(BIF_ALIST_1) {
+ Eterm obj = BIF_ARG_1;
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST:
+ BIF_RET(ERTS_MAKE_AM("list"));
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr = *boxed_val(obj);
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("tuple"));
+ case EXPORT_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("export"));
+ case FUN_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("fun"));
+ case MAP_SUBTAG:
+ switch (MAP_HEADER_TYPE(hdr)) {
+ case MAP_HEADER_TAG_FLATMAP_HEAD :
+ BIF_RET(ERTS_MAKE_AM("flatmap"));
+ case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
+ case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
+ BIF_RET(ERTS_MAKE_AM("hashmap"));
+ case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
+ BIF_RET(ERTS_MAKE_AM("hashmap_node"));
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "term_type: bad map header type %d\n", MAP_HEADER_TYPE(hdr));
+ }
+ case REFC_BINARY_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("refc_binary"));
+ case HEAP_BINARY_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("heap_binary"));
+ case SUB_BINARY_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("sub_binary"));
+ case BIN_MATCHSTATE_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("matchstate"));
+ case POS_BIG_SUBTAG:
+ case NEG_BIG_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("bignum"));
+ case REF_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("reference"));
+ case EXTERNAL_REF_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("external_reference"));
+ case EXTERNAL_PID_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("external_pid"));
+ case EXTERNAL_PORT_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("external_port"));
+ case FLOAT_SUBTAG:
+ BIF_RET(ERTS_MAKE_AM("hfloat"));
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", hdr);
+ }
}
+ case TAG_PRIMARY_IMMED1:
+ switch (obj & _TAG_IMMED1_MASK) {
+ case _TAG_IMMED1_SMALL:
+ BIF_RET(ERTS_MAKE_AM("fixnum"));
+ case _TAG_IMMED1_PID:
+ BIF_RET(ERTS_MAKE_AM("pid"));
+ case _TAG_IMMED1_PORT:
+ BIF_RET(ERTS_MAKE_AM("port"));
+ case _TAG_IMMED1_IMMED2:
+ switch (obj & _TAG_IMMED2_MASK) {
+ case _TAG_IMMED2_ATOM:
+ BIF_RET(ERTS_MAKE_AM("atom"));
+ case _TAG_IMMED2_CATCH:
+ BIF_RET(ERTS_MAKE_AM("catch"));
+ case _TAG_IMMED2_NIL:
+ BIF_RET(ERTS_MAKE_AM("nil"));
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj);
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj);
+ }
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "term_type: Invalid tag (0x%X)\n", obj);
}
- BIF_P->fvalue = BIF_ARG_1;
- BIF_ERROR(BIF_P, BADMAP);
}
/*
@@ -2763,7 +2811,7 @@ BIF_RETTYPE erts_internal_map_hashmap_children_1(BIF_ALIST_1) {
ptr += 2;
break;
default:
- erl_exit(1, "bad header\r\n");
+ erts_exit(ERTS_ERROR_EXIT, "bad header\r\n");
break;
}
ASSERT(sz < 17);
@@ -2841,7 +2889,7 @@ static Eterm hashmap_info(Process *p, Eterm node) {
}
break;
default:
- erl_exit(1, "bad header\r\n");
+ erts_exit(ERTS_ERROR_EXIT, "bad header\r\n");
break;
}
}
diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h
index c391de3f11..052fa99f03 100644
--- a/erts/emulator/beam/erl_map.h
+++ b/erts/emulator/beam/erl_map.h
@@ -57,7 +57,6 @@ typedef struct flatmap_s {
#define hashmap_size(x) (((hashmap_head_t*) hashmap_val(x))->size)
-#define hashmap_size_rel(RTERM, BASE) hashmap_size(rterm2wterm(RTERM, BASE))
#define hashmap_make_hash(Key) make_internal_hash(Key)
#define hashmap_restore_hash(Heap,Lvl,Key) \
@@ -104,23 +103,9 @@ Eterm erts_hashmap_from_array(ErtsHeapFactory*, Eterm *leafs, Uint n, int rejec
Eterm erts_hashmap_from_ks_and_vs_extra(Process *p, Eterm *ks, Eterm *vs, Uint n,
Eterm k, Eterm v);
-const Eterm *
-#if HALFWORD_HEAP
-erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base);
-# define erts_maps_get(A, B) erts_maps_get_rel(A, B, NULL)
-#else
-erts_maps_get(Eterm key, Eterm map);
-# define erts_maps_get_rel(A, B, B_BASE) erts_maps_get(A, B)
-#endif
+const Eterm *erts_maps_get(Eterm key, Eterm map);
-const Eterm *
-#if HALFWORD_HEAP
-erts_hashmap_get_rel(Uint32 hx, Eterm key, Eterm node, Eterm *map_base);
-# define erts_hashmap_get(Hx, K, M) erts_hashmap_get_rel(Hx, K, M, NULL)
-#else
-erts_hashmap_get(Uint32 hx, Eterm key, Eterm map);
-# define erts_hashmap_get_rel(Hx, K, M, M_BASE) erts_hashmap_get(Hx, K, M)
-#endif
+const Eterm *erts_hashmap_get(Uint32 hx, Eterm key, Eterm map);
/* hamt nodes v2.0
*
@@ -195,14 +180,17 @@ typedef struct hashmap_head_s {
[one cons cell + one list term in parent node] per key
[one header + one boxed term in parent node] per inner node
[one header + one size word] for root node
+ Observed average number of nodes per key is about 0.35.
*/
-#define HASHMAP_HEAP_SIZE(KEYS,NODES) ((KEYS)*3 + (NODES)*2)
+#define HASHMAP_WORDS_PER_KEY 3
+#define HASHMAP_WORDS_PER_NODE 2
#ifdef DEBUG
-# define HASHMAP_ESTIMATED_NODE_COUNT(KEYS) (KEYS)
+# define HASHMAP_ESTIMATED_TOT_NODE_SIZE(KEYS) \
+ (HASHMAP_WORDS_PER_NODE * (KEYS) * 3/10) /* slightly under estimated */
#else
-# define HASHMAP_ESTIMATED_NODE_COUNT(KEYS) (2*(KEYS)/5)
+# define HASHMAP_ESTIMATED_TOT_NODE_SIZE(KEYS) \
+ (HASHMAP_WORDS_PER_NODE * (KEYS) * 4/10) /* slightly over estimated */
#endif
#define HASHMAP_ESTIMATED_HEAP_SIZE(KEYS) \
- HASHMAP_HEAP_SIZE(KEYS,HASHMAP_ESTIMATED_NODE_COUNT(KEYS))
-
+ ((KEYS)*HASHMAP_WORDS_PER_KEY + HASHMAP_ESTIMATED_TOT_NODE_SIZE(KEYS))
#endif
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index ef52823287..88efb2c59f 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -33,8 +33,8 @@
#include "erl_binary.h"
#include "dtrace-wrapper.h"
-ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message,
- ErlMessage,
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message_ref,
+ ErtsMessageRef,
ERL_MESSAGE_BUF_SZ,
ERTS_ALC_T_MSG_REF)
@@ -44,27 +44,20 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message,
#undef HARD_DEBUG
#endif
-
-
-
-#ifdef DEBUG
-static ERTS_INLINE int in_heapfrag(const Eterm* ptr, const ErlHeapFragment *bp)
+void
+init_message(void)
{
- return ((unsigned)(ptr - bp->mem) < bp->used_size);
+ init_message_ref_alloc();
}
-#endif
-
-void
-init_message(void)
+void *erts_alloc_message_ref(void)
{
- init_message_alloc();
+ return (void *) message_ref_alloc();
}
-void
-free_message(ErlMessage* mp)
+void erts_free_message_ref(void *mp)
{
- message_free(mp);
+ message_ref_free((ErtsMessageRef *) mp);
}
/* Allocate message buffer (size in words) */
@@ -74,7 +67,8 @@ new_message_buffer(Uint size)
ErlHeapFragment* bp;
bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG,
ERTS_HEAP_FRAG_SIZE(size));
- ERTS_INIT_HEAP_FRAG(bp, size);
+ ERTS_INIT_HEAP_FRAG(bp, size, size);
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] new message buffer %p\n", erts_get_current_pid(), bp->mem));
return bp;
}
@@ -203,83 +197,57 @@ free_message_buffer(ErlHeapFragment* bp)
}while (bp != NULL);
}
-static ERTS_INLINE void
-link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp)
+void
+erts_cleanup_messages(ErtsMessage *msgp)
{
- if (bp) {
- /* Link the message buffer */
- bp->next = MBUF(proc);
- MBUF(proc) = bp;
- MBUF_SIZE(proc) += bp->used_size;
- FLAGS(proc) |= F_FORCE_GC;
-
- /* Move any off_heap's into the process */
- if (bp->off_heap.first != NULL) {
- struct erl_off_heap_header** next_p = &bp->off_heap.first;
- while (*next_p != NULL) {
- next_p = &((*next_p)->next);
+ ErtsMessage *mp = msgp;
+ while (mp) {
+ ErtsMessage *fmp;
+ ErlHeapFragment *bp;
+ if (is_non_value(ERL_MESSAGE_TERM(mp))) {
+ if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) {
+ bp = (ErlHeapFragment *) mp->data.dist_ext->ext_endp;
+ erts_cleanup_offheap(&bp->off_heap);
+ }
+ if (mp->data.dist_ext)
+ erts_free_dist_ext_copy(mp->data.dist_ext);
+ }
+ else {
+ if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG)
+ bp = mp->data.heap_frag;
+ else {
+ bp = mp->hfrag.next;
+ erts_cleanup_offheap(&mp->hfrag.off_heap);
}
- *next_p = MSO(proc).first;
- MSO(proc).first = bp->off_heap.first;
- bp->off_heap.first = NULL;
- OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead);
+ if (bp)
+ free_message_buffer(bp);
}
+ fmp = mp;
+ mp = mp->next;
+ erts_free_message(fmp);
}
}
-Eterm
-erts_msg_distext2heap(Process *pp,
- ErtsProcLocks *plcksp,
- ErlHeapFragment **bpp,
- Eterm *tokenp,
- ErtsDistExternal *dist_extp)
+ErtsMessage *
+erts_realloc_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_size)
{
- Eterm msg;
- Uint tok_sz = 0;
- Eterm *hp = NULL;
- ErtsHeapFactory factory;
- Sint sz;
-
- *bpp = NULL;
- sz = erts_decode_dist_ext_size(dist_extp);
- if (sz < 0)
- goto decode_error;
- if (is_not_nil(*tokenp)) {
- ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp);
- tok_sz = heap_frag->used_size;
- sz += tok_sz;
- }
- if (pp) {
- ErlOffHeap *ohp;
- hp = erts_alloc_message_heap(sz, bpp, &ohp, pp, plcksp);
- }
- else {
- *bpp = new_message_buffer(sz);
- hp = (*bpp)->mem;
- }
- erts_factory_message_init(&factory, pp, hp, *bpp);
- msg = erts_decode_dist_ext(&factory, dist_extp);
- if (is_non_value(msg))
- goto decode_error;
- if (is_not_nil(*tokenp)) {
- ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp);
- hp = erts_produce_heap(&factory, tok_sz, 0);
- *tokenp = copy_struct(*tokenp, tok_sz, &hp, factory.off_heap);
- erts_cleanup_offheap(&heap_frag->off_heap);
+ ErtsMessage *nmp = erts_realloc(ERTS_ALC_T_MSG, mp,
+ sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm));
+ if (nmp != mp) {
+ Eterm *sp = &mp->hfrag.mem[0];
+ Eterm *ep = sp + sz;
+ Sint offs = &nmp->hfrag.mem[0] - sp;
+ erts_offset_off_heap(&nmp->hfrag.off_heap, offs, sp, ep);
+ erts_offset_heap(&nmp->hfrag.mem[0], sz, offs, sp, ep);
+ if (brefs && brefs_size)
+ erts_offset_heap_ptr(brefs, brefs_size, offs, sp, ep);
}
- erts_free_dist_ext_copy(dist_extp);
- erts_factory_close(&factory);
- return msg;
- decode_error:
- if (is_not_nil(*tokenp)) {
- ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp);
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
- erts_free_dist_ext_copy(dist_extp);
- *bpp = NULL;
- return THE_NON_VALUE;
- }
+ nmp->hfrag.used_size = sz;
+ nmp->hfrag.alloc_size = sz;
+
+ return nmp;
+}
void
erts_queue_dist_message(Process *rcvr,
@@ -287,7 +255,7 @@ erts_queue_dist_message(Process *rcvr,
ErtsDistExternal *dist_ext,
Eterm token)
{
- ErlMessage* mp;
+ ErtsMessage* mp;
#ifdef USE_VM_PROBES
Sint tok_label = 0;
Sint tok_lastcnt = 0;
@@ -299,7 +267,17 @@ erts_queue_dist_message(Process *rcvr,
ERTS_SMP_LC_ASSERT(*rcvr_locks == erts_proc_lc_my_proc_locks(rcvr));
- mp = message_alloc();
+ mp = erts_alloc_message(0, NULL);
+ mp->data.dist_ext = dist_ext;
+
+ ERL_MESSAGE_TERM(mp) = THE_NON_VALUE;
+#ifdef USE_VM_PROBES
+ ERL_MESSAGE_DT_UTAG(mp) = NIL;
+ if (token == am_have_dt_utag)
+ ERL_MESSAGE_TOKEN(mp) = NIL;
+ else
+#endif
+ ERL_MESSAGE_TOKEN(mp) = token;
#ifdef ERTS_SMP
if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) {
@@ -318,64 +296,46 @@ erts_queue_dist_message(Process *rcvr,
if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ))
erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
/* Drop message if receiver is exiting or has a pending exit ... */
- if (is_not_nil(token)) {
- ErlHeapFragment *heap_frag;
- heap_frag = erts_dist_ext_trailer(mp->data.dist_ext);
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
- erts_free_dist_ext_copy(dist_ext);
- message_free(mp);
+ erts_cleanup_messages(mp);
}
else
#endif
if (IS_TRACED_FL(rcvr, F_TRACE_RECEIVE)) {
/* Ahh... need to decode it in order to trace it... */
- ErlHeapFragment *mbuf;
- Eterm msg;
if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ))
erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ);
- message_free(mp);
- msg = erts_msg_distext2heap(rcvr, rcvr_locks, &mbuf, &token, dist_ext);
- if (is_value(msg))
+ if (!erts_decode_dist_message(rcvr, *rcvr_locks, mp, 0))
+ erts_free_message(mp);
+ else {
+ Eterm msg = ERL_MESSAGE_TERM(mp);
+ token = ERL_MESSAGE_TOKEN(mp);
#ifdef USE_VM_PROBES
- if (DTRACE_ENABLED(message_queued)) {
- DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
-
- dtrace_proc_str(rcvr, receiver_name);
- if (token != NIL && token != am_have_dt_utag) {
- tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
- tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
- tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
- }
- DTRACE6(message_queued,
- receiver_name, size_object(msg), rcvr->msg.len,
- tok_label, tok_lastcnt, tok_serial);
- }
+ if (DTRACE_ENABLED(message_queued)) {
+ DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
+
+ dtrace_proc_str(rcvr, receiver_name);
+ if (have_seqtrace(token)) {
+ tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
+ tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
+ tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
+ }
+ DTRACE6(message_queued,
+ receiver_name, size_object(msg), rcvr->msg.len,
+ tok_label, tok_lastcnt, tok_serial);
+ }
#endif
- erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token);
+ erts_queue_message(rcvr, rcvr_locks, mp, msg, token);
+ }
}
else {
/* Enqueue message on external format */
- ERL_MESSAGE_TERM(mp) = THE_NON_VALUE;
-#ifdef USE_VM_PROBES
- ERL_MESSAGE_DT_UTAG(mp) = NIL;
- if (token == am_have_dt_utag) {
- ERL_MESSAGE_TOKEN(mp) = NIL;
- } else {
-#endif
- ERL_MESSAGE_TOKEN(mp) = token;
-#ifdef USE_VM_PROBES
- }
-#endif
- mp->next = NULL;
-
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(message_queued)) {
DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE);
dtrace_proc_str(rcvr, receiver_name);
- if (token != NIL && token != am_have_dt_utag) {
+ if (have_seqtrace(token)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -388,7 +348,7 @@ erts_queue_dist_message(Process *rcvr,
tok_label, tok_lastcnt, tok_serial);
}
#endif
- mp->data.dist_ext = dist_ext;
+
LINK_MESSAGE(rcvr, mp);
if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ))
@@ -408,9 +368,9 @@ erts_queue_dist_message(Process *rcvr,
static Sint
queue_message(Process *c_p,
Process* receiver,
- ErtsProcLocks *receiver_locks,
erts_aint32_t *receiver_state,
- ErlHeapFragment* bp,
+ ErtsProcLocks *receiver_locks,
+ ErtsMessage* mp,
Eterm message,
Eterm seq_trace_token
#ifdef USE_VM_PROBES
@@ -419,31 +379,24 @@ queue_message(Process *c_p,
)
{
Sint res;
- ErlMessage* mp;
int locked_msgq = 0;
- erts_aint_t state;
-
-#ifndef ERTS_SMP
- ASSERT(bp != NULL || receiver->mbuf == NULL);
-#endif
+ erts_aint32_t state;
ERTS_SMP_LC_ASSERT(*receiver_locks == erts_proc_lc_my_proc_locks(receiver));
- mp = message_alloc();
-
- if (receiver_state)
- state = *receiver_state;
- else
- state = erts_smp_atomic32_read_acqb(&receiver->state);
-
#ifdef ERTS_SMP
- if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT))
- goto exiting;
-
if (!(*receiver_locks & ERTS_PROC_LOCK_MSGQ)) {
if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MSGQ) == EBUSY) {
ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ;
+
+ if (receiver_state)
+ state = *receiver_state;
+ else
+ state = erts_smp_atomic32_read_nob(&receiver->state);
+ if (state & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT))
+ goto exiting;
+
if (*receiver_locks & ERTS_PROC_LOCK_STATUS) {
erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS);
need_locks |= ERTS_PROC_LOCK_STATUS;
@@ -451,13 +404,12 @@ queue_message(Process *c_p,
erts_smp_proc_lock(receiver, need_locks);
}
locked_msgq = 1;
- state = erts_smp_atomic32_read_nob(&receiver->state);
- if (receiver_state)
- *receiver_state = state;
}
#endif
+ state = erts_smp_atomic32_read_nob(&receiver->state);
+
if (state & (ERTS_PSFLG_PENDING_EXIT|ERTS_PSFLG_EXITING)) {
#ifdef ERTS_SMP
exiting:
@@ -465,9 +417,7 @@ queue_message(Process *c_p,
/* Drop message if receiver is exiting or has a pending exit... */
if (locked_msgq)
erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ);
- if (bp)
- free_message_buffer(bp);
- message_free(mp);
+ erts_cleanup_messages(mp);
return 0;
}
@@ -476,13 +426,9 @@ queue_message(Process *c_p,
#ifdef USE_VM_PROBES
ERL_MESSAGE_DT_UTAG(mp) = dt_utag;
#endif
- mp->next = NULL;
- mp->data.heap_frag = bp;
-#ifndef ERTS_SMP
res = receiver->msg.len;
-#else
- res = receiver->msg_inq.len;
+#ifdef ERTS_SMP
if (*receiver_locks & ERTS_PROC_LOCK_MAIN) {
/*
* We move 'in queue' to 'private queue' and place
@@ -492,7 +438,7 @@ queue_message(Process *c_p,
* we don't need to include the 'in queue' in
* the root set when garbage collecting.
*/
- res += receiver->msg.len;
+ res += receiver->msg_inq.len;
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver);
LINK_MESSAGE_PRIVQ(receiver, mp);
}
@@ -544,19 +490,19 @@ queue_message(Process *c_p,
void
#ifdef USE_VM_PROBES
erts_queue_message_probe(Process* receiver, ErtsProcLocks *receiver_locks,
- ErlHeapFragment* bp,
+ ErtsMessage* mp,
Eterm message, Eterm seq_trace_token, Eterm dt_utag)
#else
erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks,
- ErlHeapFragment* bp,
+ ErtsMessage* mp,
Eterm message, Eterm seq_trace_token)
#endif
{
queue_message(NULL,
receiver,
- receiver_locks,
NULL,
- bp,
+ receiver_locks,
+ mp,
message,
seq_trace_token
#ifdef USE_VM_PROBES
@@ -566,245 +512,37 @@ erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks,
}
void
-erts_link_mbuf_to_proc(struct process *proc, ErlHeapFragment *bp)
-{
- Eterm* htop = HEAP_TOP(proc);
-
- link_mbuf_to_proc(proc, bp);
- if (htop < HEAP_LIMIT(proc)) {
- *htop = make_pos_bignum_header(HEAP_LIMIT(proc)-htop-1);
- HEAP_TOP(proc) = HEAP_LIMIT(proc);
- }
-}
-
-/*
- * Moves content of message buffer attached to a message into a heap.
- * The message buffer is deallocated.
- */
-void
-erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
+erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *first_bp)
{
- struct erl_off_heap_header* oh;
- Eterm term, token, *fhp, *hp;
- Sint offs;
- Uint sz;
- ErlHeapFragment *bp;
-#ifdef USE_VM_PROBES
- Eterm utag;
-#endif
-
-#ifdef HARD_DEBUG
- struct erl_off_heap_header* dbg_oh_start = off_heap->first;
- Eterm dbg_term, dbg_token;
- ErlHeapFragment *dbg_bp;
- Uint *dbg_hp, *dbg_thp_start;
- Uint dbg_term_sz, dbg_token_sz;
-#ifdef USE_VM_PROBES
- Eterm dbg_utag;
- Uint dbg_utag_sz;
-#endif
-#endif
-
- bp = msg->data.heap_frag;
- term = ERL_MESSAGE_TERM(msg);
- token = ERL_MESSAGE_TOKEN(msg);
-#ifdef USE_VM_PROBES
- utag = ERL_MESSAGE_DT_UTAG(msg);
-#endif
- if (!bp) {
-#ifdef USE_VM_PROBES
- ASSERT(is_immed(term) && is_immed(token) && is_immed(utag));
-#else
- ASSERT(is_immed(term) && is_immed(token));
-#endif
- return;
- }
-
-#ifdef HARD_DEBUG
- dbg_term_sz = size_object(term);
- dbg_token_sz = size_object(token);
- dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz);
-#ifdef USE_VM_PROBES
- dbg_utag_sz = size_object(utag);
- dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz + dbg_utag_sz );
-#endif
- /*ASSERT(dbg_term_sz + dbg_token_sz == erts_msg_used_frag_sz(msg));
- Copied size may be smaller due to removed SubBins's or garbage.
- Copied size may be larger due to duplicated shared terms.
- */
- dbg_hp = dbg_bp->mem;
- dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap);
- dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap);
-#ifdef USE_VM_PROBES
- dbg_utag = copy_struct(utag, dbg_utag_sz, &dbg_hp, &dbg_bp->off_heap);
-#endif
- dbg_thp_start = *hpp;
-#endif
-
- if (bp->next != NULL) {
- move_multi_frags(hpp, off_heap, bp, msg->m,
-#ifdef USE_VM_PROBES
- 3
-#else
- 2
-#endif
- );
- goto copy_done;
- }
-
- OH_OVERHEAD(off_heap, bp->off_heap.overhead);
- sz = bp->used_size;
-
- ASSERT(is_immed(term) || in_heapfrag(ptr_val(term),bp));
- ASSERT(is_immed(token) || in_heapfrag(ptr_val(token),bp));
-
- fhp = bp->mem;
- hp = *hpp;
- offs = hp - fhp;
-
- oh = NULL;
- while (sz--) {
- Uint cpy_sz;
- Eterm val = *fhp++;
-
- switch (primary_tag(val)) {
- case TAG_PRIMARY_IMMED1:
- *hp++ = val;
- break;
- case TAG_PRIMARY_LIST:
- case TAG_PRIMARY_BOXED:
- ASSERT(in_heapfrag(ptr_val(val), bp));
- *hp++ = offset_ptr(val, offs);
- break;
- case TAG_PRIMARY_HEADER:
- *hp++ = val;
- switch (val & _HEADER_SUBTAG_MASK) {
- case ARITYVAL_SUBTAG:
- break;
- case REFC_BINARY_SUBTAG:
- case FUN_SUBTAG:
- case EXTERNAL_PID_SUBTAG:
- case EXTERNAL_PORT_SUBTAG:
- case EXTERNAL_REF_SUBTAG:
- oh = (struct erl_off_heap_header*) (hp-1);
- cpy_sz = thing_arityval(val);
- goto cpy_words;
- default:
- cpy_sz = header_arity(val);
-
- cpy_words:
- ASSERT(sz >= cpy_sz);
- sz -= cpy_sz;
- while (cpy_sz >= 8) {
- cpy_sz -= 8;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- *hp++ = *fhp++;
- }
- switch (cpy_sz) {
- case 7: *hp++ = *fhp++;
- case 6: *hp++ = *fhp++;
- case 5: *hp++ = *fhp++;
- case 4: *hp++ = *fhp++;
- case 3: *hp++ = *fhp++;
- case 2: *hp++ = *fhp++;
- case 1: *hp++ = *fhp++;
- default: break;
+ if (first_bp) {
+ ErlHeapFragment *bp = first_bp;
+
+ while (1) {
+ /* Move any off_heap's into the process */
+ if (bp->off_heap.first != NULL) {
+ struct erl_off_heap_header** next_p = &bp->off_heap.first;
+ while (*next_p != NULL) {
+ next_p = &((*next_p)->next);
}
- if (oh) {
- /* Add to offheap list */
- oh->next = off_heap->first;
- off_heap->first = oh;
- ASSERT(*hpp <= (Eterm*)oh);
- ASSERT(hp > (Eterm*)oh);
- oh = NULL;
- }
- break;
+ *next_p = MSO(proc).first;
+ MSO(proc).first = bp->off_heap.first;
+ bp->off_heap.first = NULL;
+ OH_OVERHEAD(&(MSO(proc)), bp->off_heap.overhead);
}
- break;
+ MBUF_SIZE(proc) += bp->used_size;
+ if (!bp->next)
+ break;
+ bp = bp->next;
}
- }
-
- ASSERT(bp->used_size == hp - *hpp);
- *hpp = hp;
-
- if (is_not_immed(token)) {
- ASSERT(in_heapfrag(ptr_val(token), bp));
- ERL_MESSAGE_TOKEN(msg) = offset_ptr(token, offs);
-#ifdef HARD_DEBUG
- ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TOKEN(msg)));
- ASSERT(hp > ptr_val(ERL_MESSAGE_TOKEN(msg)));
-#endif
- }
-
- if (is_not_immed(term)) {
- ASSERT(in_heapfrag(ptr_val(term),bp));
- ERL_MESSAGE_TERM(msg) = offset_ptr(term, offs);
-#ifdef HARD_DEBUG
- ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TERM(msg)));
- ASSERT(hp > ptr_val(ERL_MESSAGE_TERM(msg)));
-#endif
- }
-#ifdef USE_VM_PROBES
- if (is_not_immed(utag)) {
- ASSERT(in_heapfrag(ptr_val(utag), bp));
- ERL_MESSAGE_DT_UTAG(msg) = offset_ptr(utag, offs);
-#ifdef HARD_DEBUG
- ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_DT_UTAG(msg)));
- ASSERT(hp > ptr_val(ERL_MESSAGE_DT_UTAG(msg)));
-#endif
- }
-#endif
-
-copy_done:
-#ifdef HARD_DEBUG
- {
- int i, j;
- ErlHeapFragment* frag;
- {
- struct erl_off_heap_header* dbg_oh = off_heap->first;
- i = j = 0;
- while (dbg_oh != dbg_oh_start) {
- dbg_oh = dbg_oh->next;
- i++;
- }
- for (frag=bp; frag; frag=frag->next) {
- dbg_oh = frag->off_heap.first;
- while (dbg_oh) {
- dbg_oh = dbg_oh->next;
- j++;
- }
- }
- ASSERT(i == j);
- }
+ /* Link the message buffer */
+ bp->next = MBUF(proc);
+ MBUF(proc) = first_bp;
}
-#endif
-
-
- bp->off_heap.first = NULL;
- free_message_buffer(bp);
- msg->data.heap_frag = NULL;
-
-#ifdef HARD_DEBUG
- ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term));
- ASSERT(eq(ERL_MESSAGE_TOKEN(msg), dbg_token));
-#ifdef USE_VM_PROBES
- ASSERT(eq(ERL_MESSAGE_DT_UTAG(msg), dbg_utag));
-#endif
- free_message_buffer(dbg_bp);
-#endif
-
}
-
Uint
-erts_msg_attached_data_size_aux(ErlMessage *msg)
+erts_msg_attached_data_size_aux(ErtsMessage *msg)
{
Sint sz;
ASSERT(is_non_value(ERL_MESSAGE_TERM(msg)));
@@ -833,29 +571,87 @@ erts_msg_attached_data_size_aux(ErlMessage *msg)
return sz;
}
-void
-erts_move_msg_attached_data_to_heap(ErtsHeapFactory* factory,
- ErlMessage *msg)
+ErtsMessage *
+erts_try_alloc_message_on_heap(Process *pp,
+ erts_aint32_t *psp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp,
+ int *on_heap_p)
{
- if (is_value(ERL_MESSAGE_TERM(msg)))
- erts_move_msg_mbuf_to_heap(&factory->hp, factory->off_heap, msg);
- else if (msg->data.dist_ext) {
- ASSERT(msg->data.dist_ext->heap_size >= 0);
- if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) {
- ErlHeapFragment *heap_frag;
- heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
- ERL_MESSAGE_TOKEN(msg) = copy_struct(ERL_MESSAGE_TOKEN(msg),
- heap_frag->used_size,
- &factory->hp,
- factory->off_heap);
- erts_cleanup_offheap(&heap_frag->off_heap);
+#ifdef ERTS_SMP
+ int locked_main = 0;
+#endif
+ ErtsMessage *mp;
+
+ ASSERT(!(*psp & ERTS_PSFLG_OFF_HEAP_MSGQ));
+
+ if (
+#if defined(ERTS_SMP)
+ *plp & ERTS_PROC_LOCK_MAIN
+#else
+ 1
+#endif
+ ) {
+#ifdef ERTS_SMP
+ try_on_heap:
+#endif
+ if ((*psp & (ERTS_PSFLG_EXITING|ERTS_PSFLG_PENDING_EXIT))
+ || (pp->flags & F_DISABLE_GC)
+ || HEAP_LIMIT(pp) - HEAP_TOP(pp) <= sz) {
+ /*
+ * The heap is either potentially in an inconsistent
+ * state, or not large enough.
+ */
+#ifdef ERTS_SMP
+ if (locked_main) {
+ *plp &= ~ERTS_PROC_LOCK_MAIN;
+ erts_smp_proc_unlock(pp, ERTS_PROC_LOCK_MAIN);
+ }
+#endif
+ goto in_message_fragment;
}
- ERL_MESSAGE_TERM(msg) = erts_decode_dist_ext(factory,
- msg->data.dist_ext);
- erts_free_dist_ext_copy(msg->data.dist_ext);
- msg->data.dist_ext = NULL;
+
+ *hpp = HEAP_TOP(pp);
+ HEAP_TOP(pp) = *hpp + sz;
+ *ohpp = &MSO(pp);
+ mp = erts_alloc_message(0, NULL);
+ mp->data.attached = NULL;
+ *on_heap_p = !0;
+ }
+#ifdef ERTS_SMP
+ else if (erts_smp_proc_trylock(pp, ERTS_PROC_LOCK_MAIN) == 0) {
+ locked_main = 1;
+ *psp = erts_smp_atomic32_read_nob(&pp->state);
+ *plp |= ERTS_PROC_LOCK_MAIN;
+ goto try_on_heap;
}
- /* else: bad external detected when calculating size */
+#endif
+ else {
+ in_message_fragment:
+ if (!((*psp) & ERTS_PSFLG_ON_HEAP_MSGQ)) {
+ mp = erts_alloc_message(sz, hpp);
+ *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap;
+ }
+ else {
+ mp = erts_alloc_message(0, NULL);
+ if (!sz) {
+ *hpp = NULL;
+ *ohpp = NULL;
+ }
+ else {
+ ErlHeapFragment *bp;
+ bp = new_message_buffer(sz);
+ *hpp = &bp->mem[0];
+ mp->data.heap_frag = bp;
+ *ohpp = &bp->off_heap;
+ }
+ }
+ *on_heap_p = 0;
+ }
+
+ return mp;
}
/*
@@ -870,7 +666,8 @@ erts_send_message(Process* sender,
unsigned flags)
{
Uint msize;
- ErlHeapFragment* bp = NULL;
+ ErtsMessage* mp;
+ ErlOffHeap *ohp;
Eterm token = NIL;
Sint res = 0;
#ifdef USE_VM_PROBES
@@ -879,67 +676,96 @@ erts_send_message(Process* sender,
Sint tok_label = 0;
Sint tok_lastcnt = 0;
Sint tok_serial = 0;
+ Eterm utag = NIL;
+#endif
+ erts_aint32_t receiver_state;
+#ifdef SHCOPY_SEND
+ erts_shcopy_t info;
#endif
BM_STOP_TIMER(system);
BM_MESSAGE(message,sender,receiver);
BM_START_TIMER(send);
- #ifdef USE_VM_PROBES
+#ifdef USE_VM_PROBES
*sender_name = *receiver_name = '\0';
- if (DTRACE_ENABLED(message_send)) {
+ if (DTRACE_ENABLED(message_send)) {
erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)),
"%T", sender->common.id);
erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)),
"%T", receiver->common.id);
}
#endif
+
+ receiver_state = erts_smp_atomic32_read_nob(&receiver->state);
+
if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) {
Eterm* hp;
Eterm stoken = SEQ_TRACE_TOKEN(sender);
Uint seq_trace_size = 0;
#ifdef USE_VM_PROBES
Uint dt_utag_size = 0;
- Eterm utag = NIL;
-#endif
-
- BM_SWAP_TIMER(send,size);
- msize = size_object(message);
- BM_SWAP_TIMER(size,send);
-
-#ifdef USE_VM_PROBES
- if (stoken != am_have_dt_utag) {
#endif
-
+ BM_SWAP_TIMER(send,size);
+
+ /* SHCOPY corrupts the heap between
+ * copy_shared_calculate, and
+ * copy_shared_perform. (it inserts move_markers like the gc).
+ * Make sure we don't use the heap between those instances.
+ */
+ if (have_seqtrace(stoken)) {
seq_trace_update_send(sender);
seq_trace_output(stoken, message, SEQ_TRACE_SEND,
receiver->common.id, sender);
seq_trace_size = 6; /* TUPLE5 */
-#ifdef USE_VM_PROBES
- }
- if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
- dt_utag_size = size_object(DT_UTAG(sender));
- } else if (stoken == am_have_dt_utag ) {
- stoken = NIL;
}
+#ifdef USE_VM_PROBES
+ if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
+ dt_utag_size = size_object(DT_UTAG(sender));
+ } else if (stoken == am_have_dt_utag ) {
+ stoken = NIL;
+ }
#endif
- bp = new_message_buffer(msize + seq_trace_size
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ msize = copy_shared_calculate(message, &info);
+#else
+ msize = size_object(message);
+#endif
+ BM_SWAP_TIMER(size,send);
+
+ mp = erts_alloc_message_heap_state(receiver,
+ &receiver_state,
+ receiver_locks,
+ (msize
#ifdef USE_VM_PROBES
- + dt_utag_size
+ + dt_utag_size
#endif
- );
- hp = bp->mem;
+ + seq_trace_size),
+ &hp,
+ &ohp);
BM_SWAP_TIMER(send,copy);
- token = copy_struct(stoken,
- seq_trace_size,
- &hp,
- &bp->off_heap);
- message = copy_struct(message, msize, &hp, &bp->off_heap);
+#ifdef SHCOPY_SEND
+ if (is_not_immed(message))
+ message = copy_shared_perform(message, msize, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ if (is_not_immed(message))
+ message = copy_struct(message, msize, &hp, ohp);
+#endif
+ if (is_immed(stoken))
+ token = stoken;
+ else
+ token = copy_struct(stoken, seq_trace_size, &hp, ohp);
+
#ifdef USE_VM_PROBES
if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
- utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, &bp->off_heap);
+ if (is_immed(DT_UTAG(sender)))
+ utag = DT_UTAG(sender);
+ else
+ utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, ohp);
#ifdef DTRACE_TAG_HARDDEBUG
erts_fprintf(stderr,
"Dtrace -> (%T) Spreading tag (%T) with "
@@ -952,7 +778,7 @@ erts_send_message(Process* sender,
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(message_send)) {
- if (stoken != NIL && stoken != am_have_dt_utag) {
+ if (have_seqtrace(stoken)) {
tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken));
tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(stoken));
tok_serial = signed_val(SEQ_TRACE_T_SERIAL(stoken));
@@ -961,103 +787,63 @@ erts_send_message(Process* sender,
msize, tok_label, tok_lastcnt, tok_serial);
}
#endif
- res = queue_message(NULL,
- receiver,
- receiver_locks,
- NULL,
- bp,
- message,
- token
-#ifdef USE_VM_PROBES
- , utag
-#endif
- );
- BM_SWAP_TIMER(send,system);
- } else if (sender == receiver) {
- /* Drop message if receiver has a pending exit ... */
-#ifdef ERTS_SMP
- ErtsProcLocks need_locks = (~(*receiver_locks)
- & (ERTS_PROC_LOCK_MSGQ
- | ERTS_PROC_LOCK_STATUS));
- if (need_locks) {
- *receiver_locks |= need_locks;
- if (erts_smp_proc_trylock(receiver, need_locks) == EBUSY) {
- if (need_locks == ERTS_PROC_LOCK_MSGQ) {
- erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS);
- need_locks = ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS;
- }
- erts_smp_proc_lock(receiver, need_locks);
- }
+ } else {
+ Eterm *hp;
+
+ if (receiver == sender && !(receiver_state & ERTS_PSFLG_OFF_HEAP_MSGQ)) {
+ mp = erts_alloc_message(0, NULL);
+ msize = 0;
}
- if (!ERTS_PROC_PENDING_EXIT(receiver))
+ else {
+ BM_SWAP_TIMER(send,size);
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ msize = copy_shared_calculate(message, &info);
+#else
+ msize = size_object(message);
#endif
- {
- ErlMessage* mp = message_alloc();
-
- DTRACE6(message_send, sender_name, receiver_name,
- size_object(message), tok_label, tok_lastcnt, tok_serial);
- mp->data.attached = NULL;
- ERL_MESSAGE_TERM(mp) = message;
- ERL_MESSAGE_TOKEN(mp) = NIL;
-#ifdef USE_VM_PROBES
- ERL_MESSAGE_DT_UTAG(mp) = NIL;
+ BM_SWAP_TIMER(size,send);
+
+ mp = erts_alloc_message_heap_state(receiver,
+ &receiver_state,
+ receiver_locks,
+ msize,
+ &hp,
+ &ohp);
+ BM_SWAP_TIMER(send,copy);
+#ifdef SHCOPY_SEND
+ if (is_not_immed(message))
+ message = copy_shared_perform(message, msize, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ if (is_not_immed(message))
+ message = copy_struct(message, msize, &hp, ohp);
#endif
- mp->next = NULL;
- /*
- * We move 'in queue' to 'private queue' and place
- * message at the end of 'private queue' in order
- * to ensure that the 'in queue' doesn't contain
- * references into the heap. By ensuring this,
- * we don't need to include the 'in queue' in
- * the root set when garbage collecting.
- */
-
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver);
- LINK_MESSAGE_PRIVQ(receiver, mp);
-
- res = receiver->msg.len;
-
- if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) {
- trace_receive(receiver, message);
- }
+ BM_MESSAGE_COPIED(msz);
+ BM_SWAP_TIMER(copy,send);
}
- BM_SWAP_TIMER(send,system);
- } else {
- ErlOffHeap *ohp;
- Eterm *hp;
- erts_aint32_t state;
-
- BM_SWAP_TIMER(send,size);
- msize = size_object(message);
- BM_SWAP_TIMER(size,send);
- hp = erts_alloc_message_heap_state(msize,
- &bp,
- &ohp,
- receiver,
- receiver_locks,
- &state);
- BM_SWAP_TIMER(send,copy);
- message = copy_struct(message, msize, &hp, ohp);
- BM_MESSAGE_COPIED(msz);
- BM_SWAP_TIMER(copy,send);
DTRACE6(message_send, sender_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
- res = queue_message(sender,
- receiver,
- receiver_locks,
- &state,
- bp,
- message,
- token
+ }
+
+ res = queue_message(sender,
+ receiver,
+ &receiver_state,
+ receiver_locks,
+ mp,
+ message,
+ token
#ifdef USE_VM_PROBES
- , NIL
+ , utag
#endif
- );
- BM_SWAP_TIMER(send,system);
- }
- return res;
+ );
+
+ BM_SWAP_TIMER(send,system);
+
+ return res;
}
+
/*
* This function delivers an EXIT message to a process
* which is trapping EXITs.
@@ -1075,46 +861,572 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp,
Uint sz_from;
Eterm* hp;
Eterm temptoken;
- ErlHeapFragment* bp = NULL;
-
- if (token != NIL
-#ifdef USE_VM_PROBES
- && token != am_have_dt_utag
+ ErtsMessage* mp;
+ ErlOffHeap *ohp;
+#ifdef SHCOPY_SEND
+ erts_shcopy_t info;
#endif
- ) {
+ if (have_seqtrace(token)) {
ASSERT(is_tuple(token));
- sz_reason = size_object(reason);
sz_token = size_object(token);
sz_from = size_object(from);
- bp = new_message_buffer(sz_reason + sz_from + sz_token + 4);
- hp = bp->mem;
- mess = copy_struct(reason, sz_reason, &hp, &bp->off_heap);
- from_copy = copy_struct(from, sz_from, &hp, &bp->off_heap);
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ sz_reason = copy_shared_calculate(reason, &info);
+#else
+ sz_reason = size_object(reason);
+#endif
+ mp = erts_alloc_message_heap(to, to_locksp,
+ sz_reason + sz_from + sz_token + 4,
+ &hp, &ohp);
+#ifdef SHCOPY_SEND
+ mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ mess = copy_struct(reason, sz_reason, &hp, ohp);
+#endif
+ from_copy = copy_struct(from, sz_from, &hp, ohp);
save = TUPLE3(hp, am_EXIT, from_copy, mess);
hp += 4;
/* the trace token must in this case be updated by the caller */
seq_trace_output(token, save, SEQ_TRACE_SEND, to->common.id, NULL);
- temptoken = copy_struct(token, sz_token, &hp, &bp->off_heap);
- erts_queue_message(to, to_locksp, bp, save, temptoken);
+ temptoken = copy_struct(token, sz_token, &hp, ohp);
+ erts_queue_message(to, to_locksp, mp, save, temptoken);
} else {
- ErlOffHeap *ohp;
- sz_reason = size_object(reason);
sz_from = IS_CONST(from) ? 0 : size_object(from);
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ sz_reason = copy_shared_calculate(reason, &info);
+#else
+ sz_reason = size_object(reason);
+#endif
+ mp = erts_alloc_message_heap(to, to_locksp,
+ sz_reason+sz_from+4, &hp, &ohp);
- hp = erts_alloc_message_heap(sz_reason+sz_from+4,
- &bp,
- &ohp,
- to,
- to_locksp);
-
+#ifdef SHCOPY_SEND
+ mess = copy_shared_perform(reason, sz_reason, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
mess = copy_struct(reason, sz_reason, &hp, ohp);
+#endif
from_copy = (IS_CONST(from)
? from
: copy_struct(from, sz_from, &hp, ohp));
save = TUPLE3(hp, am_EXIT, from_copy, mess);
- erts_queue_message(to, to_locksp, bp, save, NIL);
+ erts_queue_message(to, to_locksp, mp, save, NIL);
+ }
+}
+
+void erts_save_message_in_proc(Process *p, ErtsMessage *msgp)
+{
+ ErlHeapFragment *hfp;
+
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ hfp = &msgp->hfrag;
+ else if (msgp->data.attached) {
+ hfp = msgp->data.heap_frag;
+ }
+ else {
+ erts_free_message(msgp);
+ return; /* Nothing to save */
+ }
+
+ while (1) {
+ struct erl_off_heap_header *ohhp = hfp->off_heap.first;
+ if (ohhp) {
+ for ( ; ohhp->next; ohhp = ohhp->next)
+ ;
+ ohhp->next = p->off_heap.first;
+ p->off_heap.first = hfp->off_heap.first;
+ hfp->off_heap.first = NULL;
+ }
+ p->off_heap.overhead += hfp->off_heap.overhead;
+ hfp->off_heap.overhead = 0;
+ p->mbuf_sz += hfp->used_size;
+
+ if (!hfp->next)
+ break;
+ hfp = hfp->next;
+ }
+
+ msgp->next = p->msg_frag;
+ p->msg_frag = msgp;
+}
+
+Sint
+erts_move_messages_off_heap(Process *c_p)
+{
+ int reds = 1;
+ /*
+ * Move all messages off heap. This *only* occurs when the
+ * process had off heap message disabled and just enabled
+ * it...
+ */
+ ErtsMessage *mp;
+
+ reds += c_p->msg.len / 10;
+
+ ASSERT(erts_smp_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ);
+ ASSERT(c_p->flags & F_OFF_HEAP_MSGQ_CHNG);
+
+ for (mp = c_p->msg.first; mp; mp = mp->next) {
+ Uint msg_sz, token_sz;
+#ifdef USE_VM_PROBES
+ Uint utag_sz;
+#endif
+ Eterm *hp;
+ ErlHeapFragment *hfrag;
+
+ if (mp->data.attached)
+ continue;
+
+ if (is_immed(ERL_MESSAGE_TERM(mp))
+#ifdef USE_VM_PROBES
+ && is_immed(ERL_MESSAGE_DT_UTAG(mp))
+#endif
+ && is_not_immed(ERL_MESSAGE_TOKEN(mp)))
+ continue;
+
+ /*
+ * The message refers into the heap. Copy the message
+ * from the heap into a heap fragment and attach
+ * it to the message...
+ */
+ msg_sz = size_object(ERL_MESSAGE_TERM(mp));
+#ifdef USE_VM_PROBES
+ utag_sz = size_object(ERL_MESSAGE_DT_UTAG(mp));
+#endif
+ token_sz = size_object(ERL_MESSAGE_TOKEN(mp));
+
+ hfrag = new_message_buffer(msg_sz
+#ifdef USE_VM_PROBES
+ + utag_sz
+#endif
+ + token_sz);
+ hp = hfrag->mem;
+ if (is_not_immed(ERL_MESSAGE_TERM(mp)))
+ ERL_MESSAGE_TERM(mp) = copy_struct(ERL_MESSAGE_TERM(mp),
+ msg_sz, &hp,
+ &hfrag->off_heap);
+ if (is_not_immed(ERL_MESSAGE_TOKEN(mp)))
+ ERL_MESSAGE_TOKEN(mp) = copy_struct(ERL_MESSAGE_TOKEN(mp),
+ token_sz, &hp,
+ &hfrag->off_heap);
+#ifdef USE_VM_PROBES
+ if (is_not_immed(ERL_MESSAGE_DT_UTAG(mp)))
+ ERL_MESSAGE_DT_UTAG(mp) = copy_struct(ERL_MESSAGE_DT_UTAG(mp),
+ utag_sz, &hp,
+ &hfrag->off_heap);
+#endif
+ mp->data.heap_frag = hfrag;
+ reds += 1;
+ }
+
+ return reds;
+}
+
+Sint
+erts_complete_off_heap_message_queue_change(Process *c_p)
+{
+ int reds = 1;
+
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p));
+ ASSERT(c_p->flags & F_OFF_HEAP_MSGQ_CHNG);
+ ASSERT(erts_smp_atomic32_read_nob(&c_p->state) & ERTS_PSFLG_OFF_HEAP_MSGQ);
+
+ /*
+ * This job was first initiated when the process changed to off heap
+ * message queue management. Since then ERTS_PSFLG_OFF_HEAP_MSGQ
+ * has been set. However, the management state might have been changed
+ * again (multiple times) since then. Check users last requested state
+ * (the flags F_OFF_HEAP_MSGQ, and F_ON_HEAP_MSGQ), and make the state
+ * consistent with that.
+ */
+
+ if (!(c_p->flags & F_OFF_HEAP_MSGQ))
+ erts_smp_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_OFF_HEAP_MSGQ);
+ else {
+ reds += 2;
+ erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ);
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
+ erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ);
+ reds += erts_move_messages_off_heap(c_p);
+ }
+ c_p->flags &= ~F_OFF_HEAP_MSGQ_CHNG;
+ return reds;
+}
+
+typedef struct {
+ Eterm pid;
+ ErtsThrPrgrLaterOp lop;
+} ErtsChangeOffHeapMessageQueue;
+
+static void
+change_off_heap_msgq(void *vcohmq)
+{
+ ErtsChangeOffHeapMessageQueue *cohmq;
+ /*
+ * Now we've waited thread progress which ensures that all
+ * messages to the process are enqueued off heap. Schedule
+ * completion of this change as a system task on the process
+ * itself. This in order to avoid lock contention on its
+ * main lock. We will be called in
+ * erts_complete_off_heap_message_queue_change() (above) when
+ * the system task has been selected for execution.
+ */
+ cohmq = (ErtsChangeOffHeapMessageQueue *) vcohmq;
+ erts_schedule_complete_off_heap_message_queue_change(cohmq->pid);
+ erts_free(ERTS_ALC_T_MSGQ_CHNG, vcohmq);
+}
+
+Eterm
+erts_change_message_queue_management(Process *c_p, Eterm new_state)
+{
+ Eterm res;
+
+#ifdef DEBUG
+ if (c_p->flags & F_OFF_HEAP_MSGQ) {
+ ASSERT(erts_smp_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ);
+ }
+ else {
+ if (c_p->flags & F_OFF_HEAP_MSGQ_CHNG) {
+ ASSERT(erts_smp_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ);
+ }
+ else {
+ ASSERT(!(erts_smp_atomic32_read_nob(&c_p->state)
+ & ERTS_PSFLG_OFF_HEAP_MSGQ));
+ }
+ }
+#endif
+
+ switch (c_p->flags & (F_OFF_HEAP_MSGQ|F_ON_HEAP_MSGQ)) {
+
+ case F_OFF_HEAP_MSGQ:
+ res = am_off_heap;
+
+ switch (new_state) {
+ case am_off_heap:
+ break;
+ case am_on_heap:
+ c_p->flags |= F_ON_HEAP_MSGQ;
+ erts_smp_atomic32_read_bor_nob(&c_p->state,
+ ERTS_PSFLG_ON_HEAP_MSGQ);
+ /* fall through */
+ case am_mixed:
+ c_p->flags &= ~F_OFF_HEAP_MSGQ;
+ /*
+ * We are not allowed to clear ERTS_PSFLG_OFF_HEAP_MSGQ
+ * if a off heap change is ongoing. It will be adjusted
+ * when the change completes...
+ */
+ if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) {
+ /* Safe to clear ERTS_PSFLG_OFF_HEAP_MSGQ... */
+ erts_smp_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_OFF_HEAP_MSGQ);
+ }
+ break;
+ default:
+ res = THE_NON_VALUE; /* badarg */
+ break;
+ }
+ break;
+
+ case F_ON_HEAP_MSGQ:
+ res = am_on_heap;
+
+ switch (new_state) {
+ case am_on_heap:
+ break;
+ case am_mixed:
+ c_p->flags &= ~F_ON_HEAP_MSGQ;
+ erts_smp_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_ON_HEAP_MSGQ);
+ break;
+ case am_off_heap:
+ c_p->flags &= ~F_ON_HEAP_MSGQ;
+ erts_smp_atomic32_read_band_nob(&c_p->state,
+ ~ERTS_PSFLG_ON_HEAP_MSGQ);
+ goto change_to_off_heap;
+ default:
+ res = THE_NON_VALUE; /* badarg */
+ break;
+ }
+ break;
+
+ case 0:
+ res = am_mixed;
+
+ switch (new_state) {
+ case am_mixed:
+ break;
+ case am_on_heap:
+ c_p->flags |= F_ON_HEAP_MSGQ;
+ erts_smp_atomic32_read_bor_nob(&c_p->state,
+ ERTS_PSFLG_ON_HEAP_MSGQ);
+ break;
+ case am_off_heap:
+ goto change_to_off_heap;
+ default:
+ res = THE_NON_VALUE; /* badarg */
+ break;
+ }
+ break;
+
+ default:
+ res = am_error;
+ ERTS_INTERNAL_ERROR("Inconsistent message queue management state");
+ break;
+ }
+
+ return res;
+
+change_to_off_heap:
+
+ c_p->flags |= F_OFF_HEAP_MSGQ;
+
+ /*
+ * We do not have to schedule a change if
+ * we have an ongoing off heap change...
+ */
+ if (!(c_p->flags & F_OFF_HEAP_MSGQ_CHNG)) {
+ ErtsChangeOffHeapMessageQueue *cohmq;
+ /*
+ * Need to set ERTS_PSFLG_OFF_HEAP_MSGQ and wait
+ * thread progress before completing the change in
+ * order to ensure that all senders observe that
+ * messages should be passed off heap. When the
+ * change has completed, GC does not need to inspect
+ * the message queue at all.
+ */
+ erts_smp_atomic32_read_bor_nob(&c_p->state,
+ ERTS_PSFLG_OFF_HEAP_MSGQ);
+ c_p->flags |= F_OFF_HEAP_MSGQ_CHNG;
+ cohmq = erts_alloc(ERTS_ALC_T_MSGQ_CHNG,
+ sizeof(ErtsChangeOffHeapMessageQueue));
+ cohmq->pid = c_p->common.id;
+ erts_schedule_thr_prgr_later_op(change_off_heap_msgq,
+ (void *) cohmq,
+ &cohmq->lop);
+ }
+
+ return res;
+}
+
+int
+erts_decode_dist_message(Process *proc, ErtsProcLocks proc_locks,
+ ErtsMessage *msgp, int force_off_heap)
+{
+ ErtsHeapFactory factory;
+ Eterm msg;
+ ErlHeapFragment *bp;
+ Sint need;
+ int decode_in_heap_frag;
+
+ decode_in_heap_frag = (force_off_heap
+ || !(proc_locks & ERTS_PROC_LOCK_MAIN)
+ || (proc->flags & F_OFF_HEAP_MSGQ));
+
+ if (msgp->data.dist_ext->heap_size >= 0)
+ need = msgp->data.dist_ext->heap_size;
+ else {
+ need = erts_decode_dist_ext_size(msgp->data.dist_ext);
+ if (need < 0) {
+ /* bad msg; remove it... */
+ if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
+ bp = erts_dist_ext_trailer(msgp->data.dist_ext);
+ erts_cleanup_offheap(&bp->off_heap);
+ }
+ erts_free_dist_ext_copy(msgp->data.dist_ext);
+ msgp->data.dist_ext = NULL;
+ return 0;
+ }
+
+ msgp->data.dist_ext->heap_size = need;
+ }
+
+ if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
+ bp = erts_dist_ext_trailer(msgp->data.dist_ext);
+ need += bp->used_size;
+ }
+
+ if (decode_in_heap_frag)
+ erts_factory_heap_frag_init(&factory, new_message_buffer(need));
+ else
+ erts_factory_proc_prealloc_init(&factory, proc, need);
+
+ ASSERT(msgp->data.dist_ext->heap_size >= 0);
+ if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
+ ErlHeapFragment *heap_frag;
+ heap_frag = erts_dist_ext_trailer(msgp->data.dist_ext);
+ ERL_MESSAGE_TOKEN(msgp) = copy_struct(ERL_MESSAGE_TOKEN(msgp),
+ heap_frag->used_size,
+ &factory.hp,
+ factory.off_heap);
+ erts_cleanup_offheap(&heap_frag->off_heap);
}
+
+ msg = erts_decode_dist_ext(&factory, msgp->data.dist_ext);
+ ERL_MESSAGE_TERM(msgp) = msg;
+ erts_free_dist_ext_copy(msgp->data.dist_ext);
+ msgp->data.attached = NULL;
+
+ if (is_non_value(msg)) {
+ erts_factory_undo(&factory);
+ return 0;
+ }
+
+ erts_factory_trim_and_close(&factory, msgp->m,
+ ERL_MESSAGE_REF_ARRAY_SZ);
+
+ ASSERT(!msgp->data.heap_frag);
+
+ if (decode_in_heap_frag)
+ msgp->data.heap_frag = factory.heap_frags;
+
+ return 1;
+}
+
+/*
+ * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0 will move off heap messages
+ * into the heap of the inspected process if off_heap_message_queue
+ * is false when process_info(_, messages) is called. That is, the
+ * following GC will have more data in the rootset compared to the
+ * scenario when process_info(_, messages) had not been called.
+ *
+ * ERTS_INSPECT_MSGQ_KEEP_OH_MSGS != 0 will keep off heap messages
+ * off heap when process_info(_, messages) is called regardless of
+ * the off_heap_message_queue setting of the process. That is, it
+ * will change the following execution of the process as little as
+ * possible.
+ */
+#define ERTS_INSPECT_MSGQ_KEEP_OH_MSGS 1
+
+Uint
+erts_prep_msgq_for_inspection(Process *c_p, Process *rp,
+ ErtsProcLocks rp_locks, ErtsMessageInfo *mip)
+{
+ Uint tot_heap_size;
+ ErtsMessage* mp;
+ Sint i;
+ int self_on_heap;
+
+ /*
+ * Prepare the message queue for inspection
+ * by process_info().
+ *
+ *
+ * - Decode all messages on external format
+ * - Remove all corrupt dist messages from queue
+ * - Save pointer to, and heap size need of each
+ * message in the mip array.
+ * - Return total heap size need for all messages
+ * that needs to be copied.
+ *
+ * If ERTS_INSPECT_MSGQ_KEEP_OH_MSGS == 0:
+ * - In case off heap messages is disabled and
+ * we are inspecting our own queue, move all
+ * off heap data into the heap.
+ */
+
+ self_on_heap = c_p == rp && !(c_p->flags & F_OFF_HEAP_MSGQ);
+
+ tot_heap_size = 0;
+ i = 0;
+ mp = rp->msg.first;
+ while (mp) {
+ Eterm msg = ERL_MESSAGE_TERM(mp);
+
+ mip[i].size = 0;
+
+ if (is_non_value(msg)) {
+ /* Dist message on external format; decode it... */
+ if (mp->data.attached)
+ erts_decode_dist_message(rp, rp_locks, mp,
+ ERTS_INSPECT_MSGQ_KEEP_OH_MSGS);
+
+ msg = ERL_MESSAGE_TERM(mp);
+
+ if (is_non_value(msg)) {
+ ErtsMessage **mpp;
+ ErtsMessage *bad_mp = mp;
+ /*
+ * Bad distribution message; remove
+ * it from the queue...
+ */
+ ASSERT(!mp->data.attached);
+
+ mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next;
+
+ if (rp->msg.save == &bad_mp->next)
+ rp->msg.save = mpp;
+ if (rp->msg.last == &bad_mp->next)
+ rp->msg.last = mpp;
+ mp = mp->next;
+ *mpp = mp;
+ rp->msg.len--;
+ bad_mp->next = NULL;
+ erts_cleanup_messages(bad_mp);
+ continue;
+ }
+ }
+
+ ASSERT(is_value(msg));
+
+#if ERTS_INSPECT_MSGQ_KEEP_OH_MSGS
+ if (is_not_immed(msg) && (!self_on_heap || mp->data.attached)) {
+ Uint sz = size_object(msg);
+ mip[i].size = sz;
+ tot_heap_size += sz;
+ }
+#else
+ if (self_on_heap) {
+ if (mp->data.attached) {
+ ErtsMessage *tmp = NULL;
+ if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
+ erts_link_mbuf_to_proc(rp, mp->data.heap_frag);
+ mp->data.attached = NULL;
+ }
+ else {
+ /*
+ * Need to replace the message reference since
+ * we will get references to the message data
+ * from the heap...
+ */
+ ErtsMessage **mpp;
+ tmp = erts_alloc_message(0, NULL);
+ sys_memcpy((void *) tmp->m, (void *) mp->m,
+ sizeof(Eterm)*ERL_MESSAGE_REF_ARRAY_SZ);
+ mpp = i == 0 ? &rp->msg.first : &mip[i-1].msgp->next;
+ tmp->next = mp->next;
+ if (rp->msg.save == &mp->next)
+ rp->msg.save = &tmp->next;
+ if (rp->msg.last == &mp->next)
+ rp->msg.last = &tmp->next;
+ *mpp = tmp;
+ erts_save_message_in_proc(rp, mp);
+ mp = tmp;
+ }
+ }
+ }
+ else if (is_not_immed(msg)) {
+ Uint sz = size_object(msg);
+ mip[i].size = sz;
+ tot_heap_size += sz;
+ }
+
+#endif
+
+ mip[i].msgp = mp;
+ i++;
+ mp = mp->next;
+ }
+
+ return tot_heap_size;
}
void erts_factory_proc_init(ErtsHeapFactory* factory,
@@ -1127,53 +1439,147 @@ void erts_factory_proc_prealloc_init(ErtsHeapFactory* factory,
Process* p,
Sint size)
{
+ ErlHeapFragment *bp = p->mbuf;
factory->mode = FACTORY_HALLOC;
factory->p = p;
factory->hp_start = HAlloc(p, size);
factory->hp = factory->hp_start;
factory->hp_end = factory->hp_start + size;
factory->off_heap = &p->off_heap;
+ factory->message = NULL;
factory->off_heap_saved.first = p->off_heap.first;
factory->off_heap_saved.overhead = p->off_heap.overhead;
- factory->heap_frags_saved = p->mbuf;
+ factory->heap_frags_saved = bp;
+ factory->heap_frags_saved_used = bp ? bp->used_size : 0;
factory->heap_frags = NULL; /* not used */
factory->alloc_type = 0; /* not used */
}
-void erts_factory_message_init(ErtsHeapFactory* factory,
- Process* rp,
- Eterm* hp,
- ErlHeapFragment* bp)
+void erts_factory_heap_frag_init(ErtsHeapFactory* factory,
+ ErlHeapFragment* bp)
+{
+ factory->mode = FACTORY_HEAP_FRAGS;
+ factory->p = NULL;
+ factory->hp_start = bp->mem;
+ factory->hp = bp->mem;
+ factory->hp_end = bp->mem + bp->alloc_size;
+ factory->off_heap = &bp->off_heap;
+ factory->message = NULL;
+ factory->heap_frags = bp;
+ factory->heap_frags_saved = NULL;
+ factory->heap_frags_saved_used = 0;
+ factory->alloc_type = ERTS_ALC_T_HEAP_FRAG;
+ ASSERT(!bp->next);
+ factory->off_heap_saved.first = factory->off_heap->first;
+ factory->off_heap_saved.overhead = factory->off_heap->overhead;
+
+ ASSERT(factory->hp >= factory->hp_start && factory->hp <= factory->hp_end);
+}
+
+
+ErtsMessage *
+erts_factory_message_create(ErtsHeapFactory* factory,
+ Process *proc,
+ ErtsProcLocks *proc_locksp,
+ Uint sz)
+{
+ Eterm *hp;
+ ErlOffHeap *ohp;
+ ErtsMessage *msgp;
+ int on_heap;
+ erts_aint32_t state;
+
+ state = erts_smp_atomic32_read_nob(&proc->state);
+
+ if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) {
+ msgp = erts_alloc_message(sz, &hp);
+ ohp = sz == 0 ? NULL : &msgp->hfrag.off_heap;
+ on_heap = 0;
+ }
+ else {
+ msgp = erts_try_alloc_message_on_heap(proc, &state,
+ proc_locksp,
+ sz, &hp, &ohp,
+ &on_heap);
+ }
+
+ if (on_heap) {
+ ERTS_SMP_ASSERT(*proc_locksp & ERTS_PROC_LOCK_MAIN);
+ ASSERT(ohp == &proc->off_heap);
+ factory->mode = FACTORY_HALLOC;
+ factory->p = proc;
+ factory->heap_frags_saved = proc->mbuf;
+ factory->heap_frags_saved_used = proc->mbuf ? proc->mbuf->used_size : 0;
+ }
+ else {
+ factory->mode = FACTORY_MESSAGE;
+ factory->p = NULL;
+ factory->heap_frags_saved = NULL;
+ factory->heap_frags_saved_used = 0;
+
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) {
+ ASSERT(!msgp->hfrag.next);
+ factory->heap_frags = NULL;
+ }
+ else {
+ ASSERT(!msgp->data.heap_frag
+ || !msgp->data.heap_frag->next);
+ factory->heap_frags = msgp->data.heap_frag;
+ }
+ }
+ factory->hp_start = hp;
+ factory->hp = hp;
+ factory->hp_end = hp + sz;
+ factory->message = msgp;
+ factory->off_heap = ohp;
+ factory->alloc_type = ERTS_ALC_T_HEAP_FRAG;
+ if (ohp) {
+ factory->off_heap_saved.first = ohp->first;
+ factory->off_heap_saved.overhead = ohp->overhead;
+ }
+ else {
+ factory->off_heap_saved.first = NULL;
+ factory->off_heap_saved.overhead = 0;
+ }
+
+ ASSERT(factory->hp >= factory->hp_start && factory->hp <= factory->hp_end);
+
+ return msgp;
+}
+
+void erts_factory_selfcontained_message_init(ErtsHeapFactory* factory,
+ ErtsMessage *msgp,
+ Eterm *hp)
{
- if (bp) {
- factory->mode = FACTORY_HEAP_FRAGS;
- factory->p = NULL;
- factory->hp_start = bp->mem;
- factory->hp = hp ? hp : bp->mem;
- factory->hp_end = bp->mem + bp->alloc_size;
- factory->off_heap = &bp->off_heap;
- factory->heap_frags = bp;
- factory->heap_frags_saved = bp;
- factory->alloc_type = ERTS_ALC_T_HEAP_FRAG;
- ASSERT(!bp->next);
+ ErlHeapFragment* bp;
+ if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG) {
+ bp = &msgp->hfrag;
+ factory->heap_frags = NULL;
}
else {
- factory->mode = FACTORY_HALLOC;
- factory->p = rp;
- factory->hp_start = hp;
- factory->hp = hp;
- factory->hp_end = HEAP_TOP(rp);
- factory->off_heap = &rp->off_heap;
- factory->heap_frags_saved = rp->mbuf;
- factory->heap_frags = NULL; /* not used */
- factory->alloc_type = 0; /* not used */
+ bp = msgp->data.heap_frag;
+ factory->heap_frags = bp;
}
+ factory->mode = FACTORY_MESSAGE;
+ factory->p = NULL;
+ factory->hp_start = bp->mem;
+ factory->hp = hp;
+ factory->hp_end = bp->mem + bp->alloc_size;
+ factory->message = msgp;
+ factory->off_heap = &bp->off_heap;
+ factory->heap_frags_saved = NULL;
+ factory->heap_frags_saved_used = 0;
+ factory->alloc_type = ERTS_ALC_T_HEAP_FRAG;
+ ASSERT(!bp->next);
factory->off_heap_saved.first = factory->off_heap->first;
factory->off_heap_saved.overhead = factory->off_heap->overhead;
ASSERT(factory->hp >= factory->hp_start && factory->hp <= factory->hp_end);
}
+/* One static sized heap that must suffice.
+ No extra heap fragments will be allocated.
+*/
void erts_factory_static_init(ErtsHeapFactory* factory,
Eterm* hp,
Uint size,
@@ -1188,6 +1594,23 @@ void erts_factory_static_init(ErtsHeapFactory* factory,
factory->off_heap_saved.overhead = factory->off_heap->overhead;
}
+/* A temporary heap with default buffer allocated/freed by client.
+ * factory_close is same as factory_undo
+ */
+void erts_factory_tmp_init(ErtsHeapFactory* factory, Eterm* hp, Uint size,
+ Uint32 atype)
+{
+ factory->mode = FACTORY_TMP;
+ factory->hp_start = hp;
+ factory->hp = hp;
+ factory->hp_end = hp + size;
+ factory->heap_frags = NULL;
+ factory->off_heap_saved.first = NULL;
+ factory->off_heap_saved.overhead = 0;
+ factory->off_heap = &factory->off_heap_saved;
+ factory->alloc_type = atype;
+}
+
/* When we know the term is an immediate and need no heap.
*/
void erts_factory_dummy_init(ErtsHeapFactory* factory)
@@ -1230,8 +1653,17 @@ static void reserve_heap(ErtsHeapFactory* factory, Uint need, Uint xtra)
factory->hp_end = factory->hp + need;
return;
- case FACTORY_HEAP_FRAGS:
- bp = factory->heap_frags;
+ case FACTORY_MESSAGE:
+ if (!factory->heap_frags) {
+ ASSERT(factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG);
+ bp = &factory->message->hfrag;
+ }
+ else {
+ /* Fall through */
+ case FACTORY_HEAP_FRAGS:
+ case FACTORY_TMP:
+ bp = factory->heap_frags;
+ }
if (bp) {
ASSERT(factory->hp > bp->mem);
@@ -1269,8 +1701,23 @@ void erts_factory_close(ErtsHeapFactory* factory)
HRelease(factory->p, factory->hp_end, factory->hp);
break;
- case FACTORY_HEAP_FRAGS:
- bp = factory->heap_frags;
+ case FACTORY_MESSAGE:
+ if (!factory->heap_frags) {
+ if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ bp = &factory->message->hfrag;
+ else
+ bp = NULL;
+ }
+ else {
+ if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ factory->message->hfrag.next = factory->heap_frags;
+ else
+ factory->message->data.heap_frag = factory->heap_frags;
+
+ /* Fall through */
+ case FACTORY_HEAP_FRAGS:
+ bp = factory->heap_frags;
+ }
if (bp) {
ASSERT(factory->hp >= bp->mem);
@@ -1280,6 +1727,9 @@ void erts_factory_close(ErtsHeapFactory* factory)
bp->used_size = factory->hp - bp->mem;
}
break;
+ case FACTORY_TMP:
+ erts_factory_undo(factory);
+ break;
case FACTORY_STATIC: break;
case FACTORY_CLOSED: break;
default:
@@ -1291,17 +1741,47 @@ void erts_factory_close(ErtsHeapFactory* factory)
void erts_factory_trim_and_close(ErtsHeapFactory* factory,
Eterm *brefs, Uint brefs_size)
{
- if (factory->mode == FACTORY_HEAP_FRAGS) {
- ErlHeapFragment* bp = factory->heap_frags;
+ ErlHeapFragment *bp;
+
+ switch (factory->mode) {
+ case FACTORY_MESSAGE: {
+ ErtsMessage *mp = factory->message;
+ if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG) {
+ if (!mp->hfrag.next) {
+ Uint sz = factory->hp - factory->hp_start;
+ mp = erts_shrink_message(mp, sz, brefs, brefs_size);
+ factory->message = mp;
+ factory->mode = FACTORY_CLOSED;
+ return;
+ }
+ /*else we don't trim multi fragmented messages for now (off_heap...) */
+ break;
+ }
+ /* Fall through... */
+ }
+ case FACTORY_HEAP_FRAGS:
+ bp = factory->heap_frags;
+ if (!bp)
+ break;
if (bp->next == NULL) {
Uint used_sz = factory->hp - bp->mem;
ASSERT(used_sz <= bp->alloc_size);
- factory->heap_frags = erts_resize_message_buffer(bp, used_sz,
- brefs, brefs_size);
+ if (used_sz > 0)
+ bp = erts_resize_message_buffer(bp, used_sz,
+ brefs, brefs_size);
+ else {
+ free_message_buffer(bp);
+ bp = NULL;
+ }
+ factory->heap_frags = bp;
+ if (factory->mode == FACTORY_MESSAGE)
+ factory->message->data.heap_frag = bp;
factory->mode = FACTORY_CLOSED;
return;
}
- /*else we don't trim multi fragmented messages for now */
+ /*else we don't trim multi fragmented messages for now (off_heap...) */
+ default:
+ break;
}
erts_factory_close(factory);
}
@@ -1349,38 +1829,47 @@ void erts_factory_undo(ErtsHeapFactory* factory)
/* Rollback heap top
*/
- if (factory->heap_frags_saved == NULL) { /* No heap frags when we started */
- ASSERT(factory->hp_start >= HEAP_START(factory->p));
- ASSERT(factory->hp_start <= HEAP_LIMIT(factory->p));
- HEAP_TOP(factory->p) = factory->hp_start;
- }
- else {
+ if (HEAP_START(factory->p) <= factory->hp_start
+ && factory->hp_start <= HEAP_LIMIT(factory->p)) {
+ HEAP_TOP(factory->p) = factory->hp_start;
+ }
+
+ /* Fix last heap frag */
+ if (factory->heap_frags_saved) {
ASSERT(factory->heap_frags_saved == factory->p->mbuf);
- if (factory->hp_start == factory->heap_frags_saved->mem) {
+ if (factory->hp_start != factory->heap_frags_saved->mem)
+ factory->heap_frags_saved->used_size = factory->heap_frags_saved_used;
+ else {
factory->p->mbuf = factory->p->mbuf->next;
ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, factory->heap_frags_saved,
ERTS_HEAP_FRAG_SIZE(factory->heap_frags_saved->alloc_size));
}
- else if (factory->hp_start != factory->hp_end) {
- unsigned remains = factory->hp_start - factory->heap_frags_saved->mem;
- ASSERT(remains > 0 && remains < factory->heap_frags_saved->used_size);
- factory->heap_frags_saved->used_size = remains;
- }
}
}
break;
+ case FACTORY_MESSAGE:
+ if (factory->message->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ factory->message->hfrag.next = factory->heap_frags;
+ else
+ factory->message->data.heap_frag = factory->heap_frags;
+ erts_cleanup_messages(factory->message);
+ break;
+ case FACTORY_TMP:
case FACTORY_HEAP_FRAGS:
+ erts_cleanup_offheap(factory->off_heap);
+ factory->off_heap->first = NULL;
+
bp = factory->heap_frags;
- do {
+ while (bp != NULL) {
ErlHeapFragment* next_bp = bp->next;
- erts_cleanup_offheap(&bp->off_heap);
+ ASSERT(bp->off_heap.first == NULL);
ERTS_HEAP_FREE(factory->alloc_type, (void *) bp,
- ERTS_HEAP_FRAG_SIZE(bp->size));
+ ERTS_HEAP_FRAG_SIZE(bp->alloc_size));
bp = next_bp;
- }while (bp != NULL);
+ }
break;
case FACTORY_CLOSED: break;
@@ -1394,4 +1883,3 @@ void erts_factory_undo(ErtsHeapFactory* factory)
factory->heap_frags = NULL;
#endif
}
-
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index fbdf3fb0e2..60035d15ae 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -24,6 +24,8 @@
struct proc_bin;
struct external_thing_;
+typedef struct erl_mesg ErtsMessage;
+
/*
* This struct represents data that must be updated by structure copy,
* but is stored outside of any heap.
@@ -32,9 +34,6 @@ struct external_thing_;
struct erl_off_heap_header {
Eterm thing_word;
Uint size;
-#if HALFWORD_HEAP
- void* dummy_ptr_padding__;
-#endif
struct erl_off_heap_header* next;
};
@@ -57,15 +56,19 @@ typedef struct {
enum {
FACTORY_CLOSED = 0,
FACTORY_HALLOC,
+ FACTORY_MESSAGE,
FACTORY_HEAP_FRAGS,
- FACTORY_STATIC
+ FACTORY_STATIC,
+ FACTORY_TMP
} mode;
Process* p;
Eterm* hp_start;
Eterm* hp;
Eterm* hp_end;
+ ErtsMessage *message;
struct erl_heap_fragment* heap_frags;
struct erl_heap_fragment* heap_frags_saved;
+ Uint heap_frags_saved_used;
ErlOffHeap* off_heap;
ErlOffHeap off_heap_saved;
Uint32 alloc_type;
@@ -73,8 +76,12 @@ typedef struct {
void erts_factory_proc_init(ErtsHeapFactory*, Process*);
void erts_factory_proc_prealloc_init(ErtsHeapFactory*, Process*, Sint size);
-void erts_factory_message_init(ErtsHeapFactory*, Process*, Eterm* hp, struct erl_heap_fragment*);
+void erts_factory_heap_frag_init(ErtsHeapFactory*, struct erl_heap_fragment*);
+ErtsMessage *erts_factory_message_create(ErtsHeapFactory *, Process *,
+ ErtsProcLocks *, Uint sz);
+void erts_factory_selfcontained_message_init(ErtsHeapFactory*, ErtsMessage *, Eterm *);
void erts_factory_static_init(ErtsHeapFactory*, Eterm* hp, Uint size, ErlOffHeap*);
+void erts_factory_tmp_init(ErtsHeapFactory*, Eterm* hp, Uint size, Uint32 atype);
void erts_factory_dummy_init(ErtsHeapFactory*);
Eterm* erts_produce_heap(ErtsHeapFactory*, Uint need, Uint xtra);
@@ -94,6 +101,8 @@ void erts_factory_undo(ErtsHeapFactory*);
#include "external.h"
#include "erl_process.h"
+#define ERTS_INVALID_HFRAG_PTR ((ErlHeapFragment *) ~((UWord) 7))
+
/*
* This struct represents a heap fragment, which is used when there
* isn't sufficient room in the process heap and we can't do a GC.
@@ -108,33 +117,53 @@ struct erl_heap_fragment {
Eterm mem[1]; /* Data */
};
-typedef struct erl_mesg {
- struct erl_mesg* next; /* Next message */
- union {
- ErtsDistExternal *dist_ext;
- ErlHeapFragment *heap_frag;
- void *attached;
- } data;
+/* m[0] = message, m[1] = seq trace token */
+#define ERL_MESSAGE_REF_ARRAY_SZ 2
+#define ERL_MESSAGE_TERM(mp) ((mp)->m[0])
+#define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1])
+
#ifdef USE_VM_PROBES
- Eterm m[3]; /* m[0] = message, m[1] = seq trace token, m[3] = dynamic trace user tag */
+/* m[2] = dynamic trace user tag */
+#undef ERL_MESSAGE_REF_ARRAY_SZ
+#define ERL_MESSAGE_REF_ARRAY_SZ 3
+#define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[2])
#else
- Eterm m[2]; /* m[0] = message, m[1] = seq trace token */
#endif
-} ErlMessage;
-#define ERL_MESSAGE_TERM(mp) ((mp)->m[0])
-#define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1])
#ifdef USE_VM_PROBES
-#define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[2])
+#define have_no_seqtrace(T) ((T) == NIL || (T) == am_have_dt_utag)
+#else
+#define have_no_seqtrace(T) ((T) == NIL)
#endif
+#define have_seqtrace(T) (!have_no_seqtrace(T))
+
+#define ERL_MESSAGE_REF_FIELDS__ \
+ ErtsMessage *next; /* Next message */ \
+ union { \
+ ErtsDistExternal *dist_ext; \
+ ErlHeapFragment *heap_frag; \
+ void *attached; \
+ } data; \
+ Eterm m[ERL_MESSAGE_REF_ARRAY_SZ]
+
+
+typedef struct erl_msg_ref__ {
+ ERL_MESSAGE_REF_FIELDS__;
+} ErtsMessageRef;
+
+struct erl_mesg {
+ ERL_MESSAGE_REF_FIELDS__;
+
+ ErlHeapFragment hfrag;
+};
/* Size of default message buffer (erl_message.c) */
#define ERL_MESSAGE_BUF_SZ 500
typedef struct {
- ErlMessage* first;
- ErlMessage** last; /* point to the last next pointer */
- ErlMessage** save;
+ ErtsMessage* first;
+ ErtsMessage** last; /* point to the last next pointer */
+ ErtsMessage** save;
Sint len; /* queue length */
/*
@@ -142,14 +171,14 @@ typedef struct {
* recv_set/1 instructions.
*/
BeamInstr* mark; /* address to rec_loop/2 instruction */
- ErlMessage** saved_last; /* saved last pointer */
+ ErtsMessage** saved_last; /* saved last pointer */
} ErlMessageQueue;
#ifdef ERTS_SMP
typedef struct {
- ErlMessage* first;
- ErlMessage** last; /* point to the last next pointer */
+ ErtsMessage* first;
+ ErtsMessage** last; /* point to the last next pointer */
Sint len; /* queue length */
} ErlMessageInQueue;
@@ -200,7 +229,7 @@ do { \
/* Unlink current message */
#define UNLINK_MESSAGE(p,msgp) do { \
- ErlMessage* __mp = (msgp)->next; \
+ ErtsMessage* __mp = (msgp)->next; \
*(p)->msg.save = __mp; \
(p)->msg.len--; \
if (__mp == NULL) \
@@ -216,76 +245,33 @@ do { \
#define SAVE_MESSAGE(p) \
(p)->msg.save = &(*(p)->msg.save)->next
-/*
- * ErtsMoveMsgAttachmentIntoProc() moves data attached to a message
- * onto the heap of a process. The attached data is the content of
- * the the message either on the internal format or on the external
- * format, and also possibly a seq trace token on the internal format.
- * If the message content is on the external format, the decode might
- * fail. If the decoding fails, ERL_MESSAGE_TERM(M) will contain
- * THE_NON_VALUE. That is, ERL_MESSAGE_TERM(M) *has* to be checked
- * afterwards and taken care of appropriately.
- *
- * ErtsMoveMsgAttachmentIntoProc() will shallow copy to heap if
- * possible; otherwise, move to heap via garbage collection.
- *
- * ErtsMoveMsgAttachmentIntoProc() is used when receiveing messages
- * in process_main() and in hipe_check_get_msg().
- */
-
-#define ErtsMoveMsgAttachmentIntoProc(M, P, ST, HT, FC, SWPO, SWPI) \
-do { \
- if ((M)->data.attached) { \
- Uint need__ = erts_msg_attached_data_size((M)); \
- { SWPO ; } \
- if ((ST) - (HT) >= need__) { \
- ErtsHeapFactory factory__; \
- erts_factory_proc_prealloc_init(&factory__, (P), need__); \
- erts_move_msg_attached_data_to_heap(&factory__, (M)); \
- erts_factory_close(&factory__); \
- if ((P)->mbuf != NULL) { \
- /* Heap was exhausted by messages. This is a rare case */ \
- /* that can currently (OTP 18) only happen if hamts are */ \
- /* far exceeding the estimated heap size. Do GC. */ \
- (FC) -= erts_garbage_collect((P), 0, NULL, 0); \
- } \
- } \
- else { \
- (FC) -= erts_garbage_collect((P), 0, NULL, 0); \
- } \
- { SWPI ; } \
- ASSERT(!(M)->data.attached); \
- } \
-} while (0)
-
#define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0)
#define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \
(sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm))
-#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, DATA_WORDS) \
-do { \
- (HEAP_FRAG_P)->next = NULL; \
- (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \
- (HEAP_FRAG_P)->used_size = (DATA_WORDS); \
- (HEAP_FRAG_P)->off_heap.first = NULL; \
- (HEAP_FRAG_P)->off_heap.overhead = 0; \
-} while (0)
+#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, USED_WORDS, DATA_WORDS) \
+ do { \
+ (HEAP_FRAG_P)->next = NULL; \
+ (HEAP_FRAG_P)->alloc_size = (DATA_WORDS); \
+ (HEAP_FRAG_P)->used_size = (USED_WORDS); \
+ (HEAP_FRAG_P)->off_heap.first = NULL; \
+ (HEAP_FRAG_P)->off_heap.overhead = 0; \
+ } while (0)
void init_message(void);
-void free_message(ErlMessage *);
ErlHeapFragment* new_message_buffer(Uint);
ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint,
Eterm *, Uint);
void free_message_buffer(ErlHeapFragment *);
void erts_queue_dist_message(Process*, ErtsProcLocks*, ErtsDistExternal *, Eterm);
#ifdef USE_VM_PROBES
-void erts_queue_message_probe(Process*, ErtsProcLocks*, ErlHeapFragment*,
+void erts_queue_message_probe(Process*, ErtsProcLocks*, ErtsMessage*,
Eterm message, Eterm seq_trace_token, Eterm dt_utag);
#define erts_queue_message(RP,RL,BP,Msg,SEQ) \
erts_queue_message_probe((RP),(RL),(BP),(Msg),(SEQ),NIL)
#else
-void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*,
+void erts_queue_message(Process*, ErtsProcLocks*, ErtsMessage*,
Eterm message, Eterm seq_trace_token);
#define erts_queue_message_probe(RP,RL,BP,Msg,SEQ,TAG) \
erts_queue_message((RP),(RL),(BP),(Msg),(SEQ))
@@ -294,20 +280,141 @@ void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm);
Sint erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned);
void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp);
-void erts_move_msg_mbuf_to_heap(Eterm**, ErlOffHeap*, ErlMessage *);
-
-Uint erts_msg_attached_data_size_aux(ErlMessage *msg);
-void erts_move_msg_attached_data_to_heap(ErtsHeapFactory*, ErlMessage *);
-Eterm erts_msg_distext2heap(Process *, ErtsProcLocks *, ErlHeapFragment **,
- Eterm *, ErtsDistExternal *);
+Uint erts_msg_attached_data_size_aux(ErtsMessage *msg);
void erts_cleanup_offheap(ErlOffHeap *offheap);
+void erts_save_message_in_proc(Process *p, ErtsMessage *msg);
+Sint erts_move_messages_off_heap(Process *c_p);
+Sint erts_complete_off_heap_message_queue_change(Process *c_p);
+Eterm erts_change_message_queue_management(Process *c_p, Eterm new_state);
+
+int erts_decode_dist_message(Process *, ErtsProcLocks, ErtsMessage *, int);
+
+void erts_cleanup_messages(ErtsMessage *mp);
+
+typedef struct {
+ Uint size;
+ ErtsMessage *msgp;
+} ErtsMessageInfo;
+
+Uint erts_prep_msgq_for_inspection(Process *c_p,
+ Process *rp,
+ ErtsProcLocks rp_locks,
+ ErtsMessageInfo *mip);
+
+void *erts_alloc_message_ref(void);
+void erts_free_message_ref(void *);
+#define ERTS_SMALL_FIX_MSG_SZ 10
+#define ERTS_MEDIUM_FIX_MSG_SZ 20
+#define ERTS_LARGE_FIX_MSG_SZ 30
+void *erts_alloc_small_message(void);
+void erts_free_small_message(void *mp);
+
+typedef struct {
+ ErtsMessage m;
+ Eterm data[ERTS_SMALL_FIX_MSG_SZ-1];
+} ErtsSmallFixSzMessage;
+
+typedef struct {
+ ErtsMessage m;
+ Eterm data[ERTS_MEDIUM_FIX_MSG_SZ-1];
+} ErtsMediumFixSzMessage;
+
+typedef struct {
+ ErtsMessage m;
+ Eterm data[ERTS_LARGE_FIX_MSG_SZ-1];
+} ErtsLargeFixSzMessage;
+
+ErtsMessage *erts_try_alloc_message_on_heap(Process *pp,
+ erts_aint32_t *psp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp,
+ int *on_heap_p);
+ErtsMessage *erts_realloc_shrink_message(ErtsMessage *mp, Uint sz,
+ Eterm *brefs, Uint brefs_size);
+
+ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp);
+ERTS_GLB_FORCE_INLINE ErtsMessage *erts_shrink_message(ErtsMessage *mp, Uint sz,
+ Eterm *brefs, Uint brefs_size);
+ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp);
ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment*);
-ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg);
+ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg);
+
+#define ERTS_MSG_COMBINED_HFRAG ((void *) 0x1)
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp)
+{
+ ErtsMessage *mp;
+
+ if (sz == 0) {
+ mp = erts_alloc_message_ref();
+ mp->next = NULL;
+ ERL_MESSAGE_TERM(mp) = NIL;
+ mp->data.attached = NULL;
+ if (hpp)
+ *hpp = NULL;
+ return mp;
+ }
+
+ mp = erts_alloc(ERTS_ALC_T_MSG,
+ sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm));
+
+ mp->next = NULL;
+ ERL_MESSAGE_TERM(mp) = NIL;
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ ERTS_INIT_HEAP_FRAG(&mp->hfrag, sz, sz);
+
+ if (hpp)
+ *hpp = &mp->hfrag.mem[0];
+
+ return mp;
+}
+
+ERTS_GLB_FORCE_INLINE ErtsMessage *
+erts_shrink_message(ErtsMessage *mp, Uint sz, Eterm *brefs, Uint brefs_size)
+{
+ if (sz == 0) {
+ ErtsMessage *nmp;
+ if (!mp->data.attached)
+ return mp;
+ ASSERT(mp->data.attached == ERTS_MSG_COMBINED_HFRAG);
+ nmp = erts_alloc_message_ref();
+#ifdef DEBUG
+ if (brefs && brefs_size) {
+ int i;
+ for (i = 0; i < brefs_size; i++)
+ ASSERT(is_non_value(brefs[i]) || is_immed(brefs[i]));
+ }
+#endif
+ erts_free(ERTS_ALC_T_MSG, mp);
+ return nmp;
+ }
+
+ ASSERT(mp->data.attached == ERTS_MSG_COMBINED_HFRAG);
+ ASSERT(mp->hfrag.used_size >= sz);
+
+ if (sz >= (mp->hfrag.alloc_size - mp->hfrag.alloc_size / 16)) {
+ mp->hfrag.used_size = sz;
+ return mp;
+ }
+
+ return erts_realloc_shrink_message(mp, sz, brefs, brefs_size);
+}
+
+ERTS_GLB_FORCE_INLINE void erts_free_message(ErtsMessage *mp)
+{
+ if (mp->data.attached != ERTS_MSG_COMBINED_HFRAG)
+ erts_free_message_ref(mp);
+ else
+ erts_free(ERTS_ALC_T_MSG, mp);
+}
+
ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp)
{
Uint sz = 0;
@@ -317,11 +424,17 @@ ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp)
return sz;
}
-ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg)
+ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg)
{
ASSERT(msg->data.attached);
- if (is_value(ERL_MESSAGE_TERM(msg)))
- return erts_used_frag_sz(msg->data.heap_frag);
+ if (is_value(ERL_MESSAGE_TERM(msg))) {
+ ErlHeapFragment *bp;
+ if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ bp = &msg->hfrag;
+ else
+ bp = msg->data.heap_frag;
+ return erts_used_frag_sz(bp);
+ }
else if (msg->data.dist_ext->heap_size < 0)
return erts_msg_attached_data_size_aux(msg);
else {
diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c
index 7dfa01c8ac..bd899fa2f9 100644
--- a/erts/emulator/beam/erl_monitors.c
+++ b/erts/emulator/beam/erl_monitors.c
@@ -356,7 +356,7 @@ void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid,
tstack[tpos++] = this;
this = &((*this)->right);
} else { /* Equal key is an error for monitors */
- erl_exit(1,"Insertion of already present monitor!");
+ erts_exit(ERTS_ERROR_EXIT,"Insertion of already present monitor!");
break;
}
}
diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c
new file mode 100644
index 0000000000..71e3fd8b6e
--- /dev/null
+++ b/erts/emulator/beam/erl_msacc.c
@@ -0,0 +1,486 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-2015. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Description: Microstate accounting.
+ *
+ * We keep track of the different states that the
+ * Erlang VM threads are in, in order to provide
+ * performance/debugging statistics. There is a
+ * small overhead in enabling this, but in the big
+ * scheme of things it should be negligible.
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#define ERTS_MSACC_STATE_STRINGS 1
+
+#include "sys.h"
+#include "global.h"
+#include "erl_threads.h"
+#include "erl_bif_unique.h"
+#include "erl_map.h"
+#include "erl_msacc.h"
+
+#if ERTS_ENABLE_MSACC
+
+static Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp);
+static void erts_msacc_reset(ErtsMsAcc *msacc);
+static ErtsMsAcc* get_msacc(void);
+
+#ifdef USE_THREADS
+erts_tsd_key_t ERTS_WRITE_UNLIKELY(erts_msacc_key);
+#else
+ErtsMsAcc *ERTS_WRITE_UNLIKELY(erts_msacc) = NULL;
+#endif
+int ERTS_WRITE_UNLIKELY(erts_msacc_enabled);
+
+static Eterm *erts_msacc_state_atoms = NULL;
+static erts_rwmtx_t msacc_mutex;
+static ErtsMsAcc *msacc_managed = NULL;
+#ifdef USE_THREADS
+static ErtsMsAcc *msacc_unmanaged = NULL;
+static Uint msacc_unmanaged_count = 0;
+#endif
+
+/* we have to split initiation as atoms are not inited in early init */
+void erts_msacc_early_init(void) {
+#ifndef ERTS_MSACC_ALWAYS_ON
+ erts_msacc_enabled = 0;
+#endif
+ erts_rwmtx_init(&msacc_mutex,"msacc_list_mutex");
+#ifdef USE_THREADS
+ erts_tsd_key_create(&erts_msacc_key,"erts_msacc_key");
+#else
+ erts_msacc = NULL;
+#endif
+}
+
+void erts_msacc_init(void) {
+ int i;
+ erts_msacc_state_atoms = erts_alloc(ERTS_ALC_T_MSACC,
+ sizeof(Eterm)*ERTS_MSACC_STATE_COUNT);
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ erts_msacc_state_atoms[i] = am_atom_put(erts_msacc_states[i],
+ strlen(erts_msacc_states[i]));
+ }
+}
+
+void erts_msacc_init_thread(char *type, int id, int managed) {
+ ErtsMsAcc *msacc;
+
+ msacc = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMsAcc));
+
+ msacc->type = strdup(type);
+ msacc->id = make_small(id);
+ msacc->unmanaged = !managed;
+ msacc->tid = erts_thr_self();
+ msacc->perf_counter = 0;
+
+#ifdef USE_THREADS
+ erts_rwmtx_rwlock(&msacc_mutex);
+ if (!managed) {
+ erts_mtx_init(&msacc->mtx,"msacc_unmanaged_mutex");
+ msacc->next = msacc_unmanaged;
+ msacc_unmanaged = msacc;
+ msacc_unmanaged_count++;
+ ERTS_MSACC_TSD_SET(msacc);
+ } else {
+ msacc->next = msacc_managed;
+ msacc_managed = msacc;
+ }
+ erts_rwmtx_rwunlock(&msacc_mutex);
+#else
+ msacc_managed = msacc;
+#endif
+
+ erts_msacc_reset(msacc);
+
+#ifdef ERTS_MSACC_ALWAYS_ON
+ ERTS_MSACC_TSD_SET(msacc);
+ msacc->perf_counter = erts_sys_perf_counter();
+ msacc->state = ERTS_MSACC_STATE_OTHER;
+#endif
+}
+
+/*
+ * Creates a structure looking like this
+ * #{ type => scheduler, id => 1, counters => #{ State1 => Counter1 ... StateN => CounterN}}
+ */
+static
+Eterm erts_msacc_gather_stats(ErtsMsAcc *msacc, Eterm **hpp, Uint *szp) {
+ int i;
+ Eterm *hp;
+ Eterm key, state_key, state_map;
+ Eterm res = THE_NON_VALUE;
+ flatmap_t *map;
+
+ if (szp) {
+ *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(3);
+ *szp += MAP_HEADER_FLATMAP_SZ + 1 + 2*(ERTS_MSACC_STATE_COUNT);
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ (void)erts_bld_sint64(NULL,szp,(Sint64)msacc->perf_counters[i]);
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ (void)erts_bld_uint64(NULL,szp,msacc->state_counters[i]);
+ *szp += 3; /* tuple to put state+perf counter in */
+#endif
+ }
+ }
+
+ if (hpp) {
+ Eterm counters[ERTS_MSACC_STATE_COUNT];
+ hp = *hpp;
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ Eterm counter = erts_bld_sint64(&hp,NULL,(Sint64)msacc->perf_counters[i]);
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ Eterm counter__ = erts_bld_uint64(&hp,NULL,msacc->state_counters[i]);
+ counters[i] = TUPLE2(hp,counter,counter__);
+ hp += 3;
+#else
+ counters[i] = counter;
+#endif
+ }
+
+ key = TUPLE3(hp,am_counters,am_id,am_type);
+ hp += 4;
+
+ state_key = make_tuple(hp);
+ hp[0] = make_arityval(ERTS_MSACC_STATE_COUNT);
+
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++)
+ hp[1+i] = erts_msacc_state_atoms[i];
+ hp += 1 + ERTS_MSACC_STATE_COUNT;
+
+ map = (flatmap_t*)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ map->thing_word = MAP_HEADER_FLATMAP;
+ map->size = ERTS_MSACC_STATE_COUNT;
+ map->keys = state_key;
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++)
+ hp[i] = counters[i];
+ hp += ERTS_MSACC_STATE_COUNT;
+ state_map = make_flatmap(map);
+
+ map = (flatmap_t*)hp;
+ hp += MAP_HEADER_FLATMAP_SZ;
+ map->thing_word = MAP_HEADER_FLATMAP;
+ map->size = 3;
+ map->keys = key;
+ hp[0] = state_map;
+ hp[1] = msacc->id;
+ hp[2] = am_atom_put(msacc->type,strlen(msacc->type));
+ hp += 3;
+
+ *hpp = hp;
+ res = make_flatmap(map);
+ }
+
+ return res;
+}
+
+typedef struct {
+ int action;
+ Process *proc;
+ Eterm ref;
+ Eterm ref_heap[REF_THING_SIZE];
+ Uint req_sched;
+ erts_smp_atomic32_t refc;
+} ErtsMSAccReq;
+
+static ErtsMsAcc* get_msacc(void) {
+ ErtsMsAcc *msacc;
+ erts_rwmtx_rlock(&msacc_mutex);
+ msacc = msacc_managed;
+ while (!erts_equal_tids(msacc->tid,erts_thr_self())) {
+ msacc = msacc->next;
+ ASSERT(msacc != NULL);
+ }
+ erts_rwmtx_runlock(&msacc_mutex);
+ return msacc;
+}
+
+static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) {
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ Process *rp = msaccrp->proc;
+ ErtsMessage *msgp = NULL;
+ Eterm **hpp, *hp;
+ Eterm ref_copy = NIL, msg;
+ Uint sz, *szp;
+ ErlOffHeap *ohp = NULL;
+ ErtsProcLocks rp_locks = (esdp && msaccrp->req_sched == esdp->no
+ ? ERTS_PROC_LOCK_MAIN : 0);
+
+ sz = 0;
+ hpp = NULL;
+ szp = &sz;
+
+ if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx);
+
+ while (1) {
+ if (hpp)
+ ref_copy = STORE_NC(hpp, ohp, msaccrp->ref);
+ else
+ *szp += REF_THING_SIZE;
+
+ if (msaccrp->action != ERTS_MSACC_GATHER)
+ msg = ref_copy;
+ else {
+ msg = erts_msacc_gather_stats(msacc, hpp, szp);
+ msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg);
+ }
+ if (hpp)
+ break;
+
+ msgp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
+ hpp = &hp;
+ szp = NULL;
+ }
+
+ if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx);
+
+ erts_queue_message(rp, &rp_locks, msgp, msg, NIL);
+
+ if (esdp && msaccrp->req_sched == esdp->no)
+ rp_locks &= ~ERTS_PROC_LOCK_MAIN;
+
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
+
+}
+
+static void
+reply_msacc(void *vmsaccrp)
+{
+ ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET();
+ ErtsMSAccReq *msaccrp = (ErtsMSAccReq *) vmsaccrp;
+
+ ASSERT(!msacc || !msacc->unmanaged);
+
+ if (msaccrp->action == ERTS_MSACC_ENABLE && !msacc) {
+ msacc = get_msacc();
+
+ msacc->perf_counter = erts_sys_perf_counter();
+
+ msacc->state = ERTS_MSACC_STATE_OTHER;
+
+ ERTS_MSACC_TSD_SET(msacc);
+
+ } else if (msaccrp->action == ERTS_MSACC_DISABLE && msacc) {
+ ERTS_MSACC_TSD_SET(NULL);
+ } else if (msaccrp->action == ERTS_MSACC_RESET) {
+ msacc = msacc ? msacc : get_msacc();
+ erts_msacc_reset(msacc);
+ } else if (msaccrp->action == ERTS_MSACC_GATHER && !msacc) {
+ msacc = get_msacc();
+ }
+
+ ASSERT(!msacc || !msacc->unmanaged);
+
+ send_reply(msacc, msaccrp);
+
+ erts_proc_dec_refc(msaccrp->proc);
+
+ if (erts_smp_atomic32_dec_read_nob(&msaccrp->refc) == 0)
+ erts_free(ERTS_ALC_T_MSACC, vmsaccrp);
+}
+
+static void erts_msacc_reset(ErtsMsAcc *msacc) {
+ int i;
+ if (msacc->unmanaged) erts_mtx_lock(&msacc->mtx);
+
+ for (i = 0; i < ERTS_MSACC_STATE_COUNT; i++) {
+ msacc->perf_counters[i] = 0;
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ msacc->state_counters[i] = 0;
+#endif
+ }
+
+ if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx);
+}
+
+#endif /* ERTS_ENABLE_MSACC */
+
+
+/*
+ * This function is responsible for enabling, disabling, resetting and
+ * gathering data related to microstate accounting.
+ *
+ * Managed threads and unmanaged threads are handled differently.
+ * - managed threads get a misc_aux job telling them to switch on msacc
+ * - unmanaged have some fields protected by a mutex that has to be taken
+ * before any values can be updated
+ *
+ * For performance reasons there is also a global value erts_msacc_enabled
+ * that controls the state of all threads. Statistics gathering is only on
+ * if erts_msacc_enabled && msacc is true.
+ */
+Eterm
+erts_msacc_request(Process *c_p, int action, Eterm *threads)
+{
+#ifdef ERTS_ENABLE_MSACC
+ ErtsMsAcc *msacc = ERTS_MSACC_TSD_GET();
+ ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p);
+ Eterm ref;
+ ErtsMSAccReq *msaccrp;
+ Eterm *hp;
+
+
+#ifdef ERTS_MSACC_ALWAYS_ON
+ if (action == ERTS_MSACC_ENABLE || action == ERTS_MSACC_DISABLE)
+ return THE_NON_VALUE;
+#else
+ /* take care of double enable, and double disable here */
+ if (msacc && action == ERTS_MSACC_ENABLE) {
+ return THE_NON_VALUE;
+ } else if (!msacc && action == ERTS_MSACC_DISABLE) {
+ return THE_NON_VALUE;
+ }
+#endif
+
+ ref = erts_make_ref(c_p);
+
+ msaccrp = erts_alloc(ERTS_ALC_T_MSACC, sizeof(ErtsMSAccReq));
+ hp = &msaccrp->ref_heap[0];
+
+ msaccrp->action = action;
+ msaccrp->proc = c_p;
+ msaccrp->ref = STORE_NC(&hp, NULL, ref);
+ msaccrp->req_sched = esdp->no;
+
+#ifdef ERTS_SMP
+ *threads = erts_no_schedulers;
+ *threads += 1; /* aux thread */
+#else
+ *threads = 1;
+#endif
+
+ erts_smp_atomic32_init_nob(&msaccrp->refc,(erts_aint32_t)*threads);
+
+ erts_proc_add_refc(c_p, *threads);
+
+ if (erts_no_schedulers > 1)
+ erts_schedule_multi_misc_aux_work(1,
+ erts_no_schedulers,
+ reply_msacc,
+ (void *) msaccrp);
+#ifdef ERTS_SMP
+ /* aux thread */
+ erts_schedule_misc_aux_work(0, reply_msacc, (void *) msaccrp);
+#endif
+
+#ifdef USE_THREADS
+ /* Manage unmanaged threads */
+ switch (action) {
+ case ERTS_MSACC_GATHER: {
+ Uint unmanaged_count;
+ ErtsMsAcc *msacc, **unmanaged;
+ int i = 0;
+
+ /* we copy a list of pointers here so that we do not have to have
+ the msacc_mutex when sending messages */
+ erts_rwmtx_rlock(&msacc_mutex);
+ unmanaged_count = msacc_unmanaged_count;
+ unmanaged = erts_alloc(ERTS_ALC_T_MSACC,
+ sizeof(ErtsMsAcc*)*unmanaged_count);
+
+ for (i = 0, msacc = msacc_unmanaged;
+ i < unmanaged_count;
+ i++, msacc = msacc->next) {
+ unmanaged[i] = msacc;
+ }
+ erts_rwmtx_runlock(&msacc_mutex);
+
+ for (i = 0; i < unmanaged_count; i++) {
+ erts_mtx_lock(&unmanaged[i]->mtx);
+ if (unmanaged[i]->perf_counter) {
+ ErtsSysPerfCounter perf_counter;
+ /* if enabled update stats */
+ perf_counter = erts_sys_perf_counter();
+ unmanaged[i]->perf_counters[unmanaged[i]->state] +=
+ perf_counter - unmanaged[i]->perf_counter;
+ unmanaged[i]->perf_counter = perf_counter;
+ }
+ erts_mtx_unlock(&unmanaged[i]->mtx);
+ send_reply(unmanaged[i],msaccrp);
+ }
+ erts_free(ERTS_ALC_T_MSACC,unmanaged);
+ /* We have just sent unmanaged_count messages, so bump no of threads */
+ *threads += unmanaged_count;
+ break;
+ }
+ case ERTS_MSACC_RESET: {
+ ErtsMsAcc *msacc;
+ erts_rwmtx_rlock(&msacc_mutex);
+ for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next)
+ erts_msacc_reset(msacc);
+ erts_rwmtx_runlock(&msacc_mutex);
+ break;
+ }
+ case ERTS_MSACC_ENABLE: {
+ erts_rwmtx_rlock(&msacc_mutex);
+ for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) {
+ erts_mtx_lock(&msacc->mtx);
+ msacc->perf_counter = erts_sys_perf_counter();
+ /* we assume the unmanaged thread is sleeping */
+ msacc->state = ERTS_MSACC_STATE_SLEEP;
+ erts_mtx_unlock(&msacc->mtx);
+ }
+ erts_rwmtx_runlock(&msacc_mutex);
+ break;
+ }
+ case ERTS_MSACC_DISABLE: {
+ ErtsSysPerfCounter perf_counter;
+ erts_rwmtx_rlock(&msacc_mutex);
+ /* make sure to update stats with latest results */
+ for (msacc = msacc_unmanaged; msacc != NULL; msacc = msacc->next) {
+ erts_mtx_lock(&msacc->mtx);
+ perf_counter = erts_sys_perf_counter();
+ msacc->perf_counters[msacc->state] += perf_counter - msacc->perf_counter;
+ msacc->perf_counter = 0;
+ erts_mtx_unlock(&msacc->mtx);
+ }
+ erts_rwmtx_runlock(&msacc_mutex);
+ break;
+ }
+ default: { ASSERT(0); }
+ }
+
+#endif
+
+ *threads = make_small(*threads);
+
+ reply_msacc((void *) msaccrp);
+
+#ifndef ERTS_MSACC_ALWAYS_ON
+ /* enable/disable the global value */
+ if (action == ERTS_MSACC_ENABLE) {
+ erts_msacc_enabled = 1;
+ } else if (action == ERTS_MSACC_DISABLE) {
+ erts_msacc_enabled = 0;
+ }
+#endif
+
+ return ref;
+#else
+ return THE_NON_VALUE;
+#endif
+}
diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h
new file mode 100644
index 0000000000..284388f7aa
--- /dev/null
+++ b/erts/emulator/beam/erl_msacc.h
@@ -0,0 +1,409 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014-2015. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifndef ERL_MSACC_H__
+#define ERL_MSACC_H__
+
+/* Can be enabled/disabled via configure */
+#if ERTS_ENABLE_MSACC == 2
+#define ERTS_MSACC_EXTENDED_STATES 1
+#endif
+
+/* Uncomment this to also count the number of
+ transitions to a state. This will add a count
+ to the counter map. */
+/* #define ERTS_MSACC_STATE_COUNTERS 1 */
+
+/* Uncomment this to make msacc to always be on,
+ this reduces overhead a little bit when profiling */
+/* #define ERTS_MSACC_ALWAYS_ON 1 */
+
+#define ERTS_MSACC_DISABLE 0
+#define ERTS_MSACC_ENABLE 1
+#define ERTS_MSACC_RESET 2
+#define ERTS_MSACC_GATHER 3
+
+/*
+ * When adding a new state, you have to:
+ * * Add it here
+ * * Increment ERTS_MSACC_STATE_COUNT
+ * * Add string value to erts_msacc_states
+ * * Have to be in alphabetical order!
+ * * Only add states to the non-extended section after
+ * careful benchmarking to make sure the overhead
+ * when disabled is minimal.
+ */
+
+#ifndef ERTS_MSACC_EXTENDED_STATES
+#define ERTS_MSACC_STATE_AUX 0
+#define ERTS_MSACC_STATE_CHECK_IO 1
+#define ERTS_MSACC_STATE_EMULATOR 2
+#define ERTS_MSACC_STATE_GC 3
+#define ERTS_MSACC_STATE_OTHER 4
+#define ERTS_MSACC_STATE_PORT 5
+#define ERTS_MSACC_STATE_SLEEP 6
+
+#define ERTS_MSACC_STATE_COUNT 7
+
+#if ERTS_MSACC_STATE_STRINGS && ERTS_ENABLE_MSACC
+static char *erts_msacc_states[] = {
+ "aux",
+ "check_io",
+ "emulator",
+ "gc",
+ "other",
+ "port",
+ "sleep"
+};
+#endif
+
+#else
+
+#define ERTS_MSACC_STATE_ALLOC 0
+#define ERTS_MSACC_STATE_AUX 1
+#define ERTS_MSACC_STATE_BIF 2
+#define ERTS_MSACC_STATE_BUSY_WAIT 3
+#define ERTS_MSACC_STATE_CHECK_IO 4
+#define ERTS_MSACC_STATE_EMULATOR 5
+#define ERTS_MSACC_STATE_ETS 6
+#define ERTS_MSACC_STATE_GC 7
+#define ERTS_MSACC_STATE_GC_FULL 8
+#define ERTS_MSACC_STATE_NIF 9
+#define ERTS_MSACC_STATE_OTHER 10
+#define ERTS_MSACC_STATE_PORT 11
+#define ERTS_MSACC_STATE_SEND 12
+#define ERTS_MSACC_STATE_SLEEP 13
+#define ERTS_MSACC_STATE_TIMERS 14
+
+#define ERTS_MSACC_STATE_COUNT 15
+
+#if ERTS_MSACC_STATE_STRINGS
+static char *erts_msacc_states[] = {
+ "alloc",
+ "aux",
+ "bif",
+ "busy_wait",
+ "check_io",
+ "emulator",
+ "ets",
+ "gc",
+ "gc_full",
+ "nif",
+ "other",
+ "port",
+ "send",
+ "sleep",
+ "timers"
+};
+#endif
+
+#endif
+
+typedef struct erl_msacc_t_ ErtsMsAcc;
+
+struct erl_msacc_t_ {
+
+ /* the the values below are protected by mtx iff unmanaged = 1 */
+ ErtsSysPerfCounter perf_counter;
+ ErtsSysPerfCounter perf_counters[ERTS_MSACC_STATE_COUNT];
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ Uint64 state_counters[ERTS_MSACC_STATE_COUNT];
+#endif
+ Uint state;
+
+ /* protected by msacc_mutex in erl_msacc.c, and should be constant */
+ int unmanaged;
+ erts_mtx_t mtx;
+ ErtsMsAcc *next;
+ erts_tid_t tid;
+ Eterm id;
+ char *type;
+};
+
+#if ERTS_ENABLE_MSACC
+
+#define ERTS_MSACC_INLINE ERTS_GLB_INLINE
+
+#ifdef USE_THREADS
+extern erts_tsd_key_t erts_msacc_key;
+#else
+extern ErtsMsAcc *erts_msacc;
+#endif
+
+#ifdef ERTS_MSACC_ALWAYS_ON
+#define erts_msacc_enabled 1
+#else
+extern int erts_msacc_enabled;
+#endif
+
+#ifdef USE_THREADS
+#define ERTS_MSACC_TSD_GET() erts_tsd_get(erts_msacc_key)
+#define ERTS_MSACC_TSD_SET(tsd) erts_tsd_set(erts_msacc_key,tsd)
+#else
+#define ERTS_MSACC_TSD_GET() erts_msacc
+#define ERTS_MSACC_TSD_SET(tsd) erts_msacc = tsd
+#endif
+
+void erts_msacc_early_init(void);
+void erts_msacc_init(void);
+void erts_msacc_init_thread(char *type, int id, int liberty);
+
+/* The defines below are used to instrument the vm code
+ * with different state changes. There are two variants
+ * of each define. One that has a cached ErtsMsAcc *
+ * that it can use, and one that does not.
+ * The cached values are necessary to have in order to get
+ * low enough overhead when running without msacc enabled.
+ *
+ * The two most common patterns to use the function with are:
+ *
+ * ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_NEWSTATE);
+ * ... call other function in new state ...
+ * ERTS_MSACC_POP_STATE();
+ *
+ * Note that the erts_msacc_push* function declare new variables, so
+ * to conform with C89 we have to call it in the beginning of a function.
+ * We might not want to change state it the beginning though, so we use this:
+ *
+ * ERTS_MSACC_PUSH_STATE();
+ * ... some other code ...
+ * ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_NEWSTATE);
+ * ... call other function in new state ...
+ * ERTS_MSACC_POP_STATE();
+ *
+ * Notice that we used the cached version of set_state as push_state already
+ * read the erts_msacc_enabled to the cache.
+ *
+ * Most macros also have other variants with the suffix _m which means that
+ * they are known to only be called in managed threads, or with the _x suffix
+ * which means that it should only be used in an emulator compiled with
+ * extended states.
+ *
+ * Here is a listing of the entire api:
+ *
+ * void ERTS_MSACC_DECLARE_CACHE()
+ * void ERTS_MSACC_UPDATE_CACHE()
+ * void ERTS_MSACC_IS_ENABLED()
+ * void ERTS_MSACC_IS_ENABLED_CACHED()
+ *
+ * void ERTS_MSACC_PUSH_STATE()
+ * void ERTS_MSACC_SET_STATE(int state)
+ * void ERTS_MSACC_PUSH_AND_SET_STATE(int state)
+ *
+ * void ERTS_MSACC_PUSH_STATE_CACHED()
+ * void ERTS_MSACC_SET_STATE_CACHED(int state)
+ * void ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(int state)
+ * void ERTS_MSACC_POP_STATE()
+ *
+ * void ERTS_MSACC_PUSH_STATE_M()
+ * void ERTS_MSACC_PUSH_STATE_CACHED_M()
+ * void ERTS_MSACC_SET_STATE_CACHED_M(int state)
+ * void ERTS_MSACC_SET_STATE_M(int state)
+ * void ERTS_MSACC_POP_STATE_M()
+ * void ERTS_MSACC_PUSH_AND_SET_STATE_M(int state)
+ *
+ * Most functions are also available with an _x suffix that are only enabled
+ * when using the extra states. If they are not, just add them to the end
+ * of this file.
+ */
+
+/* cache handling functions */
+#define ERTS_MSACC_IS_ENABLED() ERTS_UNLIKELY(erts_msacc_enabled)
+#define ERTS_MSACC_DECLARE_CACHE() \
+ ErtsMsAcc *ERTS_MSACC_UPDATE_CACHE(); \
+ ERTS_DECLARE_DUMMY(Uint __erts_msacc_state) = ERTS_MSACC_STATE_OTHER;
+#define ERTS_MSACC_IS_ENABLED_CACHED() ERTS_UNLIKELY(__erts_msacc_cache != NULL)
+#define ERTS_MSACC_UPDATE_CACHE() \
+ __erts_msacc_cache = erts_msacc_enabled ? ERTS_MSACC_TSD_GET() : NULL
+
+
+/* The defines below implicitly declare and load a new cache */
+#define ERTS_MSACC_PUSH_STATE() \
+ ERTS_MSACC_DECLARE_CACHE(); \
+ ERTS_MSACC_PUSH_STATE_CACHED()
+#define ERTS_MSACC_SET_STATE(state) \
+ ERTS_MSACC_DECLARE_CACHE(); \
+ ERTS_MSACC_SET_STATE_CACHED(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE(state) \
+ ERTS_MSACC_PUSH_STATE(); ERTS_MSACC_SET_STATE_CACHED(state)
+
+/* The defines below need an already declared cache to work */
+#define ERTS_MSACC_PUSH_STATE_CACHED() \
+ __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \
+ erts_msacc_get_state_um__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER
+#define ERTS_MSACC_SET_STATE_CACHED(state) \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) \
+ erts_msacc_set_state_um__(__erts_msacc_cache, state, 1)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state) \
+ ERTS_MSACC_PUSH_STATE_CACHED(); ERTS_MSACC_SET_STATE_CACHED(state)
+#define ERTS_MSACC_POP_STATE() \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) \
+ erts_msacc_set_state_um__(__erts_msacc_cache, __erts_msacc_state, 0)
+
+/* Only use these defines when we know that we have in a managed thread */
+#define ERTS_MSACC_PUSH_STATE_M() \
+ ERTS_MSACC_DECLARE_CACHE(); \
+ ERTS_MSACC_PUSH_STATE_CACHED_M()
+#define ERTS_MSACC_PUSH_STATE_CACHED_M() \
+ __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \
+ erts_msacc_get_state_m__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER
+#define ERTS_MSACC_SET_STATE_M(state) \
+ ERTS_MSACC_DECLARE_CACHE(); \
+ ERTS_MSACC_SET_STATE_CACHED_M(state)
+#define ERTS_MSACC_SET_STATE_CACHED_M(state) \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) \
+ erts_msacc_set_state_m__(__erts_msacc_cache, state, 1)
+#define ERTS_MSACC_POP_STATE_M() \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) \
+ erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) \
+ ERTS_MSACC_PUSH_STATE_M(); ERTS_MSACC_SET_STATE_CACHED_M(state)
+
+ERTS_MSACC_INLINE
+void erts_msacc_set_state_um__(ErtsMsAcc *msacc,Uint state,int increment);
+ERTS_MSACC_INLINE
+void erts_msacc_set_state_m__(ErtsMsAcc *msacc,Uint state,int increment);
+
+ERTS_MSACC_INLINE
+Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc);
+ERTS_MSACC_INLINE
+Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc);
+
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_MSACC_INLINE
+Uint erts_msacc_get_state_um__(ErtsMsAcc *msacc) {
+ Uint state;
+ if (msacc->unmanaged)
+ erts_mtx_lock(&msacc->mtx);
+ state = msacc->state;
+ if (msacc->unmanaged)
+ erts_mtx_unlock(&msacc->mtx);
+ return state;
+}
+
+ERTS_MSACC_INLINE
+Uint erts_msacc_get_state_m__(ErtsMsAcc *msacc) {
+ return msacc->state;
+}
+
+ERTS_MSACC_INLINE
+void erts_msacc_set_state_um__(ErtsMsAcc *msacc, Uint new_state, int increment) {
+ if (ERTS_UNLIKELY(msacc->unmanaged)) {
+ erts_mtx_lock(&msacc->mtx);
+ msacc->state = new_state;
+ if (ERTS_LIKELY(!msacc->perf_counter)) {
+ erts_mtx_unlock(&msacc->mtx);
+ return;
+ }
+ }
+
+ erts_msacc_set_state_m__(msacc,new_state,increment);
+
+ if (ERTS_UNLIKELY(msacc->unmanaged))
+ erts_mtx_unlock(&msacc->mtx);
+}
+
+ERTS_MSACC_INLINE
+void erts_msacc_set_state_m__(ErtsMsAcc *msacc, Uint new_state, int increment) {
+ ErtsSysPerfCounter prev_perf_counter;
+ Sint64 diff;
+
+ if (new_state == msacc->state)
+ return;
+
+ prev_perf_counter = msacc->perf_counter;
+ msacc->perf_counter = erts_sys_perf_counter();
+ diff = msacc->perf_counter - prev_perf_counter;
+ ASSERT(diff >= 0);
+ msacc->perf_counters[msacc->state] += diff;
+#ifdef ERTS_MSACC_STATE_COUNTERS
+ msacc->state_counters[new_state] += increment;
+#endif
+ msacc->state = new_state;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+#else
+
+#define ERTS_MSACC_IS_ENABLED() 0
+#define erts_msacc_early_init()
+#define erts_msacc_init()
+#define erts_msacc_init_thread(type, id, liberty)
+#define ERTS_MSACC_PUSH_STATE()
+#define ERTS_MSACC_PUSH_STATE_CACHED()
+#define ERTS_MSACC_POP_STATE()
+#define ERTS_MSACC_SET_STATE(state)
+#define ERTS_MSACC_SET_STATE_CACHED(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state)
+#define ERTS_MSACC_UPDATE_CACHE()
+#define ERTS_MSACC_IS_ENABLED_CACHED()
+#define ERTS_MSACC_DECLARE_CACHE()
+#define ERTS_MSACC_PUSH_STATE_M()
+#define ERTS_MSACC_PUSH_STATE_CACHED_M()
+#define ERTS_MSACC_SET_STATE_CACHED_M(state)
+#define ERTS_MSACC_POP_STATE_M()
+#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state)
+
+
+#endif /* ERTS_ENABLE_MSACC */
+
+#ifndef ERTS_MSACC_EXTENDED_STATES
+
+#define ERTS_MSACC_PUSH_STATE_X()
+#define ERTS_MSACC_POP_STATE_X()
+#define ERTS_MSACC_SET_STATE_X(state)
+#define ERTS_MSACC_SET_STATE_M_X(state)
+#define ERTS_MSACC_SET_STATE_CACHED_X(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state)
+#define ERTS_MSACC_UPDATE_CACHE_X()
+#define ERTS_MSACC_IS_ENABLED_CACHED_X() 0
+#define ERTS_MSACC_DECLARE_CACHE_X()
+#define ERTS_MSACC_PUSH_STATE_M_X()
+#define ERTS_MSACC_PUSH_STATE_CACHED_M_X()
+#define ERTS_MSACC_SET_STATE_CACHED_M_X(state)
+#define ERTS_MSACC_POP_STATE_M_X()
+#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state)
+
+#else
+
+#define ERTS_MSACC_PUSH_STATE_X() ERTS_MSACC_PUSH_STATE()
+#define ERTS_MSACC_POP_STATE_X() ERTS_MSACC_POP_STATE()
+#define ERTS_MSACC_SET_STATE_X(state) ERTS_MSACC_SET_STATE(state)
+#define ERTS_MSACC_SET_STATE_M_X(state) ERTS_MSACC_SET_STATE_M(state)
+#define ERTS_MSACC_SET_STATE_CACHED_X(state) ERTS_MSACC_SET_STATE_CACHED(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_X(state) ERTS_MSACC_PUSH_AND_SET_STATE(state)
+#define ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_CACHED(state)
+#define ERTS_MSACC_UPDATE_CACHE_X() ERTS_MSACC_UPDATE_CACHE()
+#define ERTS_MSACC_IS_ENABLED_CACHED_X() ERTS_MSACC_IS_ENABLED_CACHED()
+#define ERTS_MSACC_DECLARE_CACHE_X() ERTS_MSACC_DECLARE_CACHE()
+#define ERTS_MSACC_PUSH_STATE_M_X() ERTS_MSACC_PUSH_STATE_M()
+#define ERTS_MSACC_PUSH_STATE_CACHED_M_X() ERTS_MSACC_PUSH_STATE_CACHED_M()
+#define ERTS_MSACC_SET_STATE_CACHED_M_X(state) ERTS_MSACC_SET_STATE_CACHED_M(state)
+#define ERTS_MSACC_POP_STATE_M_X() ERTS_MSACC_POP_STATE_M()
+#define ERTS_MSACC_PUSH_AND_SET_STATE_M_X(state) ERTS_MSACC_PUSH_AND_SET_STATE_M(state)
+
+#endif /* !ERTS_MSACC_EXTENDED_STATES */
+
+#endif /* ERL_MSACC_H__ */
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index add4a66f90..8580bc2689 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -314,6 +314,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ErtsProcLocks rp_locks = 0;
Process* rp;
Process* c_p;
+ ErtsMessage *mp;
ErlHeapFragment* frags;
Eterm receiver = to_pid->pid;
int flush_me = 0;
@@ -330,7 +331,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
#ifdef ERTS_SMP
c_p = NULL;
#else
- erl_exit(ERTS_ABORT_EXIT,"enif_send: env==NULL on non-SMP VM");
+ erts_exit(ERTS_ABORT_EXIT,"enif_send: env==NULL on non-SMP VM");
#endif
}
@@ -347,7 +348,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ASSERT(frags == MBUF(&menv->phony_proc));
if (frags != NULL) {
/* Move all offheap's from phony proc to the first fragment.
- Quick and dirty, but erts_move_msg_mbuf_to_heap doesn't care. */
+ Quick and dirty... */
ASSERT(!is_offheap(&frags->off_heap));
frags->off_heap = MSO(&menv->phony_proc);
clear_offheap(&MSO(&menv->phony_proc));
@@ -359,7 +360,9 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
if (flush_me) {
flush_env(env); /* Needed for ERTS_HOLE_CHECK */
}
- erts_queue_message(rp, &rp_locks, frags, msg, am_undefined);
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = frags;
+ erts_queue_message(rp, &rp_locks, mp, msg, am_undefined);
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks)
@@ -376,9 +379,19 @@ ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)
{
Uint sz;
Eterm* hp;
+#ifdef SHCOPY
+ erts_shcopy_t info;
+ INITIALIZE_SHCOPY(info);
+ sz = copy_shared_calculate(src_term, &info);
+ hp = alloc_heap(dst_env, sz);
+ src_term = copy_shared_perform(src_term, sz, &info, &hp, &MSO(dst_env->proc));
+ DESTROY_SHCOPY(info);
+ return src_term;
+#else
sz = size_object(src_term);
hp = alloc_heap(dst_env, sz);
return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc));
+#endif
}
@@ -898,8 +911,13 @@ int enif_get_list_cell(ErlNifEnv* env, Eterm term, Eterm* head, Eterm* tail)
int enif_get_list_length(ErlNifEnv* env, Eterm term, unsigned* len)
{
- if (is_not_list(term) && is_not_nil(term)) return 0;
- *len = erts_list_length(term);
+ Sint i;
+ Uint u;
+
+ if ((i = erts_list_length(term)) < 0) return 0;
+ u = (Uint)i;
+ if ((unsigned)u != u) return 0;
+ *len = u;
return 1;
}
@@ -1173,6 +1191,27 @@ ErlNifTid enif_thread_self(void) { return erl_drv_thread_self(); }
int enif_equal_tids(ErlNifTid tid1, ErlNifTid tid2) { return erl_drv_equal_tids(tid1,tid2); }
void enif_thread_exit(void *resp) { erl_drv_thread_exit(resp); }
int enif_thread_join(ErlNifTid tid, void **respp) { return erl_drv_thread_join(tid,respp); }
+int enif_getenv(const char *key, char *value, size_t *value_size) { return erl_drv_getenv(key, value, value_size); }
+
+ErlNifTime enif_monotonic_time(ErlNifTimeUnit time_unit)
+{
+ return (ErlNifTime) erts_napi_monotonic_time((int) time_unit);
+}
+
+ErlNifTime enif_time_offset(ErlNifTimeUnit time_unit)
+{
+ return (ErlNifTime) erts_napi_time_offset((int) time_unit);
+}
+
+ErlNifTime
+enif_convert_time_unit(ErlNifTime val,
+ ErlNifTimeUnit from,
+ ErlNifTimeUnit to)
+{
+ return (ErlNifTime) erts_napi_convert_time_unit((ErtsMonotonicTime) val,
+ (int) from,
+ (int) to);
+}
int enif_fprintf(void* filep, const char* format, ...)
{
@@ -1771,12 +1810,10 @@ execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc);
ASSERT(ep);
ep->fp = NULL;
+ erts_smp_atomic32_read_band_mb(&proc->state, ~(ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_IO_PROC));
result = (*fp)(env, argc, argv);
- erts_smp_atomic32_read_band_mb(&proc->state,
- ~(ERTS_PSFLG_DIRTY_CPU_PROC
- |ERTS_PSFLG_DIRTY_IO_PROC
- |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q
- |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q));
+
if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL)
close_lib(env->mod_nif);
/*
@@ -1824,13 +1861,6 @@ schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[
a = erts_smp_atomic32_read_acqb(&proc->state);
while (1) {
n = state = a;
- /*
- * clear any current dirty flags and dirty queue indicators,
- * in case the application is shifting a job from one type
- * of dirty scheduler to the other
- */
- n &= ~(ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC
- |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q);
if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND)
n |= ERTS_PSFLG_DIRTY_CPU_PROC;
else
@@ -2230,17 +2260,17 @@ int enif_map_iterator_get_pair(ErlNifEnv *env,
***************************************************************************/
-static BeamInstr** get_func_pp(BeamInstr* mod_code, Eterm f_atom, unsigned arity)
+static BeamInstr** get_func_pp(BeamCodeHeader* mod_code, Eterm f_atom, unsigned arity)
{
- int n = (int) mod_code[MI_NUM_FUNCTIONS];
+ int n = (int) mod_code->num_functions;
int j;
for (j = 0; j < n; ++j) {
- BeamInstr* code_ptr = (BeamInstr*) mod_code[MI_FUNCTIONS+j];
+ BeamInstr* code_ptr = (BeamInstr*) mod_code->functions[j];
ASSERT(code_ptr[0] == (BeamInstr) BeamOp(op_i_func_info_IaaI));
if (f_atom == ((Eterm) code_ptr[3])
&& arity == ((unsigned) code_ptr[4])) {
- return (BeamInstr**) &mod_code[MI_FUNCTIONS+j];
+ return (BeamInstr**) &mod_code->functions[j];
}
}
return NULL;
@@ -2423,8 +2453,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
if (init_func != NULL)
handle = init_func;
- if (!in_area(caller, mod->curr.code, mod->curr.code_length)) {
- ASSERT(in_area(caller, mod->old.code, mod->old.code_length));
+ if (!in_area(caller, mod->curr.code_hdr, mod->curr.code_length)) {
+ ASSERT(in_area(caller, mod->old.code_hdr, mod->old.code_length));
ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old "
"module '%T' not allowed", mod_atom);
@@ -2478,7 +2508,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) {
BeamInstr** code_pp;
if (!erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1)
- || (code_pp = get_func_pp(mod->curr.code, f_atom, f->arity))==NULL) {
+ || (code_pp = get_func_pp(mod->curr.code_hdr, f_atom, f->arity))==NULL) {
ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u",
mod_atom, f->name, f->arity);
}
@@ -2621,7 +2651,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2)
{
BeamInstr* code_ptr;
erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1);
- code_ptr = *get_func_pp(mod->curr.code, f_atom, f->arity);
+ code_ptr = *get_func_pp(mod->curr.code_hdr, f_atom, f->arity);
if (code_ptr[1] == 0) {
code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif);
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index 7d880126f8..c9c8b1d0af 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -48,9 +48,11 @@
** add ErlNifEntry options
** add ErlNifFunc flags
** 2.8: 18.0 add enif_has_pending_exception
+** 2.9: 18.2 enif_getenv
+** 2.10: Time API
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 8
+#define ERL_NIF_MINOR_VERSION 10
/*
* The emulator will refuse to load a nif-lib with a major version
@@ -66,63 +68,31 @@
#include <stdlib.h>
-#ifdef SIZEOF_CHAR
-# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR
-# undef SIZEOF_CHAR
-#endif
-#ifdef SIZEOF_SHORT
-# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT
-# undef SIZEOF_SHORT
-#endif
-#ifdef SIZEOF_INT
-# define SIZEOF_INT_SAVED__ SIZEOF_INT
-# undef SIZEOF_INT
-#endif
-#ifdef SIZEOF_LONG
-# define SIZEOF_LONG_SAVED__ SIZEOF_LONG
-# undef SIZEOF_LONG
-#endif
-#ifdef SIZEOF_LONG_LONG
-# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG
-# undef SIZEOF_LONG_LONG
-#endif
-#ifdef HALFWORD_HEAP_EMULATOR
-# define HALFWORD_HEAP_EMULATOR_SAVED__ HALFWORD_HEAP_EMULATOR
-# undef HALFWORD_HEAP_EMULATOR
-#endif
-#include "erl_int_sizes_config.h"
-
#ifdef __cplusplus
extern "C" {
#endif
-#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
-typedef unsigned __int64 ErlNifUInt64;
-typedef __int64 ErlNifSInt64;
-#elif SIZEOF_LONG == 8
-typedef unsigned long ErlNifUInt64;
-typedef long ErlNifSInt64;
-#elif SIZEOF_LONG_LONG == 8
-typedef unsigned long long ErlNifUInt64;
-typedef long long ErlNifSInt64;
-#else
-#error No 64-bit integer type
-#endif
+typedef ErlNapiUInt64 ErlNifUInt64;
+typedef ErlNapiSInt64 ErlNifSInt64;
+typedef ErlNapiUInt ErlNifUInt;
+typedef ErlNapiSInt ErlNifSInt;
-#ifdef HALFWORD_HEAP_EMULATOR
-# define ERL_NIF_VM_VARIANT "beam.halfword"
-typedef unsigned int ERL_NIF_TERM;
-#else
# define ERL_NIF_VM_VARIANT "beam.vanilla"
-# if SIZEOF_LONG == SIZEOF_VOID_P
-typedef unsigned long ERL_NIF_TERM;
-# elif SIZEOF_LONG_LONG == SIZEOF_VOID_P
-typedef unsigned long long ERL_NIF_TERM;
-# endif
-#endif
+typedef ErlNifUInt ERL_NIF_TERM;
typedef ERL_NIF_TERM ERL_NIF_UINT;
+typedef ErlNifSInt64 ErlNifTime;
+
+#define ERL_NIF_TIME_ERROR ((ErlNifSInt64) ERTS_NAPI_TIME_ERROR__)
+
+typedef enum {
+ ERL_NIF_SEC = ERTS_NAPI_SEC__,
+ ERL_NIF_MSEC = ERTS_NAPI_MSEC__,
+ ERL_NIF_USEC = ERTS_NAPI_USEC__,
+ ERL_NIF_NSEC = ERTS_NAPI_NSEC__
+} ErlNifTimeUnit;
+
struct enif_environment_t;
typedef struct enif_environment_t ErlNifEnv;
@@ -231,6 +201,7 @@ typedef enum {
# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS
typedef struct {
# include "erl_nif_api_funcs.h"
+ void* erts_alc_test;
} TWinDynNifCallbacks;
extern TWinDynNifCallbacks WinDynNifCallbacks;
# undef ERL_NIF_API_FUNC_DECL
@@ -250,22 +221,28 @@ extern TWinDynNifCallbacks WinDynNifCallbacks;
#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
# define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks;
-# ifdef STATIC_ERLANG_NIF
-# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* MODNAME ## _nif_init(TWinDynNifCallbacks* callbacks)
-# else
-# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks)
-# endif
+# define ERL_NIF_INIT_ARGS TWinDynNifCallbacks* callbacks
# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks))
+# define ERL_NIF_INIT_EXPORT __declspec(dllexport)
#else
# define ERL_NIF_INIT_GLOB
+# define ERL_NIF_INIT_ARGS void
# define ERL_NIF_INIT_BODY
-# ifdef STATIC_ERLANG_NIF
-# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(void)
+# if defined(__GNUC__) && __GNUC__ >= 4
+# define ERL_NIF_INIT_EXPORT __attribute__ ((visibility("default")))
+# elif defined (__SUNPRO_C) && (__SUNPRO_C >= 0x550)
+# define ERL_NIF_INIT_EXPORT __global
# else
-# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void)
+# define ERL_NIF_INIT_EXPORT
# endif
#endif
+#ifdef STATIC_ERLANG_NIF
+# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(ERL_NIF_INIT_ARGS)
+#else
+# define ERL_NIF_INIT_DECL(MODNAME) ERL_NIF_INIT_EXPORT ErlNifEntry* nif_init(ERL_NIF_INIT_ARGS)
+#endif
+
#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
# define ERL_NIF_ENTRY_OPTIONS ERL_NIF_DIRTY_NIF_OPTION
#else
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index 2f2180e1aa..1448a508a2 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -159,6 +159,10 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMa
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_nif,(ErlNifEnv*,const char*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[]));
ERL_NIF_API_FUNC_DECL(int, enif_has_pending_exception, (ErlNifEnv *env, ERL_NIF_TERM* reason));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_raise_exception, (ErlNifEnv *env, ERL_NIF_TERM reason));
+ERL_NIF_API_FUNC_DECL(int,enif_getenv,(const char* key, char* value, size_t* value_size));
+ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_monotonic_time, (ErlNifTimeUnit));
+ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_time_offset, (ErlNifTimeUnit));
+ERL_NIF_API_FUNC_DECL(ErlNifTime, enif_convert_time_unit, (ErlNifTime, ErlNifTimeUnit, ErlNifTimeUnit));
/*
** ADD NEW ENTRIES HERE (before this comment) !!!
@@ -310,6 +314,10 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*));
# define enif_schedule_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_nif)
# define enif_has_pending_exception ERL_NIF_API_FUNC_MACRO(enif_has_pending_exception)
# define enif_raise_exception ERL_NIF_API_FUNC_MACRO(enif_raise_exception)
+# define enif_getenv ERL_NIF_API_FUNC_MACRO(enif_getenv)
+# define enif_monotonic_time ERL_NIF_API_FUNC_MACRO(enif_monotonic_time)
+# define enif_time_offset ERL_NIF_API_FUNC_MACRO(enif_time_offset)
+# define enif_convert_time_unit ERL_NIF_API_FUNC_MACRO(enif_convert_time_unit)
/*
** ADD NEW ENTRIES HERE (before this comment)
diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h
index 211b1a0090..b6a3531e28 100644
--- a/erts/emulator/beam/erl_node_container_utils.h
+++ b/erts/emulator/beam/erl_node_container_utils.h
@@ -255,7 +255,7 @@ extern ErtsPTab erts_port;
* Refs *
\* */
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define internal_ref_no_of_numbers(x) \
(internal_ref_data((x))[0])
@@ -328,8 +328,6 @@ extern ErtsPTab erts_port;
: external_ref_channel_no((x)))
#define is_ref(x) (is_internal_ref((x)) \
|| is_external_ref((x)))
-#define is_ref_rel(x,Base) (is_internal_ref_rel((x),Base) \
- || is_external_ref_rel((x),Base))
#define is_not_ref(x) (!is_ref(x))
#endif
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index 2fb790b953..8617f42d7b 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -37,18 +37,18 @@ erts_smp_rwmtx_t erts_node_table_rwmtx;
DistEntry *erts_hidden_dist_entries;
DistEntry *erts_visible_dist_entries;
-DistEntry *erts_not_connected_dist_entries;
+DistEntry *erts_not_connected_dist_entries; /* including erts_this_dist_entry */
Sint erts_no_of_hidden_dist_entries;
Sint erts_no_of_visible_dist_entries;
-Sint erts_no_of_not_connected_dist_entries;
+Sint erts_no_of_not_connected_dist_entries; /* including erts_this_dist_entry */
DistEntry *erts_this_dist_entry;
ErlNode *erts_this_node;
char erts_this_node_sysname_BUFFER[256],
*erts_this_node_sysname = "uninitialized yet";
-static Uint node_entries;
-static Uint dist_entries;
+static Uint node_entries = 0;
+static Uint dist_entries = 0;
static int references_atoms_need_init = 1;
@@ -91,9 +91,6 @@ dist_table_alloc(void *dep_tmpl)
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
- if(((DistEntry *) dep_tmpl) == erts_this_dist_entry)
- return dep_tmpl;
-
sysname = ((DistEntry *) dep_tmpl)->sysname;
chnl_nr = make_small((Uint) atom_val(sysname));
dep = (DistEntry *) erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry));
@@ -132,7 +129,9 @@ dist_table_alloc(void *dep_tmpl)
/* Link in */
- /* All new dist entries are "not connected" */
+ /* All new dist entries are "not connected".
+ * erts_this_dist_entry is also always included among "not connected"
+ */
dep->next = erts_not_connected_dist_entries;
if(erts_not_connected_dist_entries) {
ASSERT(erts_not_connected_dist_entries->prev == NULL);
@@ -149,9 +148,6 @@ dist_table_free(void *vdep)
{
DistEntry *dep = (DistEntry *) vdep;
- if(dep == erts_this_dist_entry)
- return;
-
ASSERT(is_nil(dep->cid));
ASSERT(dep->nlinks == NULL);
ASSERT(dep->node_links == NULL);
@@ -186,7 +182,7 @@ dist_table_free(void *vdep)
#endif
erts_free(ERTS_ALC_T_DIST_ENTRY, (void *) dep);
- ASSERT(dist_entries > 1);
+ ASSERT(dist_entries > 0);
dist_entries--;
}
@@ -306,7 +302,7 @@ static void try_delete_dist_entry(void *vdep)
* thread incremented refc twice. Once for the new reference
* and once for this thread.
*
- * If refc reach -1, noone has used the entry since we
+ * If refc reach -1, no one has used the entry since we
* set up the timer. Delete the entry.
*
* If refc reach 0, the entry is currently not in use
@@ -369,8 +365,7 @@ erts_dist_table_size(void)
ASSERT(dist_entries == (erts_no_of_visible_dist_entries
+ erts_no_of_hidden_dist_entries
- + erts_no_of_not_connected_dist_entries
- + 1 /* erts_this_dist_entry */));
+ + erts_no_of_not_connected_dist_entries));
#endif
res = (hash_table_sz(&erts_dist_table)
@@ -543,9 +538,6 @@ node_table_alloc(void *venp_tmpl)
{
ErlNode *enp;
- if(((ErlNode *) venp_tmpl) == erts_this_node)
- return venp_tmpl;
-
enp = (ErlNode *) erts_alloc(ERTS_ALC_T_NODE_ENTRY, sizeof(ErlNode));
node_entries++;
@@ -563,8 +555,7 @@ node_table_free(void *venp)
{
ErlNode *enp = (ErlNode *) venp;
- if(enp == erts_this_node)
- return;
+ ERTS_SMP_LC_ASSERT(enp != erts_this_node || erts_thr_progress_is_blocking());
erts_deref_dist_entry(enp->dist_entry);
#ifdef DEBUG
@@ -572,7 +563,7 @@ node_table_free(void *venp)
#endif
erts_free(ERTS_ALC_T_NODE_ENTRY, venp);
- ASSERT(node_entries > 1);
+ ASSERT(node_entries > 0);
node_entries--;
}
@@ -650,7 +641,7 @@ static void try_delete_node(void *venp)
* thread incremented refc twice. Once for the new reference
* and once for this thread.
*
- * If refc reach -1, noone has used the entry since we
+ * If refc reach -1, no one has used the entry since we
* set up the timer. Delete the entry.
*
* If refc reach 0, the entry is currently not in use
@@ -747,25 +738,24 @@ void erts_print_node_info(int to,
void
erts_set_this_node(Eterm sysname, Uint creation)
{
- erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx);
- erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx);
+ ERTS_SMP_LC_ASSERT(erts_thr_progress_is_blocking());
+ ASSERT(erts_refc_read(&erts_this_dist_entry->refc, 2));
- (void) hash_erase(&erts_dist_table, (void *) erts_this_dist_entry);
- erts_this_dist_entry->sysname = sysname;
- erts_this_dist_entry->creation = creation;
- (void) hash_put(&erts_dist_table, (void *) erts_this_dist_entry);
+ if (erts_refc_dectest(&erts_this_node->refc, 0) == 0)
+ try_delete_node(erts_this_node);
- (void) hash_erase(&erts_node_table, (void *) erts_this_node);
- erts_this_node->sysname = sysname;
- erts_this_node->creation = creation;
- erts_this_node_sysname = erts_this_node_sysname_BUFFER;
- erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER),
- "%T", sysname);
- (void) hash_put(&erts_node_table, (void *) erts_this_node);
+ if (erts_refc_dectest(&erts_this_dist_entry->refc, 0) == 0)
+ try_delete_dist_entry(erts_this_dist_entry);
- erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx);
- erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx);
+ erts_this_node = NULL; /* to make sure refc is bumped for this node */
+ erts_this_node = erts_find_or_insert_node(sysname, creation);
+ erts_this_dist_entry = erts_this_node->dist_entry;
+
+ erts_refc_inc(&erts_this_dist_entry->refc, 2);
+ erts_this_node_sysname = erts_this_node_sysname_BUFFER;
+ erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER),
+ "%T", sysname);
}
Uint
@@ -782,6 +772,7 @@ void erts_init_node_tables(int dd_sec)
{
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
HashFunctions f;
+ ErlNode node_tmpl;
if (dd_sec == ERTS_NODE_TAB_DELAY_GC_INFINITY)
node_tab_delete_delay = (ErtsMonotonicTime) -1;
@@ -793,16 +784,24 @@ void erts_init_node_tables(int dd_sec)
rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_FREQUENT_READ;
rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED;
- f.hash = (H_FUN) dist_table_hash;
- f.cmp = (HCMP_FUN) dist_table_cmp;
- f.alloc = (HALLOC_FUN) dist_table_alloc;
- f.free = (HFREE_FUN) dist_table_free;
-
- erts_this_dist_entry = erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry));
- dist_entries = 1;
+ erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table");
+ erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table");
+ f.hash = (H_FUN) dist_table_hash;
+ f.cmp = (HCMP_FUN) dist_table_cmp;
+ f.alloc = (HALLOC_FUN) dist_table_alloc;
+ f.free = (HFREE_FUN) dist_table_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_DIST_TABLE, &erts_dist_table, "dist_table", 11, f);
+ f.hash = (H_FUN) node_table_hash;
+ f.cmp = (HCMP_FUN) node_table_cmp;
+ f.alloc = (HALLOC_FUN) node_table_alloc;
+ f.free = (HFREE_FUN) node_table_free;
+ hash_init(ERTS_ALC_T_NODE_TABLE, &erts_node_table, "node_table", 11, f);
+
erts_hidden_dist_entries = NULL;
erts_visible_dist_entries = NULL;
erts_not_connected_dist_entries = NULL;
@@ -810,69 +809,23 @@ void erts_init_node_tables(int dd_sec)
erts_no_of_visible_dist_entries = 0;
erts_no_of_not_connected_dist_entries = 0;
- erts_this_dist_entry->next = NULL;
- erts_this_dist_entry->prev = NULL;
- erts_refc_init(&erts_this_dist_entry->refc, 1); /* erts_this_node */
-
- erts_smp_rwmtx_init_opt_x(&erts_this_dist_entry->rwmtx,
- &rwmtx_opt,
- "dist_entry",
- make_small(ERST_INTERNAL_CHANNEL_NO));
- erts_this_dist_entry->sysname = am_Noname;
- erts_this_dist_entry->cid = NIL;
- erts_this_dist_entry->connection_id = 0;
- erts_this_dist_entry->status = 0;
- erts_this_dist_entry->flags = 0;
- erts_this_dist_entry->version = 0;
-
- erts_smp_mtx_init_x(&erts_this_dist_entry->lnk_mtx,
- "dist_entry_links",
- make_small(ERST_INTERNAL_CHANNEL_NO));
- erts_this_dist_entry->node_links = NULL;
- erts_this_dist_entry->nlinks = NULL;
- erts_this_dist_entry->monitors = NULL;
-
- erts_smp_mtx_init_x(&erts_this_dist_entry->qlock,
- "dist_entry_out_queue",
- make_small(ERST_INTERNAL_CHANNEL_NO));
- erts_this_dist_entry->qflgs = 0;
- erts_this_dist_entry->qsize = 0;
- erts_this_dist_entry->out_queue.first = NULL;
- erts_this_dist_entry->out_queue.last = NULL;
- erts_this_dist_entry->suspended = NULL;
-
- erts_this_dist_entry->finalized_out_queue.first = NULL;
- erts_this_dist_entry->finalized_out_queue.last = NULL;
- erts_smp_atomic_init_nob(&erts_this_dist_entry->dist_cmd_scheduled, 0);
- erts_port_task_handle_init(&erts_this_dist_entry->dist_cmd);
- erts_this_dist_entry->send = NULL;
- erts_this_dist_entry->cache = NULL;
-
- (void) hash_put(&erts_dist_table, (void *) erts_this_dist_entry);
-
- f.hash = (H_FUN) node_table_hash;
- f.cmp = (HCMP_FUN) node_table_cmp;
- f.alloc = (HALLOC_FUN) node_table_alloc;
- f.free = (HFREE_FUN) node_table_free;
+ node_tmpl.sysname = am_Noname;
+ node_tmpl.creation = 0;
+ erts_this_node = hash_put(&erts_node_table, &node_tmpl);
+ /* +1 for erts_this_node */
+ erts_refc_init(&erts_this_node->refc, 1);
- hash_init(ERTS_ALC_T_NODE_TABLE, &erts_node_table, "node_table", 11, f);
+ ASSERT(erts_this_node->dist_entry != NULL);
+ erts_this_dist_entry = erts_this_node->dist_entry;
+ /* +1 for erts_this_dist_entry */
+ /* +1 for erts_this_node->dist_entry */
+ erts_refc_init(&erts_this_dist_entry->refc, 2);
- erts_this_node = erts_alloc(ERTS_ALC_T_NODE_ENTRY, sizeof(ErlNode));
- node_entries = 1;
- erts_refc_init(&erts_this_node->refc, 1); /* The system itself */
- erts_this_node->sysname = am_Noname;
- erts_this_node->creation = 0;
- erts_this_node->dist_entry = erts_this_dist_entry;
erts_this_node_sysname = erts_this_node_sysname_BUFFER;
erts_snprintf(erts_this_node_sysname, sizeof(erts_this_node_sysname_BUFFER),
"%T", erts_this_node->sysname);
- (void) hash_put(&erts_node_table, (void *) erts_this_node);
-
- erts_smp_rwmtx_init_opt(&erts_node_table_rwmtx, &rwmtx_opt, "node_table");
- erts_smp_rwmtx_init_opt(&erts_dist_table_rwmtx, &rwmtx_opt, "dist_table");
-
references_atoms_need_init = 1;
}
@@ -1100,7 +1053,7 @@ insert_dist_entry(DistEntry *dist, int type, Eterm id, Uint creation)
}
if(!rdp)
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"Reference to non-existing distribution table entry found!\n");
insert_dist_referrer(rdp, type, id, creation);
@@ -1161,7 +1114,7 @@ insert_node(ErlNode *node, int type, Eterm id)
}
if (!rnp)
- erl_exit(1, "Reference to non-existing node table entry found!\n");
+ erts_exit(ERTS_ERROR_EXIT, "Reference to non-existing node table entry found!\n");
insert_node_referrer(rnp, type, id);
}
@@ -1207,23 +1160,11 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
break;
}
if (insert_bin) {
-#if HALFWORD_HEAP
- UWord val = (UWord) u.pb->val;
- DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE*2); /* extra place allocated */
-#else
DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE);
-#endif
Uint *hp = &id_heap[0];
InsertedBin *nib;
-#if HALFWORD_HEAP
- int actual_need = BIG_UWORD_HEAP_SIZE(val);
- ASSERT(actual_need <= (BIG_UINT_HEAP_SIZE*2));
- UseTmpHeapNoproc(actual_need);
- a.id = erts_bld_uword(&hp, NULL, (UWord) val);
-#else
UseTmpHeapNoproc(BIG_UINT_HEAP_SIZE);
a.id = erts_bld_uint(&hp, NULL, (Uint) u.pb->val);
-#endif
erts_match_prog_foreach_offheap(u.pb->val,
insert_offheap2,
(void *) &a);
@@ -1231,11 +1172,7 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
nib->bin_val = u.pb->val;
nib->next = inserted_bins;
inserted_bins = nib;
-#if HALFWORD_HEAP
- UnUseTmpHeapNoproc(actual_need);
-#else
UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE);
-#endif
}
}
break;
@@ -1410,6 +1347,10 @@ setup_reference_table(void)
SYSTEM_REF,
TUPLE2(&heap[0], AM_system, am_undefined));
+ insert_dist_entry(erts_this_dist_entry,
+ SYSTEM_REF,
+ TUPLE2(&heap[0], AM_system, am_undefined),
+ erts_this_node->creation);
UnUseTmpHeapNoproc(3);
max = erts_ptab_max(&erts_proc);
@@ -1417,67 +1358,55 @@ setup_reference_table(void)
for (i = 0; i < max; i++) {
Process *proc = erts_pix2proc(i);
if (proc) {
- ErlMessage *msg;
+ int mli;
+ ErtsMessage *msg_list[] = {
+ proc->msg.first,
+#ifdef ERTS_SMP
+ proc->msg_inq.first,
+#endif
+ proc->msg_frag};
/* Insert Heap */
insert_offheap(&(proc->off_heap),
HEAP_REF,
proc->common.id);
- /* Insert message buffers */
+ /* Insert heap fragments buffers */
for(hfp = proc->mbuf; hfp; hfp = hfp->next)
insert_offheap(&(hfp->off_heap),
HEAP_REF,
proc->common.id);
- /* Insert msg msg buffers */
- for (msg = proc->msg.first; msg; msg = msg->next) {
- ErlHeapFragment *heap_frag = NULL;
- if (msg->data.attached) {
- if (is_value(ERL_MESSAGE_TERM(msg)))
- heap_frag = msg->data.heap_frag;
- else {
- if (msg->data.dist_ext->dep)
- insert_dist_entry(msg->data.dist_ext->dep,
- HEAP_REF, proc->common.id, 0);
- if (is_not_nil(ERL_MESSAGE_TOKEN(msg)))
- heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
+
+ /* Insert msg buffers */
+ for (mli = 0; mli < sizeof(msg_list)/sizeof(msg_list[0]); mli++) {
+ ErtsMessage *msg;
+ for (msg = msg_list[mli]; msg; msg = msg->next) {
+ ErlHeapFragment *heap_frag = NULL;
+ if (msg->data.attached) {
+ if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ heap_frag = &msg->hfrag;
+ else if (is_value(ERL_MESSAGE_TERM(msg)))
+ heap_frag = msg->data.heap_frag;
+ else {
+ if (msg->data.dist_ext->dep)
+ insert_dist_entry(msg->data.dist_ext->dep,
+ HEAP_REF, proc->common.id, 0);
+ if (is_not_nil(ERL_MESSAGE_TOKEN(msg)))
+ heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
+ }
}
- }
- if (heap_frag)
- insert_offheap(&(heap_frag->off_heap),
- HEAP_REF,
- proc->common.id);
- }
-#ifdef ERTS_SMP
- for (msg = proc->msg_inq.first; msg; msg = msg->next) {
- ErlHeapFragment *heap_frag = NULL;
- if (msg->data.attached) {
- if (is_value(ERL_MESSAGE_TERM(msg)))
- heap_frag = msg->data.heap_frag;
- else {
- if (msg->data.dist_ext->dep)
- insert_dist_entry(msg->data.dist_ext->dep,
- HEAP_REF, proc->common.id, 0);
- if (is_not_nil(ERL_MESSAGE_TOKEN(msg)))
- heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
+ while (heap_frag) {
+ insert_offheap(&(heap_frag->off_heap),
+ HEAP_REF,
+ proc->common.id);
+ heap_frag = heap_frag->next;
}
}
- if (heap_frag)
- insert_offheap(&(heap_frag->off_heap),
- HEAP_REF,
- proc->common.id);
}
-#endif
/* Insert links */
if (ERTS_P_LINKS(proc))
insert_links(ERTS_P_LINKS(proc), proc->common.id);
if (ERTS_P_MONITORS(proc))
insert_monitors(ERTS_P_MONITORS(proc), proc->common.id);
- /* Insert controller */
- {
- DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(proc);
- if (dep)
- insert_dist_entry(dep, CTRL_REF, proc->common.id, 0);
- }
}
}
diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h
index 694ac84232..fb2f2a5407 100644
--- a/erts/emulator/beam/erl_node_tables.h
+++ b/erts/emulator/beam/erl_node_tables.h
@@ -41,6 +41,7 @@
#include "sys.h"
#include "hash.h"
+#include "erl_alloc.h"
#include "erl_process.h"
#include "erl_monitors.h"
#include "erl_smp.h"
@@ -66,7 +67,7 @@
#define ERTS_DE_QFLGS_ALL (ERTS_DE_QFLG_BUSY \
| ERTS_DE_QFLG_EXIT)
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713f713f713UL)
#else
#define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713)
diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h
index acd68ef0ad..fa97707a87 100644
--- a/erts/emulator/beam/erl_port.h
+++ b/erts/emulator/beam/erl_port.h
@@ -187,6 +187,11 @@ struct _erl_drv_port {
ErtsPrtSD *psd; /* Port specific data */
int reds; /* Only used while executing driver callbacks */
+
+ struct {
+ Eterm to;
+ Uint32 ref[ERTS_MAX_REF_NUMBERS];
+ } *async_open_port; /* Reference used with async open port */
};
@@ -687,7 +692,7 @@ erts_drvport2port_state(ErlDrvPort drvport, erts_aint32_t *statep)
Port *prt = ERTS_ErlDrvPort2Port(drvport);
erts_aint32_t state;
ASSERT(prt);
- ERTS_LC_ASSERT(erts_lc_is_emu_thr());
+// ERTS_LC_ASSERT(erts_lc_is_emu_thr());
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return ERTS_INVALID_ERL_DRV_PORT;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)
@@ -944,4 +949,9 @@ ErtsPortOpResult erts_port_control(Process *, Port *, unsigned int, Eterm, Eterm
ErtsPortOpResult erts_port_call(Process *, Port *, unsigned int, Eterm, Eterm *);
ErtsPortOpResult erts_port_info(Process *, Port *, Eterm, Eterm *);
+/*
+ * Signals from ports to ports. Used by sys drivers.
+ */
+int erl_drv_port_control(Eterm, char, char*, ErlDrvSizeT);
+
#endif
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index 5c38db1cbc..e85395e062 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -1648,6 +1648,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
int active;
Uint64 start_time = 0;
ErtsSchedulerData *esdp = runq->scheduler;
+ ERTS_MSACC_PUSH_STATE_M();
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq));
@@ -1690,6 +1691,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
state = erts_atomic32_read_nob(&pp->state);
pp->reds = ERTS_PORT_REDS_EXECUTE;
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
goto begin_handle_tasks;
while (1) {
@@ -1734,7 +1736,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
reds = ERTS_PORT_REDS_INPUT;
ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0);
DTRACE_DRIVER(driver_ready_input, pp);
- /* NOTE some windows/ose drivers use ->ready_input
+ /* NOTE some windows drivers use ->ready_input
for input and output */
(*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data,
ptp->u.alive.td.io.event);
@@ -1784,7 +1786,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
reds = erts_dist_command(pp, CONTEXT_REDS - pp->reds);
break;
default:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Invalid port task type: %d\n",
(int) ptp->type);
break;
@@ -1822,6 +1824,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp)
}
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
if (io_tasks_executed) {
@@ -2048,7 +2051,7 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
break;
}
default:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Invalid port task type: %d\n",
(int) ptp->type);
}
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
index 2917d58932..45ba4371dc 100644
--- a/erts/emulator/beam/erl_printf_term.c
+++ b/erts/emulator/beam/erl_printf_term.c
@@ -117,13 +117,12 @@ do { \
/* return 0 if list is not a non-empty flat list of printable characters */
static int
-is_printable_string(Eterm list, Eterm* base)
-{
+is_printable_string(Eterm list) {
int len = 0;
int c;
while(is_list(list)) {
- Eterm* consp = list_val_rel(list, base);
+ Eterm* consp = list_val(list);
Eterm hd = CAR(consp);
if (!is_byte(hd))
@@ -260,9 +259,7 @@ static char *format_binary(Uint16 x, char *b) {
#endif
static int
-print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
- Eterm* obj_base) /* ignored if !HALFWORD_HEAP */
-{
+print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) {
DECLARE_WSTACK(s);
int res;
int i;
@@ -308,7 +305,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
obj = (Eterm) popped.word;
L_print_one_cons:
{
- Eterm* cons = list_val_rel(obj, obj_base);
+ Eterm* cons = list_val(obj);
Eterm tl;
obj = CAR(cons);
@@ -344,11 +341,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
PRINT_CHAR(res, fn, arg, '>');
goto L_done;
}
-#if HALFWORD_HEAP
- wobj = is_immed(obj) ? (Wterm)obj : rterm2wterm(obj, obj_base);
-#else
wobj = (Wterm)obj;
-#endif
switch (tag_val_def(wobj)) {
case NIL_DEF:
PRINT_STRING(res, fn, arg, "[]");
@@ -424,10 +417,10 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
PRINT_CHAR(res, fn, arg, '>');
break;
case LIST_DEF:
- if (is_printable_string(obj, obj_base)) {
+ if (is_printable_string(obj)) {
int c;
PRINT_CHAR(res, fn, arg, '"');
- nobj = list_val_rel(obj, obj_base);
+ nobj = list_val(obj);
while (1) {
if ((*dcount)-- <= 0)
goto L_done;
@@ -441,7 +434,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
}
if (is_not_list(*nobj))
break;
- nobj = list_val_rel(*nobj, obj_base);
+ nobj = list_val(*nobj);
}
PRINT_CHAR(res, fn, arg, '"');
} else {
@@ -469,11 +462,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
case BINARY_DEF:
{
byte* bytep;
- Uint bytesize = binary_size_rel(obj,obj_base);
+ Uint bytesize = binary_size(obj);
Uint bitoffs;
Uint bitsize;
byte octet;
- ERTS_GET_BINARY_BYTES_REL(obj, bytep, bitoffs, bitsize, obj_base);
+ ERTS_GET_BINARY_BYTES(obj, bytep, bitoffs, bitsize);
if (bitsize || !bytesize
|| !is_printable_ascii(bytep, bytesize, bitoffs)) {
@@ -648,13 +641,11 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
int
-erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision,
- ErlPfEterm* term_base)
-{
+erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision) {
int res;
ERTS_CT_ASSERT(sizeof(ErlPfEterm) == sizeof(Eterm));
- res = print_term(fn, arg, (Eterm)term, &precision, (Eterm*)term_base);
+ res = print_term(fn, arg, (Eterm)term, &precision);
if (res < 0)
return res;
if (precision <= 0)
diff --git a/erts/emulator/beam/erl_printf_term.h b/erts/emulator/beam/erl_printf_term.h
index 87618a36d7..4618457f27 100644
--- a/erts/emulator/beam/erl_printf_term.h
+++ b/erts/emulator/beam/erl_printf_term.h
@@ -22,6 +22,5 @@
#define ERL_PRINTF_TERM_H__
#include "erl_printf_format.h"
-int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision,
- ErlPfEterm* term_base);
+int erts_printf_term(fmtfn_t fn, void* arg, ErlPfEterm term, long precision);
#endif
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 3b1b593d1c..a706ebf595 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -58,11 +58,7 @@
#define ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST (CONTEXT_REDS/10)
-#ifndef ERTS_SCHED_MIN_SPIN
#define ERTS_SCHED_SPIN_UNTIL_YIELD 100
-#else
-#define ERTS_SCHED_SPIN_UNTIL_YIELD 1
-#endif
#define ERTS_SCHED_SYS_SLEEP_SPINCOUNT_VERY_LONG 40
#define ERTS_SCHED_AUX_WORK_SLEEP_SPINCOUNT_FACT_VERY_LONG 1000
@@ -119,7 +115,7 @@
#define RUNQ_SET_RQ(X, RQ) erts_smp_atomic_set_nob((X), (erts_aint_t) (RQ))
#ifdef DEBUG
-# if defined(ARCH_64) && !HALFWORD_HEAP
+# if defined(ARCH_64)
# define ERTS_DBG_SET_INVALID_RUNQP(RQP, N) \
(RUNQ_SET_RQ((RQP), (0xdeadbeefdead0003LL | ((N) << 4)))
# define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) \
@@ -152,19 +148,13 @@ extern BeamInstr beam_apply[];
extern BeamInstr beam_exit[];
extern BeamInstr beam_continue_exit[];
-#ifdef __OSE__
-/* Eager check I/O not supported on OSE yet. */
-int erts_eager_check_io = 0;
-#else
-int erts_eager_check_io = 1;
-#endif
-int erts_sched_compact_load;
-int erts_sched_balance_util = 0;
-Uint erts_no_schedulers;
-#ifdef ERTS_DIRTY_SCHEDULERS
-Uint erts_no_dirty_cpu_schedulers;
-Uint erts_no_dirty_io_schedulers;
-#endif
+int ERTS_WRITE_UNLIKELY(erts_default_spo_flags) = 0;
+int ERTS_WRITE_UNLIKELY(erts_eager_check_io) = 1;
+int ERTS_WRITE_UNLIKELY(erts_sched_compact_load);
+int ERTS_WRITE_UNLIKELY(erts_sched_balance_util) = 0;
+Uint ERTS_WRITE_UNLIKELY(erts_no_schedulers);
+Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_cpu_schedulers) = 0;
+Uint ERTS_WRITE_UNLIKELY(erts_no_dirty_io_schedulers) = 0;
static char *erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_NO_FLAGS] = {0};
int erts_aux_work_no_flags = ERTS_SSI_AUX_WORK_NO_FLAGS;
@@ -196,84 +186,176 @@ int erts_disable_proc_not_running_opt;
static ErtsAuxWorkData *aux_thread_aux_work_data;
-#define ERTS_SCHDLR_SSPND_CHNG_WAITER (((erts_aint32_t) 1) << 0)
+#define ERTS_SCHDLR_SSPND_CHNG_NMSB (((erts_aint32_t) 1) << 0)
#define ERTS_SCHDLR_SSPND_CHNG_MSB (((erts_aint32_t) 1) << 1)
#define ERTS_SCHDLR_SSPND_CHNG_ONLN (((erts_aint32_t) 1) << 2)
+#define ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN (((erts_aint32_t) 1) << 3)
-#ifndef DEBUG
+typedef enum {
+ ERTS_SCHED_NORMAL,
+ ERTS_SCHED_DIRTY_CPU,
+ ERTS_SCHED_DIRTY_IO
+} ErtsSchedType;
-#define ERTS_SCHDLR_SSPND_CHNG_SET(VAL, OLD_VAL) \
- erts_smp_atomic32_set_nob(&schdlr_sspnd.changing, (VAL))
+typedef struct {
+ int ongoing;
+ ErtsProcList *blckrs;
+ ErtsProcList *chngq;
+} ErtsMultiSchedulingBlock;
-#ifdef ERTS_DIRTY_SCHEDULERS
-#define ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(VAL, OLD_VAL) \
- erts_smp_atomic32_set_nob(&schdlr_sspnd.dirty_cpu_changing, (VAL))
-#define ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(VAL, OLD_VAL) \
- erts_smp_atomic32_set_nob(&schdlr_sspnd.dirty_io_changing, (VAL))
-#endif
+static struct {
+ erts_smp_mtx_t mtx;
+ Uint32 online;
+ Uint32 curr_online;
+ Uint32 active;
+ erts_smp_atomic32_t changing;
+ ErtsProcList *chngq;
+ Eterm changer;
+ ErtsMultiSchedulingBlock nmsb; /* Normal multi Scheduling Block */
+ ErtsMultiSchedulingBlock msb; /* Multi Scheduling Block */
+} schdlr_sspnd;
-#else
+#define ERTS_SCHDLR_SSPND_S_BITS 10
+#define ERTS_SCHDLR_SSPND_DCS_BITS 11
+#define ERTS_SCHDLR_SSPND_DIS_BITS 11
-#define ERTS_SCHDLR_SSPND_CHNG_SET(VAL, OLD_VAL) \
-do { \
- erts_aint32_t old_val__; \
- old_val__ = erts_smp_atomic32_xchg_nob(&schdlr_sspnd.changing, \
- (VAL)); \
- ASSERT(old_val__ == (OLD_VAL)); \
-} while (0)
+#define ERTS_SCHDLR_SSPND_S_MASK ((1 << ERTS_SCHDLR_SSPND_S_BITS)-1)
+#define ERTS_SCHDLR_SSPND_DCS_MASK ((1 << ERTS_SCHDLR_SSPND_DCS_BITS)-1)
+#define ERTS_SCHDLR_SSPND_DIS_MASK ((1 << ERTS_SCHDLR_SSPND_DIS_BITS)-1)
-#ifdef ERTS_DIRTY_SCHEDULERS
-#define ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(VAL, OLD_VAL) \
-do { \
- erts_aint32_t old_val__; \
- old_val__ = erts_smp_atomic32_xchg_nob(&schdlr_sspnd.dirty_cpu_changing, \
- (VAL)); \
- ASSERT(old_val__ == (OLD_VAL)); \
-} while (0)
-#define ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(VAL, OLD_VAL) \
-do { \
- erts_aint32_t old_val__; \
- old_val__ = erts_smp_atomic32_xchg_nob(&schdlr_sspnd.dirty_io_changing, \
- (VAL)); \
- ASSERT(old_val__ == (OLD_VAL)); \
-} while (0)
-#endif
+#define ERTS_SCHDLR_SSPND_S_SHIFT 0
+#define ERTS_SCHDLR_SSPND_DCS_SHIFT (ERTS_SCHDLR_SSPND_S_SHIFT \
+ + ERTS_SCHDLR_SSPND_S_BITS)
+#define ERTS_SCHDLR_SSPND_DIS_SHIFT (ERTS_SCHDLR_SSPND_DCS_SHIFT \
+ + ERTS_SCHDLR_SSPND_DCS_BITS)
+#if (ERTS_SCHDLR_SSPND_S_BITS \
+ + ERTS_SCHDLR_SSPND_DCS_BITS \
+ + ERTS_SCHDLR_SSPND_DIS_BITS) > 32
+# error Wont fit in Uint32
#endif
-
-static struct {
- erts_smp_mtx_t mtx;
- erts_smp_cnd_t cnd;
- int online;
- int curr_online;
- int wait_curr_online;
-#ifdef ERTS_DIRTY_SCHEDULERS
- int dirty_cpu_online;
- int dirty_cpu_curr_online;
- int dirty_cpu_wait_curr_online;
- int dirty_io_online;
- int dirty_io_curr_online;
- int dirty_io_wait_curr_online;
+#if (ERTS_MAX_NO_OF_SCHEDULERS-1) > ERTS_SCHDLR_SSPND_S_MASK
+# error Max no schedulers wont fit in its bit-field
#endif
- erts_smp_atomic32_t changing;
- erts_smp_atomic32_t active;
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_atomic32_t dirty_cpu_changing;
- erts_smp_atomic32_t dirty_cpu_active;
- erts_smp_atomic32_t dirty_io_changing;
- erts_smp_atomic32_t dirty_io_active;
+#if ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS > ERTS_SCHDLR_SSPND_DCS_MASK
+# error Max no dirty cpu schedulers wont fit in its bit-field
#endif
- struct {
- int ongoing;
- long wait_active;
-#ifdef ERTS_DIRTY_SCHEDULERS
- long dirty_cpu_wait_active;
- long dirty_io_wait_active;
+#if ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS > ERTS_SCHDLR_SSPND_DIS_MASK
+# error Max no dirty io schedulers wont fit in its bit-field
#endif
- ErtsProcList *procs;
- } msb; /* Multi Scheduling Block */
-} schdlr_sspnd;
+
+#define ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(S, DCS, DIS) \
+ ((((Uint32) (((S) & ERTS_SCHDLR_SSPND_S_MASK))-1) \
+ << ERTS_SCHDLR_SSPND_S_SHIFT) \
+ | ((((Uint32) ((DCS) & ERTS_SCHDLR_SSPND_DCS_MASK)) \
+ << ERTS_SCHDLR_SSPND_DCS_SHIFT)) \
+ | ((((Uint32) ((DIS) & ERTS_SCHDLR_SSPND_DIS_MASK)) \
+ << ERTS_SCHDLR_SSPND_DIS_SHIFT)))
+
+static void init_scheduler_suspend(void);
+
+static ERTS_INLINE Uint32
+schdlr_sspnd_get_nscheds(Uint32 *valp, ErtsSchedType type)
+{
+ Uint32 res = (Uint32) (*valp);
+ switch (type) {
+ case ERTS_SCHED_NORMAL:
+ res >>= ERTS_SCHDLR_SSPND_S_SHIFT;
+ res &= (Uint32) ERTS_SCHDLR_SSPND_S_MASK;
+ res++;
+ break;
+ case ERTS_SCHED_DIRTY_CPU:
+ res >>= ERTS_SCHDLR_SSPND_DCS_SHIFT;
+ res &= (Uint32) ERTS_SCHDLR_SSPND_DCS_MASK;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ res >>= ERTS_SCHDLR_SSPND_DIS_SHIFT;
+ res &= (Uint32) ERTS_SCHDLR_SSPND_DIS_MASK;
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ return 0;
+ }
+
+ return res;
+}
+
+static ERTS_INLINE void
+schdlr_sspnd_dec_nscheds(Uint32 *valp, ErtsSchedType type)
+{
+ ASSERT(schdlr_sspnd_get_nscheds(valp, type) > 0);
+
+ switch (type) {
+ case ERTS_SCHED_NORMAL:
+ *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_S_SHIFT;
+ break;
+ case ERTS_SCHED_DIRTY_CPU:
+ *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_DCS_SHIFT;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ *valp -= ((Uint32) 1) << ERTS_SCHDLR_SSPND_DIS_SHIFT;
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ }
+}
+
+static ERTS_INLINE void
+schdlr_sspnd_inc_nscheds(Uint32 *valp, ErtsSchedType type)
+{
+ switch (type) {
+ case ERTS_SCHED_NORMAL:
+ ASSERT(schdlr_sspnd_get_nscheds(valp, type)
+ < ERTS_MAX_NO_OF_SCHEDULERS-1);
+ *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_S_SHIFT;
+ break;
+ case ERTS_SCHED_DIRTY_CPU:
+ ASSERT(schdlr_sspnd_get_nscheds(valp, type)
+ < ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS);
+ *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_DCS_SHIFT;
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ ASSERT(schdlr_sspnd_get_nscheds(valp, type)
+ < ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS);
+ *valp += ((Uint32) 1) << ERTS_SCHDLR_SSPND_DIS_SHIFT;
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ }
+}
+
+static ERTS_INLINE void
+schdlr_sspnd_set_nscheds(Uint32 *valp, ErtsSchedType type, Uint32 no)
+{
+ Uint32 val = *valp;
+
+ switch (type) {
+ case ERTS_SCHED_NORMAL:
+ ASSERT(no > 0);
+ val &= ~(((Uint32) ERTS_SCHDLR_SSPND_S_MASK)
+ << ERTS_SCHDLR_SSPND_S_SHIFT);
+ val |= (((no-1) & ((Uint32) ERTS_SCHDLR_SSPND_S_MASK))
+ << ERTS_SCHDLR_SSPND_S_SHIFT);
+ break;
+ case ERTS_SCHED_DIRTY_CPU:
+ val &= ~(((Uint32) ERTS_SCHDLR_SSPND_DCS_MASK)
+ << ERTS_SCHDLR_SSPND_DCS_SHIFT);
+ val |= ((no & ((Uint32) ERTS_SCHDLR_SSPND_DCS_MASK))
+ << ERTS_SCHDLR_SSPND_DCS_SHIFT);
+ break;
+ case ERTS_SCHED_DIRTY_IO:
+ val &= ~(((Uint32) ERTS_SCHDLR_SSPND_DIS_MASK)
+ << ERTS_SCHDLR_SSPND_DIS_SHIFT);
+ val |= ((no & ((Uint32) ERTS_SCHDLR_SSPND_DIS_MASK))
+ << ERTS_SCHDLR_SSPND_DIS_SHIFT);
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid scheduler type");
+ }
+
+ *valp = val;
+}
static struct {
erts_smp_mtx_t update_mtx;
@@ -303,7 +385,7 @@ do { \
erts_sched_stat_t erts_sched_stat;
#ifdef USE_THREADS
-static erts_tsd_key_t sched_data_key;
+static erts_tsd_key_t ERTS_WRITE_UNLIKELY(sched_data_key);
#endif
static erts_smp_atomic32_t function_calls;
@@ -343,16 +425,16 @@ static ErtsAlignedSchedulerSleepInfo *aligned_dirty_io_sched_sleep_info;
static Uint last_reductions;
static Uint last_exact_reductions;
-Uint erts_default_process_flags;
-Eterm erts_system_monitor;
-Eterm erts_system_monitor_long_gc;
-Uint erts_system_monitor_long_schedule;
-Eterm erts_system_monitor_large_heap;
+Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor);
+Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_long_gc);
+Uint ERTS_WRITE_UNLIKELY(erts_system_monitor_long_schedule);
+Eterm ERTS_WRITE_UNLIKELY(erts_system_monitor_large_heap);
struct erts_system_monitor_flags_t erts_system_monitor_flags;
/* system performance monitor */
Eterm erts_system_profile;
struct erts_system_profile_flags_t erts_system_profile_flags;
+int erts_system_profile_ts_type = ERTS_TRACE_FLG_NOW_TIMESTAMP;
#if ERTS_MAX_PROCESSES > 0x7fffffff
#error "Need to store process_count in another type"
@@ -360,7 +442,8 @@ struct erts_system_profile_flags_t erts_system_profile_flags;
typedef enum {
ERTS_PSTT_GC, /* Garbage Collect */
- ERTS_PSTT_CPC /* Check Process Code */
+ ERTS_PSTT_CPC, /* Check Process Code */
+ ERTS_PSTT_COHMQ /* Change off heap message queue */
} ErtsProcSysTaskType;
#define ERTS_MAX_PROC_SYS_TASK_ARGS 2
@@ -433,8 +516,10 @@ do { \
do { \
ErtsRunQueue *RQVAR; \
int ix__; \
+ int online__ = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, \
+ ERTS_SCHED_NORMAL); \
ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&schdlr_sspnd.mtx)); \
- for (ix__ = 0; ix__ < schdlr_sspnd.online; ix__++) { \
+ for (ix__ = 0; ix__ < online__; ix__++) { \
RQVAR = ERTS_RUNQ_IX(ix__); \
erts_smp_runq_lock(RQVAR); \
{ DO; } \
@@ -506,16 +591,13 @@ dbg_chk_aux_work_val(erts_aint32_t value)
#if HAVE_ERTS_MSEG
valid |= ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK;
#endif
-#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
- valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN;
-#endif
#ifdef ERTS_SSI_AUX_WORK_REAP_PORTS
valid |= ERTS_SSI_AUX_WORK_REAP_PORTS;
#endif
valid |= ERTS_SSI_AUX_WORK_DEBUG_WAIT_COMPLETED;
if (~valid & value)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Invalid aux_work value found: 0x%x\n",
~valid & value);
}
@@ -595,8 +677,6 @@ erts_pre_init_process(void)
= "MISC_THR_PRGR";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MISC_IX]
= "MISC";
- erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX]
- = "CHECK_CHILDREN";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_SET_TMO_IX]
= "SET_TMO";
erts_aux_work_flag_descr[ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX]
@@ -625,11 +705,6 @@ erts_pre_init_process(void)
erts_psd_required_locks[ERTS_PSD_SCHED_ID].set_locks
= ERTS_PSD_SCHED_ID_SET_LOCKS;
- erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].get_locks
- = ERTS_PSD_DIST_ENTRY_GET_LOCKS;
- erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].set_locks
- = ERTS_PSD_DIST_ENTRY_SET_LOCKS;
-
erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].get_locks
= ERTS_PSD_CALL_TIME_BP_GET_LOCKS;
erts_psd_required_locks[ERTS_PSD_CALL_TIME_BP].set_locks
@@ -689,7 +764,6 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab)
last_reductions = 0;
last_exact_reductions = 0;
- erts_default_process_flags = 0;
}
void
@@ -959,6 +1033,12 @@ sched_wall_time_change(ErtsSchedulerData *esdp, int working)
}
}
}
+ if (!working) {
+ ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_BUSY_WAIT);
+ } else {
+ ERTS_MSACC_SET_STATE_M_X(ERTS_MSACC_STATE_OTHER);
+ }
+
}
typedef struct {
@@ -971,25 +1051,24 @@ typedef struct {
erts_smp_atomic32_t refc;
} ErtsSchedWallTimeReq;
-#if !HALFWORD_HEAP
+typedef struct {
+ Process *proc;
+ Eterm ref;
+ Eterm ref_heap[REF_THING_SIZE];
+ Uint req_sched;
+ erts_smp_atomic32_t refc;
+} ErtsSystemCheckReq;
+
+
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(swtreq,
ErtsSchedWallTimeReq,
5,
ERTS_ALC_T_SCHED_WTIME_REQ)
-#else
-static ERTS_INLINE ErtsSchedWallTimeReq *
-swtreq_alloc(void)
-{
- return erts_alloc(ERTS_ALC_T_SCHED_WTIME_REQ,
- sizeof(ErtsSchedWallTimeReq));
-}
-static ERTS_INLINE void
-swtreq_free(ErtsSchedWallTimeReq *ptr)
-{
- erts_free(ERTS_ALC_T_SCHED_WTIME_REQ, ptr);
-}
-#endif
+ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(screq,
+ ErtsSystemCheckReq,
+ 5,
+ ERTS_ALC_T_SYS_CHECK_REQ)
static void
reply_sched_wall_time(void *vswtrp)
@@ -1006,7 +1085,7 @@ reply_sched_wall_time(void *vswtrp)
Eterm **hpp;
Uint sz, *szp;
ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErtsMessage *mp = NULL;
ASSERT(esdp);
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -1062,12 +1141,12 @@ reply_sched_wall_time(void *vswtrp)
if (hpp)
break;
- hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
szp = NULL;
hpp = &hp;
}
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (swtrp->req_sched == esdp->no)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -1122,6 +1201,75 @@ erts_sched_wall_time_request(Process *c_p, int set, int enable)
return ref;
}
+static void
+reply_system_check(void *vscrp)
+{
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ErtsSystemCheckReq *scrp = (ErtsSystemCheckReq *) vscrp;
+ ErtsProcLocks rp_locks = (scrp->req_sched == esdp->no ? ERTS_PROC_LOCK_MAIN : 0);
+ Process *rp = scrp->proc;
+ Eterm msg;
+ Eterm *hp = NULL;
+ Eterm **hpp;
+ Uint sz;
+ ErlOffHeap *ohp = NULL;
+ ErtsMessage *mp = NULL;
+
+ ASSERT(esdp);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
+#endif
+
+ sz = REF_THING_SIZE;
+ mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
+ hpp = &hp;
+ msg = STORE_NC(hpp, ohp, scrp->ref);
+
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
+
+ if (scrp->req_sched == esdp->no)
+ rp_locks &= ~ERTS_PROC_LOCK_MAIN;
+
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
+
+ erts_proc_dec_refc(rp);
+
+ if (erts_smp_atomic32_dec_read_nob(&scrp->refc) == 0)
+ screq_free(vscrp);
+}
+
+
+Eterm erts_system_check_request(Process *c_p) {
+ ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p);
+ Eterm ref;
+ ErtsSystemCheckReq *scrp;
+ Eterm *hp;
+
+ scrp = screq_alloc();
+ ref = erts_make_ref(c_p);
+ hp = &scrp->ref_heap[0];
+
+ scrp->proc = c_p;
+ scrp->ref = STORE_NC(&hp, NULL, ref);
+ scrp->req_sched = esdp->no;
+ erts_smp_atomic32_init_nob(&scrp->refc, (erts_aint32_t) erts_no_schedulers);
+
+ erts_proc_add_refc(c_p, (Sint) erts_no_schedulers);
+
+#ifdef ERTS_SMP
+ if (erts_no_schedulers > 1)
+ erts_schedule_multi_misc_aux_work(1,
+ erts_no_schedulers,
+ reply_system_check,
+ (void *) scrp);
+#endif
+
+ reply_system_check((void *) scrp);
+
+ return ref;
+}
+
static ERTS_INLINE ErtsProcList *
proclist_create(Process *p)
{
@@ -1132,6 +1280,15 @@ proclist_create(Process *p)
return plp;
}
+static ERTS_INLINE ErtsProcList *
+proclist_copy(ErtsProcList *plp0)
+{
+ ErtsProcList *plp1 = proclist_alloc();
+ plp1->pid = plp0->pid;
+ plp1->started_interval = plp0->started_interval;
+ return plp1;
+}
+
static ERTS_INLINE void
proclist_destroy(ErtsProcList *plp)
{
@@ -1139,6 +1296,12 @@ proclist_destroy(ErtsProcList *plp)
}
ErtsProcList *
+erts_proclist_copy(ErtsProcList *plp)
+{
+ return proclist_copy(plp);
+}
+
+ErtsProcList *
erts_proclist_create(Process *p)
{
return proclist_create(p);
@@ -1216,7 +1379,7 @@ erts_sched_finish_poke(ErtsSchedulerSleepInfo *ssi, erts_aint32_t flags)
case 0:
break;
default:
- erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error\n",
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error\n",
__FILE__, __LINE__);
break;
}
@@ -1729,15 +1892,17 @@ handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waitin
int need_thr_progress = 0;
ErtsThrPrgrVal wakeup = ERTS_THR_PRGR_INVALID;
int more_work = 0;
-
+ ERTS_MSACC_PUSH_STATE_M_X();
#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
#endif
unset_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD);
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_ALLOC);
erts_alloc_scheduler_handle_delayed_dealloc((void *) awdp->esdp,
&need_thr_progress,
&wakeup,
&more_work);
+ ERTS_MSACC_POP_STATE_M_X();
if (more_work) {
if (set_aux_work_flags(ssi, ERTS_SSI_AUX_WORK_DD)
& ERTS_SSI_AUX_WORK_DD_THR_PRGR) {
@@ -2124,34 +2289,6 @@ erts_debug_wait_completed(Process *c_p, int flags)
}
-#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
-void
-erts_smp_notify_check_children_needed(void)
-{
- int i;
- for (i = 0; i < erts_no_schedulers; i++)
- set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(i),
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
-#ifdef ERTS_DIRTY_SCHEDULERS
- for (i = 0; i < erts_no_dirty_cpu_schedulers; i++)
- set_aux_work_flags_wakeup_nob(ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(i),
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
- for (i = 0; i < erts_no_dirty_io_schedulers; i++)
- set_aux_work_flags_wakeup_nob(ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(i),
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
-#endif
-}
-
-static ERTS_INLINE erts_aint32_t
-handle_check_children(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
-{
- unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_CHECK_CHILDREN);
- erts_check_children();
- return aux_work & ~ERTS_SSI_AUX_WORK_CHECK_CHILDREN;
-}
-
-#endif
-
static void
notify_reap_ports_relb(void)
{
@@ -2200,7 +2337,7 @@ handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
erts_port_release(prt);
}
if (erts_smp_atomic32_dec_read_nob(&erts_halt_progress) == 0) {
- erl_exit_flush_async(erts_halt_code, "");
+ erts_flush_async_exit(erts_halt_code, "");
}
}
return aux_work & ~ERTS_SSI_AUX_WORK_REAP_PORTS;
@@ -2237,13 +2374,17 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \
if (!(aux_work & ~ignore)) { \
ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); \
+ ERTS_MSACC_UPDATE_CACHE(); \
+ ERTS_MSACC_POP_STATE_M(); \
return aux_work; \
} \
}
erts_aint32_t aux_work = orig_aux_work;
erts_aint32_t ignore = 0;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_AUX);
+ ASSERT(!awdp->esdp || !ERTS_SCHEDULER_IS_DIRTY(awdp->esdp));
#ifdef ERTS_SMP
haw_thr_prgr_current_reset(awdp);
#endif
@@ -2305,10 +2446,6 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_MISC,
handle_misc_aux_work);
-#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
- HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CHECK_CHILDREN,
- handle_check_children);
-#endif
HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_SET_TMO,
handle_setup_aux_work_timer);
@@ -2336,6 +2473,8 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting)
haw_thr_prgr_current_check_progress(awdp);
#endif
+ ERTS_MSACC_UPDATE_CACHE();
+ ERTS_MSACC_POP_STATE_M();
return aux_work;
#undef HANDLE_AUX_WORK
@@ -2536,19 +2675,10 @@ try_set_sys_scheduling(void)
#endif
static ERTS_INLINE int
-prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking)
+prepare_for_sys_schedule(int non_blocking)
{
if (non_blocking && erts_eager_check_io) {
#ifdef ERTS_SMP
-#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1
- if (esdp->no != 1) {
- /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used
- then we make sure to wake scheduler 1 */
- ErtsRunQueue *rq = ERTS_RUNQ_IX(0);
- wake_scheduler(rq);
- return 0;
- }
-#endif
return try_set_sys_scheduling();
#else
return 1;
@@ -2558,16 +2688,6 @@ prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking)
#ifdef ERTS_SMP
while (!erts_port_task_have_outstanding_io_tasks()
&& try_set_sys_scheduling()) {
-#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1
- if (esdp->no != 1) {
- /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used
- then we make sure to wake scheduler 1 */
- ErtsRunQueue *rq = ERTS_RUNQ_IX(0);
- clear_sys_scheduling();
- wake_scheduler(rq);
- return 0;
- }
-#endif
if (!erts_port_task_have_outstanding_io_tasks())
return 1;
clear_sys_scheduling();
@@ -2619,13 +2739,6 @@ sched_active(Uint no, ErtsRunQueue *rq)
profile_scheduler(make_small(no), am_active);
}
-static int ERTS_INLINE
-ongoing_multi_scheduling_block(void)
-{
- ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&schdlr_sspnd.mtx));
- return schdlr_sspnd.msb.ongoing;
-}
-
static ERTS_INLINE void
empty_runq_aux(ErtsRunQueue *rq, Uint32 old_flags)
{
@@ -2862,6 +2975,8 @@ aux_thread(void *unused)
ssi->event = erts_tse_fetch();
+ erts_msacc_init_thread("aux", 1, 1);
+
callbacks.arg = (void *) ssi;
callbacks.wakeup = thr_prgr_wakeup;
callbacks.prepare_wait = thr_prgr_prep_wait;
@@ -2872,6 +2987,7 @@ aux_thread(void *unused)
init_aux_work_data(awdp, NULL, NULL);
awdp->ssi = ssi;
+
sched_prep_spin_wait(ssi);
while (1) {
@@ -2891,8 +3007,6 @@ aux_thread(void *unused)
erts_thr_progress_active(NULL, thr_prgr_active = 0);
erts_thr_progress_prepare_wait(NULL);
- ERTS_SCHED_FAIR_YIELD();
-
flgs = sched_spin_wait(ssi, 0);
if (flgs & ERTS_SSI_FLG_SLEEPING) {
@@ -2927,6 +3041,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
#ifdef ERTS_SMP
int thr_prgr_active = 1;
erts_aint32_t flgs;
+#endif
+ ERTS_MSACC_PUSH_STATE_M();
+#ifdef ERTS_SMP
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
@@ -2960,7 +3077,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
* be waiting in erl_sys_schedule()
*/
- if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(esdp, 0)) {
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(0)) {
sched_waiting(esdp->no, rq);
@@ -2974,17 +3091,17 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
sched_wall_time_change(esdp, thr_prgr_active);
while (1) {
- ErtsMonotonicTime current_time;
+ ErtsMonotonicTime current_time = 0;
aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
- if (aux_work) {
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) {
+ if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (!thr_prgr_active) {
erts_thr_progress_active(esdp, thr_prgr_active = 1);
sched_wall_time_change(esdp, 1);
}
aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1);
- if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)
- && erts_thr_progress_update(esdp))
+ ERTS_MSACC_UPDATE_CACHE();
+ if (aux_work && erts_thr_progress_update(esdp))
erts_thr_progress_leader_update(esdp);
}
@@ -3008,8 +3125,10 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
timeout_time = erts_check_next_timeout_time(esdp);
current_time = erts_get_monotonic_time(esdp);
do_timeout = (current_time >= timeout_time);
- } else
+ } else {
+ current_time = 0;
timeout_time = ERTS_MONOTONIC_TIME_MAX;
+ }
if (do_timeout) {
if (!thr_prgr_active) {
erts_thr_progress_active(esdp, thr_prgr_active = 1);
@@ -3025,8 +3144,6 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
erts_thr_progress_prepare_wait(esdp);
}
- ERTS_SCHED_FAIR_YIELD();
-
flgs = sched_spin_wait(ssi, spincount);
if (flgs & ERTS_SSI_FLG_SLEEPING) {
ASSERT(flgs & ERTS_SSI_FLG_WAITING);
@@ -3047,7 +3164,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
- 1) + 1;
} else
timeout = -1;
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
res = erts_tse_twait(ssi->event, timeout);
+ ERTS_MSACC_POP_STATE_M();
current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
erts_get_monotonic_time(esdp);
} while (res == EINTR);
@@ -3097,13 +3216,8 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
#ifdef ERTS_DIRTY_SCHEDULERS
ASSERT(!ERTS_SCHEDULER_IS_DIRTY(esdp));
#endif
-
-#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1
- ASSERT(esdp->no == 1);
-#endif
sched_waiting_sys(esdp->no, rq);
-
erts_smp_runq_unlock(rq);
ASSERT(working);
@@ -3121,9 +3235,13 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
if (working)
sched_wall_time_change(esdp, working = 0);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
+
ASSERT(!erts_port_task_have_outstanding_io_tasks());
erl_sys_schedule(1); /* Might give us something to do */
+ ERTS_MSACC_POP_STATE_M();
+
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
current_time = erts_get_monotonic_time(esdp);
if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
@@ -3136,25 +3254,23 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
#endif
aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
- if (aux_work) {
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- if (!working)
- sched_wall_time_change(esdp, working = 1);
+ if (aux_work && !ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (!working)
+ sched_wall_time_change(esdp, working = 1);
#ifdef ERTS_SMP
- if (!thr_prgr_active)
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ if (!thr_prgr_active)
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
#endif
- }
aux_work = handle_aux_work(&esdp->aux_work_data, aux_work, 1);
+ ERTS_MSACC_UPDATE_CACHE();
#ifdef ERTS_SMP
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && aux_work &&
- erts_thr_progress_update(esdp))
+ if (aux_work && erts_thr_progress_update(esdp))
erts_thr_progress_leader_update(esdp);
#endif
}
#ifndef ERTS_SMP
- if (rq->len != 0 || rq->misc.start)
+ if (erts_smp_atomic32_read_dirty(&rq->len) != 0 || rq->misc.start)
goto sys_woken;
#else
flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
@@ -3173,7 +3289,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
* Got to check that we still got I/O tasks; otherwise
* we have to continue checking for I/O...
*/
- if (!prepare_for_sys_schedule(esdp, 0)) {
+ if (!prepare_for_sys_schedule(0)) {
spincount *= ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT;
goto tse_wait;
}
@@ -3195,7 +3311,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
* Got to check that we still got I/O tasks; otherwise
* we have to wait in erl_sys_schedule() after all...
*/
- if (!prepare_for_sys_schedule(esdp, 0)) {
+ if (!prepare_for_sys_schedule(0)) {
/*
* Not allowed to wait in erl_sys_schedule;
* do tse wait instead...
@@ -3244,8 +3360,12 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
ASSERT(!erts_port_task_have_outstanding_io_tasks());
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
+
erl_sys_schedule(0);
+ ERTS_MSACC_POP_STATE_M();
+
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp);
if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
@@ -3253,7 +3373,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
}
#ifndef ERTS_SMP
- if (rq->len == 0 && !rq->misc.start)
+ if (erts_smp_atomic32_read_dirty(&rq->len) == 0 && !rq->misc.start)
goto sys_aux_work;
sys_woken:
#else
@@ -3315,7 +3435,8 @@ wake_scheduler(ErtsRunQueue *rq)
* so all code *should* handle this without having
* the lock on the run queue.
*/
- ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq));
+ ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked(rq)
+ || ERTS_RUNQ_IX_IS_DIRTY(rq->ix));
ssi = rq->scheduler->ssi;
@@ -3640,6 +3761,13 @@ check_requeue_process(ErtsRunQueue *rq, int prio_q)
return 0;
}
+static ERTS_INLINE void
+free_proxy_proc(Process *proxy)
+{
+ ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY);
+ erts_free(ERTS_ALC_T_PROC, proxy);
+}
+
#ifdef ERTS_SMP
static ErtsRunQueue *
@@ -3722,7 +3850,7 @@ immigrate(ErtsRunQueue *c_rq, ErtsMigrationPath *mp)
prio = ERTS_PORT_PRIO_LEVEL;
break;
default:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:%s(): Invalid immigrate queue mask",
__FILE__, __LINE__, __func__);
prio = 0;
@@ -3746,7 +3874,7 @@ immigrate(ErtsRunQueue *c_rq, ErtsMigrationPath *mp)
rq = erts_port_runq(prt);
if (rq) {
if (rq != c_rq)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:%s(): Internal error",
__FILE__, __LINE__, __func__);
erts_enqueue_port(c_rq, prt);
@@ -3811,24 +3939,33 @@ static ERTS_INLINE void
resume_run_queue(ErtsRunQueue *rq)
{
int pix;
+ Uint32 oflgs;
erts_smp_runq_lock(rq);
- (void) ERTS_RUNQ_FLGS_READ_BSET(rq,
- (ERTS_RUNQ_FLG_OUT_OF_WORK
- | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK
- | ERTS_RUNQ_FLG_SUSPENDED),
- (ERTS_RUNQ_FLG_OUT_OF_WORK
- | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK));
+ oflgs = ERTS_RUNQ_FLGS_READ_BSET(rq,
+ (ERTS_RUNQ_FLG_OUT_OF_WORK
+ | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK
+ | ERTS_RUNQ_FLG_SUSPENDED),
+ (ERTS_RUNQ_FLG_OUT_OF_WORK
+ | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK));
+
+ if (oflgs & ERTS_RUNQ_FLG_SUSPENDED) {
+ erts_aint32_t len;
+
+ rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS;
+ for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) {
+ len = erts_smp_atomic32_read_dirty(&rq->procs.prio_info[pix].len);
+ rq->procs.prio_info[pix].max_len = len;
+ rq->procs.prio_info[pix].reds = 0;
+ }
+ len = erts_smp_atomic32_read_dirty(&rq->ports.info.len);
+ rq->ports.info.max_len = len;
+ rq->ports.info.reds = 0;
+ len = erts_smp_atomic32_read_dirty(&rq->len);
+ rq->max_len = len;
- rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS;
- for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) {
- rq->procs.prio_info[pix].max_len = 0;
- rq->procs.prio_info[pix].reds = 0;
}
- rq->ports.info.max_len = 0;
- rq->ports.info.reds = 0;
- rq->max_len = 0;
erts_smp_runq_unlock(rq);
@@ -3937,7 +4074,7 @@ evacuate_run_queue(ErtsRunQueue *rq,
prt_rq = erts_port_runq(prt);
if (prt_rq) {
if (prt_rq != to_rq)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:%s() internal error\n",
__FILE__, __LINE__, __func__);
erts_enqueue_port(to_rq, prt);
@@ -3954,9 +4091,6 @@ evacuate_run_queue(ErtsRunQueue *rq,
erts_aint32_t state;
Process *proc;
int notify = 0;
-#ifdef ERTS_DIRTY_SCHEDULERS
- int requeue;
-#endif
to_rq = NULL;
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -3971,49 +4105,94 @@ evacuate_run_queue(ErtsRunQueue *rq,
proc = dequeue_process(rq, prio_q, &state);
while (proc) {
-#ifdef ERTS_DIRTY_SCHEDULERS
- requeue = 1;
+ Process *real_proc;
+ int prio;
+ erts_aint32_t max_qbit, qbit, real_state;
+
+ prio = ERTS_PSFLGS_GET_PRQ_PRIO(state);
+ qbit = ((erts_aint32_t) 1) << prio;
+
+ if (!(state & ERTS_PSFLG_PROXY)) {
+ real_proc = proc;
+ real_state = state;
+ }
+ else {
+ real_proc = erts_proc_lookup_raw(proc->common.id);
+ if (!real_proc) {
+ free_proxy_proc(proc);
+ goto handle_next_proc;
+ }
+ real_state = erts_smp_atomic32_read_acqb(&real_proc->state);
+ }
+
+ max_qbit = (state >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET);
+ max_qbit &= ERTS_PSFLGS_QMASK;
+ max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS;
+ max_qbit &= -max_qbit;
+
+ if (qbit > max_qbit) {
+ /* Process already queued with higher prio; drop it... */
+ if (real_proc != proc)
+ free_proxy_proc(proc);
+ else {
+ erts_aint32_t clr_bits;
+#ifdef DEBUG
+ erts_aint32_t old;
#endif
- if (ERTS_PSFLG_BOUND & state) {
- /* Bound processes get stuck here... */
- proc->next = NULL;
- if (sbpp->last)
- sbpp->last->next = proc;
- else
- sbpp->first = proc;
- sbpp->last = proc;
-#ifdef ERTS_DIRTY_SCHEDULERS
- requeue = 0;
+
+ clr_bits = ERTS_PSFLG_IN_RUNQ;
+ clr_bits |= qbit << ERTS_PSFLGS_IN_PRQ_MASK_OFFSET;
+
+#ifdef DEBUG
+ old =
+#else
+ (void)
#endif
+ erts_smp_atomic32_read_band_mb(&proc->state,
+ ~clr_bits);
+ ASSERT((old & clr_bits) == clr_bits);
+
+ }
+
+ goto handle_next_proc;
}
+
#ifdef ERTS_DIRTY_SCHEDULERS
- else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) {
+
+ if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix)) {
+ erts_aint32_t dqbit = qbit;
#ifdef DEBUG
- erts_aint32_t old =
-#else
- (void)
+ erts_aint32_t old_dqbit;
#endif
- erts_smp_atomic32_read_band_nob(&proc->state,
- ~(ERTS_PSFLG_DIRTY_CPU_PROC
- | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q));
- /* assert that no other dirty flags are set */
- ASSERT(!(old & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)));
- } else if (state & ERTS_PSFLG_DIRTY_IO_PROC_IN_Q) {
+
+ if (rq == ERTS_DIRTY_CPU_RUNQ)
+ dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET;
+ else {
+ ASSERT(rq == ERTS_DIRTY_IO_RUNQ);
+ dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET;
+ }
+
#ifdef DEBUG
- erts_aint32_t old =
+ old_dqbit = (int)
#else
- (void)
+ (void)
#endif
- erts_smp_atomic32_read_band_nob(&proc->state,
- ~(ERTS_PSFLG_DIRTY_IO_PROC
- | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q));
- /* assert that no other dirty flags are set */
- ASSERT(!(old & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)));
+ erts_smp_atomic32_read_band_mb(&real_proc->dirty_state,
+ ~dqbit);
+ ASSERT(old_dqbit & dqbit);
}
- if (requeue) {
-#else
- else {
#endif
+
+ if (ERTS_PSFLG_BOUND & real_state) {
+ /* Bound processes get stuck here... */
+ proc->next = NULL;
+ if (sbpp->last)
+ sbpp->last->next = proc;
+ else
+ sbpp->first = proc;
+ sbpp->last = proc;
+ }
+ else {
int prio = (int) ERTS_PSFLGS_GET_PRQ_PRIO(state);
erts_smp_runq_unlock(rq);
@@ -4036,6 +4215,8 @@ evacuate_run_queue(ErtsRunQueue *rq,
erts_smp_runq_lock(rq);
}
+
+ handle_next_proc:
proc = dequeue_process(rq, prio_q, &state);
}
if (notify)
@@ -4138,7 +4319,7 @@ no_procs:
return 0;
else {
if (prt_rq != rq)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:%s() internal error\n",
__FILE__, __LINE__, __func__);
*rq_lockedp = 1;
@@ -4970,7 +5151,7 @@ erts_fprintf(stderr, "--------------------------------\n");
rq->out_of_work_count = 0;
(void) ERTS_RUNQ_FLGS_READ_BSET(rq, ERTS_RUNQ_FLGS_MIGRATION_INFO, flags);
- rq->max_len = rq->len;
+ rq->max_len = erts_smp_atomic32_read_dirty(&rq->len);
for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) {
ErtsRunQueueInfo *rqi;
rqi = (pix == ERTS_PORT_PRIO_LEVEL
@@ -5128,7 +5309,7 @@ wakeup_other_check(ErtsRunQueue *rq, Uint32 flags)
{
int wo_reds = rq->wakeup_other_reds;
if (wo_reds) {
- int left_len = rq->len - 1;
+ int left_len = erts_smp_atomic32_read_dirty(&rq->len) - 1;
if (left_len < 1) {
int wo_reduce = wo_reds << wakeup_other.dec_shift;
wo_reduce &= wakeup_other.dec_mask;
@@ -5201,7 +5382,7 @@ wakeup_other_check_legacy(ErtsRunQueue *rq, Uint32 flags)
{
int wo_reds = rq->wakeup_other_reds;
if (wo_reds) {
- erts_aint32_t len = rq->len;
+ erts_aint32_t len = erts_smp_atomic32_read_dirty(&rq->len);
if (len < 2) {
rq->wakeup_other -= ERTS_WAKEUP_OTHER_DEC_LEGACY*wo_reds;
if (rq->wakeup_other < 0)
@@ -5297,7 +5478,7 @@ runq_supervisor(void *unused)
ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
if (ERTS_RUNQ_FLGS_GET(rq) & ERTS_RUNQ_FLG_NONEMPTY) {
erts_smp_runq_lock(rq);
- if (rq->len != 0)
+ if (erts_smp_atomic32_read_dirty(&rq->len) != 0)
wake_scheduler_on_empty_runq(rq); /* forced wakeup... */
erts_smp_runq_unlock(rq);
}
@@ -5316,17 +5497,11 @@ erts_early_init_scheduling(int no_schedulers)
wakeup_other.threshold = ERTS_SCHED_WAKEUP_OTHER_THRESHOLD_MEDIUM;
wakeup_other.type = ERTS_SCHED_WAKEUP_OTHER_TYPE_DEFAULT;
#endif
-#ifndef ERTS_SCHED_MIN_SPIN
sched_busy_wait.sys_schedule = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM;
sched_busy_wait.tse = (ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM
* ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT);
sched_busy_wait.aux_work = (ERTS_SCHED_SYS_SLEEP_SPINCOUNT_MEDIUM
* ERTS_SCHED_AUX_WORK_SLEEP_SPINCOUNT_FACT_MEDIUM);
-#else
- sched_busy_wait.sys_schedule = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE;
- sched_busy_wait.tse = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE;
- sched_busy_wait.aux_work = ERTS_SCHED_SYS_SLEEP_SPINCOUNT_NONE;
-#endif
}
int
@@ -5510,9 +5685,6 @@ init_scheduler_data(ErtsSchedulerData* esdp, int num,
esdp->f_reg_array =
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_BEAM_REGISTER,
MAX_REG * sizeof(FloatDef));
-#if !HEAP_ON_C_STACK
- esdp->num_tmp_heap_used = 0;
-#endif
#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_RUNQ_IX_IS_DIRTY(runq->ix)) {
esdp->no = 0;
@@ -5572,6 +5744,9 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
char *daww_ptr;
size_t daww_sz;
size_t size_runqs;
+#ifdef ERTS_SMP
+ erts_aint32_t set_schdlr_sspnd_change_flags;
+#endif
init_misc_op_list_alloc();
init_proc_sys_task_queues_alloc();
@@ -5647,7 +5822,7 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
}
rq->out_of_work_count = 0;
rq->max_len = 0;
- rq->len = 0;
+ erts_smp_atomic32_set_nob(&rq->len, 0);
rq->wakeup_other = 0;
rq->wakeup_other_reds = 0;
rq->halt_in_progress = 0;
@@ -5797,9 +5972,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
#endif
init_misc_aux_work();
-#if !HALFWORD_HEAP
init_swtreq_alloc();
-#endif
+ init_screq_alloc();
erts_atomic32_init_nob(&debug_wait_completed_count, 0); /* debug only */
debug_wait_completed_flags = 0;
@@ -5810,25 +5984,6 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
erts_alloc_permanent_cache_aligned(ERTS_ALC_T_SCHDLR_DATA,
sizeof(ErtsAuxWorkData));
- erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd");
- erts_smp_cnd_init(&schdlr_sspnd.cnd);
-
- erts_smp_atomic32_init_nob(&schdlr_sspnd.changing, 0);
- schdlr_sspnd.online = no_schedulers_online;
- schdlr_sspnd.curr_online = no_schedulers;
- schdlr_sspnd.msb.ongoing = 0;
- erts_smp_atomic32_init_nob(&schdlr_sspnd.active, no_schedulers);
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_cpu_changing, 0);
- schdlr_sspnd.dirty_cpu_online = no_dirty_cpu_schedulers_online;
- schdlr_sspnd.dirty_cpu_curr_online = no_dirty_cpu_schedulers;
- erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_cpu_active, no_dirty_cpu_schedulers);
- erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_io_changing, 0);
- schdlr_sspnd.dirty_io_online = no_dirty_io_schedulers;
- schdlr_sspnd.dirty_io_curr_online = no_dirty_io_schedulers;
- erts_smp_atomic32_init_nob(&schdlr_sspnd.dirty_io_active, no_dirty_io_schedulers);
-#endif
- schdlr_sspnd.msb.procs = NULL;
init_no_runqs(no_schedulers_online, no_schedulers_online);
balance_info.last_active_runqs = no_schedulers;
erts_smp_mtx_init(&balance_info.update_mtx, "migration_info_update");
@@ -5843,32 +5998,66 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
init_migration_paths();
- if (no_schedulers_online < no_schedulers) {
+ init_scheduler_suspend();
+
+ set_schdlr_sspnd_change_flags = 0;
+
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL,
+ no_schedulers_online);
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.curr_online,
+ ERTS_SCHED_NORMAL,
+ no_schedulers);
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL,
+ no_schedulers);
+
+ if (no_schedulers_online != no_schedulers) {
+ ASSERT(no_schedulers_online < no_schedulers);
+ set_schdlr_sspnd_change_flags |= ERTS_SCHDLR_SSPND_CHNG_ONLN;
+ schdlr_sspnd.changer = am_init;
change_no_used_runqs(no_schedulers_online);
for (ix = no_schedulers_online; ix < erts_no_run_queues; ix++)
suspend_run_queue(ERTS_RUNQ_IX(ix));
}
- schdlr_sspnd.wait_curr_online = no_schedulers_online;
- schdlr_sspnd.curr_online *= 2; /* Boot strapping... */
- ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
#ifdef ERTS_DIRTY_SCHEDULERS
- schdlr_sspnd.dirty_cpu_wait_curr_online = no_dirty_cpu_schedulers_online;
- schdlr_sspnd.dirty_cpu_curr_online *= 2;
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- for (ix = no_dirty_cpu_schedulers_online; ix < no_dirty_cpu_schedulers; ix++) {
- ErtsSchedulerData* esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix);
- erts_smp_atomic32_read_bor_nob(&esdp->ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_DIRTY_CPU,
+ no_dirty_cpu_schedulers_online);
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.curr_online,
+ ERTS_SCHED_DIRTY_CPU,
+ no_dirty_cpu_schedulers);
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_DIRTY_CPU,
+ no_dirty_cpu_schedulers);
+
+ if (no_dirty_cpu_schedulers_online != no_dirty_cpu_schedulers) {
+ ASSERT(no_dirty_cpu_schedulers_online < no_dirty_cpu_schedulers);
+ set_schdlr_sspnd_change_flags |= ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN;
+ for (ix = no_dirty_cpu_schedulers_online; ix < no_dirty_cpu_schedulers; ix++) {
+ ErtsSchedulerData* esdp = ERTS_DIRTY_CPU_SCHEDULER_IX(ix);
+ erts_smp_atomic32_read_bor_nob(&esdp->ssi->flags, ERTS_SSI_FLG_SUSPENDED);
+ }
}
- schdlr_sspnd.dirty_io_wait_curr_online = no_dirty_io_schedulers;
- schdlr_sspnd.dirty_io_curr_online *= 2;
- ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_DIRTY_IO,
+ no_dirty_io_schedulers);
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.curr_online,
+ ERTS_SCHED_DIRTY_IO,
+ no_dirty_io_schedulers);
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_DIRTY_IO,
+ no_dirty_io_schedulers);
+
#endif
+ if (set_schdlr_sspnd_change_flags)
+ erts_smp_atomic32_set_nob(&schdlr_sspnd.changing,
+ set_schdlr_sspnd_change_flags);
+
erts_smp_atomic32_init_nob(&doing_sys_schedule, 0);
init_misc_aux_work();
@@ -5883,11 +6072,9 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online
#endif
}
erts_no_schedulers = 1;
-#ifdef ERTS_DIRTY_SCHEDULERS
erts_no_dirty_cpu_schedulers = 0;
erts_no_dirty_io_schedulers = 0;
#endif
-#endif
erts_smp_atomic32_init_nob(&function_calls, 0);
@@ -5979,19 +6166,96 @@ make_proxy_proc(Process *prev_proxy, Process *proc, erts_aint32_t prio)
return proxy;
}
-static ERTS_INLINE void
-free_proxy_proc(Process *proxy)
-{
- ASSERT(erts_smp_atomic32_read_nob(&proxy->state) & ERTS_PSFLG_PROXY);
- erts_free(ERTS_ALC_T_PROC, proxy);
-}
-
#define ERTS_ENQUEUE_NOT 0
#define ERTS_ENQUEUE_NORMAL_QUEUE 1
-#ifdef ERTS_DIRTY_SCHEDULERS
#define ERTS_ENQUEUE_DIRTY_CPU_QUEUE 2
#define ERTS_ENQUEUE_DIRTY_IO_QUEUE 3
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+static int
+check_dirty_enqueue_in_prio_queue(Process *c_p,
+ erts_aint32_t *newp,
+ erts_aint32_t actual,
+ erts_aint32_t aprio,
+ erts_aint32_t qbit)
+{
+ int queue;
+ erts_aint32_t dact, max_qbit;
+
+ /* Termination should be done on an ordinary scheduler */
+ if (actual & ERTS_PSFLG_EXITING) {
+ *newp &= ~ERTS_PSFLGS_DIRTY_WORK;
+ return ERTS_ENQUEUE_NORMAL_QUEUE;
+ }
+
+ /*
+ * If we have system tasks, we enqueue on ordinary run-queue
+ * and take care of those system tasks first.
+ */
+ if (actual & ERTS_PSFLG_ACTIVE_SYS)
+ return ERTS_ENQUEUE_NORMAL_QUEUE;
+
+ dact = erts_smp_atomic32_read_mb(&c_p->dirty_state);
+ if (actual & (ERTS_PSFLG_DIRTY_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_CPU_PROC)) {
+ max_qbit = ((dact >> ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET)
+ & ERTS_PDSFLGS_QMASK);
+ queue = ERTS_ENQUEUE_DIRTY_CPU_QUEUE;
+ }
+ else {
+ ASSERT(actual & ERTS_PSFLG_DIRTY_IO_PROC);
+ max_qbit = ((dact >> ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET)
+ & ERTS_PDSFLGS_QMASK);
+ queue = ERTS_ENQUEUE_DIRTY_IO_QUEUE;
+ }
+
+ max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS;
+ max_qbit &= -max_qbit;
+
+ if (qbit >= max_qbit)
+ return ERTS_ENQUEUE_NOT; /* Already queued in higher or equal prio */
+ if ((actual & (ERTS_PSFLG_IN_RUNQ|ERTS_PSFLGS_USR_PRIO_MASK))
+ != (aprio << ERTS_PSFLGS_USR_PRIO_OFFSET)) {
+ /*
+ * Process struct already enqueued, or actual prio not
+ * equal to user prio, i.e., enqueue using proxy.
+ */
+ return -1*queue;
+ }
+
+ *newp |= ERTS_PSFLG_IN_RUNQ;
+ return queue;
+}
+
+static ERTS_INLINE int
+fin_dirty_enq_s_change(Process *p,
+ int pstruct_reserved,
+ erts_aint32_t enq_prio,
+ int qmask_offset)
+{
+ erts_aint32_t qbit = 1 << enq_prio;
+ qbit <<= qmask_offset;
+
+ if (qbit & erts_smp_atomic32_read_bor_mb(&p->dirty_state, qbit)) {
+ /* Already enqueue by someone else... */
+ if (pstruct_reserved) {
+ /* We reserved process struct for enqueue; clear it... */
+#ifdef DEBUG
+ erts_aint32_t old =
+#else
+ (void)
#endif
+ erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_IN_RUNQ);
+ ASSERT(old & ERTS_PSFLG_IN_RUNQ);
+ }
+ return 0;
+ }
+
+ return !0;
+}
+
+#endif /* ERTS_DIRTY_SCHEDULERS */
static ERTS_INLINE int
check_enqueue_in_prio_queue(Process *c_p,
@@ -6007,61 +6271,14 @@ check_enqueue_in_prio_queue(Process *c_p,
*prq_prio_p = aprio;
#ifdef ERTS_DIRTY_SCHEDULERS
- if (actual & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) {
- /*
- * If we have system tasks of a priority higher
- * or equal to the user priority, we enqueue
- * on ordinary run-queue and take care of
- * those system tasks first.
- */
- if (actual & ERTS_PSFLG_ACTIVE_SYS) {
- erts_aint32_t uprio, stprio, qmask;
- uprio = (actual >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK;
- if (aprio < uprio)
- goto enqueue_normal_runq; /* system tasks with higher prio */
- erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS);
- qmask = c_p->sys_task_qs->qmask;
- erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS);
- switch (qmask & -qmask) {
- case MAX_BIT:
- stprio = PRIORITY_MAX;
- break;
- case HIGH_BIT:
- stprio = PRIORITY_HIGH;
- break;
- case NORMAL_BIT:
- stprio = PRIORITY_NORMAL;
- break;
- case LOW_BIT:
- stprio = PRIORITY_LOW;
- break;
- default:
- stprio = PRIORITY_LOW+1;
- break;
- }
- if (stprio <= uprio)
- goto enqueue_normal_runq; /* system tasks with higher prio */
- }
-
- /* Enqueue in dirty run queue if not already enqueued */
- if (actual & (ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q))
- return ERTS_ENQUEUE_NOT; /* already in queue */
- if (actual & ERTS_PSFLG_DIRTY_CPU_PROC) {
- *newp |= ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q;
- if (actual & ERTS_PSFLG_IN_RUNQ)
- return -ERTS_ENQUEUE_DIRTY_CPU_QUEUE; /* use proxy */
- *newp |= ERTS_PSFLG_IN_RUNQ;
- return ERTS_ENQUEUE_DIRTY_CPU_QUEUE;
- }
- *newp |= ERTS_PSFLG_DIRTY_IO_PROC_IN_Q;
- if (actual & ERTS_PSFLG_IN_RUNQ)
- return -ERTS_ENQUEUE_DIRTY_IO_QUEUE; /* use proxy */
- *newp |= ERTS_PSFLG_IN_RUNQ;
- return ERTS_ENQUEUE_DIRTY_IO_QUEUE;
+ if (actual & ERTS_PSFLGS_DIRTY_WORK) {
+ int res = check_dirty_enqueue_in_prio_queue(c_p, newp, actual,
+ aprio, qbit);
+ if (res != ERTS_ENQUEUE_NORMAL_QUEUE)
+ return res;
}
-
- enqueue_normal_runq:
#endif
+
max_qbit = (actual >> ERTS_PSFLGS_IN_PRQ_MASK_OFFSET) & ERTS_PSFLGS_QMASK;
max_qbit |= 1 << ERTS_PSFLGS_QMASK_BITS;
max_qbit &= -max_qbit;
@@ -6093,6 +6310,65 @@ check_enqueue_in_prio_queue(Process *c_p,
return ERTS_ENQUEUE_NORMAL_QUEUE;
}
+static ERTS_INLINE ErtsRunQueue *
+select_enqueue_run_queue(int enqueue, int enq_prio, Process *p, erts_aint32_t state)
+{
+
+ switch (enqueue) {
+
+ case ERTS_ENQUEUE_NOT:
+
+ return NULL;
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+ case ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
+ case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
+
+ if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio,
+ ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET))
+ return ERTS_DIRTY_CPU_RUNQ;
+
+ return NULL;
+
+
+ case ERTS_ENQUEUE_DIRTY_IO_QUEUE:
+ case -ERTS_ENQUEUE_DIRTY_IO_QUEUE:
+
+ if (fin_dirty_enq_s_change(p, enqueue > 0, enq_prio,
+ ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET))
+ return ERTS_DIRTY_IO_RUNQ;
+
+ return NULL;
+
+#endif
+
+ default: {
+ ErtsRunQueue* runq;
+
+ ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE
+ || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE);
+
+ runq = erts_get_runq_proc(p);
+
+#ifdef ERTS_SMP
+ if (!(ERTS_PSFLG_BOUND & state)) {
+ ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio);
+ if (new_runq) {
+ RUNQ_SET_RQ(&p->run_queue, new_runq);
+ runq = new_runq;
+ }
+ }
+#endif
+
+ ASSERT(runq);
+
+ return runq;
+ }
+ }
+}
+
+
/*
* schedule_out_process() return with c_rq locked.
*/
@@ -6101,11 +6377,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
{
erts_aint32_t a, e, n, enq_prio = -1;
int enqueue; /* < 0 -> use proxy */
- Process* sched_p;
ErtsRunQueue* runq;
-#ifdef ERTS_SMP
- int check_emigration_need;
-#endif
a = state;
@@ -6117,7 +6389,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
enqueue = ERTS_ENQUEUE_NOT;
n &= ~(ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS);
- if (a & ERTS_PSFLG_ACTIVE_SYS
+ if (a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS)
|| (a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE) {
enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a);
}
@@ -6126,16 +6398,17 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
break;
}
- switch (enqueue) {
- case ERTS_ENQUEUE_NOT:
+ runq = select_enqueue_run_queue(enqueue, enq_prio, p, n);
+
+ if (!runq) {
+
if (erts_system_profile_flags.runnable_procs) {
/* Status lock prevents out of order "runnable proc" trace msgs */
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
- if (!(a & ERTS_PSFLG_ACTIVE_SYS)
- && (!(a & ERTS_PSFLG_ACTIVE)
- || (a & ERTS_PSFLG_SUSPENDED))) {
+ if (!(a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) {
/* Process inactive */
profile_runnable_proc(p, am_inactive);
}
@@ -6148,98 +6421,76 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces
return 0;
-#ifdef ERTS_DIRTY_SCHEDULERS
-#ifdef ERTS_SMP
- case ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
- case -ERTS_ENQUEUE_DIRTY_CPU_QUEUE:
- runq = ERTS_DIRTY_CPU_RUNQ;
- ASSERT(ERTS_SCHEDULER_IS_DIRTY_CPU(runq->scheduler));
-#ifdef ERTS_SMP
- check_emigration_need = 0;
-#endif
- break;
+ }
+ else {
+ Process* sched_p;
- case ERTS_ENQUEUE_DIRTY_IO_QUEUE:
- case -ERTS_ENQUEUE_DIRTY_IO_QUEUE:
- runq = ERTS_DIRTY_IO_RUNQ;
- ASSERT(ERTS_SCHEDULER_IS_DIRTY_IO(runq->scheduler));
-#ifdef ERTS_SMP
- check_emigration_need = 0;
-#endif
- break;
-#endif
-#endif
+ ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS)));
- default:
- ASSERT(enqueue == ERTS_ENQUEUE_NORMAL_QUEUE
- || enqueue == -ERTS_ENQUEUE_NORMAL_QUEUE);
+ if (enqueue < 0)
+ sched_p = make_proxy_proc(proxy, p, enq_prio);
+ else {
+ sched_p = p;
+ if (proxy)
+ free_proxy_proc(proxy);
+ }
- runq = erts_get_runq_proc(p);
-#ifdef ERTS_SMP
- check_emigration_need = !(ERTS_PSFLG_BOUND & n);
-#endif
- break;
- }
+ ASSERT(runq);
- ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & ERTS_PSFLG_ACTIVE_SYS));
+ erts_smp_runq_lock(runq);
- if (enqueue < 0)
- sched_p = make_proxy_proc(proxy, p, enq_prio);
- else {
- sched_p = p;
- if (proxy)
- free_proxy_proc(proxy);
- }
+ /* Enqueue the process */
+ enqueue_process(runq, (int) enq_prio, sched_p);
-#ifdef ERTS_SMP
- if (check_emigration_need) {
- ErtsRunQueue *new_runq = erts_check_emigration_need(runq, enq_prio);
- if (new_runq) {
- RUNQ_SET_RQ(&sched_p->run_queue, new_runq);
- runq = new_runq;
- }
- }
-#endif
+ if (runq == c_rq)
+ return 1;
- ASSERT(runq);
+ erts_smp_runq_unlock(runq);
- erts_smp_runq_lock(runq);
+ smp_notify_inc_runq(runq);
- /* Enqueue the process */
- enqueue_process(runq, (int) enq_prio, sched_p);
+ erts_smp_runq_lock(c_rq);
- if (runq == c_rq)
return 1;
- erts_smp_runq_unlock(runq);
- smp_notify_inc_runq(runq);
- erts_smp_runq_lock(c_rq);
- return 1;
+ }
+
}
static ERTS_INLINE void
-add2runq(Process *p, erts_aint32_t state, erts_aint32_t prio)
+add2runq(int enqueue, erts_aint32_t prio,
+ Process *proc, erts_aint32_t state,
+ Process **proxy)
{
- ErtsRunQueue *runq = erts_get_runq_proc(p);
+ ErtsRunQueue *runq;
-#ifdef ERTS_SMP
- if (!(ERTS_PSFLG_BOUND & state)) {
- ErtsRunQueue *new_runq = erts_check_emigration_need(runq, (int) prio);
- if (new_runq) {
- RUNQ_SET_RQ(&p->run_queue, new_runq);
- runq = new_runq;
- }
- }
-#endif
- ASSERT(runq);
+ runq = select_enqueue_run_queue(enqueue, prio, proc, state);
- erts_smp_runq_lock(runq);
+ if (runq) {
+ Process *sched_p;
- /* Enqueue the process */
- enqueue_process(runq, (int) prio, p);
+ if (enqueue > 0)
+ sched_p = proc;
+ else {
+ Process *pxy;
- erts_smp_runq_unlock(runq);
- smp_notify_inc_runq(runq);
+ if (!proxy)
+ pxy = NULL;
+ else {
+ pxy = *proxy;
+ *proxy = NULL;
+ }
+ sched_p = make_proxy_proc(pxy, proc, prio);
+ }
+
+ erts_smp_runq_lock(runq);
+
+ /* Enqueue the process */
+ enqueue_process(runq, (int) prio, sched_p);
+ erts_smp_runq_unlock(runq);
+ smp_notify_inc_runq(runq);
+ }
}
static ERTS_INLINE int
@@ -6345,10 +6596,7 @@ schedule_process(Process *p, erts_aint32_t in_state, ErtsProcLocks locks)
&state,
&enq_prio,
locks);
- if (enqueue != ERTS_ENQUEUE_NOT)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
void
@@ -6357,22 +6605,99 @@ erts_schedule_process(Process *p, erts_aint32_t state, ErtsProcLocks locks)
schedule_process(p, state, locks);
}
-static void
-schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy)
+static int
+schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st)
{
- /*
- * Expects status lock to be locked when called, and
- * returns with status lock unlocked...
- */
- erts_aint32_t a = state, n, enq_prio = -1;
+ int res;
+ int locked;
+ ErtsProcSysTaskQs *stqs, *free_stqs;
+ erts_aint32_t state, a, n, enq_prio;
int enqueue; /* < 0 -> use proxy */
- unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs;
+ unsigned int prof_runnable_procs;
+
+ res = 1; /* prepare for success */
+ st->next = st->prev = st; /* Prep for empty prio queue */
+ state = erts_smp_atomic32_read_nob(&p->state);
+ prof_runnable_procs = erts_system_profile_flags.runnable_procs;
+ locked = 0;
+ free_stqs = NULL;
+ if (state & ERTS_PSFLG_ACTIVE_SYS)
+ stqs = NULL;
+ else {
+ alloc_qs:
+ stqs = proc_sys_task_queues_alloc();
+ stqs->qmask = 1 << prio;
+ stqs->ncount = 0;
+ stqs->q[PRIORITY_MAX] = NULL;
+ stqs->q[PRIORITY_HIGH] = NULL;
+ stqs->q[PRIORITY_NORMAL] = NULL;
+ stqs->q[PRIORITY_LOW] = NULL;
+ stqs->q[prio] = st;
+ }
+
+ if (!locked) {
+ locked = 1;
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+
+ state = erts_smp_atomic32_read_nob(&p->state);
+ if (state & ERTS_PSFLG_EXITING) {
+ free_stqs = stqs;
+ res = 0;
+ goto cleanup;
+ }
+ }
+
+ if (!p->sys_task_qs) {
+ if (stqs)
+ p->sys_task_qs = stqs;
+ else
+ goto alloc_qs;
+ }
+ else {
+ free_stqs = stqs;
+ stqs = p->sys_task_qs;
+ if (!stqs->q[prio]) {
+ stqs->q[prio] = st;
+ stqs->qmask |= 1 << prio;
+ }
+ else {
+ st->next = stqs->q[prio];
+ st->prev = stqs->q[prio]->prev;
+ st->next->prev = st;
+ st->prev->next = st;
+ ASSERT(stqs->qmask & (1 << prio));
+ }
+ }
+
+ if (ERTS_PSFLGS_GET_ACT_PRIO(state) > prio) {
+ erts_aint32_t n, a, e;
+ /* Need to elevate actual prio */
+
+ a = state;
+ do {
+ if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) {
+ n = a;
+ break;
+ }
+ n = e = a;
+ n &= ~ERTS_PSFLGS_ACT_PRIO_MASK;
+ n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET);
+ a = erts_smp_atomic32_cmpxchg_nob(&p->state, n, e);
+ } while (a != e);
+ state = n;
+ }
+
+
+ a = state;
+ enq_prio = -1;
/* Status lock prevents out of order "runnable proc" trace msgs */
ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p));
- if (!prof_runnable_procs)
+ if (!prof_runnable_procs) {
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ locked = 0;
+ }
ASSERT(!(state & ERTS_PSFLG_PROXY));
@@ -6380,8 +6705,10 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy)
erts_aint32_t e;
n = e = a;
- if (a & ERTS_PSFLG_FREE)
+ if (a & ERTS_PSFLG_FREE) {
+ res = 0;
goto cleanup; /* We don't want to schedule free processes... */
+ }
enqueue = ERTS_ENQUEUE_NOT;
n |= ERTS_PSFLG_ACTIVE_SYS;
@@ -6405,29 +6732,22 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy)
}
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- prof_runnable_procs = 0;
+ locked = 0;
}
- if (enqueue != ERTS_ENQUEUE_NOT) {
- Process *sched_p;
- if (enqueue > 0)
- sched_p = p;
- else {
- sched_p = make_proxy_proc(proxy, p, enq_prio);
- proxy = NULL;
- }
- add2runq(sched_p, n, enq_prio);
- }
+ add2runq(enqueue, enq_prio, p, n, NULL);
cleanup:
- if (prof_runnable_procs)
+ if (locked)
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
- if (proxy)
- free_proxy_proc(proxy);
+ if (free_stqs)
+ proc_sys_task_queues_free(free_stqs);
ERTS_SMP_LC_ASSERT(!(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)));
+
+ return res;
}
static ERTS_INLINE int
@@ -6469,9 +6789,6 @@ suspend_process(Process *c_p, Process *p)
if (suspended) {
- ASSERT(!(ERTS_PSFLG_RUNNING & state)
- || p == erts_get_current_process());
-
if (suspended > 0 && erts_system_profile_flags.runnable_procs) {
/* 'state' is before our change... */
@@ -6513,23 +6830,7 @@ resume_process(Process *p, ErtsProcLocks locks)
&state,
&enq_prio,
locks);
- if (enqueue)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
-}
-
-int
-erts_get_max_no_executing_schedulers(void)
-{
-#ifdef ERTS_SMP
- if (erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))
- return (int) erts_no_schedulers;
- ERTS_THR_MEMORY_BARRIER;
- return (int) erts_smp_atomic32_read_nob(&schdlr_sspnd.active);
-#else
- return 1;
-#endif
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
#ifdef ERTS_SMP
@@ -6634,42 +6935,82 @@ sched_set_suspended_sleeptype(ErtsSchedulerSleepInfo *ssi)
}
}
-#ifdef ERTS_DIRTY_SCHEDULERS
+static void
+init_scheduler_suspend(void)
+{
+ erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd");
+ schdlr_sspnd.online = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0);
+ schdlr_sspnd.curr_online = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0);
+ schdlr_sspnd.active = ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0);
+ erts_smp_atomic32_init_nob(&schdlr_sspnd.changing, 0);
+ schdlr_sspnd.chngq = NULL;
+ schdlr_sspnd.changer = am_false;
+ schdlr_sspnd.nmsb.ongoing = 0;
+ schdlr_sspnd.nmsb.blckrs = NULL;
+ schdlr_sspnd.nmsb.chngq = NULL;
+ schdlr_sspnd.msb.ongoing = 0;
+ schdlr_sspnd.msb.blckrs = NULL;
+ schdlr_sspnd.msb.chngq = NULL;
+}
+
+typedef struct {
+ struct {
+ Eterm chngr;
+ Eterm nxt;
+ } onln;
+ struct {
+ ErtsProcList *chngrs;
+ } msb;
+} ErtsSchdlrSspndResume;
+
+static void
+schdlr_sspnd_resume_proc(Eterm pid)
+{
+ Process *p = erts_pid2proc(NULL, 0, pid, ERTS_PROC_LOCK_STATUS);
+ if (p) {
+ resume_process(p, ERTS_PROC_LOCK_STATUS);
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ }
+}
+
+static ERTS_INLINE void
+schdlr_sspnd_resume_procs(ErtsSchedType sched_type,
+ ErtsSchdlrSspndResume *resume)
+{
+ if (is_internal_pid(resume->onln.chngr)) {
+ schdlr_sspnd_resume_proc(resume->onln.chngr);
+ resume->onln.chngr = NIL;
+ }
+ if (is_internal_pid(resume->onln.nxt)) {
+ schdlr_sspnd_resume_proc(resume->onln.nxt);
+ resume->onln.nxt = NIL;
+ }
+ while (resume->msb.chngrs) {
+ ErtsProcList *plp = resume->msb.chngrs;
+ resume->msb.chngrs = plp->next;
+ schdlr_sspnd_resume_proc(plp->pid);
+ proclist_destroy(plp);
+ }
+}
static void
suspend_scheduler(ErtsSchedulerData *esdp)
{
erts_aint32_t flgs;
erts_aint32_t changing;
-#ifdef ERTS_DIRTY_SCHEDULERS
- long no = (long) (ERTS_SCHEDULER_IS_DIRTY(esdp)
- ? ERTS_DIRTY_SCHEDULER_NO(esdp)
- : esdp->no);
-#else
- long no = (long) esdp->no;
-#endif
+ long no;
ErtsSchedulerSleepInfo *ssi = esdp->ssi;
- long active_schedulers;
int curr_online = 1;
- int wake = 0;
+ ErtsSchdlrSspndResume resume = {{NIL, NIL}, {NULL}};
erts_aint32_t aux_work;
int thr_prgr_active = 1;
ErtsStuckBoundProcesses sbp = {NULL, NULL};
- int* ss_onlinep;
- int* ss_curr_onlinep;
- int* ss_wait_curr_onlinep;
- long* ss_wait_activep;
- long ss_wait_active_target;
- erts_smp_atomic32_t* ss_changingp;
- erts_smp_atomic32_t* ss_activep;
+ ErtsSchedType sched_type;
+ erts_aint32_t online_flag;
/*
* Schedulers may be suspended in two different ways:
* - A scheduler may be suspended since it is not online.
- * All schedulers with scheduler ids greater than
- * schdlr_sspnd.online are suspended; same for dirty
- * schedulers and schdlr_sspnd.dirty_cpu_online and
- * schdlr_sspnd.dirty_io_online.
* - Multi scheduling is blocked. All schedulers except the
* scheduler with scheduler id 1 are suspended, and all
* dirty CPU and dirty I/O schedulers are suspended.
@@ -6677,27 +7018,43 @@ suspend_scheduler(ErtsSchedulerData *esdp)
* Regardless of why a scheduler is suspended, it ends up here.
*/
- ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp) || no != 1);
-
#ifdef ERTS_DIRTY_SCHEDULERS
if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ no = ERTS_DIRTY_SCHEDULER_NO(esdp);
+ if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) {
+ online_flag = ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN;
+ sched_type = ERTS_SCHED_DIRTY_CPU;
+ }
+ else {
+ online_flag = 0;
+ sched_type = ERTS_SCHED_DIRTY_IO;
+ }
+ }
+ else
+#endif
+ {
+ online_flag = ERTS_SCHDLR_SSPND_CHNG_ONLN;
+ no = esdp->no;
+ sched_type = ERTS_SCHED_NORMAL;
+ }
+
+ ASSERT(sched_type != ERTS_SCHED_NORMAL || no != 1);
+
+ if (sched_type != ERTS_SCHED_NORMAL) {
if (erts_smp_mtx_trylock(&schdlr_sspnd.mtx) == EBUSY) {
erts_smp_runq_unlock(esdp->run_queue);
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
erts_smp_runq_lock(esdp->run_queue);
}
- if (ongoing_multi_scheduling_block())
+ if (schdlr_sspnd.msb.ongoing)
evacuate_run_queue(esdp->run_queue, &sbp);
- } else
-#endif
+ erts_smp_runq_unlock(esdp->run_queue);
+ }
+ else {
evacuate_run_queue(esdp->run_queue, &sbp);
- erts_smp_runq_unlock(esdp->run_queue);
+ erts_smp_runq_unlock(esdp->run_queue);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- {
erts_sched_check_cpu_bind_prep_suspend(esdp);
if (erts_system_profile_flags.scheduler)
@@ -6711,317 +7068,115 @@ suspend_scheduler(ErtsSchedulerData *esdp)
flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED);
if (flgs & ERTS_SSI_FLG_SUSPENDED) {
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- if (ERTS_RUNQ_IS_DIRTY_CPU_RUNQ(esdp->run_queue)) {
- active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.dirty_cpu_active);
- ASSERT(active_schedulers >= 0);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing);
- ss_onlinep = &schdlr_sspnd.dirty_cpu_online;
- ss_curr_onlinep = &schdlr_sspnd.dirty_cpu_curr_online;
- ss_wait_curr_onlinep = &schdlr_sspnd.dirty_cpu_wait_curr_online;
- ss_changingp = &schdlr_sspnd.dirty_cpu_changing;
- ss_wait_activep = &schdlr_sspnd.msb.dirty_cpu_wait_active;
- ss_activep = &schdlr_sspnd.dirty_cpu_active;
- } else {
- active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.dirty_io_active);
- ASSERT(active_schedulers >= 0);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing);
- ss_onlinep = &schdlr_sspnd.dirty_io_online;
- ss_curr_onlinep = &schdlr_sspnd.dirty_io_curr_online;
- ss_wait_curr_onlinep = &schdlr_sspnd.dirty_io_wait_curr_online;
- ss_changingp = &schdlr_sspnd.dirty_io_changing;
- ss_wait_activep = &schdlr_sspnd.msb.dirty_io_wait_active;
- ss_activep = &schdlr_sspnd.dirty_io_active;
- }
- ss_wait_active_target = 0;
- }
- else
-#endif
- {
- active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.active);
- ASSERT(active_schedulers >= 1);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
- ss_onlinep = &schdlr_sspnd.online;
- ss_curr_onlinep = &schdlr_sspnd.curr_online;
- ss_wait_curr_onlinep = &schdlr_sspnd.wait_curr_online;
- ss_changingp = &schdlr_sspnd.changing;
- ss_wait_activep = &schdlr_sspnd.msb.wait_active;
- ss_activep = &schdlr_sspnd.active;
- ss_wait_active_target = 1;
- }
- if (changing & ERTS_SCHDLR_SSPND_CHNG_MSB) {
- if (active_schedulers == *ss_wait_activep)
- wake = 1;
- if (active_schedulers == ss_wait_active_target) {
- changing = erts_smp_atomic32_read_band_nob(ss_changingp,
- ~ERTS_SCHDLR_SSPND_CHNG_MSB);
- changing &= ~ERTS_SCHDLR_SSPND_CHNG_MSB;
- }
- }
-
- while (1) {
- if (changing & ERTS_SCHDLR_SSPND_CHNG_ONLN) {
- int changed = 0;
- if (no > *ss_onlinep && curr_online) {
- (*ss_curr_onlinep)--;
- curr_online = 0;
- changed = 1;
- }
- else if (no <= *ss_onlinep && !curr_online) {
- (*ss_curr_onlinep)++;
- curr_online = 1;
- changed = 1;
- }
- if (changed
- && *ss_curr_onlinep == *ss_wait_curr_onlinep)
- wake = 1;
- if (*ss_onlinep == *ss_curr_onlinep) {
- changing = erts_smp_atomic32_read_band_nob(ss_changingp,
- ~ERTS_SCHDLR_SSPND_CHNG_ONLN);
- changing &= ~ERTS_SCHDLR_SSPND_CHNG_ONLN;
- }
- }
+ schdlr_sspnd_dec_nscheds(&schdlr_sspnd.active, sched_type);
- if (wake) {
- erts_smp_cnd_signal(&schdlr_sspnd.cnd);
- wake = 0;
- }
+ ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL) >= 1);
- if (curr_online && !ongoing_multi_scheduling_block()) {
- flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
- if (!(flgs & ERTS_SSI_FLG_SUSPENDED))
- break;
- }
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
- while (1) {
- erts_aint32_t qmask;
- erts_aint32_t flgs;
+ while (1) {
- qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue)
- & ERTS_RUNQ_FLGS_QMASK);
- aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
- if (aux_work|qmask) {
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- if (aux_work)
- aux_work = handle_aux_work(&esdp->aux_work_data,
- aux_work,
- 1);
-
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) &&
- (aux_work && erts_thr_progress_update(esdp)))
- erts_thr_progress_leader_update(esdp);
- if (qmask) {
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- erts_smp_runq_lock(esdp->run_queue);
- if (ongoing_multi_scheduling_block())
- evacuate_run_queue(esdp->run_queue, &sbp);
- erts_smp_runq_unlock(esdp->run_queue);
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
- } else
-#endif
- {
- erts_smp_runq_lock(esdp->run_queue);
- evacuate_run_queue(esdp->run_queue, &sbp);
- erts_smp_runq_unlock(esdp->run_queue);
- }
+ if (changing & (ERTS_SCHDLR_SSPND_CHNG_NMSB
+ | ERTS_SCHDLR_SSPND_CHNG_MSB)) {
+ int i = 0;
+ ErtsMultiSchedulingBlock *msb[3] = {0};
+ if (changing & ERTS_SCHDLR_SSPND_CHNG_NMSB)
+ msb[i++] = &schdlr_sspnd.nmsb;
+ if (changing & ERTS_SCHDLR_SSPND_CHNG_MSB)
+ msb[i++] = &schdlr_sspnd.msb;
+
+ for (i = 0; msb[i]; i++) {
+ erts_aint32_t clr_flg = 0;
+
+ if (msb[i] == &schdlr_sspnd.nmsb
+ && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL) == 1) {
+ clr_flg = ERTS_SCHDLR_SSPND_CHNG_NMSB;
}
- }
-
- if (!aux_work) {
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- {
- if (thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 0);
- sched_wall_time_change(esdp, 0);
- }
- erts_thr_progress_prepare_wait(esdp);
+ else if (schdlr_sspnd.active
+ == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0)) {
+ clr_flg = ERTS_SCHDLR_SSPND_CHNG_MSB;
}
- flgs = sched_spin_suspended(ssi,
- ERTS_SCHED_SUSPEND_SLEEP_SPINCOUNT);
- if (flgs == (ERTS_SSI_FLG_SLEEPING
- | ERTS_SSI_FLG_WAITING
- | ERTS_SSI_FLG_SUSPENDED)) {
- flgs = sched_set_suspended_sleeptype(ssi);
- if (flgs == (ERTS_SSI_FLG_SLEEPING
- | ERTS_SSI_FLG_TSE_SLEEPING
- | ERTS_SSI_FLG_WAITING
- | ERTS_SSI_FLG_SUSPENDED)) {
- int res;
- do {
- res = erts_tse_twait(ssi->event, -1);
- } while (res == EINTR);
+ if (clr_flg) {
+ ErtsProcList *plp, *end_plp;
+ changing = erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ ~clr_flg);
+ changing &= ~clr_flg;
+ (void) erts_proclist_fetch(&msb[i]->chngq, &end_plp);
+ /* resume processes that initiated the multi scheduling block... */
+ plp = msb[i]->chngq;
+ while (plp) {
+ erts_proclist_store_last(&msb[i]->blckrs,
+ proclist_copy(plp));
+ plp = plp->next;
}
+ if (end_plp)
+ end_plp->next = resume.msb.chngrs;
+ resume.msb.chngrs = msb[i]->chngq;
+ msb[i]->chngq = NULL;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- erts_thr_progress_finalize_wait(esdp);
}
-
- flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING
- | ERTS_SSI_FLG_SUSPENDED));
- if (!(flgs & ERTS_SSI_FLG_SUSPENDED))
- break;
- changing = erts_smp_atomic32_read_nob(ss_changingp);
- if (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER)
- break;
}
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- changing = erts_smp_atomic32_read_nob(ss_changingp);
- }
-
- active_schedulers = erts_smp_atomic32_inc_read_nob(ss_activep);
- changing = erts_smp_atomic32_read_nob(ss_changingp);
- if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB)
- && *ss_onlinep == active_schedulers) {
- erts_smp_atomic32_read_band_nob(ss_changingp,
- ~ERTS_SCHDLR_SSPND_CHNG_MSB);
- }
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- ASSERT(no <= *ss_onlinep);
- ASSERT(!ongoing_multi_scheduling_block());
-
- }
-
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-
- ASSERT(curr_online);
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- {
- if (erts_system_profile_flags.scheduler)
- profile_scheduler(make_small(esdp->no), am_active);
-
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- }
-
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
- (void) erts_get_monotonic_time(esdp);
- erts_smp_runq_lock(esdp->run_queue);
- non_empty_runq(esdp->run_queue);
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
-#endif
- {
- schedule_bound_processes(esdp->run_queue, &sbp);
-
- erts_sched_check_cpu_bind_post_suspend(esdp);
- }
-}
-
-#else /* !ERTS_DIRTY_SCHEDULERS */
-
-static void
-suspend_scheduler(ErtsSchedulerData *esdp)
-{
- erts_aint32_t flgs;
- erts_aint32_t changing;
- long no = (long) esdp->no;
- ErtsSchedulerSleepInfo *ssi = esdp->ssi;
- long active_schedulers;
- int curr_online = 1;
- int wake = 0;
- erts_aint32_t aux_work;
- int thr_prgr_active = 1;
- ErtsStuckBoundProcesses sbp = {NULL, NULL};
-
- /*
- * Schedulers may be suspended in two different ways:
- * - A scheduler may be suspended since it is not online.
- * All schedulers with scheduler ids greater than
- * schdlr_sspnd.online are suspended.
- * - Multi scheduling is blocked. All schedulers except the
- * scheduler with scheduler id 1 are suspended.
- *
- * Regardless of why a scheduler is suspended, it ends up here.
- */
-
- ASSERT(no != 1);
-
- evacuate_run_queue(esdp->run_queue, &sbp);
-
- erts_smp_runq_unlock(esdp->run_queue);
-
- erts_sched_check_cpu_bind_prep_suspend(esdp);
-
- if (erts_system_profile_flags.scheduler)
- profile_scheduler(make_small(esdp->no), am_inactive);
-
- sched_wall_time_change(esdp, 0);
-
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
-
- flgs = sched_prep_spin_suspended(ssi, ERTS_SSI_FLG_SUSPENDED);
- if (flgs & ERTS_SSI_FLG_SUSPENDED) {
-
- active_schedulers = erts_smp_atomic32_dec_read_nob(&schdlr_sspnd.active);
- ASSERT(active_schedulers >= 1);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
- if (changing & ERTS_SCHDLR_SSPND_CHNG_MSB) {
- if (active_schedulers == schdlr_sspnd.msb.wait_active)
- wake = 1;
- if (active_schedulers == 1) {
- changing = erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
- ~ERTS_SCHDLR_SSPND_CHNG_MSB);
- changing &= ~ERTS_SCHDLR_SSPND_CHNG_MSB;
- }
- }
-
- while (1) {
- if (changing & ERTS_SCHDLR_SSPND_CHNG_ONLN) {
+ if (changing & online_flag) {
int changed = 0;
- if (no > schdlr_sspnd.online && curr_online) {
- schdlr_sspnd.curr_online--;
+ Uint32 st_online;
+
+ st_online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ sched_type);
+ if (no > st_online && curr_online) {
+ schdlr_sspnd_dec_nscheds(&schdlr_sspnd.curr_online,
+ sched_type);
curr_online = 0;
changed = 1;
}
- else if (no <= schdlr_sspnd.online && !curr_online) {
- schdlr_sspnd.curr_online++;
+ else if (no <= st_online && !curr_online) {
+ schdlr_sspnd_inc_nscheds(&schdlr_sspnd.curr_online,
+ sched_type);
curr_online = 1;
changed = 1;
}
if (changed
- && schdlr_sspnd.curr_online == schdlr_sspnd.wait_curr_online)
- wake = 1;
- if (schdlr_sspnd.online == schdlr_sspnd.curr_online) {
+ && (schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ sched_type)
+ == schdlr_sspnd_get_nscheds(&schdlr_sspnd.curr_online,
+ sched_type))) {
+ ErtsProcList *plp;
changing = erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
- ~ERTS_SCHDLR_SSPND_CHNG_ONLN);
- changing &= ~ERTS_SCHDLR_SSPND_CHNG_ONLN;
+ ~online_flag);
+ changing &= ~online_flag;
+ if (sched_type == ERTS_SCHED_NORMAL) {
+ ASSERT(is_internal_pid(schdlr_sspnd.changer)
+ || schdlr_sspnd.changer == am_init);
+ /* resume process that initiated this change... */
+ resume.onln.chngr = schdlr_sspnd.changer;
+ plp = erts_proclist_peek_first(schdlr_sspnd.chngq);
+ if (!plp)
+ schdlr_sspnd.changer = am_false;
+ else {
+ schdlr_sspnd.changer = am_true; /* change right in transit */
+ /* resume process that is queued for next change... */
+ resume.onln.nxt = plp->pid;
+ ASSERT(is_internal_pid(resume.onln.nxt));
+ }
+ }
}
}
- if (wake) {
- erts_smp_cnd_signal(&schdlr_sspnd.cnd);
- wake = 0;
- }
-
- if (curr_online && !ongoing_multi_scheduling_block()) {
+ if (curr_online
+ && (sched_type == ERTS_SCHED_NORMAL
+ ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)
+ : !schdlr_sspnd.msb.ongoing)) {
flgs = erts_smp_atomic32_read_acqb(&ssi->flags);
if (!(flgs & ERTS_SSI_FLG_SUSPENDED))
break;
}
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ schdlr_sspnd_resume_procs(sched_type, &resume);
+
while (1) {
ErtsMonotonicTime current_time;
erts_aint32_t qmask;
@@ -7029,55 +7184,78 @@ suspend_scheduler(ErtsSchedulerData *esdp)
qmask = (ERTS_RUNQ_FLGS_GET(esdp->run_queue)
& ERTS_RUNQ_FLGS_QMASK);
- aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
- if (aux_work|qmask) {
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- if (aux_work)
- aux_work = handle_aux_work(&esdp->aux_work_data,
- aux_work,
- 1);
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && aux_work &&
- erts_thr_progress_update(esdp))
- erts_thr_progress_leader_update(esdp);
+
+ if (sched_type != ERTS_SCHED_NORMAL) {
if (qmask) {
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
erts_smp_runq_lock(esdp->run_queue);
- evacuate_run_queue(esdp->run_queue, &sbp);
+ if (schdlr_sspnd.msb.ongoing)
+ evacuate_run_queue(esdp->run_queue, &sbp);
erts_smp_runq_unlock(esdp->run_queue);
+ erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
}
+ aux_work = 0;
+ }
+ else {
+
+ aux_work = erts_atomic32_read_acqb(&ssi->aux_work);
+
+ if (aux_work|qmask) {
+ if (!thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ sched_wall_time_change(esdp, 1);
+ }
+ if (aux_work)
+ aux_work = handle_aux_work(&esdp->aux_work_data,
+ aux_work,
+ 1);
+
+ if (aux_work && erts_thr_progress_update(esdp))
+ erts_thr_progress_leader_update(esdp);
+ if (qmask) {
+ erts_smp_runq_lock(esdp->run_queue);
+ evacuate_run_queue(esdp->run_queue, &sbp);
+ erts_smp_runq_unlock(esdp->run_queue);
+ }
+ }
+
}
if (aux_work) {
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
- current_time = erts_get_monotonic_time(esdp);
- if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) {
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
- }
- erts_bump_timers(esdp->timer_wheel, current_time);
+ ASSERT(sched_type == ERTS_SCHED_NORMAL);
+ current_time = erts_get_monotonic_time(esdp);
+ if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref)) {
+ if (!thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ sched_wall_time_change(esdp, 1);
}
+ erts_bump_timers(esdp->timer_wheel, current_time);
}
}
else {
ErtsMonotonicTime timeout_time;
- int do_timeout = 0;
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ int do_timeout;
+
+ if (sched_type == ERTS_SCHED_NORMAL) {
timeout_time = erts_check_next_timeout_time(esdp);
current_time = erts_get_monotonic_time(esdp);
do_timeout = (current_time >= timeout_time);
- } else
+ }
+ else {
timeout_time = ERTS_MONOTONIC_TIME_MAX;
+ current_time = 0;
+ do_timeout = 0;
+ }
+
if (do_timeout) {
+ ASSERT(sched_type == ERTS_SCHED_NORMAL);
if (!thr_prgr_active) {
erts_thr_progress_active(esdp, thr_prgr_active = 1);
sched_wall_time_change(esdp, 1);
}
}
else {
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (sched_type == ERTS_SCHED_NORMAL) {
if (thr_prgr_active) {
erts_thr_progress_active(esdp, thr_prgr_active = 0);
sched_wall_time_change(esdp, 0);
@@ -7096,30 +7274,39 @@ suspend_scheduler(ErtsSchedulerData *esdp)
| ERTS_SSI_FLG_SUSPENDED)) {
int res;
- current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
- erts_get_monotonic_time(esdp);
+ if (sched_type == ERTS_SCHED_NORMAL)
+ current_time = erts_get_monotonic_time(esdp);
+ else
+ current_time = 0;
+
do {
Sint64 timeout;
if (current_time >= timeout_time)
break;
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (sched_type != ERTS_SCHED_NORMAL)
+ timeout = -1;
+ else
timeout = ERTS_MONOTONIC_TO_NSEC(timeout_time
- current_time
- 1) + 1;
- } else
- timeout = -1;
res = erts_tse_twait(ssi->event, timeout);
- current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
- erts_get_monotonic_time(esdp);
+
+ if (sched_type == ERTS_SCHED_NORMAL)
+ current_time = erts_get_monotonic_time(esdp);
+ else
+ current_time = 0;
+
} while (res == EINTR);
}
}
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp))
+ if (sched_type == ERTS_SCHED_NORMAL)
erts_thr_progress_finalize_wait(esdp);
}
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && current_time >= timeout_time)
+ if (current_time >= timeout_time) {
+ ASSERT(sched_type == ERTS_SCHED_NORMAL);
erts_bump_timers(esdp->timer_wheel, current_time);
+ }
}
flgs = sched_prep_spin_suspended(ssi, (ERTS_SSI_FLG_WAITING
@@ -7127,7 +7314,7 @@ suspend_scheduler(ErtsSchedulerData *esdp)
if (!(flgs & ERTS_SSI_FLG_SUSPENDED))
break;
changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
- if (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER)
+ if (changing)
break;
}
@@ -7135,612 +7322,494 @@ suspend_scheduler(ErtsSchedulerData *esdp)
changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
}
- active_schedulers = erts_smp_atomic32_inc_read_nob(&schdlr_sspnd.active);
+ schdlr_sspnd_inc_nscheds(&schdlr_sspnd.active, sched_type);
changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
if ((changing & ERTS_SCHDLR_SSPND_CHNG_MSB)
- && schdlr_sspnd.online == active_schedulers) {
+ && schdlr_sspnd.online == schdlr_sspnd.active) {
erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
~ERTS_SCHDLR_SSPND_CHNG_MSB);
}
- ASSERT(no <= schdlr_sspnd.online);
- ASSERT(!ongoing_multi_scheduling_block());
-
+ ASSERT(no <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online, sched_type));
+ ASSERT((sched_type == ERTS_SCHED_NORMAL
+ ? !(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)
+ : !schdlr_sspnd.msb.ongoing));
}
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ ASSERT(!resume.msb.chngrs);
+ schdlr_sspnd_resume_procs(sched_type, &resume);
+
ASSERT(curr_online);
- if (erts_system_profile_flags.scheduler)
- profile_scheduler(make_small(esdp->no), am_active);
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (erts_system_profile_flags.scheduler)
+ profile_scheduler(make_small(esdp->no), am_active);
- if (!thr_prgr_active) {
- erts_thr_progress_active(esdp, thr_prgr_active = 1);
- sched_wall_time_change(esdp, 1);
+ if (!thr_prgr_active) {
+ erts_thr_progress_active(esdp, thr_prgr_active = 1);
+ sched_wall_time_change(esdp, 1);
+ }
}
+ if (sched_type == ERTS_SCHED_NORMAL)
+ (void) erts_get_monotonic_time(esdp);
erts_smp_runq_lock(esdp->run_queue);
non_empty_runq(esdp->run_queue);
- schedule_bound_processes(esdp->run_queue, &sbp);
+ if (sched_type == ERTS_SCHED_NORMAL) {
+ schedule_bound_processes(esdp->run_queue, &sbp);
- erts_sched_check_cpu_bind_post_suspend(esdp);
+ erts_sched_check_cpu_bind_post_suspend(esdp);
+ }
}
-#endif
-
-ErtsSchedSuspendResult
+void
erts_schedulers_state(Uint *total,
Uint *online,
Uint *active,
Uint *dirty_cpu,
Uint *dirty_cpu_online,
+ Uint *dirty_cpu_active,
Uint *dirty_io,
- int yield_allowed)
+ Uint *dirty_io_active)
{
- int res = ERTS_SCHDLR_SSPND_EINVAL;
- erts_aint32_t changing;
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
-#ifdef ERTS_DIRTY_SCHEDULERS
- changing |= (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing)
- | erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing));
-#endif
- if (yield_allowed && (changing & ~ERTS_SCHDLR_SSPND_CHNG_WAITER))
- res = ERTS_SCHDLR_SSPND_YIELD_RESTART;
- else {
+ if (active || online || dirty_cpu_online
+ || dirty_cpu_active || dirty_io_active) {
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
if (active)
- *active = schdlr_sspnd.online;
+ *active = schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL);
if (online)
- *online = schdlr_sspnd.online;
- if (ongoing_multi_scheduling_block() && active)
- *active = 1;
-#ifdef ERTS_DIRTY_SCHEDULERS
+ *online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.curr_online,
+ ERTS_SCHED_NORMAL);
+ if (dirty_cpu_active)
+ *dirty_cpu_active = schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_DIRTY_CPU);
if (dirty_cpu_online)
- *dirty_cpu_online = schdlr_sspnd.dirty_cpu_online;
-#endif
- res = ERTS_SCHDLR_SSPND_DONE;
+ *dirty_cpu_online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.curr_online,
+ ERTS_SCHED_DIRTY_CPU);
+ if (dirty_io_active)
+ *dirty_io_active = schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_DIRTY_IO);
+ erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
}
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+
if (total)
*total = erts_no_schedulers;
-#ifdef ERTS_DIRTY_SCHEDULERS
if (dirty_cpu)
*dirty_cpu = erts_no_dirty_cpu_schedulers;
if (dirty_io)
*dirty_io = erts_no_dirty_io_schedulers;
-#endif
- return res;
}
-#ifdef ERTS_DIRTY_SCHEDULERS
+static void
+abort_sched_onln_chng_waitq(Process *p)
+{
+ Eterm resume = NIL;
+
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+
+#ifdef DEBUG
+ {
+ int found_it = 0;
+ ErtsProcList *plp = erts_proclist_peek_first(schdlr_sspnd.chngq);
+ while (plp) {
+ if (erts_proclist_same(plp, p))
+ found_it++;
+ plp = erts_proclist_peek_next(schdlr_sspnd.chngq, plp);
+ }
+ ASSERT(found_it == !!(p->flags & F_SCHDLR_ONLN_WAITQ));
+ }
+#endif
+
+ if (p->flags & F_SCHDLR_ONLN_WAITQ) {
+ ErtsProcList *plp = NULL;
+
+ plp = erts_proclist_peek_first(schdlr_sspnd.chngq);
+ if (plp) {
+ if (erts_proclist_same(plp, p)
+ && schdlr_sspnd.changer == am_true) {
+ p->flags &= ~F_SCHDLR_ONLN_WAITQ;
+ /*
+ * Change right was in transit to us;
+ * transfer it to the next process by
+ * resuming it...
+ */
+ erts_proclist_remove(&schdlr_sspnd.chngq, plp);
+ proclist_destroy(plp);
+ plp = erts_proclist_peek_first(schdlr_sspnd.chngq);
+ if (plp)
+ resume = plp->pid;
+ else
+ schdlr_sspnd.changer = am_false;
+ }
+ else {
+ do {
+ if (erts_proclist_same(plp, p)) {
+ p->flags &= ~F_SCHDLR_ONLN_WAITQ;
+ erts_proclist_remove(&schdlr_sspnd.chngq, plp);
+ proclist_destroy(plp);
+ break;
+ }
+ plp = erts_proclist_peek_next(schdlr_sspnd.chngq, plp);
+ } while (plp);
+ }
+ }
+ }
+
+ erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+
+ if (is_internal_pid(resume))
+ schdlr_sspnd_resume_proc(resume);
+}
ErtsSchedSuspendResult
erts_set_schedulers_online(Process *p,
ErtsProcLocks plocks,
Sint new_no,
- Sint *old_no
-#ifdef ERTS_DIRTY_SCHEDULERS
- , int dirty_only
-#endif
- )
+ Sint *old_no,
+ int dirty_only)
{
- ErtsSchedulerData *esdp;
- int ix, res = -1, no, have_unlocked_plocks, end_wait;
- erts_aint32_t changing = 0;
+ int resume_proc, ix, res = -1, no, have_unlocked_plocks;
+ erts_aint32_t changing = 0, change_flags;
+ int online, increase;
+ ErtsProcList *plp;
#ifdef ERTS_DIRTY_SCHEDULERS
- ErtsSchedulerSleepInfo* ssi;
- int dirty_no, change_dirty;
+ int dirty_no, change_dirty, dirty_online;
+#else
+ ASSERT(!dirty_only);
#endif
if (new_no < 1)
return ERTS_SCHDLR_SSPND_EINVAL;
-#ifdef ERTS_DIRTY_SCHEDULERS
else if (dirty_only && erts_no_dirty_cpu_schedulers < new_no)
return ERTS_SCHDLR_SSPND_EINVAL;
-#endif
else if (erts_no_schedulers < new_no)
return ERTS_SCHDLR_SSPND_EINVAL;
- esdp = ERTS_PROC_GET_SCHDATA(p);
- end_wait = 0;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (dirty_only)
+ resume_proc = 0;
+ else
+#endif
+ {
+ resume_proc = 1;
+ /*
+ * If we suspend current process we need to suspend before
+ * requesting the change; otherwise, we got a resume/suspend
+ * race...
+ */
+ if (!(plocks & ERTS_PROC_LOCK_STATUS))
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ suspend_process(p, p);
+ if (!(plocks & ERTS_PROC_LOCK_STATUS))
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ }
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ change_flags = 0;
have_unlocked_plocks = 0;
no = (int) new_no;
#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(schdlr_sspnd.dirty_cpu_online <= erts_no_dirty_cpu_schedulers);
+ if (!dirty_only)
+#endif
+ {
+ changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
+ if (changing & ERTS_SCHDLR_SSPND_CHNG_ONLN) {
+ enqueue_wait:
+ p->flags |= F_SCHDLR_ONLN_WAITQ;
+ plp = proclist_create(p);
+ erts_proclist_store_last(&schdlr_sspnd.chngq, plp);
+ resume_proc = 0;
+ res = ERTS_SCHDLR_SSPND_YIELD_RESTART;
+ goto done;
+ }
+ plp = erts_proclist_peek_first(schdlr_sspnd.chngq);
+ if (!plp) {
+ ASSERT(schdlr_sspnd.changer == am_false);
+ }
+ else {
+ ASSERT(schdlr_sspnd.changer == am_true);
+ if (!erts_proclist_same(plp, p))
+ goto enqueue_wait;
+ p->flags &= ~F_SCHDLR_ONLN_WAITQ;
+ erts_proclist_remove(&schdlr_sspnd.chngq, plp);
+ proclist_destroy(plp);
+ }
+ }
+
+ *old_no = online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL);
+#ifndef ERTS_DIRTY_SCHEDULERS
+ if (no == online) {
+ res = ERTS_SCHDLR_SSPND_DONE;
+ goto done;
+ }
+#else /* ERTS_DIRTY_SCHEDULERS */
+ dirty_online = schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_DIRTY_CPU);
+ if (dirty_only)
+ *old_no = dirty_online;
+
+ ASSERT(dirty_online <= erts_no_dirty_cpu_schedulers);
+
if (dirty_only) {
- if (no > schdlr_sspnd.online) {
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
- return ERTS_SCHDLR_SSPND_EINVAL;
+ if (no > online) {
+ res = ERTS_SCHDLR_SSPND_EINVAL;
+ goto done;
}
dirty_no = no;
+ if (dirty_no == dirty_online) {
+ res = ERTS_SCHDLR_SSPND_DONE;
+ goto done;
+ }
+ change_dirty = 1;
} else {
/*
* Adjust the number of dirty CPU schedulers online relative to the
* adjustment made to the number of normal schedulers online.
*/
int total_pct = erts_no_dirty_cpu_schedulers*100/erts_no_schedulers;
- int onln_pct = no*total_pct/schdlr_sspnd.online;
- dirty_no = schdlr_sspnd.dirty_cpu_online*onln_pct/100;
+ int onln_pct = no*total_pct/online;
+ dirty_no = dirty_online*onln_pct/100;
if (dirty_no == 0)
dirty_no = 1;
ASSERT(dirty_no <= erts_no_dirty_cpu_schedulers);
- }
-#endif
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
-#ifdef ERTS_DIRTY_SCHEDULERS
- changing |= erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing);
-#endif
- if (changing) {
- res = ERTS_SCHDLR_SSPND_YIELD_RESTART;
- }
- else {
- int online = *old_no = schdlr_sspnd.online;
-#ifdef ERTS_DIRTY_SCHEDULERS
- int dirty_online = schdlr_sspnd.dirty_cpu_online;
- if (dirty_only) {
- *old_no = schdlr_sspnd.dirty_cpu_online;
- if (dirty_no == schdlr_sspnd.dirty_cpu_online) {
+ if (no != online)
+ change_dirty = (dirty_no != dirty_online);
+ else {
+ dirty_only = 1;
+ if (dirty_no == dirty_online) {
res = ERTS_SCHDLR_SSPND_DONE;
+ goto done;
}
change_dirty = 1;
- } else {
-#endif
- if (no == schdlr_sspnd.online) {
-#ifdef ERTS_DIRTY_SCHEDULERS
- dirty_only = 1;
- if (dirty_no == schdlr_sspnd.dirty_cpu_online)
-#endif
- res = ERTS_SCHDLR_SSPND_DONE;
-#ifdef ERTS_DIRTY_SCHEDULERS
- else
- change_dirty = 1;
-#endif
- }
-#ifdef ERTS_DIRTY_SCHEDULERS
- else
- change_dirty = (dirty_no != schdlr_sspnd.dirty_cpu_online);
}
-#endif
- if (res == -1)
- {
- int increase = (no > online);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!dirty_only) {
-#endif
- ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- schdlr_sspnd.online = no;
-#ifdef ERTS_DIRTY_SCHEDULERS
- } else
- increase = (dirty_no > dirty_online);
- if (change_dirty) {
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- schdlr_sspnd.dirty_cpu_online = dirty_no;
- }
-#endif
- if (increase) {
- int ix;
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (!dirty_only) {
-#endif
- schdlr_sspnd.wait_curr_online = no;
- if (ongoing_multi_scheduling_block()) {
- for (ix = online; ix < no; ix++)
- erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix));
- }
- else {
- if (plocks) {
- have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
- }
- change_no_used_runqs(no);
+ }
+ if (change_dirty) {
+ change_flags |= ERTS_SCHDLR_SSPND_CHNG_DCPU_ONLN;
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_DIRTY_CPU,
+ dirty_no);
+ }
+
+ if (dirty_only)
+ increase = (dirty_no > dirty_online);
+ else
+#endif /* ERTS_DIRTY_SCHEDULERS */
+ {
+ change_flags |= ERTS_SCHDLR_SSPND_CHNG_ONLN;
+ schdlr_sspnd_set_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL,
+ no);
+ increase = (no > online);
+ }
- for (ix = online; ix < no; ix++)
- resume_run_queue(ERTS_RUNQ_IX(ix));
+ erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing, change_flags);
- for (ix = no; ix < erts_no_run_queues; ix++)
- suspend_run_queue(ERTS_RUNQ_IX(ix));
- }
+ res = ERTS_SCHDLR_SSPND_DONE;
+ if (increase) {
+ int ix;
#ifdef ERTS_DIRTY_SCHEDULERS
+ if (change_dirty) {
+ ErtsSchedulerSleepInfo* ssi;
+ if (schdlr_sspnd.msb.ongoing) {
+ for (ix = dirty_online; ix < dirty_no; ix++) {
+ ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
+ erts_sched_poke(ssi);
}
- if (change_dirty) {
- schdlr_sspnd.dirty_cpu_wait_curr_online = dirty_no;
- ASSERT(schdlr_sspnd.dirty_cpu_curr_online !=
- schdlr_sspnd.dirty_cpu_wait_curr_online);
- if (ongoing_multi_scheduling_block()) {
- for (ix = dirty_online; ix < dirty_no; ix++) {
- ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
- erts_sched_poke(ssi);
- }
- } else {
- for (ix = dirty_online; ix < dirty_no; ix++) {
- ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
- scheduler_ssi_resume_wake(ssi);
- erts_smp_atomic32_read_band_nob(&ssi->flags,
- ~ERTS_SSI_FLG_SUSPENDED);
- }
- wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0);
- }
+ } else {
+ for (ix = dirty_online; ix < dirty_no; ix++) {
+ ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
+ scheduler_ssi_resume_wake(ssi);
}
-#endif
- res = ERTS_SCHDLR_SSPND_DONE;
}
- else /* if (no < online) */ {
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (change_dirty) {
- schdlr_sspnd.dirty_cpu_wait_curr_online = dirty_no;
- ASSERT(schdlr_sspnd.dirty_cpu_curr_online !=
- schdlr_sspnd.dirty_cpu_wait_curr_online);
- if (ongoing_multi_scheduling_block()) {
- for (ix = dirty_no; ix < dirty_online; ix++) {
- ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
- erts_sched_poke(ssi);
- }
- } else {
- for (ix = dirty_no; ix < dirty_online; ix++) {
- ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
- erts_smp_atomic32_read_bor_nob(&ssi->flags,
- ERTS_SSI_FLG_SUSPENDED);
- }
- wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0);
- }
- }
- if (dirty_only) {
- res = ERTS_SCHDLR_SSPND_DONE;
- }
- else
+ }
+ if (!dirty_only)
#endif
- {
- if (p->scheduler_data->no <= no) {
- res = ERTS_SCHDLR_SSPND_DONE;
- schdlr_sspnd.wait_curr_online = no;
- }
- else {
- /*
- * Yield! Current process needs to migrate
- * before bif returns.
- */
- res = ERTS_SCHDLR_SSPND_YIELD_DONE;
- schdlr_sspnd.wait_curr_online = no+1;
- }
-
- if (ongoing_multi_scheduling_block()) {
- for (ix = no; ix < online; ix++)
- erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix));
- }
- else {
- if (plocks) {
- have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
- }
-
- change_no_used_runqs(no);
- for (ix = no; ix < erts_no_run_queues; ix++)
- suspend_run_queue(ERTS_RUNQ_IX(ix));
-
- for (ix = no; ix < online; ix++) {
- ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
- wake_scheduler(rq);
- }
- }
- }
+ {
+ if (schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) {
+ for (ix = online; ix < no; ix++)
+ erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix));
}
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (change_dirty) {
- while (schdlr_sspnd.dirty_cpu_curr_online != schdlr_sspnd.dirty_cpu_wait_curr_online)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_cpu_changing,
- ~ERTS_SCHDLR_SSPND_CHNG_WAITER);
- }
- if (!dirty_only)
-#endif
- {
- if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) {
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
- if (plocks && !have_unlocked_plocks) {
- have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
- }
- erts_thr_progress_active(esdp, 0);
- erts_thr_progress_prepare_wait(esdp);
- end_wait = 1;
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ else {
+ if (plocks) {
+ have_unlocked_plocks = 1;
+ erts_smp_proc_unlock(p, plocks);
}
+ change_no_used_runqs(no);
- while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
+ for (ix = online; ix < no; ix++)
+ resume_run_queue(ERTS_RUNQ_IX(ix));
- ASSERT(res != ERTS_SCHDLR_SSPND_DONE
- ? (ERTS_SCHDLR_SSPND_CHNG_WAITER
- & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))
- : (ERTS_SCHDLR_SSPND_CHNG_WAITER
- == erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)));
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
- ~ERTS_SCHDLR_SSPND_CHNG_WAITER);
+ for (ix = no; ix < erts_no_run_queues; ix++)
+ suspend_run_queue(ERTS_RUNQ_IX(ix));
}
}
}
-
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+ else /* if decrease */ {
#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(schdlr_sspnd.dirty_cpu_online <= schdlr_sspnd.online);
- if (!dirty_only)
-#endif
- {
- if (end_wait) {
- erts_thr_progress_finalize_wait(esdp);
- erts_thr_progress_active(esdp, 1);
- }
- if (have_unlocked_plocks)
- erts_smp_proc_lock(p, plocks);
- }
-
- return res;
-}
-
-#else /* !ERTS_DIRTY_SCHEDULERS */
-
-ErtsSchedSuspendResult
-erts_set_schedulers_online(Process *p,
- ErtsProcLocks plocks,
- Sint new_no,
- Sint *old_no)
-{
- ErtsSchedulerData *esdp;
- int ix, res, no, have_unlocked_plocks, end_wait;
- erts_aint32_t changing;
-
- if (new_no < 1 || erts_no_schedulers < new_no)
- return ERTS_SCHDLR_SSPND_EINVAL;
-
- esdp = ERTS_PROC_GET_SCHDATA(p);
- end_wait = 0;
-
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
-
- have_unlocked_plocks = 0;
- no = (int) new_no;
-
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
- if (changing) {
- res = ERTS_SCHDLR_SSPND_YIELD_RESTART;
- }
- else {
- int online = *old_no = schdlr_sspnd.online;
- if (no == schdlr_sspnd.online) {
- res = ERTS_SCHDLR_SSPND_DONE;
- }
- else {
- ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_ONLN
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- schdlr_sspnd.online = no;
- if (no > online) {
- int ix;
- schdlr_sspnd.wait_curr_online = no;
- if (ongoing_multi_scheduling_block()) {
- for (ix = online; ix < no; ix++)
- erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix));
+ if (change_dirty) {
+ ErtsSchedulerSleepInfo* ssi;
+ if (schdlr_sspnd.msb.ongoing) {
+ for (ix = dirty_no; ix < dirty_online; ix++) {
+ ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
+ erts_sched_poke(ssi);
}
- else {
- if (plocks) {
- have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
- }
- change_no_used_runqs(no);
-
- for (ix = online; ix < no; ix++)
- resume_run_queue(ERTS_RUNQ_IX(ix));
-
- for (ix = no; ix < erts_no_run_queues; ix++)
- suspend_run_queue(ERTS_RUNQ_IX(ix));
+ } else {
+ for (ix = dirty_no; ix < dirty_online; ix++) {
+ ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
+ erts_smp_atomic32_read_bor_nob(&ssi->flags,
+ ERTS_SSI_FLG_SUSPENDED);
}
- res = ERTS_SCHDLR_SSPND_DONE;
+ wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0);
}
- else /* if (no < online) */ {
- if (p->scheduler_data->no <= no) {
- res = ERTS_SCHDLR_SSPND_DONE;
- schdlr_sspnd.wait_curr_online = no;
- }
- else {
- /*
- * Yield! Current process needs to migrate
- * before bif returns.
- */
- res = ERTS_SCHDLR_SSPND_YIELD_DONE;
- schdlr_sspnd.wait_curr_online = no+1;
- }
-
- if (ongoing_multi_scheduling_block()) {
- for (ix = no; ix < online; ix++)
- erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix));
- }
- else {
- if (plocks) {
- have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
- }
-
- change_no_used_runqs(no);
- for (ix = no; ix < erts_no_run_queues; ix++)
- suspend_run_queue(ERTS_RUNQ_IX(ix));
-
- for (ix = no; ix < online; ix++) {
- ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
- wake_scheduler(rq);
- }
- }
+ }
+ if (!dirty_only)
+#endif
+ {
+ if (schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing) {
+ for (ix = no; ix < online; ix++)
+ erts_sched_poke(ERTS_SCHED_SLEEP_INFO_IX(ix));
}
-
- if (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) {
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
- if (plocks && !have_unlocked_plocks) {
+ else {
+ if (plocks) {
have_unlocked_plocks = 1;
erts_smp_proc_unlock(p, plocks);
}
- erts_thr_progress_active(esdp, 0);
- erts_thr_progress_prepare_wait(esdp);
- end_wait = 1;
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- }
-
- while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ASSERT(res != ERTS_SCHDLR_SSPND_DONE
- ? (ERTS_SCHDLR_SSPND_CHNG_WAITER
- & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))
- : (ERTS_SCHDLR_SSPND_CHNG_WAITER
- == erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)));
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
- ~ERTS_SCHDLR_SSPND_CHNG_WAITER);
+ change_no_used_runqs(no);
+ for (ix = no; ix < erts_no_run_queues; ix++)
+ suspend_run_queue(ERTS_RUNQ_IX(ix));
+ for (ix = no; ix < online; ix++) {
+ ErtsRunQueue *rq = ERTS_RUNQ_IX(ix);
+ wake_scheduler(rq);
+ }
+ }
}
}
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
- if (end_wait) {
- erts_thr_progress_finalize_wait(esdp);
- erts_thr_progress_active(esdp, 1);
+ if (change_flags & ERTS_SCHDLR_SSPND_CHNG_ONLN) {
+ /* Suspend and wait for requested change to complete... */
+ schdlr_sspnd.changer = p->common.id;
+ resume_proc = 0;
+ res = ERTS_SCHDLR_SSPND_YIELD_DONE;
}
+
+done:
+
+ ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_DIRTY_CPU)
+ <= schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL));
+
+ erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+
if (have_unlocked_plocks)
erts_smp_proc_lock(p, plocks);
+ if (resume_proc) {
+ if (!(plocks & ERTS_PROC_LOCK_STATUS))
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ resume_process(p, plocks|ERTS_PROC_LOCK_STATUS);
+ if (!(plocks & ERTS_PROC_LOCK_STATUS))
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ }
+
return res;
}
-#endif
-
ErtsSchedSuspendResult
-erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all)
+erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal, int all)
{
- int ix, res, have_unlocked_plocks = 0, online;
- erts_aint32_t changing;
+ int resume_proc, ix, res, have_unlocked_plocks = 0;
ErtsProcList *plp;
#ifdef ERTS_DIRTY_SCHEDULERS
ErtsSchedulerSleepInfo* ssi;
#endif
+ ErtsMultiSchedulingBlock *msbp;
+ erts_aint32_t chng_flg;
+ int have_blckd_flg;
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- changing = erts_smp_atomic32_read_nob(&schdlr_sspnd.changing);
-#ifdef ERTS_DIRTY_SCHEDULERS
- changing |= (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing)
- | erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing));
-#endif
- if (changing) {
- res = ERTS_SCHDLR_SSPND_YIELD_RESTART; /* Yield */
+ if (normal) {
+ chng_flg = ERTS_SCHDLR_SSPND_CHNG_NMSB;
+ have_blckd_flg = F_HAVE_BLCKD_NMSCHED;
+ msbp = &schdlr_sspnd.nmsb;
+ }
+ else {
+ chng_flg = ERTS_SCHDLR_SSPND_CHNG_MSB;
+ have_blckd_flg = F_HAVE_BLCKD_MSCHED;
+ msbp = &schdlr_sspnd.msb;
}
- else if (on) { /* ------ BLOCK ------ */
- if (schdlr_sspnd.msb.procs) {
+
+ /*
+ * If we suspend current process we need to suspend before
+ * requesting the change; otherwise, we got a resume/suspend
+ * race...
+ */
+ if (!on) {
+ /* We never suspend current process when unblocking... */
+ resume_proc = 0;
+ }
+ else {
+ resume_proc = 1;
+ if (!(plocks & ERTS_PROC_LOCK_STATUS))
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ suspend_process(p, p);
+ if (!(plocks & ERTS_PROC_LOCK_STATUS))
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ }
+
+ erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ if (on) { /* ------ BLOCK ------ */
+ if (msbp->chngq) {
+ ASSERT(msbp->ongoing);
+ p->flags |= have_blckd_flg;
+ goto wait_until_msb;
+ }
+ else if (msbp->blckrs) {
+ ASSERT(msbp->ongoing);
plp = proclist_create(p);
- erts_proclist_store_last(&schdlr_sspnd.msb.procs, plp);
- p->flags |= F_HAVE_BLCKD_MSCHED;
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1);
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) == 0);
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active) == 0);
-#endif
+ erts_proclist_store_last(&msbp->blckrs, plp);
+ p->flags |= have_blckd_flg;
+ ASSERT(schdlr_sspnd.active == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0));
ASSERT(p->scheduler_data->no == 1);
- res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED;
- } else {
- int online = schdlr_sspnd.online;
- p->flags |= F_HAVE_BLCKD_MSCHED;
+ if (schdlr_sspnd.msb.ongoing)
+ res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED;
+ else
+ res = ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED;
+ }
+ else {
+ int online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL);
+ ASSERT(!msbp->ongoing);
+ p->flags |= have_blckd_flg;
if (plocks) {
have_unlocked_plocks = 1;
erts_smp_proc_unlock(p, plocks);
}
- ASSERT(!ongoing_multi_scheduling_block());
- schdlr_sspnd.msb.ongoing = 1;
- if (online == 1) {
- res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED;
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1);
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active) == 1);
- ASSERT(!(erts_smp_atomic32_read_nob(&ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(0)->flags)
- & ERTS_SSI_FLG_SUSPENDED));
- schdlr_sspnd.msb.dirty_cpu_wait_active = 0;
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(0);
- erts_smp_atomic32_read_bor_nob(&ssi->flags, ERTS_SSI_FLG_SUSPENDED);
- wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0);
- while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active)
- != schdlr_sspnd.msb.dirty_cpu_wait_active)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
-
- schdlr_sspnd.msb.dirty_io_wait_active = 0;
- ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) {
- ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix);
- erts_smp_atomic32_read_bor_nob(&ssi->flags,
- ERTS_SSI_FLG_SUSPENDED);
- }
- wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0);
- while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active)
- != schdlr_sspnd.msb.dirty_io_wait_active)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
-#endif
+ ASSERT(!msbp->ongoing);
+ msbp->ongoing = 1;
+ if (schdlr_sspnd.active == ERTS_SCHDLR_SSPND_MAKE_NSCHEDS_VAL(1, 0, 0)
+ || (normal && schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL) == 1)) {
ASSERT(p->scheduler_data->no == 1);
+ plp = proclist_create(p);
+ erts_proclist_store_last(&msbp->blckrs, plp);
+ if (schdlr_sspnd.msb.ongoing)
+ res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED;
+ else
+ res = ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED;
}
else {
- ERTS_SCHDLR_SSPND_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- if (p->scheduler_data->no == 1) {
- res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED;
- schdlr_sspnd.msb.wait_active = 1;
- }
- else {
- /*
- * Yield! Current process needs to migrate
- * before bif returns.
- */
- res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED;
- schdlr_sspnd.msb.wait_active = 2;
- }
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- schdlr_sspnd.msb.dirty_cpu_wait_active = 0;
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) {
- ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
- erts_smp_atomic32_read_bor_nob(&ssi->flags,
- ERTS_SSI_FLG_SUSPENDED);
- }
- wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0);
- while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_active)
- != schdlr_sspnd.msb.dirty_cpu_wait_active)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
- ASSERT(schdlr_sspnd.dirty_cpu_curr_online == schdlr_sspnd.dirty_cpu_online);
-
- schdlr_sspnd.msb.dirty_io_wait_active = 0;
- ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET((ERTS_SCHDLR_SSPND_CHNG_MSB
- | ERTS_SCHDLR_SSPND_CHNG_WAITER), 0);
- for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) {
- ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix);
- erts_smp_atomic32_read_bor_nob(&ssi->flags,
- ERTS_SSI_FLG_SUSPENDED);
- }
- wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0);
- while (erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_active)
- != schdlr_sspnd.msb.dirty_io_wait_active)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
- ASSERT(schdlr_sspnd.dirty_io_curr_online == schdlr_sspnd.dirty_io_online);
-#endif
+ erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing,
+ chng_flg);
change_no_used_runqs(1);
for (ix = 1; ix < erts_no_run_queues; ix++)
suspend_run_queue(ERTS_RUNQ_IX(ix));
@@ -7750,84 +7819,84 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all)
wake_scheduler(rq);
}
- if (erts_smp_atomic32_read_nob(&schdlr_sspnd.active)
- != schdlr_sspnd.msb.wait_active) {
- ErtsSchedulerData *esdp;
-
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-
- if (plocks && !have_unlocked_plocks) {
- have_unlocked_plocks = 1;
- erts_smp_proc_unlock(p, plocks);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!normal) {
+ for (ix = 0; ix < erts_no_dirty_cpu_schedulers; ix++) {
+ ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
+ erts_smp_atomic32_read_bor_nob(&ssi->flags,
+ ERTS_SSI_FLG_SUSPENDED);
}
+ wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0);
- esdp = ERTS_PROC_GET_SCHDATA(p);
-
- erts_thr_progress_active(esdp, 0);
- erts_thr_progress_prepare_wait(esdp);
-
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
-
- while (erts_smp_atomic32_read_nob(&schdlr_sspnd.active)
- != schdlr_sspnd.msb.wait_active)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd,
- &schdlr_sspnd.mtx);
-
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-
- erts_thr_progress_active(esdp, 1);
- erts_thr_progress_finalize_wait(esdp);
+ for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) {
+ ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix);
+ erts_smp_atomic32_read_bor_nob(&ssi->flags,
+ ERTS_SSI_FLG_SUSPENDED);
+ }
+ wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0);
+ }
+#endif
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
+ wait_until_msb:
- }
+ ASSERT(chng_flg & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing));
- ASSERT(res != ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED
- ? (ERTS_SCHDLR_SSPND_CHNG_WAITER
- & erts_smp_atomic32_read_nob(&schdlr_sspnd.changing))
- : (ERTS_SCHDLR_SSPND_CHNG_WAITER
- == erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)));
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
- ~ERTS_SCHDLR_SSPND_CHNG_WAITER);
+ plp = proclist_create(p);
+ erts_proclist_store_last(&msbp->chngq, plp);
+ resume_proc = 0;
+ if (schdlr_sspnd.msb.ongoing)
+ res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED;
+ else
+ res = ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED;
}
- plp = proclist_create(p);
- erts_proclist_store_last(&schdlr_sspnd.msb.procs, plp);
ASSERT(p->scheduler_data);
}
}
- else if (!ongoing_multi_scheduling_block()) {
- /* unblock not ongoing */
- ASSERT(!schdlr_sspnd.msb.procs);
- res = ERTS_SCHDLR_SSPND_DONE;
+ else if (!msbp->ongoing) {
+ ASSERT(!msbp->blckrs);
+ goto unblock_res;
}
else { /* ------ UNBLOCK ------ */
- if (p->flags & F_HAVE_BLCKD_MSCHED) {
- ErtsProcList *plp = erts_proclist_peek_first(schdlr_sspnd.msb.procs);
-
- while (plp) {
- ErtsProcList *tmp_plp = plp;
- plp = erts_proclist_peek_next(schdlr_sspnd.msb.procs, plp);
- if (erts_proclist_same(tmp_plp, p)) {
- erts_proclist_remove(&schdlr_sspnd.msb.procs, tmp_plp);
- proclist_destroy(tmp_plp);
- if (!all)
- break;
+ if (p->flags & have_blckd_flg) {
+ ErtsProcList *plps[2];
+ ErtsProcList *plp;
+ int limit = 0;
+
+ plps[limit++] = erts_proclist_peek_first(msbp->blckrs);
+ if (all)
+ plps[limit++] = erts_proclist_peek_first(msbp->chngq);
+
+ for (ix = 0; ix < limit; ix++) {
+ plp = plps[ix];
+ while (plp) {
+ ErtsProcList *tmp_plp = plp;
+ plp = erts_proclist_peek_next(msbp->blckrs, plp);
+ if (erts_proclist_same(tmp_plp, p)) {
+ erts_proclist_remove(&msbp->blckrs, tmp_plp);
+ proclist_destroy(tmp_plp);
+ if (!all)
+ break;
+ }
}
}
}
- if (schdlr_sspnd.msb.procs)
- res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED;
- else {
- ERTS_SCHDLR_SSPND_CHNG_SET(ERTS_SCHDLR_SSPND_CHNG_MSB, 0);
- p->flags &= ~F_HAVE_BLCKD_MSCHED;
- schdlr_sspnd.msb.ongoing = 0;
- if (schdlr_sspnd.online == 1) {
+ if (!msbp->blckrs && !msbp->chngq) {
+ int online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_NORMAL);
+ erts_smp_atomic32_read_bor_nob(&schdlr_sspnd.changing,
+ chng_flg);
+ p->flags &= ~have_blckd_flg;
+ msbp->ongoing = 0;
+ if (online == 1) {
/* No normal schedulers to resume */
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.active) == 1);
- ERTS_SCHDLR_SSPND_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_MSB);
+ ASSERT(schdlr_sspnd_get_nscheds(&schdlr_sspnd.active,
+ ERTS_SCHED_NORMAL) == 1);
+#ifndef ERTS_DIRTY_SCHEDULERS
+ erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
+ ~chng_flg);
+#endif
}
- else {
- online = schdlr_sspnd.online;
+ else if (!(schdlr_sspnd.msb.ongoing|schdlr_sspnd.nmsb.ongoing)) {
if (plocks) {
have_unlocked_plocks = 1;
erts_smp_proc_unlock(p, plocks);
@@ -7843,83 +7912,91 @@ erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all)
suspend_run_queue(ERTS_RUNQ_IX(ix));
}
#ifdef ERTS_DIRTY_SCHEDULERS
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(ERTS_SCHDLR_SSPND_CHNG_MSB, 0);
- schdlr_sspnd.msb.dirty_cpu_wait_active = schdlr_sspnd.dirty_cpu_online;
- for (ix = 0; ix < schdlr_sspnd.dirty_cpu_online; ix++) {
- ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
- scheduler_ssi_resume_wake(ssi);
- erts_smp_atomic32_read_band_nob(&ssi->flags,
- ~ERTS_SSI_FLG_SUSPENDED);
- }
- wake_dirty_schedulers(ERTS_DIRTY_CPU_RUNQ, 0);
-
- ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(ERTS_SCHDLR_SSPND_CHNG_MSB, 0);
- schdlr_sspnd.msb.dirty_io_wait_active = erts_no_dirty_io_schedulers;
- for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) {
- ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix);
- scheduler_ssi_resume_wake(ssi);
- erts_smp_atomic32_read_band_nob(&ssi->flags,
- ~ERTS_SSI_FLG_SUSPENDED);
- }
- wake_dirty_schedulers(ERTS_DIRTY_IO_RUNQ, 0);
+ if (!normal) {
+ ASSERT(!schdlr_sspnd.msb.ongoing);
+ online = (int) schdlr_sspnd_get_nscheds(&schdlr_sspnd.online,
+ ERTS_SCHED_DIRTY_CPU);
+ for (ix = 0; ix < online; ix++) {
+ ssi = ERTS_DIRTY_CPU_SCHED_SLEEP_INFO_IX(ix);
+ scheduler_ssi_resume_wake(ssi);
+ }
+
+ for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) {
+ ssi = ERTS_DIRTY_IO_SCHED_SLEEP_INFO_IX(ix);
+ scheduler_ssi_resume_wake(ssi);
+ }
+ }
#endif
- res = ERTS_SCHDLR_SSPND_DONE;
}
+
+ unblock_res:
+ if (schdlr_sspnd.msb.ongoing)
+ res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED;
+ else if (schdlr_sspnd.nmsb.ongoing)
+ res = ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED;
+ else
+ res = ERTS_SCHDLR_SSPND_DONE;
}
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
+
if (have_unlocked_plocks)
erts_smp_proc_lock(p, plocks);
- return res;
-}
-#ifdef DEBUG
-void
-erts_dbg_multi_scheduling_return_trap(Process *p, Eterm return_value)
-{
- if (return_value == am_blocked) {
- erts_aint32_t active = erts_smp_atomic32_read_nob(&schdlr_sspnd.active);
- ASSERT(1 <= active && active <= 2);
- ASSERT(ERTS_PROC_GET_SCHDATA(p)->no == 1);
+ if (resume_proc) {
+ if (!(plocks & ERTS_PROC_LOCK_STATUS))
+ erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ resume_process(p, plocks|ERTS_PROC_LOCK_STATUS);
+ if (!(plocks & ERTS_PROC_LOCK_STATUS))
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
}
+
+ return res;
}
-#endif
int
erts_is_multi_scheduling_blocked(void)
{
int res;
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- res = schdlr_sspnd.msb.procs != NULL;
+ if (schdlr_sspnd.msb.blckrs)
+ res = 1;
+ else if (schdlr_sspnd.nmsb.blckrs)
+ res = -1;
+ else
+ res = 0;
erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
return res;
}
Eterm
-erts_multi_scheduling_blockers(Process *p)
+erts_multi_scheduling_blockers(Process *p, int normal)
{
Eterm res = NIL;
+ ErtsMultiSchedulingBlock *msbp;
+
+ msbp = normal ? &schdlr_sspnd.nmsb : &schdlr_sspnd.msb;
erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- if (!erts_proclist_is_empty(schdlr_sspnd.msb.procs)) {
+ if (!erts_proclist_is_empty(msbp->blckrs)) {
Eterm *hp, *hp_end;
ErtsProcList *plp1, *plp2;
Uint max_size = 0;
- for (plp1 = erts_proclist_peek_first(schdlr_sspnd.msb.procs);
+ for (plp1 = erts_proclist_peek_first(msbp->blckrs);
plp1;
- plp1 = erts_proclist_peek_next(schdlr_sspnd.msb.procs, plp1)) {
+ plp1 = erts_proclist_peek_next(msbp->blckrs, plp1)) {
max_size += 2;
}
ASSERT(max_size);
hp = HAlloc(p, max_size);
hp_end = hp + max_size;
- for (plp1 = erts_proclist_peek_first(schdlr_sspnd.msb.procs);
+ for (plp1 = erts_proclist_peek_first(msbp->blckrs);
plp1;
- plp1 = erts_proclist_peek_next(schdlr_sspnd.msb.procs, plp1)) {
- for (plp2 = erts_proclist_peek_first(schdlr_sspnd.msb.procs);
+ plp1 = erts_proclist_peek_next(msbp->blckrs, plp1)) {
+ for (plp2 = erts_proclist_peek_first(msbp->blckrs);
plp2->pid != plp1->pid;
- plp2 = erts_proclist_peek_next(schdlr_sspnd.msb.procs, plp2));
+ plp2 = erts_proclist_peek_next(msbp->blckrs, plp2));
if (plp2 == plp1) {
res = CONS(hp, plp1->pid, res);
hp += 2;
@@ -7944,6 +8021,9 @@ sched_thread_func(void *vesdp)
erts_sched_init_time_sup(esdp);
+ (void) ERTS_RUNQ_FLGS_SET_NOB(esdp->run_queue,
+ ERTS_RUNQ_FLG_EXEC);
+
#ifdef ERTS_SMP
tse = erts_tse_fetch();
erts_tse_prepare_timed(tse);
@@ -7954,6 +8034,8 @@ sched_thread_func(void *vesdp)
callbacks.wait = thr_prgr_wait;
callbacks.finalize_wait = thr_prgr_fin_wait;
+ erts_msacc_init_thread("scheduler", no, 1);
+
erts_thr_progress_register_managed_thread(esdp, &callbacks, 0);
erts_alloc_register_scheduler(vesdp);
#endif
@@ -7983,39 +8065,6 @@ sched_thread_func(void *vesdp)
#endif
erts_thread_init_float();
- if (no == 1) {
- erts_thr_progress_active(esdp, 0);
- erts_thr_progress_prepare_wait(esdp);
- }
-
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
-
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.changing)
- & ERTS_SCHDLR_SSPND_CHNG_ONLN);
-
- if (--schdlr_sspnd.curr_online == schdlr_sspnd.wait_curr_online) {
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.changing,
- ~ERTS_SCHDLR_SSPND_CHNG_ONLN);
- if (no != 1)
-#ifdef ERTS_DIRTY_SCHEDULERS
- erts_smp_cnd_broadcast(&schdlr_sspnd.cnd);
-#else
- erts_smp_cnd_signal(&schdlr_sspnd.cnd);
-#endif
- }
-
- if (no == 1) {
- while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ERTS_SCHDLR_SSPND_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
- }
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-
- if (no == 1) {
- erts_thr_progress_finalize_wait(esdp);
- erts_thr_progress_active(esdp, 1);
- }
-
#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC
esdp->verify_unused_temp_alloc
= erts_alloc_get_verify_unused_temp_alloc(
@@ -8025,7 +8074,7 @@ sched_thread_func(void *vesdp)
process_main();
/* No schedulers should *ever* terminate */
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Scheduler thread number %beu terminated\n",
no);
return NULL;
@@ -8070,27 +8119,9 @@ sched_dirty_cpu_thread_func(void *vesdp)
#endif
erts_thread_init_float();
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_cpu_changing)
- & ERTS_SCHDLR_SSPND_CHNG_ONLN);
-
- if (--schdlr_sspnd.dirty_cpu_curr_online == schdlr_sspnd.dirty_cpu_wait_curr_online) {
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_cpu_changing,
- ~ERTS_SCHDLR_SSPND_CHNG_ONLN);
- if (no != 1)
- erts_smp_cnd_broadcast(&schdlr_sspnd.cnd);
- }
-
- if (no == 1) {
- while (schdlr_sspnd.dirty_cpu_curr_online != schdlr_sspnd.dirty_cpu_wait_curr_online)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ERTS_SCHDLR_SSPND_DIRTY_CPU_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
- }
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-
process_main();
/* No schedulers should *ever* terminate */
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Dirty CPU scheduler thread number %beu terminated\n",
no);
return NULL;
@@ -8133,27 +8164,9 @@ sched_dirty_io_thread_func(void *vesdp)
#endif
erts_thread_init_float();
- erts_smp_mtx_lock(&schdlr_sspnd.mtx);
- ASSERT(erts_smp_atomic32_read_nob(&schdlr_sspnd.dirty_io_changing)
- & ERTS_SCHDLR_SSPND_CHNG_ONLN);
-
- if (--schdlr_sspnd.dirty_io_curr_online == schdlr_sspnd.dirty_io_wait_curr_online) {
- erts_smp_atomic32_read_band_nob(&schdlr_sspnd.dirty_io_changing,
- ~ERTS_SCHDLR_SSPND_CHNG_ONLN);
- if (no != 1)
- erts_smp_cnd_broadcast(&schdlr_sspnd.cnd);
- }
-
- if (no == 1) {
- while (schdlr_sspnd.dirty_io_curr_online != schdlr_sspnd.dirty_io_wait_curr_online)
- erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx);
- ERTS_SCHDLR_SSPND_DIRTY_IO_CHNG_SET(0, ERTS_SCHDLR_SSPND_CHNG_WAITER);
- }
- erts_smp_mtx_unlock(&schdlr_sspnd.mtx);
-
process_main();
/* No schedulers should *ever* terminate */
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Dirty I/O scheduler thread number %beu terminated\n",
no);
return NULL;
@@ -8183,12 +8196,12 @@ erts_start_schedulers(void)
erts_snprintf(opts.name, 16, "runq_supervisor");
erts_atomic_init_nob(&runq_supervisor_sleeping, 0);
if (0 != ethr_event_init(&runq_supervision_event))
- erl_exit(1, "Failed to create run-queue supervision event\n");
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create run-queue supervision event\n");
if (0 != ethr_thr_create(&runq_supervisor_tid,
runq_supervisor,
NULL,
&opts))
- erl_exit(1, "Failed to create run-queue supervision thread\n");
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create run-queue supervision thread\n");
}
#endif
@@ -8209,18 +8222,12 @@ erts_start_schedulers(void)
erts_snprintf(opts.name, 16, "%lu_scheduler", actual + 1);
-#ifdef __OSE__
- /* This should be done in the bind strategy */
- opts.coreNo = (actual+1) % ose_num_cpus();
-#endif
-
res = ethr_thr_create(&esdp->tid, sched_thread_func, (void*)esdp, &opts);
if (res != 0) {
break;
}
}
-
erts_no_schedulers = actual;
#ifdef ERTS_DIRTY_SCHEDULERS
@@ -8232,14 +8239,14 @@ erts_start_schedulers(void)
erts_snprintf(opts.name, 16, "%d_dirty_cpu_scheduler", ix + 1);
res = ethr_thr_create(&esdp->tid,sched_dirty_cpu_thread_func,(void*)esdp,&opts);
if (res != 0)
- erl_exit(1, "Failed to create dirty cpu scheduler thread %d\n", ix);
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty cpu scheduler thread %d\n", ix);
}
for (ix = 0; ix < erts_no_dirty_io_schedulers; ix++) {
ErtsSchedulerData *esdp = ERTS_DIRTY_IO_SCHEDULER_IX(ix);
erts_snprintf(opts.name, 16, "%d_dirty_io_scheduler", ix + 1);
res = ethr_thr_create(&esdp->tid,sched_dirty_io_thread_func,(void*)esdp,&opts);
if (res != 0)
- erl_exit(1, "Failed to create dirty io scheduler thread %d\n", ix);
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create dirty io scheduler thread %d\n", ix);
}
}
#endif
@@ -8249,16 +8256,12 @@ erts_start_schedulers(void)
erts_snprintf(opts.name, 16, "aux");
-#ifdef __OSE__
- opts.coreNo = 0;
-#endif /* __OSE__ */
-
res = ethr_thr_create(&aux_tid, aux_thread, NULL, &opts);
if (res != 0)
- erl_exit(1, "Failed to create aux thread\n");
+ erts_exit(ERTS_ERROR_EXIT, "Failed to create aux thread\n");
if (actual < 1)
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"Failed to create any scheduler-threads: %s (%d)\n",
erl_errno_id(res),
res);
@@ -8272,7 +8275,6 @@ erts_start_schedulers(void)
actual, actual == 1 ? " was" : "s were");
erts_send_error_to_logger_nogl(dsbufp);
}
-
}
#endif /* ERTS_SMP */
@@ -8291,7 +8293,7 @@ add_pend_suspend(Process *suspendee,
sizeof(ErtsPendingSuspend));
psp->next = NULL;
#ifdef DEBUG
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
psp->end = (ErtsPendingSuspend *) 0xdeaddeaddeaddead;
#else
psp->end = (ErtsPendingSuspend *) 0xdeaddead;
@@ -8413,9 +8415,8 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks,
resume_process(rp, rp_locks);
}
else {
-
rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS,
- pid, pid_locks|ERTS_PROC_LOCK_STATUS);
+ pid, ERTS_PROC_LOCK_STATUS);
if (!rp) {
c_p->flags &= ~F_P2PNR_RESCHED;
@@ -8424,40 +8425,84 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks,
ASSERT(!(c_p->flags & F_P2PNR_RESCHED));
- if (suspend) {
- if (suspend_process(c_p, rp))
- goto done;
- }
- else {
- if (!((ERTS_PSFLG_RUNNING|ERTS_PSFLG_RUNNING_SYS)
- & erts_smp_atomic32_read_acqb(&rp->state)))
- goto done;
+ /*
+ * Suspend the other process in order to prevent
+ * it from being selected for normal execution.
+ * This will however not prevent it from being
+ * selected for execution of a system task. If
+ * it is selected for execution of a system task
+ * we might be blocked for quite a while if the
+ * try-lock below fails. That is, there is room
+ * for improvement here...
+ */
- }
+ if (!suspend_process(c_p, rp)) {
+ /* Other process running */
- /* Other process running */
+ ASSERT(ERTS_PSFLG_RUNNING
+ & erts_smp_atomic32_read_nob(&rp->state));
- /*
- * If we got pending suspenders and suspend ourselves waiting
- * to suspend another process we might deadlock.
- * In this case we have to yield, be suspended by
- * someone else and then do it all over again.
- */
- if (!c_p->pending_suspenders) {
- /* Mark rp pending for suspend by c_p */
- add_pend_suspend(rp, c_p->common.id, handle_pend_sync_suspend);
- ASSERT(is_nil(c_p->suspendee));
+ running:
- /* Suspend c_p; when rp is suspended c_p will be resumed. */
- suspend_process(c_p, c_p);
- c_p->flags |= F_P2PNR_RESCHED;
+ /*
+ * If we got pending suspenders and suspend ourselves waiting
+ * to suspend another process we might deadlock.
+ * In this case we have to yield, be suspended by
+ * someone else and then do it all over again.
+ */
+ if (!c_p->pending_suspenders) {
+ /* Mark rp pending for suspend by c_p */
+ add_pend_suspend(rp, c_p->common.id, handle_pend_sync_suspend);
+ ASSERT(is_nil(c_p->suspendee));
+
+ /* Suspend c_p; when rp is suspended c_p will be resumed. */
+ suspend_process(c_p, c_p);
+ c_p->flags |= F_P2PNR_RESCHED;
+ }
+ /* Yield (caller is assumed to yield immediately in bif). */
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+ rp = ERTS_PROC_LOCK_BUSY;
+ }
+ else {
+ ErtsProcLocks need_locks = pid_locks & ~ERTS_PROC_LOCK_STATUS;
+ if (need_locks && erts_smp_proc_trylock(rp, need_locks) == EBUSY) {
+ if (ERTS_PSFLG_RUNNING_SYS
+ & erts_smp_atomic32_read_nob(&rp->state)) {
+ /* Executing system task... */
+ resume_process(rp, ERTS_PROC_LOCK_STATUS);
+ goto running;
+ }
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
+ /*
+ * If we are unlucky, the process just got selected for
+ * execution of a system task. In this case we may be
+ * blocked here for quite a while... Execution of system
+ * tasks are fortunately quite rare events. We try to
+ * avoid this by checking if it is in a state executing
+ * system tasks (above), but it will not prevent all
+ * scenarios for a long block here...
+ */
+ rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS,
+ pid, pid_locks|ERTS_PROC_LOCK_STATUS);
+ if (!rp)
+ goto done;
+ }
+
+ /*
+ * The previous suspend has prevented the process
+ * from being selected for normal execution regardless
+ * of locks held or not held on it...
+ */
+ ASSERT(!(ERTS_PSFLG_RUNNING
+ & erts_smp_atomic32_read_nob(&rp->state)));
+
+ if (!suspend)
+ resume_process(rp, pid_locks|ERTS_PROC_LOCK_STATUS);
}
- /* Yield (caller is assumed to yield immediately in bif). */
- erts_smp_proc_unlock(rp, pid_locks|ERTS_PROC_LOCK_STATUS);
- rp = ERTS_PROC_LOCK_BUSY;
}
done:
+
if (rp && rp != ERTS_PROC_LOCK_BUSY && !(pid_locks & ERTS_PROC_LOCK_STATUS))
erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
if (unlock_c_p_status)
@@ -8952,24 +8997,39 @@ resume_process_1(BIF_ALIST_1)
}
Uint
-erts_run_queues_len(Uint *qlen)
+erts_run_queues_len(Uint *qlen, int atomic_queues_read, int incl_active_sched)
{
int i = 0;
Uint len = 0;
- ERTS_ATOMIC_FOREACH_RUNQ(rq,
- {
- Sint pqlen = 0;
- int pix;
- for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++)
- pqlen += RUNQ_READ_LEN(&rq->procs.prio_info[pix].len);
+ if (atomic_queues_read)
+ ERTS_ATOMIC_FOREACH_RUNQ(rq,
+ {
+ Sint rq_len = (Sint) erts_smp_atomic32_read_dirty(&rq->len);
+ ASSERT(rq_len >= 0);
+ if (incl_active_sched
+ && (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_EXEC)) {
+ rq_len++;
+ }
+ if (qlen)
+ qlen[i++] = rq_len;
+ len += (Uint) rq_len;
+ }
+ );
+ else {
+ for (i = 0; i < erts_no_run_queues; i++) {
+ ErtsRunQueue *rq = ERTS_RUNQ_IX(i);
+ Sint rq_len = (Sint) erts_smp_atomic32_read_nob(&rq->len);
+ ASSERT(rq_len >= 0);
+ if (incl_active_sched
+ && (ERTS_RUNQ_FLGS_GET_NOB(rq) & ERTS_RUNQ_FLG_EXEC)) {
+ rq_len++;
+ }
+ if (qlen)
+ qlen[i] = rq_len;
+ len += (Uint) rq_len;
+ }
- if (pqlen < 0)
- pqlen = 0;
- if (qlen)
- qlen[i++] = pqlen;
- len += pqlen;
}
- );
return len;
}
@@ -9228,6 +9288,8 @@ Process *schedule(Process *p, int calls)
Uint32 flags;
erts_aint32_t state = 0; /* Supress warning... */
+ ERTS_MSACC_DECLARE_CACHE();
+
#ifdef USE_VM_PROBES
if (p != NULL && DTRACE_ENABLED(process_unscheduled)) {
DTRACE_CHARBUF(process_buf, DTRACE_TERM_BUF_SIZE);
@@ -9262,6 +9324,8 @@ Process *schedule(Process *p, int calls)
} else {
sched_out_proc:
+ ASSERT(!(p->flags & F_DELAY_GC));
+
#ifdef ERTS_SMP
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
esdp = p->scheduler_data;
@@ -9330,6 +9394,8 @@ Process *schedule(Process *p, int calls)
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
+
if (state & ERTS_PSFLG_FREE) {
#ifdef ERTS_SMP
ASSERT(esdp->free_process == p);
@@ -9366,15 +9432,16 @@ Process *schedule(Process *p, int calls)
#ifdef ERTS_SMP
ErtsMigrationPaths *mps;
ErtsMigrationPath *mp;
- ErtsProcList *pnd_xtrs = rq->procs.pending_exiters;
- if (erts_proclist_fetch(&pnd_xtrs, NULL)) {
- rq->procs.pending_exiters = NULL;
- erts_smp_runq_unlock(rq);
- handle_pending_exiters(pnd_xtrs);
- erts_smp_runq_lock(rq);
- }
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ ErtsProcList *pnd_xtrs = rq->procs.pending_exiters;
+ if (erts_proclist_fetch(&pnd_xtrs, NULL)) {
+ rq->procs.pending_exiters = NULL;
+ erts_smp_runq_unlock(rq);
+ handle_pending_exiters(pnd_xtrs);
+ erts_smp_runq_lock(rq);
+ }
+
if (rq->check_balance_reds <= 0)
check_balance(rq);
@@ -9396,8 +9463,10 @@ Process *schedule(Process *p, int calls)
if (flags & (ERTS_RUNQ_FLG_CHK_CPU_BIND|ERTS_RUNQ_FLG_SUSPENDED)) {
if (flags & ERTS_RUNQ_FLG_SUSPENDED) {
+ (void) ERTS_RUNQ_FLGS_UNSET_NOB(rq, ERTS_RUNQ_FLG_EXEC);
suspend_scheduler(esdp);
- flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
+ flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC);
+ flags |= ERTS_RUNQ_FLG_EXEC;
}
if (flags & ERTS_RUNQ_FLG_CHK_CPU_BIND) {
flags = ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_CHK_CPU_BIND);
@@ -9412,24 +9481,20 @@ Process *schedule(Process *p, int calls)
suspend_scheduler(esdp);
#endif
- {
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
erts_aint32_t aux_work;
- int leader_update = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0
- : erts_thr_progress_update(esdp);
+ int leader_update = erts_thr_progress_update(esdp);
aux_work = erts_atomic32_read_acqb(&esdp->ssi->aux_work);
- if (aux_work | leader_update | ERTS_SCHED_FAIR) {
+ if (aux_work | leader_update) {
erts_smp_runq_unlock(rq);
if (leader_update)
erts_thr_progress_leader_update(esdp);
- else if (ERTS_SCHED_FAIR)
- ERTS_SCHED_FAIR_YIELD();
if (aux_work)
handle_aux_work(&esdp->aux_work_data, aux_work, 0);
erts_smp_runq_lock(rq);
}
- ERTS_SMP_LC_ASSERT(ERTS_SCHEDULER_IS_DIRTY(esdp)
- || !erts_thr_progress_is_blocking());
+ ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
}
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
@@ -9488,8 +9553,11 @@ Process *schedule(Process *p, int calls)
}
#endif
+ (void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_EXEC);
scheduler_wait(&fcalls, esdp, rq);
-
+ flags = ERTS_RUNQ_FLGS_SET_NOB(rq, ERTS_RUNQ_FLG_EXEC);
+ flags |= ERTS_RUNQ_FLG_EXEC;
+ ERTS_MSACC_UPDATE_CACHE();
#ifdef ERTS_SMP
non_empty_runq(rq);
#endif
@@ -9498,12 +9566,14 @@ Process *schedule(Process *p, int calls)
}
else if (!ERTS_SCHEDULER_IS_DIRTY(esdp) &&
(fcalls > input_reductions &&
- prepare_for_sys_schedule(esdp, !0))) {
+ prepare_for_sys_schedule(!0))) {
ErtsMonotonicTime current_time;
/*
* Schedule system-level activities.
*/
+ ERTS_MSACC_PUSH_STATE_CACHED_M();
+
erts_smp_atomic32_set_relb(&function_calls, 0);
fcalls = 0;
@@ -9511,7 +9581,9 @@ Process *schedule(Process *p, int calls)
erts_sys_schedule_interrupt(0);
#endif
erts_smp_runq_unlock(rq);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
erl_sys_schedule(1);
+ ERTS_MSACC_POP_STATE_M();
current_time = erts_get_monotonic_time(esdp);
if (current_time >= erts_next_timeout_time(esdp->next_tmo_ref))
@@ -9569,11 +9641,12 @@ Process *schedule(Process *p, int calls)
pick_next_process: {
erts_aint32_t psflg_band_mask;
int prio_q;
- int qmask;
+ int qmask, qbit;
flags = ERTS_RUNQ_FLGS_GET_NOB(rq);
qmask = (int) (flags & ERTS_RUNQ_FLGS_PROCS_QMASK);
- switch (qmask & -qmask) {
+ qbit = qmask & -qmask;
+ switch (qbit) {
case MAX_BIT:
prio_q = PRIORITY_MAX;
break;
@@ -9589,9 +9662,12 @@ Process *schedule(Process *p, int calls)
case 0: /* No process at all */
default:
ASSERT(qmask == 0);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
goto check_activities_to_run;
}
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_EMULATOR);
+
BM_START_TIMER(system);
/*
@@ -9601,20 +9677,11 @@ Process *schedule(Process *p, int calls)
ASSERT(p); /* Wrong qmask in rq->flags? */
- psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state)
- + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET));
-
-#ifdef ERTS_DIRTY_SCHEDULERS
- ASSERT((state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) !=
- (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC));
- if (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC)) {
- ASSERT((ERTS_SCHEDULER_IS_DIRTY_CPU(esdp) && (state & ERTS_PSFLG_DIRTY_CPU_PROC)) ||
- (ERTS_SCHEDULER_IS_DIRTY_IO(esdp) && (state & ERTS_PSFLG_DIRTY_IO_PROC)));
- if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && !(state & ERTS_PSFLG_ACTIVE_SYS))
- goto pick_next_process;
- state &= ~(ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q);
- }
-#endif
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp))
+ psflg_band_mask = ~((erts_aint32_t) 0);
+ else
+ psflg_band_mask = ~(((erts_aint32_t) 1) << (ERTS_PSFLGS_GET_PRQ_PRIO(state)
+ + ERTS_PSFLGS_IN_PRQ_MASK_OFFSET));
if (!(state & ERTS_PSFLG_PROXY))
psflg_band_mask &= ~ERTS_PSFLG_IN_RUNQ;
@@ -9637,9 +9704,11 @@ Process *schedule(Process *p, int calls)
| ERTS_PSFLG_RUNNING_SYS))) {
tmp = state & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_PENDING_EXIT
- | ERTS_PSFLG_ACTIVE_SYS);
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS);
if (tmp != ERTS_PSFLG_SUSPENDED) {
- if (state & ERTS_PSFLG_ACTIVE_SYS)
+ if (state & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
new |= ERTS_PSFLG_RUNNING_SYS;
else
new |= ERTS_PSFLG_RUNNING;
@@ -9652,7 +9721,8 @@ Process *schedule(Process *p, int calls)
| ERTS_PSFLG_FREE))
|| ((state & (ERTS_PSFLG_SUSPENDED
| ERTS_PSFLG_PENDING_EXIT
- | ERTS_PSFLG_ACTIVE_SYS))
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
== ERTS_PSFLG_SUSPENDED)) {
if (state & ERTS_PSFLG_FREE)
erts_proc_dec_refc(p);
@@ -9671,10 +9741,42 @@ Process *schedule(Process *p, int calls)
esdp->current_process = p;
+
+ reds = context_reds;
+
+#ifdef ERTS_SMP
+
+ erts_smp_runq_unlock(rq);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+#ifdef DEBUG
+ int old_dqbit;
+#endif
+ int dqbit = qbit;
+
+ if (rq == ERTS_DIRTY_CPU_RUNQ)
+ dqbit <<= ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET;
+ else {
+ ASSERT(rq == ERTS_DIRTY_IO_RUNQ);
+ dqbit <<= ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET;
+ }
+
+#ifdef DEBUG
+ old_dqbit = (int)
+#else
+ (void)
+#endif
+ erts_smp_atomic32_read_band_mb(&p->dirty_state, ~dqbit);
+ ASSERT(old_dqbit & dqbit);
+ }
+#endif /* ERTS_DIRTY_SCHEDULERS */
+
+#endif /* ERTS_SMP */
+
}
#ifdef ERTS_SMP
- erts_smp_runq_unlock(rq);
if (flags & ERTS_RUNQ_FLG_PROTECTED)
(void) ERTS_RUNQ_FLGS_UNSET(rq, ERTS_RUNQ_FLG_PROTECTED);
@@ -9683,6 +9785,8 @@ Process *schedule(Process *p, int calls)
erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
+ state = erts_smp_atomic32_read_nob(&p->state);
+
if (erts_sched_stat.enabled) {
int prio;
UWord old = ERTS_PROC_SCHED_ID(p,
@@ -9707,15 +9811,56 @@ Process *schedule(Process *p, int calls)
erts_smp_spin_unlock(&erts_sched_stat.lock);
}
- if (ERTS_PROC_PENDING_EXIT(p)) {
+ ASSERT(!p->scheduler_data);
+ p->scheduler_data = esdp;
+
+ state = erts_smp_atomic32_read_nob(&p->state);
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
+ if (!!(state & ERTS_PSFLGS_DIRTY_WORK)
+ & !(state & ERTS_PSFLG_ACTIVE_SYS)) {
+ /* Migrate to dirty scheduler... */
+ sunlock_sched_out_proc:
+ erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ p->fcalls = reds;
+ goto sched_out_proc;
+
+ }
+ }
+ else {
+ if (state & (ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_PENDING_EXIT
+ | ERTS_PSFLG_EXITING)) {
+ /* Migrate to normal scheduler... */
+ goto sunlock_sched_out_proc;
+ }
+ if ((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS)
+ && rq == ERTS_DIRTY_IO_RUNQ) {
+ /* Migrate to dirty cpu scheduler... */
+ goto sunlock_sched_out_proc;
+ }
+
+ ASSERT((state & ERTS_PSFLG_DIRTY_ACTIVE_SYS)
+ || *p->i == (BeamInstr) em_call_nif);
+
+ ASSERT(rq == ERTS_DIRTY_CPU_RUNQ
+ ? (state & (ERTS_PSFLG_DIRTY_CPU_PROC
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ : (rq == ERTS_DIRTY_IO_RUNQ
+ && (state & ERTS_PSFLG_DIRTY_IO_PROC)));
+ }
+#endif
+
+ if (state & ERTS_PSFLG_PENDING_EXIT) {
erts_handle_pending_exit(p,
ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
state = erts_smp_atomic32_read_nob(&p->state);
}
- ASSERT(!p->scheduler_data);
- p->scheduler_data = esdp;
-#endif
- reds = context_reds;
+
+#endif /* ERTS_SMP */
+
+ p->fcalls = reds;
if (IS_TRACED(p)) {
if (state & ERTS_PSFLG_EXITING) {
@@ -9744,7 +9889,8 @@ Process *schedule(Process *p, int calls)
reds -= execute_sys_tasks(p, &state, reds);
if (reds <= 0
#ifdef ERTS_DIRTY_SCHEDULERS
- || (state & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC))
+ || ERTS_SCHEDULER_IS_DIRTY(esdp)
+ || (state & ERTS_PSFLGS_DIRTY_WORK)
#endif
) {
p->fcalls = reds;
@@ -9777,13 +9923,13 @@ Process *schedule(Process *p, int calls)
}
}
- if (!(state & ERTS_PSFLG_EXITING)
- && ((FLAGS(p) & F_FORCE_GC)
- || (MSO(p).overhead > BIN_VHEAP_SZ(p)))) {
- reds -= erts_garbage_collect(p, 0, p->arg_reg, p->arity);
- if (reds <= 0) {
- p->fcalls = reds;
- goto sched_out_proc;
+ if (ERTS_IS_GC_DESIRED(p)) {
+ if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & F_DISABLE_GC)) {
+ reds -= erts_garbage_collect_nobump(p, 0, p->arg_reg, p->arity);
+ if (reds <= 0) {
+ p->fcalls = reds;
+ goto sched_out_proc;
+ }
}
}
@@ -9792,7 +9938,6 @@ Process *schedule(Process *p, int calls)
proxy_p = NULL;
}
- p->fcalls = reds;
ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
/* Never run a suspended process */
@@ -9823,7 +9968,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result)
if (rp) {
ErtsProcLocks rp_locks;
ErlOffHeap *ohp;
- ErlHeapFragment* bp;
+ ErtsMessage *mp;
Eterm *hp, msg, req_id, result;
Uint st_result_sz, hsz;
#ifdef DEBUG
@@ -9835,11 +9980,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result)
st_result_sz = is_immed(st_result) ? 0 : size_object(st_result);
hsz = st->req_id_sz + st_result_sz + 4 /* 3-tuple */;
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp);
#ifdef DEBUG
hp_start = hp;
@@ -9864,7 +10005,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result)
ASSERT(hp_start + hsz == hp);
#endif
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -10066,10 +10207,10 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
else {
if (!garbage_collected) {
FLAGS(c_p) |= F_NEED_FULLSWEEP;
- reds += erts_garbage_collect(c_p,
- 0,
- c_p->arg_reg,
- c_p->arity);
+ reds += erts_garbage_collect_nobump(c_p,
+ 0,
+ c_p->arg_reg,
+ c_p->arity);
garbage_collected = 1;
}
st_res = am_true;
@@ -10078,7 +10219,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
case ERTS_PSTT_CPC:
st_res = erts_check_process_code(c_p,
st->arg[0],
- st->arg[1] == am_true,
+ unsigned_val(st->arg[1]),
&reds);
if (is_non_value(st_res)) {
/* Needed gc, but gc was disabled */
@@ -10086,6 +10227,10 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds)
st = NULL;
}
break;
+ case ERTS_PSTT_COHMQ:
+ reds += erts_complete_off_heap_message_queue_change(c_p);
+ st_res = am_true;
+ break;
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
@@ -10128,6 +10273,9 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds)
case ERTS_PSTT_CPC:
st_res = am_false;
break;
+ case ERTS_PSTT_COHMQ:
+ st_res = am_false;
+ break;
default:
ERTS_INTERNAL_ERROR("Invalid process sys task type");
st_res = am_false;
@@ -10146,10 +10294,8 @@ BIF_RETTYPE
erts_internal_request_system_task_3(BIF_ALIST_3)
{
Process *rp = erts_proc_lookup(BIF_ARG_1);
- ErtsProcSysTaskQs *stqs, *free_stqs = NULL;
ErtsProcSysTask *st = NULL;
- erts_aint32_t prio, rp_state;
- int rp_locked;
+ erts_aint32_t prio;
Eterm noproc_res, req_type;
if (!rp && !is_internal_pid(BIF_ARG_1)) {
@@ -10206,7 +10352,6 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
}
st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK,
ERTS_PROC_SYS_TASK_SIZE(tot_sz));
- st->next = st->prev = st; /* Prep for empty prio queue */
ERTS_INIT_OFF_HEAP(&st->off_heap);
hp = &st->heap[0];
@@ -10238,7 +10383,7 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
case am_check_process_code:
if (is_not_atom(st->arg[0]))
goto badarg;
- if (st->arg[1] != am_true && st->arg[1] != am_false)
+ if (is_not_small(st->arg[1]) || (unsigned_val(st->arg[1]) & ~ERTS_CPC_ALL))
goto badarg;
noproc_res = am_false;
st->type = ERTS_PSTT_CPC;
@@ -10250,95 +10395,11 @@ erts_internal_request_system_task_3(BIF_ALIST_3)
goto badarg;
}
- rp_state = erts_smp_atomic32_read_nob(&rp->state);
-
- rp_locked = 0;
-
- free_stqs = NULL;
- if (rp_state & ERTS_PSFLG_ACTIVE_SYS)
- stqs = NULL;
- else {
- alloc_qs:
- stqs = proc_sys_task_queues_alloc();
- stqs->qmask = 1 << prio;
- stqs->ncount = 0;
- stqs->q[PRIORITY_MAX] = NULL;
- stqs->q[PRIORITY_HIGH] = NULL;
- stqs->q[PRIORITY_NORMAL] = NULL;
- stqs->q[PRIORITY_LOW] = NULL;
- stqs->q[prio] = st;
- }
-
- if (!rp_locked) {
- rp_locked = 1;
- erts_smp_proc_lock(rp, ERTS_PROC_LOCK_STATUS);
-
- rp_state = erts_smp_atomic32_read_nob(&rp->state);
- if (rp_state & ERTS_PSFLG_EXITING) {
- erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS);
- rp = NULL;
- free_stqs = stqs;
- goto noproc;
- }
- }
-
- if (!rp->sys_task_qs) {
- if (stqs)
- rp->sys_task_qs = stqs;
- else
- goto alloc_qs;
+ if (!schedule_process_sys_task(rp, prio, st)) {
+ noproc:
+ notify_sys_task_executed(BIF_P, st, noproc_res);
}
- else {
- if (stqs)
- free_stqs = stqs;
- stqs = rp->sys_task_qs;
- if (!stqs->q[prio]) {
- stqs->q[prio] = st;
- stqs->qmask |= 1 << prio;
- }
- else {
- st->next = stqs->q[prio];
- st->prev = stqs->q[prio]->prev;
- st->next->prev = st;
- st->prev->next = st;
- ASSERT(stqs->qmask & (1 << prio));
- }
- }
-
- if (ERTS_PSFLGS_GET_ACT_PRIO(rp_state) > prio) {
- erts_aint32_t n, a, e;
- /* Need to elevate actual prio */
-
- a = rp_state;
- do {
- if (ERTS_PSFLGS_GET_ACT_PRIO(a) <= prio) {
- n = a;
- break;
- }
- n = e = a;
- n &= ~ERTS_PSFLGS_ACT_PRIO_MASK;
- n |= (prio << ERTS_PSFLGS_ACT_PRIO_OFFSET);
- a = erts_smp_atomic32_cmpxchg_nob(&rp->state, n, e);
- } while (a != e);
- rp_state = n;
- }
-
- /*
- * schedule_process_sys_task() unlocks status
- * lock on process.
- */
- schedule_process_sys_task(rp, rp_state, NULL);
-
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
-
- BIF_RET(am_ok);
-
-noproc:
- notify_sys_task_executed(BIF_P, st, noproc_res);
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
BIF_RET(am_ok);
badarg:
@@ -10347,11 +10408,35 @@ badarg:
erts_cleanup_offheap(&st->off_heap);
erts_free(ERTS_ALC_T_PROC_SYS_TSK, st);
}
- if (free_stqs)
- proc_sys_task_queues_free(free_stqs);
BIF_ERROR(BIF_P, BADARG);
}
+void
+erts_schedule_complete_off_heap_message_queue_change(Eterm pid)
+{
+ Process *rp = erts_proc_lookup(pid);
+ if (rp) {
+ ErtsProcSysTask *st;
+ erts_aint32_t state;
+ int i;
+
+ st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK,
+ ERTS_PROC_SYS_TASK_SIZE(0));
+ st->type = ERTS_PSTT_COHMQ;
+ st->requester = NIL;
+ st->reply_tag = NIL;
+ st->req_id = NIL;
+ st->req_id_sz = 0;
+ for (i = 0; i < ERTS_MAX_PROC_SYS_TASK_ARGS; i++)
+ st->arg[i] = NIL;
+ ERTS_INIT_OFF_HEAP(&st->off_heap);
+ state = erts_smp_atomic32_read_nob(&rp->state);
+
+ if (!schedule_process_sys_task(rp, ERTS_PSFLGS_GET_USR_PRIO(state), st))
+ erts_free(ERTS_ALC_T_PROC_SYS_TSK, st);
+ }
+}
+
static void
save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio)
{
@@ -10737,6 +10822,9 @@ static void early_init_process_struct(void *varg, Eterm data)
Process *proc = arg->proc;
proc->common.id = make_internal_pid(data);
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_atomic32_init_nob(&proc->dirty_state, 0);
+#endif
erts_smp_atomic32_init_relb(&proc->state, arg->state);
#ifdef ERTS_SMP
@@ -10797,6 +10885,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
Eterm args, /* Arguments for function (must be well-formed list). */
ErlSpawnOpts* so) /* Options for spawn. */
{
+ Uint flags = 0;
ErtsRunQueue *rq = NULL;
Process *p;
Sint arity; /* Number of arguments. */
@@ -10806,6 +10895,10 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
Eterm res = THE_NON_VALUE;
erts_aint32_t state = 0;
erts_aint32_t prio = (erts_aint32_t) PRIORITY_NORMAL;
+#ifdef SHCOPY_SPAWN
+ erts_shcopy_t info;
+ INITIALIZE_SHCOPY(info);
+#endif
#ifdef ERTS_SMP
erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR);
@@ -10834,6 +10927,15 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
state |= (((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_ACT_PRIO_OFFSET)
| ((prio & ERTS_PSFLGS_PRIO_MASK) << ERTS_PSFLGS_USR_PRIO_OFFSET));
+ if (so->flags & SPO_OFF_HEAP_MSGQ) {
+ state |= ERTS_PSFLG_OFF_HEAP_MSGQ;
+ flags |= F_OFF_HEAP_MSGQ;
+ }
+ else if (so->flags & SPO_ON_HEAP_MSGQ) {
+ state |= ERTS_PSFLG_ON_HEAP_MSGQ;
+ flags |= F_ON_HEAP_MSGQ;
+ }
+
if (!rq)
rq = erts_get_runq_proc(parent);
@@ -10852,11 +10954,15 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
BM_COUNT(processes_spawned);
BM_SWAP_TIMER(system,size);
+#ifdef SHCOPY_SPAWN
+ arg_size = copy_shared_calculate(args, &info);
+#else
arg_size = size_object(args);
+#endif
BM_SWAP_TIMER(size,system);
heap_need = arg_size;
- p->flags = erts_default_process_flags;
+ p->flags = flags;
p->static_flags = 0;
if (so->flags & SPO_SYSTEM_PROC)
@@ -10905,12 +11011,13 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->stop = p->hend = p->heap + sz;
p->htop = p->heap;
p->heap_sz = sz;
+ p->abandoned_heap = NULL;
+ p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
p->catches = 0;
p->bin_vheap_sz = p->min_vheap_size;
p->bin_old_vheap_sz = p->min_vheap_size;
p->bin_old_vheap = 0;
- p->bin_vheap_mature = 0;
p->sys_task_qs = NULL;
@@ -10929,7 +11036,12 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
BM_MESSAGE(args,p,parent);
BM_START_TIMER(system);
BM_SWAP_TIMER(system,copy);
+#ifdef SHCOPY_SPAWN
+ p->arg_reg[2] = copy_shared_perform(args, arg_size, &info, &p->htop, &p->off_heap);
+ DESTROY_SHCOPY(info);
+#else
p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap);
+#endif
BM_MESSAGE_COPIED(arg_size);
BM_SWAP_TIMER(copy,system);
p->arity = 3;
@@ -10975,6 +11087,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
p->accessor_bif_timers = NULL;
#endif
p->mbuf = NULL;
+ p->msg_frag = NULL;
p->mbuf_sz = 0;
p->psd = NULL;
p->dictionary = NULL;
@@ -11110,6 +11223,8 @@ void erts_init_empty_process(Process *p)
p->stop = NULL;
p->hend = NULL;
p->heap = NULL;
+ p->abandoned_heap = NULL;
+ p->live_hf_end = ERTS_INVALID_HFRAG_PTR;
p->gen_gcs = 0;
p->max_gen_gcs = 0;
p->min_heap_size = 0;
@@ -11130,7 +11245,6 @@ void erts_init_empty_process(Process *p)
p->bin_old_vheap_sz = BIN_VH_MIN_SIZE;
p->bin_old_vheap = 0;
p->sys_task_qs = NULL;
- p->bin_vheap_mature = 0;
ERTS_PTMR_INIT(p);
p->next = NULL;
p->off_heap.first = NULL;
@@ -11142,6 +11256,7 @@ void erts_init_empty_process(Process *p)
p->old_htop = NULL;
p->old_heap = NULL;
p->mbuf = NULL;
+ p->msg_frag = NULL;
p->mbuf_sz = 0;
p->psd = NULL;
ERTS_P_MONITORS(p) = NULL;
@@ -11199,6 +11314,9 @@ void erts_init_empty_process(Process *p)
p->last_old_htop = NULL;
#endif
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_atomic32_init_nob(&p->dirty_state, 0);
+#endif
erts_smp_atomic32_init_nob(&p->state, (erts_aint32_t) PRIORITY_NORMAL);
#ifdef ERTS_SMP
@@ -11230,6 +11348,8 @@ erts_debug_verify_clean_empty_process(Process* p)
ASSERT(p->htop == NULL);
ASSERT(p->stop == NULL);
ASSERT(p->hend == NULL);
+ ASSERT(p->abandoned_heap == NULL);
+ ASSERT(p->live_hf_end == ERTS_INVALID_HFRAG_PTR);
ASSERT(p->heap == NULL);
ASSERT(p->common.id == ERTS_INVALID_PID);
ASSERT(ERTS_TRACER_PROC(p) == NIL);
@@ -11307,9 +11427,10 @@ erts_cleanup_empty_process(Process* p)
static void
delete_process(Process* p)
{
- ErlMessage* mp;
-
+ Eterm *heap;
VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->common.id));
+ VERBOSE(DEBUG_SHCOPY, ("[pid=%T] delete process: %p %p %p %p\n", p->common.id,
+ HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p)));
/* Cleanup psd */
@@ -11333,16 +11454,17 @@ delete_process(Process* p)
* Release heaps. Clobber contents in DEBUG build.
*/
-
-#ifdef DEBUG
- sys_memset(p->heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm));
-#endif
-
#ifdef HIPE
hipe_delete_process(&p->hipe);
#endif
- ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) p->heap, p->heap_sz*sizeof(Eterm));
+ heap = p->abandoned_heap ? p->abandoned_heap : p->heap;
+
+#ifdef DEBUG
+ sys_memset(heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm));
+#endif
+
+ ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) heap, p->heap_sz*sizeof(Eterm));
if (p->old_heap != NULL) {
#ifdef DEBUG
@@ -11361,27 +11483,14 @@ delete_process(Process* p)
free_message_buffer(p->mbuf);
}
+ if (p->msg_frag)
+ erts_cleanup_messages(p->msg_frag);
+
erts_erase_dicts(p);
/* free all pending messages */
- mp = p->msg.first;
- while(mp != NULL) {
- ErlMessage* next_mp = mp->next;
- if (mp->data.attached) {
- if (is_value(mp->m[0]))
- free_message_buffer(mp->data.heap_frag);
- else {
- if (is_not_nil(mp->m[1])) {
- ErlHeapFragment *heap_frag;
- heap_frag = (ErlHeapFragment *) mp->data.dist_ext->ext_endp;
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
- erts_free_dist_ext_copy(mp->data.dist_ext);
- }
- }
- free_message(mp);
- mp = next_mp;
- }
+ erts_cleanup_messages(p->msg.first);
+ p->msg.first = NULL;
ASSERT(!p->nodes_monitors);
ASSERT(!p->suspend_monitors);
@@ -11400,7 +11509,9 @@ set_proc_exiting(Process *p,
ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCKS_ALL);
enqueue = change_proc_schedule_state(p,
- ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT,
+ (ERTS_PSFLG_SUSPENDED
+ | ERTS_PSFLG_PENDING_EXIT
+ | ERTS_PSFLGS_DIRTY_WORK),
ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE,
&state,
&enq_prio,
@@ -11434,10 +11545,7 @@ set_proc_exiting(Process *p,
}
#endif
- if (enqueue)
- add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio),
- state,
- enq_prio);
+ add2runq(enqueue, enq_prio, p, state, NULL);
}
static ERTS_INLINE erts_aint32_t
@@ -11540,6 +11648,11 @@ save_pending_exiter(Process *p)
else
rq = esdp->run_queue;
+#ifdef ERTS_DIRTY_SCHEDULERS
+ if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
+ rq = ERTS_RUNQ_IX(0); /* Handle on ordinary scheduler */
+#endif
+
plp = proclist_create(p);
erts_smp_runq_lock(rq);
@@ -11549,13 +11662,8 @@ save_pending_exiter(Process *p)
non_empty_runq(rq);
erts_smp_runq_unlock(rq);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (ERTS_RUNQ_IX_IS_DIRTY(rq->ix))
- wake_dirty_schedulers(rq, 0);
- else
-#endif
- wake_scheduler(rq);
+ wake_scheduler(rq);
}
#endif
@@ -11569,35 +11677,46 @@ static ERTS_INLINE void
send_exit_message(Process *to, ErtsProcLocks *to_locksp,
Eterm exit_term, Uint term_size, Eterm token)
{
- if (token == NIL
-#ifdef USE_VM_PROBES
- || token == am_have_dt_utag
-#endif
- ) {
- Eterm* hp;
- Eterm mess;
- ErlHeapFragment* bp;
- ErlOffHeap *ohp;
-
- hp = erts_alloc_message_heap(term_size, &bp, &ohp, to, to_locksp);
+ ErtsMessage *mp;
+ ErlOffHeap *ohp;
+ Eterm* hp;
+ Eterm mess;
+#ifdef SHCOPY_SEND
+ erts_shcopy_t info;
+#endif
+
+ if (!have_seqtrace(token)) {
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ term_size = copy_shared_calculate(exit_term, &info);
+ mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp);
+ mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp);
mess = copy_struct(exit_term, term_size, &hp, ohp);
- erts_queue_message(to, to_locksp, bp, mess, NIL);
+#endif
+ erts_queue_message(to, to_locksp, mp, mess, NIL);
} else {
- ErlHeapFragment* bp;
- Eterm* hp;
- Eterm mess;
Eterm temp_token;
Uint sz_token;
ASSERT(is_tuple(token));
sz_token = size_object(token);
- bp = new_message_buffer(term_size+sz_token);
- hp = bp->mem;
- mess = copy_struct(exit_term, term_size, &hp, &bp->off_heap);
+#ifdef SHCOPY_SEND
+ INITIALIZE_SHCOPY(info);
+ term_size = copy_shared_calculate(exit_term, &info);
+ mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp);
+ mess = copy_shared_perform(exit_term, term_size, &info, &hp, ohp);
+ DESTROY_SHCOPY(info);
+#else
+ mp = erts_alloc_message_heap(to, to_locksp, term_size+sz_token, &hp, &ohp);
+ mess = copy_struct(exit_term, term_size, &hp, ohp);
+#endif
/* the trace token must in this case be updated by the caller */
seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, NULL);
- temp_token = copy_struct(token, sz_token, &hp, &bp->off_heap);
- erts_queue_message(to, to_locksp, bp, mess, temp_token);
+ temp_token = copy_struct(token, sz_token, &hp, ohp);
+ erts_queue_message(to, to_locksp, mp, mess, temp_token);
}
}
@@ -11706,11 +11825,7 @@ send_exit_signal(Process *c_p, /* current process if and only
if ((state & ERTS_PSFLG_TRAP_EXIT)
&& (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) {
- if (is_not_nil(token)
-#ifdef USE_VM_PROBES
- && token != am_have_dt_utag
-#endif
- && token_update)
+ if (have_seqtrace(token) && token_update)
seq_trace_update_send(token_update);
if (is_value(exit_tuple))
send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token);
@@ -12097,7 +12212,7 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext)
break;
default:
- erl_exit(1, "bad type in link list\n");
+ erts_exit(ERTS_ERROR_EXIT, "bad type in link list\n");
break;
}
erts_destroy_link(lnk);
@@ -12138,7 +12253,7 @@ erts_do_exit_process(Process* p, Eterm reason)
#endif
if (p->static_flags & ERTS_STC_FLG_SYSTEM_PROC)
- erl_exit(ERTS_DUMP_EXIT, "System process %T terminated: %T\n",
+ erts_exit(ERTS_DUMP_EXIT, "System process %T terminated: %T\n",
p->common.id, reason);
#ifdef ERTS_SMP
@@ -12242,21 +12357,46 @@ erts_continue_exit_process(Process *p)
#endif
#ifdef ERTS_SMP
+ if (p->flags & F_SCHDLR_ONLN_WAITQ)
+ abort_sched_onln_chng_waitq(p);
+
if (p->flags & F_HAVE_BLCKD_MSCHED) {
ErtsSchedSuspendResult ssr;
- ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1);
+ ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 0, 1);
+ switch (ssr) {
+ case ERTS_SCHDLR_SSPND_YIELD_RESTART:
+ goto yield;
+ case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
+ case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED:
+ case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED:
+ case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED:
+ case ERTS_SCHDLR_SSPND_DONE:
+ case ERTS_SCHDLR_SSPND_YIELD_DONE:
+ p->flags &= ~F_HAVE_BLCKD_MSCHED;
+ break;
+ case ERTS_SCHDLR_SSPND_EINVAL:
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n",
+ __FILE__, __LINE__, (int) ssr);
+ }
+ }
+ if (p->flags & F_HAVE_BLCKD_NMSCHED) {
+ ErtsSchedSuspendResult ssr;
+ ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1, 1);
switch (ssr) {
case ERTS_SCHDLR_SSPND_YIELD_RESTART:
goto yield;
case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
+ case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED:
case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED:
+ case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED:
case ERTS_SCHDLR_SSPND_DONE:
case ERTS_SCHDLR_SSPND_YIELD_DONE:
p->flags &= ~F_HAVE_BLCKD_MSCHED;
break;
case ERTS_SCHDLR_SSPND_EINVAL:
default:
- erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n",
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n",
__FILE__, __LINE__, (int) ssr);
}
}
@@ -12373,9 +12513,7 @@ erts_continue_exit_process(Process *p)
erts_proc_dec_refc(p);
}
- dep = ((p->flags & F_DISTRIBUTION)
- ? ERTS_PROC_SET_DIST_ENTRY(p, ERTS_PROC_LOCKS_ALL, NULL)
- : NULL);
+ dep = (p->flags & F_DISTRIBUTION) ? erts_this_dist_entry : NULL;
scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, ERTS_PROC_LOCKS_ALL, NULL);
pbt = ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCKS_ALL, NULL);
nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, ERTS_PROC_LOCKS_ALL, NULL);
@@ -12387,8 +12525,6 @@ erts_continue_exit_process(Process *p)
if (dep) {
erts_do_net_exits(dep, reason);
- if(dep)
- erts_deref_dist_entry(dep);
}
/*
@@ -12547,7 +12683,7 @@ stack_element_dump(int to, void *to_arg, Eterm* sp, int yreg)
}
if (is_CP(x)) {
- erts_print(to, to_arg, "Return addr %p (", (Eterm *) EXPAND_POINTER(x));
+ erts_print(to, to_arg, "Return addr %p (", (Eterm *) x);
print_function_from_pc(to, to_arg, cp_val(x));
erts_print(to, to_arg, ")\n");
yreg = 0;
@@ -12757,10 +12893,10 @@ erts_print_scheduler_info(int to, void *to_arg, ErtsSchedulerData *esdp) {
* The same global atomic is used as refcount.
*
* A BIF that calls this should make sure to schedule out to never come back:
- * erl_halt((int)(- code));
+ * erts_halt(code);
* ERTS_BIF_YIELD1(bif_export[BIF_erlang_halt_1], BIF_P, NIL);
*/
-void erl_halt(int code)
+void erts_halt(int code)
{
if (-1 == erts_smp_atomic32_cmpxchg_acqb(&erts_halt_progress,
erts_no_schedulers,
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 20ffe7ea7c..c88bd7056c 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -60,6 +60,9 @@ typedef struct process Process;
#include "erl_mseg.h"
#include "erl_async.h"
#include "erl_gc.h"
+#define ERTS_ONLY_INCLUDE_TRACE_FLAGS
+#include "erl_trace.h"
+#undef ERTS_ONLY_INCLUDE_TRACE_FLAGS
#ifdef HIPE
#include "hipe_process.h"
@@ -76,10 +79,8 @@ struct ErtsNodesMonitor_;
#define ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT 0
#define ERTS_MAX_NO_OF_SCHEDULERS 1024
-#ifdef ERTS_DIRTY_SCHEDULERS
#define ERTS_MAX_NO_OF_DIRTY_CPU_SCHEDULERS ERTS_MAX_NO_OF_SCHEDULERS
#define ERTS_MAX_NO_OF_DIRTY_IO_SCHEDULERS ERTS_MAX_NO_OF_SCHEDULERS
-#endif
#define ERTS_DEFAULT_MAX_PROCESSES (1 << 18)
@@ -170,8 +171,10 @@ extern int erts_sched_thread_suggested_stack_size;
(((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 5))
#define ERTS_RUNQ_FLG_PROTECTED \
(((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 6))
+#define ERTS_RUNQ_FLG_EXEC \
+ (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 7))
-#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 7)
+#define ERTS_RUNQ_FLG_MAX (ERTS_RUNQ_FLG_BASE2 + 8)
#define ERTS_RUNQ_FLGS_MIGRATION_QMASKS \
(ERTS_RUNQ_FLGS_EMIGRATE_QMASK \
@@ -215,6 +218,9 @@ extern int erts_sched_thread_suggested_stack_size;
#define ERTS_RUNQ_FLGS_SET(RQ, FLGS) \
((Uint32) erts_smp_atomic32_read_bor_relb(&(RQ)->flags, \
(erts_aint32_t) (FLGS)))
+#define ERTS_RUNQ_FLGS_SET_NOB(RQ, FLGS) \
+ ((Uint32) erts_smp_atomic32_read_bor_nob(&(RQ)->flags, \
+ (erts_aint32_t) (FLGS)))
#define ERTS_RUNQ_FLGS_BSET(RQ, MSK, FLGS) \
((Uint32) erts_smp_atomic32_read_bset_relb(&(RQ)->flags, \
(erts_aint32_t) (MSK), \
@@ -222,6 +228,9 @@ extern int erts_sched_thread_suggested_stack_size;
#define ERTS_RUNQ_FLGS_UNSET(RQ, FLGS) \
((Uint32) erts_smp_atomic32_read_band_relb(&(RQ)->flags, \
(erts_aint32_t) ~(FLGS)))
+#define ERTS_RUNQ_FLGS_UNSET_NOB(RQ, FLGS) \
+ ((Uint32) erts_smp_atomic32_read_band_nob(&(RQ)->flags, \
+ (erts_aint32_t) ~(FLGS)))
#define ERTS_RUNQ_FLGS_GET(RQ) \
((Uint32) erts_smp_atomic32_read_acqb(&(RQ)->flags))
#define ERTS_RUNQ_FLGS_GET_NOB(RQ) \
@@ -235,7 +244,9 @@ extern int erts_sched_thread_suggested_stack_size;
typedef enum {
ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED,
+ ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED,
ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED,
+ ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED,
ERTS_SCHDLR_SSPND_DONE,
ERTS_SCHDLR_SSPND_YIELD_RESTART,
ERTS_SCHDLR_SSPND_YIELD_DONE,
@@ -293,7 +304,6 @@ typedef enum {
ERTS_SSI_AUX_WORK_ASYNC_READY_CLEAN_IX,
ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX,
ERTS_SSI_AUX_WORK_MISC_IX,
- ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX,
ERTS_SSI_AUX_WORK_SET_TMO_IX,
ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK_IX,
ERTS_SSI_AUX_WORK_REAP_PORTS_IX,
@@ -326,8 +336,6 @@ typedef enum {
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_THR_PRGR_IX)
#define ERTS_SSI_AUX_WORK_MISC \
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_MISC_IX)
-#define ERTS_SSI_AUX_WORK_CHECK_CHILDREN \
- (((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_CHECK_CHILDREN_IX)
#define ERTS_SSI_AUX_WORK_SET_TMO \
(((erts_aint32_t) 1) << ERTS_SSI_AUX_WORK_SET_TMO_IX)
#define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK \
@@ -467,7 +475,7 @@ struct ErtsRunQueue_ {
int full_reds_history[ERTS_FULL_REDS_HISTORY_SIZE];
int out_of_work_count;
erts_aint32_t max_len;
- erts_aint32_t len;
+ erts_smp_atomic32_t len;
int wakeup_other;
int wakeup_other_reds;
int halt_in_progress;
@@ -607,7 +615,7 @@ typedef enum {
typedef union {
struct {
ErtsDirtySchedulerType type: 1;
- unsigned num: 31;
+ Uint num: sizeof(Uint)*8 - 1;
} s;
Uint no;
} ErtsDirtySchedId;
@@ -632,12 +640,6 @@ struct ErtsSchedulerData_ {
Process *free_process;
ErtsThrPrgrData thr_progress_data;
#endif
-#if !HEAP_ON_C_STACK
- Eterm tmp_heap[TMP_HEAP_SIZE];
- int num_tmp_heap_used;
- Eterm beam_emu_tmp_heap[BEAM_EMU_TMP_HEAP_SIZE];
- Eterm erl_arith_tmp_heap[ERL_ARITH_TMP_HEAP_SIZE];
-#endif
ErtsSchedulerSleepInfo *ssi;
Process *current_process;
Uint no; /* Scheduler number for normal schedulers */
@@ -691,13 +693,6 @@ extern ErtsAlignedSchedulerData *erts_aligned_dirty_io_scheduler_data;
extern ErtsSchedulerData *erts_scheduler_data;
#endif
-#ifdef ERTS_SCHED_FAIR
-#define ERTS_SCHED_FAIR_YIELD() ETHR_YIELD()
-#else
-#define ERTS_SCHED_FAIR 0
-#define ERTS_SCHED_FAIR_YIELD()
-#endif
-
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
int erts_smp_lc_runq_is_locked(ErtsRunQueue *);
#endif
@@ -728,7 +723,19 @@ erts_smp_inc_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio)
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
- len = erts_smp_atomic32_read_nob(&rqi->len);
+ len = erts_smp_atomic32_read_dirty(&rq->len);
+
+#ifdef ERTS_SMP
+ if (len == 0)
+ erts_non_empty_runq(rq);
+#endif
+ len++;
+ if (rq->max_len < len)
+ rq->max_len = len;
+ ASSERT(len > 0);
+ erts_smp_atomic32_set_nob(&rq->len, len);
+
+ len = erts_smp_atomic32_read_dirty(&rqi->len);
ASSERT(len >= 0);
if (len == 0) {
ASSERT((erts_smp_atomic32_read_nob(&rq->flags)
@@ -741,15 +748,6 @@ erts_smp_inc_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio)
rqi->max_len = len;
erts_smp_atomic32_set_relb(&rqi->len, len);
-
-#ifdef ERTS_SMP
- if (rq->len == 0)
- erts_non_empty_runq(rq);
-#endif
- rq->len++;
- if (rq->max_len < rq->len)
- rq->max_len = len;
- ASSERT(rq->len > 0);
}
ERTS_GLB_INLINE void
@@ -759,7 +757,12 @@ erts_smp_dec_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio)
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
- len = erts_smp_atomic32_read_nob(&rqi->len);
+ len = erts_smp_atomic32_read_dirty(&rq->len);
+ len--;
+ ASSERT(len >= 0);
+ erts_smp_atomic32_set_nob(&rq->len, len);
+
+ len = erts_smp_atomic32_read_dirty(&rqi->len);
len--;
ASSERT(len >= 0);
if (len == 0) {
@@ -770,8 +773,6 @@ erts_smp_dec_runq_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi, int prio)
}
erts_smp_atomic32_set_relb(&rqi->len, len);
- rq->len--;
- ASSERT(rq->len >= 0);
}
ERTS_GLB_INLINE void
@@ -781,7 +782,7 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi)
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
- len = erts_smp_atomic32_read_nob(&rqi->len);
+ len = erts_smp_atomic32_read_dirty(&rqi->len);
ASSERT(rqi->max_len >= len);
rqi->max_len = len;
}
@@ -801,12 +802,11 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi)
#define ERTS_PSD_ERROR_HANDLER 0
#define ERTS_PSD_SAVED_CALLS_BUF 1
#define ERTS_PSD_SCHED_ID 2
-#define ERTS_PSD_DIST_ENTRY 3
-#define ERTS_PSD_CALL_TIME_BP 4
-#define ERTS_PSD_DELAYED_GC_TASK_QS 5
-#define ERTS_PSD_NIF_TRAP_EXPORT 6
+#define ERTS_PSD_CALL_TIME_BP 3
+#define ERTS_PSD_DELAYED_GC_TASK_QS 4
+#define ERTS_PSD_NIF_TRAP_EXPORT 5
-#define ERTS_PSD_SIZE 7
+#define ERTS_PSD_SIZE 6
typedef struct {
void *data[ERTS_PSD_SIZE];
@@ -824,9 +824,6 @@ typedef struct {
#define ERTS_PSD_SCHED_ID_GET_LOCKS ERTS_PROC_LOCK_STATUS
#define ERTS_PSD_SCHED_ID_SET_LOCKS ERTS_PROC_LOCK_STATUS
-#define ERTS_PSD_DIST_ENTRY_GET_LOCKS ERTS_PROC_LOCK_MAIN
-#define ERTS_PSD_DIST_ENTRY_SET_LOCKS ERTS_PROC_LOCK_MAIN
-
#define ERTS_PSD_CALL_TIME_BP_GET_LOCKS ERTS_PROC_LOCK_MAIN
#define ERTS_PSD_CALL_TIME_BP_SET_LOCKS ERTS_PROC_LOCK_MAIN
@@ -911,7 +908,6 @@ struct ErtsPendingSuspend_ {
# define MIN_VHEAP_SIZE(p) (p)->min_vheap_size
# define BIN_VHEAP_SZ(p) (p)->bin_vheap_sz
-# define BIN_VHEAP_MATURE(p) (p)->bin_vheap_mature
# define BIN_OLD_VHEAP_SZ(p) (p)->bin_old_vheap_sz
# define BIN_OLD_VHEAP(p) (p)->bin_old_vheap
@@ -929,6 +925,7 @@ struct process {
Eterm* stop; /* Stack top */
Eterm* heap; /* Heap start */
Eterm* hend; /* Heap end */
+ Eterm* abandoned_heap;
Uint heap_sz; /* Size of heap in words */
Uint min_heap_size; /* Minimum size of heap (in words). */
Uint min_vheap_size; /* Minimum size of virtual heap (in words). */
@@ -1025,18 +1022,22 @@ struct process {
Uint16 gen_gcs; /* Number of (minor) generational GCs. */
Uint16 max_gen_gcs; /* Max minor gen GCs before fullsweep. */
ErlOffHeap off_heap; /* Off-heap data updated by copy_struct(). */
- ErlHeapFragment* mbuf; /* Pointer to message buffer list */
- Uint mbuf_sz; /* Size of all message buffers */
+ ErlHeapFragment* mbuf; /* Pointer to heap fragment list */
+ ErlHeapFragment* live_hf_end;
+ ErtsMessage *msg_frag; /* Pointer to message fragment list */
+ Uint mbuf_sz; /* Total size of heap fragments and message fragments */
ErtsPSD *psd; /* Rarely used process specific data */
Uint64 bin_vheap_sz; /* Virtual heap block size for binaries */
- Uint64 bin_vheap_mature; /* Virtual heap block size for binaries */
Uint64 bin_old_vheap_sz; /* Virtual old heap block size for binaries */
Uint64 bin_old_vheap; /* Virtual old heap size for binaries */
ErtsProcSysTaskQs *sys_task_qs;
erts_smp_atomic32_t state; /* Process state flags (see ERTS_PSFLG_*) */
+#ifdef ERTS_DIRTY_SCHEDULERS
+ erts_smp_atomic32_t dirty_state; /* Process dirty state flags (see ERTS_PDSFLG_*) */
+#endif
#ifdef ERTS_SMP
ErlMessageInQueue msg_inq;
@@ -1054,6 +1055,7 @@ struct process {
#ifdef CHECK_FOR_HOLES
Eterm* last_htop; /* No need to scan the heap below this point. */
ErlHeapFragment* last_mbuf; /* No need to scan beyond this mbuf. */
+ ErlHeapFragment* heap_hfrag; /* Heap abandoned, htop now lives in this frag */
#endif
#ifdef DEBUG
@@ -1077,6 +1079,7 @@ extern const Process erts_invalid_process;
do { \
(p)->last_htop = 0; \
(p)->last_mbuf = 0; \
+ (p)->heap_hfrag = NULL; \
} while (0)
# define ERTS_HOLE_CHECK(p) erts_check_for_holes((p))
@@ -1154,15 +1157,16 @@ void erts_check_for_holes(Process* p);
#define ERTS_PSFLG_RUNNING_SYS ERTS_PSFLG_BIT(15)
#define ERTS_PSFLG_PROXY ERTS_PSFLG_BIT(16)
#define ERTS_PSFLG_DELAYED_SYS ERTS_PSFLG_BIT(17)
-#ifdef ERTS_DIRTY_SCHEDULERS
-#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(18)
-#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(19)
-#define ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q ERTS_PSFLG_BIT(20)
-#define ERTS_PSFLG_DIRTY_IO_PROC_IN_Q ERTS_PSFLG_BIT(21)
+#define ERTS_PSFLG_OFF_HEAP_MSGQ ERTS_PSFLG_BIT(18)
+#define ERTS_PSFLG_ON_HEAP_MSGQ ERTS_PSFLG_BIT(19)
+#define ERTS_PSFLG_DIRTY_CPU_PROC ERTS_PSFLG_BIT(20)
+#define ERTS_PSFLG_DIRTY_IO_PROC ERTS_PSFLG_BIT(21)
+#define ERTS_PSFLG_DIRTY_ACTIVE_SYS ERTS_PSFLG_BIT(22)
#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 22)
-#else
-#define ERTS_PSFLG_MAX (ERTS_PSFLGS_ZERO_BIT_OFFSET + 18)
-#endif
+
+#define ERTS_PSFLGS_DIRTY_WORK (ERTS_PSFLG_DIRTY_CPU_PROC \
+ | ERTS_PSFLG_DIRTY_IO_PROC \
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS)
#define ERTS_PSFLGS_IN_PRQ_MASK (ERTS_PSFLG_IN_PRQ_MAX \
| ERTS_PSFLG_IN_PRQ_HIGH \
@@ -1174,7 +1178,37 @@ void erts_check_for_holes(Process* p);
#define ERTS_PSFLGS_GET_USR_PRIO(PSFLGS) \
(((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK)
#define ERTS_PSFLGS_GET_PRQ_PRIO(PSFLGS) \
- (((PSFLGS) >> ERTS_PSFLGS_USR_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK)
+ (((PSFLGS) >> ERTS_PSFLGS_PRQ_PRIO_OFFSET) & ERTS_PSFLGS_PRIO_MASK)
+
+#ifdef ERTS_DIRTY_SCHEDULERS
+
+/*
+ * Flags in the dirty_state field.
+ */
+
+#define ERTS_PDSFLG_IN_CPU_PRQ_MAX (((erts_aint32_t) 1) << 0)
+#define ERTS_PDSFLG_IN_CPU_PRQ_HIGH (((erts_aint32_t) 1) << 1)
+#define ERTS_PDSFLG_IN_CPU_PRQ_NORMAL (((erts_aint32_t) 1) << 2)
+#define ERTS_PDSFLG_IN_CPU_PRQ_LOW (((erts_aint32_t) 1) << 3)
+#define ERTS_PDSFLG_IN_IO_PRQ_MAX (((erts_aint32_t) 1) << 4)
+#define ERTS_PDSFLG_IN_IO_PRQ_HIGH (((erts_aint32_t) 1) << 5)
+#define ERTS_PDSFLG_IN_IO_PRQ_NORMAL (((erts_aint32_t) 1) << 6)
+#define ERTS_PDSFLG_IN_IO_PRQ_LOW (((erts_aint32_t) 1) << 7)
+
+#define ERTS_PDSFLGS_QMASK ERTS_PSFLGS_QMASK
+#define ERTS_PDSFLGS_IN_CPU_PRQ_MASK_OFFSET 0
+#define ERTS_PDSFLGS_IN_IO_PRQ_MASK_OFFSET ERTS_PSFLGS_QMASK_BITS
+
+#define ERTS_PDSFLG_IN_CPU_PRQ_MASK (ERTS_PDSFLG_IN_CPU_PRQ_MAX \
+ | ERTS_PDSFLG_IN_CPU_PRQ_HIGH \
+ | ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\
+ | ERTS_PDSFLG_IN_CPU_PRQ_LOW)
+#define ERTS_PDSFLG_IN_IO_PRQ_MASK (ERTS_PDSFLG_IN_CPU_PRQ_MAX \
+ | ERTS_PDSFLG_IN_CPU_PRQ_HIGH \
+ | ERTS_PDSFLG_IN_CPU_PRQ_NORMAL\
+ | ERTS_PDSFLG_IN_CPU_PRQ_LOW)
+#endif
+
/*
* Static flags that do not change after process creation.
@@ -1209,12 +1243,16 @@ void erts_check_for_holes(Process* p);
#define SPO_USE_ARGS 2
#define SPO_MONITOR 4
#define SPO_SYSTEM_PROC 8
+#define SPO_OFF_HEAP_MSGQ 16
+#define SPO_ON_HEAP_MSGQ 32
+
+extern int erts_default_spo_flags;
/*
* The following struct contains options for a process to be spawned.
*/
typedef struct {
- Uint flags;
+ int flags;
int error_code; /* Error code returned from create_process(). */
Eterm mref; /* Monitor ref returned (if SPO_MONITOR was given). */
@@ -1254,7 +1292,6 @@ Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra);
Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz);
#endif
-extern Uint erts_default_process_flags;
extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx;
/* If any of the erts_system_monitor_* variables are set (enabled),
** erts_system_monitor must be != NIL, to allow testing on just
@@ -1282,6 +1319,7 @@ struct erts_system_profile_flags_t {
unsigned int exclusive : 1;
};
extern struct erts_system_profile_flags_t erts_system_profile_flags;
+extern int erts_system_profile_ts_type;
/* process flags */
#define F_HIBERNATE_SCHED (1 << 0) /* Schedule out after hibernate op */
@@ -1295,63 +1333,110 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
#define F_HAVE_BLCKD_MSCHED (1 << 8) /* Process has blocked multi-scheduling */
#define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */
#define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */
-#define F_DISABLE_GC (1 << 11) /* Disable GC */
+#define F_DISABLE_GC (1 << 11) /* Disable GC (see below) */
+#define F_OFF_HEAP_MSGQ (1 << 12) /* Off heap msg queue */
+#define F_ON_HEAP_MSGQ (1 << 13) /* Off heap msg queue */
+#define F_OFF_HEAP_MSGQ_CHNG (1 << 14) /* Off heap msg queue changing */
+#define F_ABANDONED_HEAP_USE (1 << 15) /* Have usage of abandoned heap */
+#define F_DELAY_GC (1 << 16) /* Similar to disable GC (see below) */
+#define F_SCHDLR_ONLN_WAITQ (1 << 17) /* Process enqueued waiting to change schedulers online */
+#define F_HAVE_BLCKD_NMSCHED (1 << 18) /* Process has blocked normal multi-scheduling */
+
+/*
+ * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent
+ * GC of the process, but it is important to use the right
+ * one:
+ * - F_DISABLE_GC should *only* be used by BIFs. This when
+ * the BIF needs to yield while preventig a GC.
+ * - F_DELAY_GC should only be used when GC is temporarily
+ * disabled while the process is scheduled. A process must
+ * not be scheduled out while F_DELAY_GC is set.
+ */
+
+#define ERTS_TRACE_FLAGS_TS_TYPE_SHIFT 0
+
+#define F_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N)))
/* process trace_flags */
-#define F_SENSITIVE (1 << 0)
-#define F_TRACE_SEND (1 << 1)
-#define F_TRACE_RECEIVE (1 << 2)
-#define F_TRACE_SOS (1 << 3) /* Set on spawn */
-#define F_TRACE_SOS1 (1 << 4) /* Set on first spawn */
-#define F_TRACE_SOL (1 << 5) /* Set on link */
-#define F_TRACE_SOL1 (1 << 6) /* Set on first link */
-#define F_TRACE_CALLS (1 << 7)
-#define F_TIMESTAMP (1 << 8)
-#define F_TRACE_PROCS (1 << 9)
-#define F_TRACE_FIRST_CHILD (1 << 10)
-#define F_TRACE_SCHED (1 << 11)
-#define F_TRACE_GC (1 << 12)
-#define F_TRACE_ARITY_ONLY (1 << 13)
-#define F_TRACE_RETURN_TO (1 << 14) /* Return_to trace when breakpoint tracing */
-#define F_TRACE_SILENT (1 << 15) /* No call trace msg suppress */
-#define F_TRACER (1 << 16) /* May be (has been) tracer */
-#define F_EXCEPTION_TRACE (1 << 17) /* May have exception trace on stack */
+
+#define F_NOW_TS (ERTS_TRACE_FLG_NOW_TIMESTAMP \
+ << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define F_STRICT_MON_TS (ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP \
+ << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define F_MON_TS (ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP \
+ << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define F_SENSITIVE F_TRACE_FLAG(0)
+#define F_TRACE_SEND F_TRACE_FLAG(1)
+#define F_TRACE_RECEIVE F_TRACE_FLAG(2)
+#define F_TRACE_SOS F_TRACE_FLAG(3) /* Set on spawn */
+#define F_TRACE_SOS1 F_TRACE_FLAG(4) /* Set on first spawn */
+#define F_TRACE_SOL F_TRACE_FLAG(5) /* Set on link */
+#define F_TRACE_SOL1 F_TRACE_FLAG(6) /* Set on first link */
+#define F_TRACE_CALLS F_TRACE_FLAG(7)
+#define F_TRACE_PROCS F_TRACE_FLAG(8)
+#define F_TRACE_FIRST_CHILD F_TRACE_FLAG(9)
+#define F_TRACE_SCHED F_TRACE_FLAG(10)
+#define F_TRACE_GC F_TRACE_FLAG(11)
+#define F_TRACE_ARITY_ONLY F_TRACE_FLAG(12)
+#define F_TRACE_RETURN_TO F_TRACE_FLAG(13) /* Return_to trace when breakpoint tracing */
+#define F_TRACE_SILENT F_TRACE_FLAG(14) /* No call trace msg suppress */
+#define F_TRACER F_TRACE_FLAG(15) /* May be (has been) tracer */
+#define F_EXCEPTION_TRACE F_TRACE_FLAG(16) /* May have exception trace on stack */
/* port trace flags, currently the same as process trace flags */
-#define F_TRACE_SCHED_PORTS (1 << 18) /* Trace of port scheduling */
-#define F_TRACE_SCHED_PROCS (1 << 19) /* With virtual scheduling */
-#define F_TRACE_PORTS (1 << 20) /* Ports equivalent to F_TRACE_PROCS */
-#define F_TRACE_SCHED_NO (1 << 21) /* Trace with scheduler id */
-#define F_TRACE_SCHED_EXIT (1 << 22)
+#define F_TRACE_SCHED_PORTS F_TRACE_FLAG(17) /* Trace of port scheduling */
+#define F_TRACE_SCHED_PROCS F_TRACE_FLAG(18) /* With virtual scheduling */
+#define F_TRACE_PORTS F_TRACE_FLAG(19) /* Ports equivalent to F_TRACE_PROCS */
+#define F_TRACE_SCHED_NO F_TRACE_FLAG(20) /* Trace with scheduler id */
+#define F_TRACE_SCHED_EXIT F_TRACE_FLAG(21)
-#define F_NUM_FLAGS 23
+#define F_NUM_FLAGS (ERTS_TRACE_TS_TYPE_BITS + 22)
#ifdef DEBUG
# define F_INITIAL_TRACE_FLAGS (5 << F_NUM_FLAGS)
#else
# define F_INITIAL_TRACE_FLAGS 0
#endif
+/* F_TIMESTAMP_MASK is a bit-field of all all timestamp types */
+#define F_TIMESTAMP_MASK \
+ (ERTS_TRACE_TS_TYPE_MASK << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT)
+
#define TRACEE_FLAGS ( F_TRACE_PROCS | F_TRACE_CALLS \
| F_TRACE_SOS | F_TRACE_SOS1| F_TRACE_RECEIVE \
| F_TRACE_SOL | F_TRACE_SOL1 | F_TRACE_SEND \
- | F_TRACE_SCHED | F_TIMESTAMP | F_TRACE_GC \
+ | F_TRACE_SCHED | F_TIMESTAMP_MASK | F_TRACE_GC \
| F_TRACE_ARITY_ONLY | F_TRACE_RETURN_TO \
| F_TRACE_SILENT | F_TRACE_SCHED_PROCS | F_TRACE_PORTS \
| F_TRACE_SCHED_PORTS | F_TRACE_SCHED_NO \
| F_TRACE_SCHED_EXIT)
#define ERTS_TRACEE_MODIFIER_FLAGS \
- (F_TRACE_SILENT | F_TIMESTAMP | F_TRACE_SCHED_NO)
+ (F_TRACE_SILENT | F_TIMESTAMP_MASK | F_TRACE_SCHED_NO)
#define ERTS_PORT_TRACEE_FLAGS \
(ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS)
#define ERTS_PROC_TRACEE_FLAGS \
((TRACEE_FLAGS & ~ERTS_PORT_TRACEE_FLAGS) | ERTS_TRACEE_MODIFIER_FLAGS)
+#define SEQ_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N)))
+
/* Sequential trace flags */
+
+/* SEQ_TRACE_TIMESTAMP_MASK is a bit-field */
+#define SEQ_TRACE_TIMESTAMP_MASK \
+ (ERTS_TRACE_TS_TYPE_MASK << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)
+
#define SEQ_TRACE_SEND (1 << 0)
#define SEQ_TRACE_RECEIVE (1 << 1)
#define SEQ_TRACE_PRINT (1 << 2)
-#define SEQ_TRACE_TIMESTAMP (1 << 3)
+
+#define ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT 3
+
+#define SEQ_TRACE_NOW_TS (ERTS_TRACE_FLG_NOW_TIMESTAMP \
+ << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define SEQ_TRACE_STRICT_MON_TS (ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP \
+ << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)
+#define SEQ_TRACE_MON_TS (ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP \
+ << ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT)
#ifdef USE_VM_PROBES
#define DT_UTAG_PERMANENT (1 << 0)
@@ -1440,6 +1525,7 @@ void erts_init_scheduling(int, int
int erts_set_gc_state(Process *c_p, int enable);
Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable);
+Eterm erts_system_check_request(Process *c_p);
Eterm erts_gc_info_request(Process *c_p);
Uint64 erts_get_proc_interval(void);
Uint64 erts_ensure_later_proc_interval(Uint64);
@@ -1449,6 +1535,7 @@ int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj); /* see erl_nif.c
void erts_destroy_nif_export(void *); /* see erl_nif.c */
ErtsProcList *erts_proclist_create(Process *);
+ErtsProcList *erts_proclist_copy(ErtsProcList *);
void erts_proclist_destroy(ErtsProcList *);
ERTS_GLB_INLINE int erts_proclist_same(ErtsProcList *, Process *);
@@ -1629,40 +1716,31 @@ void erts_schedule_thr_prgr_later_cleanup_op(void (*)(void *),
void *,
ErtsThrPrgrLaterOp *,
UWord);
+void erts_schedule_complete_off_heap_message_queue_change(Eterm pid);
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
int erts_dbg_check_halloc_lock(Process *p);
#endif
-#ifdef DEBUG
-void erts_dbg_multi_scheduling_return_trap(Process *, Eterm);
-#endif
-int erts_get_max_no_executing_schedulers(void);
#if defined(ERTS_SMP) || defined(ERTS_DIRTY_SCHEDULERS)
-ErtsSchedSuspendResult
-erts_schedulers_state(Uint *, Uint *, Uint *, Uint *, Uint *, Uint *, int);
+void
+erts_schedulers_state(Uint *, Uint *, Uint *, Uint *, Uint *, Uint *, Uint *, Uint *);
#endif
#ifdef ERTS_SMP
ErtsSchedSuspendResult
erts_set_schedulers_online(Process *p,
ErtsProcLocks plocks,
Sint new_no,
- Sint *old_no
-#ifdef ERTS_DIRTY_SCHEDULERS
- , int dirty_only
-#endif
- );
+ Sint *old_no,
+ int dirty_only);
ErtsSchedSuspendResult
-erts_block_multi_scheduling(Process *, ErtsProcLocks, int, int);
+erts_block_multi_scheduling(Process *, ErtsProcLocks, int, int, int);
int erts_is_multi_scheduling_blocked(void);
-Eterm erts_multi_scheduling_blockers(Process *);
+Eterm erts_multi_scheduling_blockers(Process *, int);
void erts_start_schedulers(void);
void erts_alloc_notify_delayed_dealloc(int);
void erts_alloc_ensure_handle_delayed_dealloc_call(int);
-#ifdef ERTS_SMP
void erts_notify_canceled_timer(ErtsSchedulerData *, int);
#endif
-void erts_smp_notify_check_children_needed(void);
-#endif
#if ERTS_USE_ASYNC_READY_Q
void erts_notify_check_async_ready_queue(void *);
#endif
@@ -1682,7 +1760,7 @@ void erts_sched_notify_check_cpu_bind(void);
Uint erts_active_schedulers(void);
void erts_init_process(int, int, int);
Eterm erts_process_status(Process *, ErtsProcLocks, Process *, Eterm);
-Uint erts_run_queues_len(Uint *);
+Uint erts_run_queues_len(Uint *, int, int);
void erts_add_to_runq(Process *);
Eterm erts_bound_schedulers_term(Process *c_p);
Eterm erts_get_cpu_topology_term(Process *c_p, Eterm which);
@@ -1756,7 +1834,7 @@ Uint erts_debug_nbalance(void);
int erts_debug_wait_completed(Process *c_p, int flags);
-Uint erts_process_memory(Process *c_p);
+Uint erts_process_memory(Process *c_p, int incl_msg_inq);
#ifdef ERTS_SMP
# define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data)
@@ -1887,11 +1965,6 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data)
#define ERTS_PROC_SCHED_ID(P, L, ID) \
((UWord) erts_psd_set((P), (L), ERTS_PSD_SCHED_ID, (void *) (ID)))
-#define ERTS_PROC_GET_DIST_ENTRY(P) \
- ((DistEntry *) erts_psd_get((P), ERTS_PSD_DIST_ENTRY))
-#define ERTS_PROC_SET_DIST_ENTRY(P, L, D) \
- ((DistEntry *) erts_psd_set((P), (L), ERTS_PSD_DIST_ENTRY, (void *) (D)))
-
#define ERTS_PROC_GET_SAVED_CALLS_BUF(P) \
((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SAVED_CALLS_BUF))
#define ERTS_PROC_SET_SAVED_CALLS_BUF(P, L, SCB) \
@@ -2071,6 +2144,22 @@ ERTS_GLB_INLINE void erts_smp_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq);
ERTS_GLB_INLINE void erts_smp_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2);
ERTS_GLB_INLINE void erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2);
+ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap_state(Process *pp,
+ erts_aint32_t *psp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp);
+ERTS_GLB_INLINE ErtsMessage *erts_alloc_message_heap(Process *pp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp);
+
+ERTS_GLB_INLINE void erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp,
+ Eterm *start_hp, Eterm *used_hp, Eterm *end_hp,
+ Eterm *brefs, Uint brefs_size);
+
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE
@@ -2219,6 +2308,63 @@ erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2)
#endif
}
+ERTS_GLB_INLINE ErtsMessage *
+erts_alloc_message_heap_state(Process *pp,
+ erts_aint32_t *psp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp)
+{
+ int on_heap;
+
+ if ((*psp) & ERTS_PSFLG_OFF_HEAP_MSGQ) {
+ ErtsMessage *mp = erts_alloc_message(sz, hpp);
+ *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap;
+ return mp;
+ }
+
+ return erts_try_alloc_message_on_heap(pp, psp, plp, sz, hpp, ohpp, &on_heap);
+}
+
+ERTS_GLB_INLINE ErtsMessage *
+erts_alloc_message_heap(Process *pp,
+ ErtsProcLocks *plp,
+ Uint sz,
+ Eterm **hpp,
+ ErlOffHeap **ohpp)
+{
+ erts_aint32_t state = erts_smp_atomic32_read_nob(&pp->state);
+ return erts_alloc_message_heap_state(pp, &state, plp, sz, hpp, ohpp);
+}
+
+ERTS_GLB_INLINE void
+erts_shrink_message_heap(ErtsMessage **msgpp, Process *pp,
+ Eterm *start_hp, Eterm *used_hp, Eterm *end_hp,
+ Eterm *brefs, Uint brefs_size)
+{
+ ASSERT(start_hp <= used_hp && used_hp <= end_hp);
+ if ((*msgpp)->data.attached == ERTS_MSG_COMBINED_HFRAG)
+ *msgpp = erts_shrink_message(*msgpp, used_hp - start_hp,
+ brefs, brefs_size);
+ else if (!(*msgpp)->data.attached) {
+ ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN
+ & erts_proc_lc_my_proc_locks(pp));
+ HRelease(pp, end_hp, used_hp);
+ }
+ else {
+ ErlHeapFragment *hfrag = (*msgpp)->data.heap_frag;
+ if (start_hp != used_hp)
+ hfrag = erts_resize_message_buffer(hfrag, used_hp - start_hp,
+ brefs, brefs_size);
+ else {
+ free_message_buffer(hfrag);
+ hfrag = NULL;
+ }
+ (*msgpp)->data.heap_frag = hfrag;
+ }
+}
+
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
ERTS_GLB_INLINE ErtsAtomCacheMap *erts_get_atom_cache_map(Process *c_p);
@@ -2312,6 +2458,6 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi)
#endif
-void erl_halt(int code);
+void erts_halt(int code);
extern erts_smp_atomic32_t erts_halt_progress;
extern int erts_halt_code;
diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c
index 8606371bdf..487b944fc0 100644
--- a/erts/emulator/beam/erl_process_dict.c
+++ b/erts/emulator/beam/erl_process_dict.c
@@ -51,16 +51,19 @@
#define INITIAL_SIZE (erts_pd_initial_size)
/* Hash utility macros */
-#define HASH_RANGE(PDict) ((PDict)->homeSize + (PDict)->splitPosition)
+#define HASH_RANGE(PDict) ((PDict)->usedSlots)
-#define MAKE_HASH(Term) \
-((is_small(Term)) ? unsigned_val(Term) : \
- ((is_atom(Term)) ? \
- (atom_tab(atom_val(term))->slot.bucket.hvalue) : \
- make_hash2(Term)))
+#define MAKE_HASH(Term) \
+ ((is_small(Term)) ? unsigned_val(Term) : \
+ ((is_atom(Term)) ? \
+ (atom_tab(atom_val(Term))->slot.bucket.hvalue) : \
+ make_internal_hash(Term)))
#define PD_SZ2BYTES(Sz) (sizeof(ProcDict) + ((Sz) - 1)*sizeof(Eterm))
+#define pd_hash_value(Pdict, Key) \
+ pd_hash_value_to_ix(Pdict, MAKE_HASH((Key)))
+
/* Memory allocation macros */
#define PD_ALLOC(Sz) \
erts_alloc(ERTS_ALC_T_PROC_DICT, (Sz))
@@ -74,14 +77,19 @@
#define TCDR(Term) CDR(list_val(Term))
/* Array access macro */
-#define ARRAY_GET(PDict, Index) (((PDict)->size > (Index)) ? \
- (PDict)->data[Index] : NIL)
+#define ARRAY_GET(PDict, Index) (ASSERT((Index) < (PDict)->arraySize), \
+ (PDict)->data[Index])
+#define ARRAY_PUT(PDict, Index, Val) (ASSERT((Index) < (PDict)->arraySize), \
+ (PDict)->data[Index] = (Val))
+
+#define IS_POW2(X) ((X) && !((X) & ((X)-1)))
/*
* Forward decalarations
*/
static void pd_hash_erase(Process *p, Eterm id, Eterm *ret);
static void pd_hash_erase_all(Process *p);
+static Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id);
static Eterm pd_hash_get_keys(Process *p, Eterm value);
static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd);
static Eterm pd_hash_get_all(Process *p, ProcDict *pd);
@@ -91,9 +99,9 @@ static void shrink(Process *p, Eterm* ret);
static void grow(Process *p);
static void array_shrink(ProcDict **ppd, unsigned int need);
-static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term);
+static void ensure_array_size(ProcDict**, unsigned int size);
-static unsigned int pd_hash_value(ProcDict *pdict, Eterm term);
+static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx);
static unsigned int next_array_size(unsigned int need);
/*
@@ -134,6 +142,16 @@ static void pd_check(ProcDict *pd);
** External interface
*/
+int
+erts_pd_set_initial_size(int size)
+{
+ if (size <= 0)
+ return 0;
+
+ erts_pd_initial_size = 1 << erts_fit_in_bits_uint(size-1);
+ return 1;
+}
+
/*
* Called from break handler
*/
@@ -146,9 +164,9 @@ erts_dictionary_dump(int to, void *to_arg, ProcDict *pd)
/*PD_CHECK(pd);*/
if (pd == NULL)
return;
- erts_print(to, to_arg, "(size = %d, used = %d, homeSize = %d, "
+ erts_print(to, to_arg, "(size = %d, usedSlots = %d, "
"splitPosition = %d, numElements = %d)\n",
- pd->size, pd->used, pd->homeSize,
+ pd->arraySize, pd->usedSlots,
pd->splitPosition, (unsigned int) pd->numElements);
for (i = 0; i < HASH_RANGE(pd); ++i) {
erts_print(to, to_arg, "%d: %T\n", i, ARRAY_GET(pd, i));
@@ -203,7 +221,7 @@ erts_dicts_mem_size(Process *p)
{
Uint size = 0;
if (p->dictionary)
- size += PD_SZ2BYTES(p->dictionary->size);
+ size += PD_SZ2BYTES(p->dictionary->arraySize);
return size;
}
@@ -345,7 +363,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret)
if (is_boxed(old)) { /* Tuple */
ASSERT(is_tuple(old));
if (EQ(tuple_val(old)[1], id)) {
- array_put(&(p->dictionary), hval, NIL);
+ ARRAY_PUT(p->dictionary, hval, NIL);
--(p->dictionary->numElements);
*ret = tuple_val(old)[2];
}
@@ -365,7 +383,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret)
old = ARRAY_GET(p->dictionary, hval);
ASSERT(is_list(old));
if (is_nil(TCDR(old))) {
- array_put(&p->dictionary, hval, TCAR(old));
+ ARRAY_PUT(p->dictionary, hval, TCAR(old));
}
} else if (is_not_nil(old)) {
#ifdef DEBUG
@@ -374,7 +392,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret)
"display term found in line %d:\n"
"%T\n", p->common.id, __LINE__, old);
#endif
- erl_exit(1, "Damaged process dictionary found during erase/1.");
+ erts_exit(ERTS_ERROR_EXIT, "Damaged process dictionary found during erase/1.");
}
if ((range = HASH_RANGE(p->dictionary)) > INITIAL_SIZE &&
range / 2 > (p->dictionary->numElements)) {
@@ -390,40 +408,56 @@ static void pd_hash_erase_all(Process *p)
}
}
+Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id)
+{
+ unsigned int hval;
+ ProcDict *pd = p->dictionary;
+
+ ASSERT(hx == MAKE_HASH(id));
+ if (pd == NULL)
+ return am_undefined;
+ hval = pd_hash_value_to_ix(pd, hx);
+ return pd_hash_get_with_hval(p, ARRAY_GET(pd, hval), id);
+}
+
Eterm erts_pd_hash_get(Process *p, Eterm id)
{
unsigned int hval;
- Eterm tmp;
ProcDict *pd = p->dictionary;
if (pd == NULL)
return am_undefined;
hval = pd_hash_value(pd, id);
- tmp = ARRAY_GET(pd, hval);
- if (is_boxed(tmp)) { /* Tuple */
- ASSERT(is_tuple(tmp));
- if (EQ(tuple_val(tmp)[1], id)) {
- return tuple_val(tmp)[2];
+ return pd_hash_get_with_hval(p, ARRAY_GET(pd, hval), id);
+}
+
+Eterm pd_hash_get_with_hval(Process *p, Eterm bucket, Eterm id)
+{
+ if (is_boxed(bucket)) { /* Tuple */
+ ASSERT(is_tuple(bucket));
+ if (EQ(tuple_val(bucket)[1], id)) {
+ return tuple_val(bucket)[2];
}
- } else if (is_list(tmp)) {
- for (; tmp != NIL && !EQ(tuple_val(TCAR(tmp))[1], id); tmp = TCDR(tmp)) {
+ } else if (is_list(bucket)) {
+ for (; bucket != NIL && !EQ(tuple_val(TCAR(bucket))[1], id); bucket = TCDR(bucket)) {
;
}
- if (tmp != NIL) {
- return tuple_val(TCAR(tmp))[2];
+ if (bucket != NIL) {
+ return tuple_val(TCAR(bucket))[2];
}
- } else if (is_not_nil(tmp)) {
+ } else if (is_not_nil(bucket)) {
#ifdef DEBUG
erts_fprintf(stderr,
"Process dictionary for process %T is broken, trying to "
"display term found in line %d:\n"
- "%T\n", p->common.id, __LINE__, tmp);
+ "%T\n", p->common.id, __LINE__, bucket);
#endif
- erl_exit(1, "Damaged process dictionary found during get/1.");
+ erts_exit(ERTS_ERROR_EXIT, "Damaged process dictionary found during get/1.");
}
return am_undefined;
}
+
#define PD_GET_TKEY(Dst,Src) \
do { \
ASSERT(is_tuple((Src))); \
@@ -549,8 +583,11 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
if (p->dictionary == NULL) {
/* Create it */
- array_put(&(p->dictionary), INITIAL_SIZE - 1, NIL);
- p->dictionary->homeSize = INITIAL_SIZE;
+ ensure_array_size(&p->dictionary, INITIAL_SIZE);
+ p->dictionary->usedSlots = INITIAL_SIZE;
+ p->dictionary->sizeMask = INITIAL_SIZE*2 - 1;
+ p->dictionary->splitPosition = 0;
+ p->dictionary->numElements = 0;
}
hval = pd_hash_value(p->dictionary, id);
old = ARRAY_GET(p->dictionary, hval);
@@ -583,7 +620,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
root[0] = id;
root[1] = value;
root[2] = old;
- BUMP_REDS(p, erts_garbage_collect(p, needed, root, 3));
+ erts_garbage_collect(p, needed, root, 3);
id = root[0];
value = root[1];
old = root[2];
@@ -602,19 +639,19 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
* Update the dictionary.
*/
if (is_nil(old)) {
- array_put(&(p->dictionary), hval, tpl);
+ ARRAY_PUT(p->dictionary, hval, tpl);
++(p->dictionary->numElements);
} else if (is_boxed(old)) {
ASSERT(is_tuple(old));
if (EQ(tuple_val(old)[1],id)) {
- array_put(&(p->dictionary), hval, tpl);
+ ARRAY_PUT(p->dictionary, hval, tpl);
return tuple_val(old)[2];
} else {
hp = HeapOnlyAlloc(p, 4);
tmp = CONS(hp, old, NIL);
hp += 2;
++(p->dictionary->numElements);
- array_put(&(p->dictionary), hval, CONS(hp, tpl, tmp));
+ ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, tmp));
hp += 2;
ASSERT(hp <= hp_limit);
}
@@ -624,7 +661,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
* New key. Simply prepend the tuple to the beginning of the list.
*/
hp = HeapOnlyAlloc(p, 2);
- array_put(&(p->dictionary), hval, CONS(hp, tpl, old));
+ ARRAY_PUT(p->dictionary, hval, CONS(hp, tpl, old));
hp += 2;
ASSERT(hp <= hp_limit);
++(p->dictionary->numElements);
@@ -659,7 +696,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
nlist = CONS(hp, tpl, nlist);
hp += 2;
ASSERT(hp <= hp_limit);
- array_put(&(p->dictionary), hval, nlist);
+ ARRAY_PUT(p->dictionary, hval, nlist);
return tuple_val(TCAR(tmp))[2];
}
} else {
@@ -670,7 +707,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
"%T\n", p->common.id, __LINE__, old);
#endif
- erl_exit(1, "Damaged process dictionary found during put/2.");
+ erts_exit(ERTS_ERROR_EXIT, "Damaged process dictionary found during put/2.");
}
if (HASH_RANGE(p->dictionary) <= p->dictionary->numElements) {
grow(p);
@@ -684,6 +721,7 @@ static Eterm pd_hash_put(Process *p, Eterm id, Eterm value)
static void shrink(Process *p, Eterm* ret)
{
+ ProcDict *pd = p->dictionary;
unsigned int range = HASH_RANGE(p->dictionary);
unsigned int steps = (range*3) / 10;
Eterm hi, lo, tmp;
@@ -698,25 +736,26 @@ static void shrink(Process *p, Eterm* ret)
}
for (i = 0; i < steps; ++i) {
- ProcDict *pd = p->dictionary;
if (pd->splitPosition == 0) {
- pd->homeSize /= 2;
- pd->splitPosition = pd->homeSize;
+ ASSERT(IS_POW2(pd->usedSlots));
+ pd->sizeMask = pd->usedSlots - 1;
+ pd->splitPosition = pd->usedSlots / 2;
}
--(pd->splitPosition);
- hi = ARRAY_GET(pd, (pd->splitPosition + pd->homeSize));
+ /* Must wait to decrement 'usedSlots' for GC rootset below */
+ hi = ARRAY_GET(pd, pd->usedSlots - 1);
lo = ARRAY_GET(pd, pd->splitPosition);
if (hi != NIL) {
if (lo == NIL) {
- array_put(&(p->dictionary), pd->splitPosition, hi);
+ ARRAY_PUT(pd, pd->splitPosition, hi);
} else {
- int needed = 4;
+ Sint needed = 4;
if (is_list(hi) && is_list(lo)) {
needed = 2*erts_list_length(hi);
}
if (HeapWordsLeft(p) < needed) {
- BUMP_REDS(p, erts_garbage_collect(p, needed, ret, 1));
- hi = pd->data[(pd->splitPosition + pd->homeSize)];
+ erts_garbage_collect(p, needed, ret, 1);
+ hi = pd->data[pd->usedSlots - 1];
lo = pd->data[pd->splitPosition];
}
#ifdef DEBUG
@@ -727,13 +766,13 @@ static void shrink(Process *p, Eterm* ret)
hp = HeapOnlyAlloc(p, 4);
tmp = CONS(hp, hi, NIL);
hp += 2;
- array_put(&(p->dictionary), pd->splitPosition,
+ ARRAY_PUT(pd, pd->splitPosition,
CONS(hp,lo,tmp));
hp += 2;
ASSERT(hp <= hp_limit);
} else { /* hi is a list */
hp = HeapOnlyAlloc(p, 2);
- array_put(&(p->dictionary), pd->splitPosition,
+ ARRAY_PUT(pd, pd->splitPosition,
CONS(hp, lo, hi));
hp += 2;
ASSERT(hp <= hp_limit);
@@ -741,7 +780,7 @@ static void shrink(Process *p, Eterm* ret)
} else { /* lo is a list */
if (is_tuple(hi)) {
hp = HeapOnlyAlloc(p, 2);
- array_put(&(p->dictionary), pd->splitPosition,
+ ARRAY_PUT(pd, pd->splitPosition,
CONS(hp, hi, lo));
hp += 2;
ASSERT(hp <= hp_limit);
@@ -753,14 +792,15 @@ static void shrink(Process *p, Eterm* ret)
hp += 2;
}
ASSERT(hp <= hp_limit);
- array_put(&(p->dictionary), pd->splitPosition, lo);
+ ARRAY_PUT(pd, pd->splitPosition, lo);
}
}
}
}
- array_put(&(p->dictionary), (pd->splitPosition + pd->homeSize), NIL);
+ --pd->usedSlots;
+ ARRAY_PUT(pd, pd->usedSlots, NIL);
}
- if (HASH_RANGE(p->dictionary) <= (p->dictionary->size / 4)) {
+ if (HASH_RANGE(p->dictionary) <= (p->dictionary->arraySize / 4)) {
array_shrink(&(p->dictionary), (HASH_RANGE(p->dictionary) * 3) / 2);
}
}
@@ -768,14 +808,14 @@ static void shrink(Process *p, Eterm* ret)
static void grow(Process *p)
{
unsigned int i,j;
- unsigned int steps = p->dictionary->homeSize / 5;
+ unsigned int steps = (p->dictionary->usedSlots / 4) & 0xf;
Eterm l1,l2;
Eterm l;
Eterm *hp;
unsigned int pos;
unsigned int homeSize;
- int needed = 0;
- ProcDict *pd;
+ Sint needed = 0;
+ ProcDict *pd = p->dictionary;
#ifdef DEBUG
Eterm *hp_limit;
#endif
@@ -784,18 +824,20 @@ static void grow(Process *p)
if (steps == 0)
steps = 1;
/* Dont grow over MAX_HASH */
- if ((MAX_HASH - steps) <= HASH_RANGE(p->dictionary)) {
+ if ((MAX_HASH - steps) <= HASH_RANGE(pd)) {
return;
}
+ ensure_array_size(&p->dictionary, HASH_RANGE(pd) + steps);
+ pd = p->dictionary;
+
/*
* Calculate total number of heap words needed, and garbage collect
* if necessary.
*/
- pd = p->dictionary;
pos = pd->splitPosition;
- homeSize = pd->homeSize;
+ homeSize = pd->usedSlots - pd->splitPosition;
for (i = 0; i < steps; ++i) {
if (pos == homeSize) {
homeSize *= 2;
@@ -811,7 +853,7 @@ static void grow(Process *p)
}
}
if (HeapWordsLeft(p) < needed) {
- BUMP_REDS(p, erts_garbage_collect(p, needed, 0, 0));
+ erts_garbage_collect(p, needed, 0, 0);
}
#ifdef DEBUG
hp_limit = p->htop + needed;
@@ -820,21 +862,22 @@ static void grow(Process *p)
/*
* Now grow.
*/
-
+ homeSize = pd->usedSlots - pd->splitPosition;
for (i = 0; i < steps; ++i) {
- ProcDict *pd = p->dictionary;
- if (pd->splitPosition == pd->homeSize) {
- pd->homeSize *= 2;
- pd->splitPosition = 0;
+ if (pd->splitPosition == homeSize) {
+ homeSize *= 2;
+ pd->sizeMask = homeSize*2 - 1;
+ pd->splitPosition = 0;
}
pos = pd->splitPosition;
++pd->splitPosition; /* For the hashes */
+ ++pd->usedSlots;
+ ASSERT(pos + homeSize == pd->usedSlots - 1);
l = ARRAY_GET(pd, pos);
if (is_tuple(l)) {
if (pd_hash_value(pd, tuple_val(l)[1]) != pos) {
- array_put(&(p->dictionary), pos +
- p->dictionary->homeSize, l);
- array_put(&(p->dictionary), pos, NIL);
+ ARRAY_PUT(pd, pos + homeSize, l);
+ ARRAY_PUT(pd, pos, NIL);
}
} else {
l2 = NIL;
@@ -856,10 +899,8 @@ static void grow(Process *p)
if (l2 != NIL && TCDR(l2) == NIL)
l2 = TCAR(l2);
ASSERT(hp <= hp_limit);
- /* After array_put pd is no longer valid */
- array_put(&(p->dictionary), pos, l1);
- array_put(&(p->dictionary), pos +
- p->dictionary->homeSize, l2);
+ ARRAY_PUT(pd, pos, l1);
+ ARRAY_PUT(pd, pos + homeSize, l2);
}
}
@@ -876,73 +917,65 @@ static void array_shrink(ProcDict **ppd, unsigned int need)
{
unsigned int siz = next_array_size(need);
- HDEBUGF(("array_shrink: size = %d, used = %d, need = %d",
- (*ppd)->size, (*ppd)->used, need));
+ HDEBUGF(("array_shrink: size = %d, need = %d",
+ (*ppd)->arraySize, need));
- if (siz > (*ppd)->size)
+ if (siz >= (*ppd)->arraySize)
return; /* Only shrink */
*ppd = PD_REALLOC(((void *) *ppd),
- PD_SZ2BYTES((*ppd)->size),
+ PD_SZ2BYTES((*ppd)->arraySize),
PD_SZ2BYTES(siz));
- (*ppd)->size = siz;
- if ((*ppd)->size < (*ppd)->used)
- (*ppd)->used = (*ppd)->size;
+ (*ppd)->arraySize = siz;
}
-static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term)
+static void ensure_array_size(ProcDict **ppdict, unsigned int size)
{
+ ProcDict *pd = *ppdict;
unsigned int i;
- Eterm ret;
- if (*ppdict == NULL) {
- Uint siz = next_array_size(ndx+1);
- ProcDict *p;
- p = PD_ALLOC(PD_SZ2BYTES(siz));
+ if (pd == NULL) {
+ Uint siz = next_array_size(size);
+
+ pd = PD_ALLOC(PD_SZ2BYTES(siz));
for (i = 0; i < siz; ++i)
- p->data[i] = NIL;
- p->size = siz;
- p->homeSize = p->splitPosition = p->numElements = p->used = 0;
- *ppdict = p;
- } else if (ndx >= (*ppdict)->size) {
- Uint osize = (*ppdict)->size;
- Uint nsize = next_array_size(ndx+1);
- *ppdict = PD_REALLOC(((void *) *ppdict),
+ pd->data[i] = NIL;
+ pd->arraySize = siz;
+ *ppdict = pd;
+ } else if (size > pd->arraySize) {
+ Uint osize = pd->arraySize;
+ Uint nsize = next_array_size(size);
+ pd = PD_REALLOC(((void *) pd),
PD_SZ2BYTES(osize),
PD_SZ2BYTES(nsize));
for (i = osize; i < nsize; ++i)
- (*ppdict)->data[i] = NIL;
- (*ppdict)->size = nsize;
+ pd->data[i] = NIL;
+ pd->arraySize = nsize;
+ *ppdict = pd;
}
- ret = (*ppdict)->data[ndx];
- (*ppdict)->data[ndx] = term;
- if ((ndx + 1) > (*ppdict)->used)
- (*ppdict)->used = ndx + 1;
-#ifdef HARDDEBUG
- HDEBUGF(("array_put: (*ppdict)->size = %d, (*ppdict)->used = %d, ndx = %d",
- (*ppdict)->size, (*ppdict)->used, ndx));
- erts_fprintf(stderr, "%T", term);
-#endif /* HARDDEBUG */
- return ret;
}
/*
** Basic utilities
*/
-static unsigned int pd_hash_value(ProcDict *pdict, Eterm term)
+static unsigned int pd_hash_value_to_ix(ProcDict *pdict, Uint32 hx)
{
- Uint hash, high;
+ Uint high;
- hash = MAKE_HASH(term);
- high = hash % (pdict->homeSize*2);
+ ASSERT(IS_POW2(pdict->sizeMask+1));
+ ASSERT(HASH_RANGE(pdict) >= (pdict->sizeMask >> 1));
+ ASSERT(HASH_RANGE(pdict) <= (pdict->sizeMask + 1));
+
+ high = hx & pdict->sizeMask;
if (high >= HASH_RANGE(pdict))
- return hash % pdict->homeSize;
+ return hx & (pdict->sizeMask >> 1);
return high;
}
+
static unsigned int next_array_size(unsigned int need)
{
static unsigned int tab[] =
@@ -1002,35 +1035,39 @@ static unsigned int next_array_size(unsigned int need)
static void pd_check(ProcDict *pd)
{
unsigned int i;
+ unsigned int used;
Uint num;
if (pd == NULL)
return;
- ASSERT(pd->size >= pd->used);
+ used = HASH_RANGE(pd);
+ ASSERT(pd->arraySize >= used);
ASSERT(HASH_RANGE(pd) <= MAX_HASH);
- for (i = 0, num = 0; i < pd->used; ++i) {
+ for (i = 0, num = 0; i < used; ++i) {
Eterm t = pd->data[i];
if (is_nil(t)) {
continue;
} else if (is_tuple(t)) {
++num;
ASSERT(arityval(*tuple_val(t)) == 2);
+ ASSERT(pd_hash_value(pd, tuple_val(t)[1]) == i);
continue;
} else if (is_list(t)) {
while (t != NIL) {
++num;
ASSERT(is_tuple(TCAR(t)));
ASSERT(arityval(*(tuple_val(TCAR(t)))) == 2);
+ ASSERT(pd_hash_value(pd, tuple_val(TCAR(t))[1]) == i);
t = TCDR(t);
}
continue;
} else {
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"Found tag 0x%08x in process dictionary at position %d",
(unsigned long) t, (int) i);
}
}
ASSERT(num == pd->numElements);
- ASSERT(pd->splitPosition <= pd->homeSize);
+ ASSERT(pd->usedSlots >= pd->splitPosition*2);
}
#endif /* DEBUG */
diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h
index cc53800eb5..dac214c8a1 100644
--- a/erts/emulator/beam/erl_process_dict.h
+++ b/erts/emulator/beam/erl_process_dict.h
@@ -23,14 +23,18 @@
#include "sys.h"
typedef struct proc_dict {
- unsigned int size;
- unsigned int used;
- unsigned int homeSize;
+ unsigned int sizeMask;
+ unsigned int usedSlots;
+ unsigned int arraySize;
unsigned int splitPosition;
Uint numElements;
Eterm data[1]; /* The beginning of an array of erlang terms */
} ProcDict;
+#define ERTS_PD_START(PD) ((PD)->data)
+#define ERTS_PD_SIZE(PD) ((PD)->usedSlots)
+
+int erts_pd_set_initial_size(int size);
Uint erts_dicts_mem_size(struct process *p);
void erts_erase_dicts(struct process *p);
void erts_dictionary_dump(int to, void *to_arg, ProcDict *pd);
@@ -39,5 +43,6 @@ void erts_deep_dictionary_dump(int to, void *to_arg,
Eterm erts_dictionary_copy(struct process *p, ProcDict *pd);
Eterm erts_pd_hash_get(struct process *p, Eterm id);
+Eterm erts_pd_hash_get_with_hx(Process *p, Uint32 hx, Eterm id);
#endif
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 25f0b1ed38..39c36ee7a9 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -78,13 +78,14 @@ erts_deep_process_dump(int to, void *to_arg)
dump_binaries(to, to_arg, all_binaries);
}
-Uint erts_process_memory(Process *p) {
- ErlMessage *mp;
+Uint erts_process_memory(Process *p, int incl_msg_inq) {
+ ErtsMessage *mp;
Uint size = 0;
struct saved_calls *scb;
size += sizeof(Process);
- ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
+ if (incl_msg_inq)
+ ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size);
erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size);
@@ -92,7 +93,7 @@ Uint erts_process_memory(Process *p) {
if (p->old_hend && p->old_heap)
size += (p->old_hend - p->old_heap) * sizeof(Eterm);
- size += p->msg.len * sizeof(ErlMessage);
+ size += p->msg.len * sizeof(ErtsMessage);
for (mp = p->msg.first; mp; mp = mp->next)
if (mp->data.attached)
@@ -119,7 +120,7 @@ static void
dump_process_info(int to, void *to_arg, Process *p)
{
Eterm* sp;
- ErlMessage* mp;
+ ErtsMessage* mp;
int yreg = -1;
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
@@ -365,7 +366,7 @@ heap_dump(int to, void *to_arg, Eterm x)
while (x != OUR_NIL) {
if (is_CP(x)) {
- next = (Eterm *) EXPAND_POINTER(x);
+ next = (Eterm *) x;
} else if (is_list(x)) {
ptr = list_val(x);
if (ptr[0] != OUR_NIL) {
@@ -378,7 +379,7 @@ heap_dump(int to, void *to_arg, Eterm x)
ptr[1] = make_small(0);
}
x = ptr[0];
- ptr[0] = (Eterm) COMPRESS_POINTER(next);
+ ptr[0] = (Eterm) next;
next = ptr + 1;
continue;
}
@@ -408,7 +409,7 @@ heap_dump(int to, void *to_arg, Eterm x)
ptr[0] = OUR_NIL;
} else {
x = ptr[arity];
- ptr[0] = (Eterm) COMPRESS_POINTER(next);
+ ptr[0] = (Eterm) next;
next = ptr + arity - 1;
continue;
}
@@ -617,7 +618,7 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) {
if (psflg)
erts_print(to, to_arg, " | ");
- for (i = 0; i < ERTS_PSFLG_MAX && psflg; i++) {
+ for (i = 0; i <= ERTS_PSFLG_MAX && psflg; i++) {
erts_aint32_t chk = (1 << i);
if (psflg & chk) {
switch (chk) {
@@ -657,16 +658,16 @@ erts_dump_extended_process_state(int to, void *to_arg, erts_aint32_t psflg) {
erts_print(to, to_arg, "PROXY"); break;
case ERTS_PSFLG_DELAYED_SYS:
erts_print(to, to_arg, "DELAYED_SYS"); break;
-#ifdef ERTS_DIRTY_SCHEDULERS
+ case ERTS_PSFLG_OFF_HEAP_MSGQ:
+ erts_print(to, to_arg, "OFF_HEAP_MSGQ"); break;
+ case ERTS_PSFLG_ON_HEAP_MSGQ:
+ erts_print(to, to_arg, "ON_HEAP_MSGQ"); break;
case ERTS_PSFLG_DIRTY_CPU_PROC:
erts_print(to, to_arg, "DIRTY_CPU_PROC"); break;
case ERTS_PSFLG_DIRTY_IO_PROC:
erts_print(to, to_arg, "DIRTY_IO_PROC"); break;
- case ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q:
- erts_print(to, to_arg, "DIRTY_CPU_PROC_IN_Q"); break;
- case ERTS_PSFLG_DIRTY_IO_PROC_IN_Q:
- erts_print(to, to_arg, "DIRTY_IO_PROC_IN_Q"); break;
-#endif
+ case ERTS_PSFLG_DIRTY_ACTIVE_SYS:
+ erts_print(to, to_arg, "DIRTY_ACTIVE_SYS"); break;
default:
erts_print(to, to_arg, "UNKNOWN(%d)", chk); break;
}
diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h
index a64c993e8f..9c59301086 100644
--- a/erts/emulator/beam/erl_process_lock.h
+++ b/erts/emulator/beam/erl_process_lock.h
@@ -523,6 +523,10 @@ erts_smp_proc_lock__(Process *p,
ERTS_LC_ASSERT((locks & ~ERTS_PROC_LOCKS_ALL) == 0);
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ erts_proc_lc_lock(p, locks, file, line);
+#endif
+
old_lflgs = erts_smp_proc_raw_trylock__(p, locks);
if (old_lflgs != 0) {
@@ -544,9 +548,6 @@ erts_smp_proc_lock__(Process *p,
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_proc_lock_post_x(&(p->lock), locks, file, line);
#endif
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_proc_lc_lock(p, locks, file, line);
-#endif
#ifdef ERTS_PROC_LOCK_DEBUG
erts_proc_lock_op_debug(p, locks, 1);
diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c
index f7997df051..9ed175fe01 100644
--- a/erts/emulator/beam/erl_ptab.c
+++ b/erts/emulator/beam/erl_ptab.c
@@ -1255,7 +1255,7 @@ ptab_list_bif_engine(Process *c_p, Eterm *res_accp, Binary *mbp)
return 1;
default:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:ptab_list_bif_engine(): Invalid state: %d\n",
__FILE__, __LINE__, (int) ptlbdp->state);
}
diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c
index e5050bfaa5..d2343912b4 100644
--- a/erts/emulator/beam/erl_term.c
+++ b/erts/emulator/beam/erl_term.c
@@ -28,6 +28,37 @@
#include <stdlib.h>
#include <stdio.h>
+void
+erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz)
+{
+#ifdef TAG_LITERAL_PTR
+ Eterm *hp_end, *hp;
+
+ hp_end = hp_start + hsz;
+ hp = hp_start;
+
+ while (hp < hp_end) {
+ switch (primary_tag(*hp)) {
+ case TAG_PRIMARY_BOXED:
+ case TAG_PRIMARY_LIST:
+ *hp |= TAG_LITERAL_PTR;
+ break;
+ case TAG_PRIMARY_HEADER:
+ if (header_is_thing(*hp)) {
+ hp += thing_arityval(*hp);
+ }
+ break;
+ default:
+ break;
+ }
+
+ hp++;
+ }
+ if (is_boxed(*term) || is_list(*term))
+ *term |= TAG_LITERAL_PTR;
+#endif
+}
+
__decl_noreturn static void __noreturn
et_abort(const char *expr, const char *file, unsigned line)
{
@@ -41,7 +72,7 @@ et_abort(const char *expr, const char *file, unsigned line)
* Prevent infinite loop.
*/
have_been_called = 1;
- erl_exit(1, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr);
+ erts_exit(ERTS_ERROR_EXIT, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr);
}
#else
erts_fprintf(stderr, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr);
@@ -174,9 +205,7 @@ ET_DEFINE_CHECKED(Uint,external_thing_data_words,ExternalThing*,is_thing_ptr);
ET_DEFINE_CHECKED(Eterm,make_cp,UWord *,_is_taggable_pointer);
ET_DEFINE_CHECKED(UWord *,cp_val,Eterm,is_CP);
ET_DEFINE_CHECKED(Uint,catch_val,Eterm,is_catch);
-ET_DEFINE_CHECKED(Uint,x_reg_offset,Uint,_is_xreg);
-ET_DEFINE_CHECKED(Uint,y_reg_offset,Uint,_is_yreg);
-ET_DEFINE_CHECKED(Uint,x_reg_index,Uint,_is_xreg);
-ET_DEFINE_CHECKED(Uint,y_reg_index,Uint,_is_yreg);
+ET_DEFINE_CHECKED(Uint,loader_x_reg_index,Uint,_is_loader_x_reg);
+ET_DEFINE_CHECKED(Uint,loader_y_reg_index,Uint,_is_loader_y_reg);
#endif /* ET_DEBUG */
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index d5e91d80d9..2b28762db5 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -21,34 +21,10 @@
#ifndef __ERL_TERM_H
#define __ERL_TERM_H
-#include "sys.h" /* defines HALFWORD_HEAP */
+#include "erl_mmap.h"
typedef UWord Wterm; /* Full word terms */
-#if HALFWORD_HEAP
-# define HEAP_ON_C_STACK 0
-# if HALFWORD_ASSERT
-# ifdef ET_DEBUG
-# undef ET_DEBUG
-# endif
-# define ET_DEBUG 1
-# endif
-# if 1
-# define CHECK_POINTER_MASK 0xFFFFFFFF00000000UL
-# define COMPRESS_POINTER(APointer) ((Eterm) (UWord) (APointer))
-# define EXPAND_POINTER(AnEterm) ((UWord) (AnEterm))
-# else
-# define CHECK_POINTER_MASK 0x0UL
-# define COMPRESS_POINTER(AnUint) (AnUint)
-# define EXPAND_POINTER(APointer) (APointer)
-# endif
-#else
-# define HEAP_ON_C_STACK 1
-# define CHECK_POINTER_MASK 0x0UL
-# define COMPRESS_POINTER(AnUint) (AnUint)
-# define EXPAND_POINTER(APointer) (APointer)
-#endif
-
struct erl_node_; /* Declared in erl_node_tables.h */
/*
@@ -74,6 +50,24 @@ struct erl_node_; /* Declared in erl_node_tables.h */
#define _ET_APPLY(F,X) _unchecked_##F(X)
#endif
+#if defined(ARCH_64)
+# define TAG_PTR_MASK__ 0x7
+# if !defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+# ifdef HIPE
+# error Hipe on 64-bit needs a real mmap as it does not support the literal tag
+# endif
+# define TAG_LITERAL_PTR 0x4
+# else
+# undef TAG_LITERAL_PTR
+# endif
+#elif defined(ARCH_32)
+# define TAG_PTR_MASK__ 0x3
+# undef TAG_LITERAL_PTR
+#else
+# error Not supported arch
+#endif
+
+
#define _TAG_PRIMARY_SIZE 2
#define _TAG_PRIMARY_MASK 0x3
#define TAG_PRIMARY_HEADER 0x0
@@ -190,15 +184,13 @@ struct erl_node_; /* Declared in erl_node_tables.h */
/* boxed object access methods */
-#if HALFWORD_HEAP
-#define _is_taggable_pointer(x) (((UWord)(x) & (CHECK_POINTER_MASK | 0x3)) == 0)
-#define _boxed_precond(x) (is_boxed(x))
-#else
-#define _is_taggable_pointer(x) (((Uint)(x) & 0x3) == 0)
+
+#define _is_taggable_pointer(x) (((Uint)(x) & TAG_PTR_MASK__) == 0)
+
#define _boxed_precond(x) (is_boxed(x))
-#endif
-#define _is_aligned(x) (((Uint)(x) & 0x3) == 0)
-#define _unchecked_make_boxed(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_BOXED)
+
+#define _is_aligned(x) (((Uint)(x) & TAG_PTR_MASK__) == 0)
+#define _unchecked_make_boxed(x) ((Uint)(x) + TAG_PRIMARY_BOXED)
_ET_DECLARE_CHECKED(Eterm,make_boxed,const Eterm*)
#define make_boxed(x) _ET_APPLY(make_boxed,(x))
#if 1
@@ -209,12 +201,16 @@ _ET_DECLARE_CHECKED(int,is_boxed,Eterm)
#else
#define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED)
#endif
-#define _unchecked_boxed_val(x) ((Eterm*) EXPAND_POINTER(((x) - TAG_PRIMARY_BOXED)))
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_boxed_val(x) _unchecked_ptr_val(x)
+#else
+#define _unchecked_boxed_val(x) ((Eterm*) ((x) - TAG_PRIMARY_BOXED))
+#endif
_ET_DECLARE_CHECKED(Eterm*,boxed_val,Wterm)
#define boxed_val(x) _ET_APPLY(boxed_val,(x))
/* cons cell ("list") access methods */
-#define _unchecked_make_list(x) ((Uint) COMPRESS_POINTER(x) + TAG_PRIMARY_LIST)
+#define _unchecked_make_list(x) ((Uint)(x) + TAG_PRIMARY_LIST)
_ET_DECLARE_CHECKED(Eterm,make_list,const Eterm*)
#define make_list(x) _ET_APPLY(make_list,(x))
#if 1
@@ -226,12 +222,12 @@ _ET_DECLARE_CHECKED(int,is_not_list,Eterm)
#define is_list(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_LIST)
#define is_not_list(x) (!is_list((x)))
#endif
-#if HALFWORD_HEAP
#define _list_precond(x) (is_list(x))
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_list_val(x) _unchecked_ptr_val(x)
#else
-#define _list_precond(x) (is_list(x))
+#define _unchecked_list_val(x) ((Eterm*) ((x) - TAG_PRIMARY_LIST))
#endif
-#define _unchecked_list_val(x) ((Eterm*) EXPAND_POINTER((x) - TAG_PRIMARY_LIST))
_ET_DECLARE_CHECKED(Eterm*,list_val,Wterm)
#define list_val(x) _ET_APPLY(list_val,(x))
@@ -242,15 +238,22 @@ _ET_DECLARE_CHECKED(Eterm*,list_val,Wterm)
#define CDR(x) ((x)[1])
/* generic tagged pointer (boxed or list) access methods */
-#define _unchecked_ptr_val(x) ((Eterm*) EXPAND_POINTER((x) & ~((Uint) 0x3)))
+#define _unchecked_ptr_val(x) ((Eterm*) ((x) & ~((Uint) TAG_PTR_MASK__)))
#define ptr_val(x) _unchecked_ptr_val((x)) /*XXX*/
#define _unchecked_offset_ptr(x,offs) ((x)+((offs)*sizeof(Eterm)))
#define offset_ptr(x,offs) _unchecked_offset_ptr(x,offs) /*XXX*/
#define _unchecked_byte_offset_ptr(x,byte_offs) ((x)+(offs))
#define byte_offset_ptr(x,offs) _unchecked_byte_offset_ptr(x,offs) /*XXX*/
+#ifdef TAG_LITERAL_PTR
+#define _unchecked_is_not_literal_ptr(x) (!((x) & TAG_LITERAL_PTR))
+#define is_not_literal_ptr(x) _unchecked_is_not_literal_ptr((x)) /*XXX*/
+#define is_literal_ptr(x) (!is_not_literal_ptr((x))) /*XXX*/
+#endif
+
+
/* fixnum ("small") access methods */
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define SMALL_BITS (64-4)
#define SMALL_DIGITS (17)
#else
@@ -396,11 +399,7 @@ _ET_DECLARE_CHECKED(Eterm*,fun_val,Wterm)
_ET_DECLARE_CHECKED(Eterm*,export_val,Wterm)
#define export_val(x) _ET_APPLY(export_val,(x))
#define is_export_header(x) ((x) == HEADER_EXPORT)
-#if HALFWORD_HEAP
-#define HEADER_EXPORT _make_header(2,_TAG_HEADER_EXPORT)
-#else
#define HEADER_EXPORT _make_header(1,_TAG_HEADER_EXPORT)
-#endif
/* bignum access methods */
#define make_pos_bignum_header(sz) _make_header((sz),_TAG_HEADER_POS_BIG)
@@ -424,7 +423,7 @@ _ET_DECLARE_CHECKED(Eterm*,big_val,Wterm)
#define big_val(x) _ET_APPLY(big_val,(x))
/* flonum ("float") access methods */
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define HEADER_FLONUM _make_header(1,_TAG_HEADER_FLOAT)
#else
#define HEADER_FLONUM _make_header(2,_TAG_HEADER_FLOAT)
@@ -445,12 +444,12 @@ typedef union float_def
byte fb[sizeof(ieee754_8)];
Uint16 fs[sizeof(ieee754_8) / sizeof(Uint16)];
Uint32 fw[sizeof(ieee754_8) / sizeof(Uint32)];
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
Uint fdw;
#endif
} FloatDef;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
#define FLOAT_VAL_GET_DOUBLE(fval, f) (f).fdw = *((fval)+1)
@@ -727,7 +726,7 @@ _ET_DECLARE_CHECKED(struct erl_node_*,internal_port_node,Eterm)
#define ERTS_MAX_REF_NUMBERS 3
#define ERTS_REF_NUMBERS ERTS_MAX_REF_NUMBERS
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
# define ERTS_REF_WORDS (ERTS_REF_NUMBERS/2 + 1)
# define ERTS_REF_32BIT_WORDS (ERTS_REF_NUMBERS+1)
#else
@@ -749,7 +748,7 @@ typedef struct {
#define make_ref_thing_header(DW) \
_make_header((DW)+REF_THING_HEAD_SIZE-1,_TAG_HEADER_REF)
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
/*
* Ref layout on a 64-bit little endian machine:
@@ -1009,27 +1008,20 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm)
#define MAP_HEADER_VAL(Hdr) (((Hdr) >> (_HEADER_ARITY_OFFS + MAP_HEADER_TAG_SZ + MAP_HEADER_ARITY_SZ)) & (0xffff))
#define make_hashmap(x) make_boxed((Eterm*)(x))
-#define make_hashmap_rel make_boxed_rel
#define is_hashmap(x) (is_boxed((x)) && is_hashmap_header(*boxed_val((x))))
#define is_not_hashmap(x) (!is_hashmap(x))
-#define is_hashmap_rel(RTERM,BASE) is_hashmap(rterm2wterm(RTERM,BASE))
#define is_hashmap_header(x) (((x) & (_HEADER_MAP_HASHMAP_HEAD_MASK)) == HAMT_SUBTAG_HEAD_ARRAY)
#define hashmap_val(x) _unchecked_boxed_val((x))
-#define hashmap_val_rel(RTERM, BASE) hashmap_val(rterm2wterm(RTERM, BASE))
#define make_flatmap(x) make_boxed((Eterm*)(x))
-#define make_flatmap_rel(x, BASE) make_boxed_rel((Eterm*)(x),(BASE))
#define is_flatmap(x) (is_boxed((x)) && is_flatmap_header(*boxed_val((x))))
-#define is_flatmap_rel(RTERM,BASE) is_flatmap(rterm2wterm(RTERM,BASE))
#define is_not_flatmap(x) (!is_flatmap((x)))
#define is_flatmap_header(x) (((x) & (_HEADER_MAP_SUBTAG_MASK)) == HAMT_SUBTAG_HEAD_FLATMAP)
#define flatmap_val(x) (_unchecked_boxed_val((x)))
-#define flatmap_val_rel(RTERM, BASE) flatmap_val(rterm2wterm(RTERM, BASE))
#define is_map_header(x) (((x) & (_TAG_HEADER_MASK)) == _TAG_HEADER_MAP)
#define is_map(x) (is_boxed((x)) && is_map_header(*boxed_val(x)))
#define is_not_map(x) (!is_map(x))
-#define is_map_rel(RTERM,BASE) is_map(rterm2wterm(RTERM,BASE))
/* number tests */
@@ -1048,14 +1040,14 @@ _ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm)
#error "fix yer arch, like"
#endif
-#define _unchecked_make_cp(x) ((Eterm) COMPRESS_POINTER(x))
+#define _unchecked_make_cp(x) ((Eterm)(x))
_ET_DECLARE_CHECKED(Eterm,make_cp,BeamInstr*)
#define make_cp(x) _ET_APPLY(make_cp,(x))
#define is_not_CP(x) ((x) & _CPMASK)
#define is_CP(x) (!is_not_CP(x))
-#define _unchecked_cp_val(x) ((BeamInstr*) EXPAND_POINTER(x))
+#define _unchecked_cp_val(x) ((BeamInstr*) (x))
_ET_DECLARE_CHECKED(BeamInstr*,cp_val,Eterm)
#define cp_val(x) _ET_APPLY(cp_val,(x))
@@ -1071,44 +1063,40 @@ _ET_DECLARE_CHECKED(Uint,catch_val,Eterm)
/*
* Overloaded tags.
*
- * SMALL = 15
- * ATOM/NIL=7
+ * In the loader, we want to tag a term in a way so that it can
+ * be any literal (atom/integer/float/tuple/list/binary) or a
+ * register.
*
- * Note that the two least significant bits in SMALL/ATOM/NIL always are 3;
- * thus, we can distinguish register from literals by looking at only these
- * two bits.
+ * We can achive that by overloading the PID and PORT tags to
+ * mean X and Y registers. That works because there are no
+ * pid or port literals.
*/
-#define X_REG_DEF 0
-#define Y_REG_DEF 1
-#define R_REG_DEF 2
+#define _LOADER_TAG_XREG _TAG_IMMED1_PID
+#define _LOADER_TAG_YREG _TAG_IMMED1_PORT
+#define _LOADER_TAG_SIZE _TAG_IMMED1_SIZE
+#define _LOADER_MASK _TAG_IMMED1_MASK
-#define beam_reg_tag(x) ((x) & 3)
+#define LOADER_X_REG _LOADER_TAG_XREG
+#define LOADER_Y_REG _LOADER_TAG_YREG
-#define make_rreg() R_REG_DEF
-#define make_xreg(ix) (((ix) * sizeof(Eterm)) | X_REG_DEF)
-#define make_yreg(ix) (((ix) * sizeof(Eterm)) | Y_REG_DEF)
+#define make_loader_x_reg(R) (((R) << _LOADER_TAG_SIZE) | _LOADER_TAG_XREG)
+#define make_loader_y_reg(R) (((R) << _LOADER_TAG_SIZE) | _LOADER_TAG_YREG)
-#define _is_xreg(x) (beam_reg_tag(x) == X_REG_DEF)
-#define _is_yreg(x) (beam_reg_tag(x) == Y_REG_DEF)
+#define loader_reg_index(R) ((R) >> _LOADER_TAG_SIZE)
-#define _unchecked_x_reg_offset(R) ((R) - X_REG_DEF)
-_ET_DECLARE_CHECKED(Uint,x_reg_offset,Uint)
-#define x_reg_offset(R) _ET_APPLY(x_reg_offset,(R))
+#define loader_tag(T) ((T) & _LOADER_MASK)
-#define _unchecked_y_reg_offset(R) ((R) - Y_REG_DEF)
-_ET_DECLARE_CHECKED(Uint,y_reg_offset,Uint)
-#define y_reg_offset(R) _ET_APPLY(y_reg_offset,(R))
+#define _is_loader_x_reg(x) (loader_tag(x) == _LOADER_TAG_XREG)
+#define _is_loader_y_reg(x) (loader_tag(x) == _LOADER_TAG_YREG)
-#define reg_index(R) ((R) / sizeof(Eterm))
+#define _unchecked_loader_x_reg_index(R) ((R) >> _LOADER_TAG_SIZE)
+_ET_DECLARE_CHECKED(Uint,loader_x_reg_index,Uint)
+#define loader_x_reg_index(R) _ET_APPLY(loader_x_reg_index,(R))
-#define _unchecked_x_reg_index(R) ((R) >> 2)
-_ET_DECLARE_CHECKED(Uint,x_reg_index,Uint)
-#define x_reg_index(R) _ET_APPLY(x_reg_index,(R))
-
-#define _unchecked_y_reg_index(R) ((R) >> 2)
-_ET_DECLARE_CHECKED(Uint,y_reg_index,Uint)
-#define y_reg_index(R) _ET_APPLY(y_reg_index,(R))
+#define _unchecked_loader_y_reg_index(R) ((R) >> _LOADER_TAG_SIZE)
+_ET_DECLARE_CHECKED(Uint,loader_y_reg_index,Uint)
+#define loader_y_reg_index(R) _ET_APPLY(loader_y_reg_index,(R))
/*
* Backwards compatibility definitions:
@@ -1160,82 +1148,9 @@ extern unsigned tag_val_def(Wterm);
#define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF)
#define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF)
-#if HALFWORD_HEAP
-#define ptr2rel(PTR,BASE) ((Eterm*)((char*)(PTR) - (char*)(BASE)))
-#define rterm2wterm(REL,BASE) ((Wterm)(REL) + (Wterm)(BASE))
-
-#else /* HALFWORD_HEAP */
-
-#define ptr2rel(PTR,BASE) (PTR)
-#define rterm2wterm(REL,BASE) (REL)
-
-#endif /* !HALFWORD_HEAP */
-
-#define make_list_rel(PTR, BASE) make_list(ptr2rel(PTR,BASE))
-#define make_boxed_rel(PTR, BASE) make_boxed(ptr2rel(PTR,BASE))
-#define make_fun_rel make_boxed_rel
-#define make_binary_rel make_boxed_rel
-#define make_tuple_rel make_boxed_rel
-#define make_external_rel make_boxed_rel
-#define make_internal_ref_rel make_boxed_rel
-#define make_big_rel make_boxed_rel
-
-#define binary_val_rel(RTERM, BASE) binary_val(rterm2wterm(RTERM, BASE))
-#define list_val_rel(RTERM, BASE) list_val(rterm2wterm(RTERM, BASE))
-#define boxed_val_rel(RTERM, BASE) boxed_val(rterm2wterm(RTERM, BASE))
-#define tuple_val_rel(RTERM, BASE) tuple_val(rterm2wterm(RTERM, BASE))
-#define export_val_rel(RTERM, BASE) export_val(rterm2wterm(RTERM, BASE))
-#define fun_val_rel(RTERM, BASE) fun_val(rterm2wterm(RTERM, BASE))
-#define big_val_rel(RTERM,BASE) big_val(rterm2wterm(RTERM,BASE))
-#define float_val_rel(RTERM,BASE) float_val(rterm2wterm(RTERM,BASE))
-#define internal_ref_val_rel(RTERM,BASE) internal_ref_val(rterm2wterm(RTERM,BASE))
-
-#define external_thing_ptr_rel(RTERM, BASE) external_thing_ptr(rterm2wterm(RTERM, BASE))
-#define external_data_words_rel(RTERM,BASE) external_data_words(rterm2wterm(RTERM,BASE))
-
-#define external_port_node_rel(RTERM,BASE) external_port_node(rterm2wterm(RTERM,BASE))
-#define external_port_data_rel(RTERM,BASE) external_port_data(rterm2wterm(RTERM,BASE))
-
-#define is_external_pid_rel(RTERM,BASE) is_external_pid(rterm2wterm(RTERM,BASE))
-#define external_pid_node_rel(RTERM,BASE) external_pid_node(rterm2wterm(RTERM,BASE))
-#define external_pid_data_rel(RTERM,BASE) external_pid_data(rterm2wterm(RTERM,BASE))
+#define is_same(A,B) ((A)==(B))
-#define is_binary_rel(RTERM,BASE) is_binary(rterm2wterm(RTERM,BASE))
-#define is_float_rel(RTERM,BASE) is_float(rterm2wterm(RTERM,BASE))
-#define is_fun_rel(RTERM,BASE) is_fun(rterm2wterm(RTERM,BASE))
-#define is_big_rel(RTERM,BASE) is_big(rterm2wterm(RTERM,BASE))
-#define is_export_rel(RTERM,BASE) is_export(rterm2wterm(RTERM,BASE))
-#define is_tuple_rel(RTERM,BASE) is_tuple(rterm2wterm(RTERM,BASE))
-
-#define GET_DOUBLE_REL(RTERM, f, BASE) GET_DOUBLE(rterm2wterm(RTERM,BASE), f)
-
-#define ref_thing_ptr_rel(RTERM,BASE) ref_thing_ptr(rterm2wterm(RTERM,BASE))
-#define is_internal_ref_rel(RTERM,BASE) is_internal_ref(rterm2wterm(RTERM,BASE))
-#define is_external_rel(RTERM,BASE) is_external(rterm2wterm(RTERM,BASE))
-#define is_external_port_rel(RTERM,BASE) is_external_port(rterm2wterm(RTERM,BASE))
-#define is_external_ref_rel(RTERM,BASE) is_external_ref(rterm2wterm(RTERM,BASE))
-
-#define external_node_rel(RTERM,BASE) external_node(rterm2wterm(RTERM,BASE))
-
-
-#if HALFWORD_HEAP
-ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-ERTS_GLB_INLINE int is_same(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base)
-{
- /* If bases differ, assume a and b are on different "heaps",
- ie can only be same if immed */
- ASSERT(a_base == b_base || is_immed(a) || is_immed(b)
- || rterm2wterm(a,a_base) != rterm2wterm(b,b_base));
-
- return a == b && (a_base == b_base || is_immed(a));
-}
-#endif
-
-#else /* !HALFWORD_HEAP */
-#define is_same(A,A_BASE,B,B_BASE) ((A)==(B))
-#endif
+void erts_set_literal_tag(Eterm *term, Eterm *hp_start, Eterm hsz);
#endif /* __ERL_TERM_H */
diff --git a/erts/emulator/beam/erl_thr_progress.c b/erts/emulator/beam/erl_thr_progress.c
index 7148b756e7..7b06fd840f 100644
--- a/erts/emulator/beam/erl_thr_progress.c
+++ b/erts/emulator/beam/erl_thr_progress.c
@@ -502,7 +502,7 @@ erts_thr_progress_register_unmanaged_thread(ErtsThrPrgrCallbacks *callbacks)
if (tpd) {
if (!tpd->is_temporary)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:%s(): Double register of thread\n",
__FILE__, __LINE__, __func__);
is_blocking = tpd->is_blocking;
@@ -524,7 +524,7 @@ erts_thr_progress_register_unmanaged_thread(ErtsThrPrgrCallbacks *callbacks)
#endif
ASSERT(tpd->id >= 0);
if (tpd->id >= intrnl->unmanaged.no)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:%s(): Too many unmanaged registered threads\n",
__FILE__, __LINE__, __func__);
@@ -547,7 +547,7 @@ erts_thr_progress_register_managed_thread(ErtsSchedulerData *esdp,
if (tpd) {
if (!tpd->is_temporary)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:%s(): Double register of thread\n",
__FILE__, __LINE__, __func__);
is_blocking = tpd->is_blocking;
@@ -568,7 +568,7 @@ erts_thr_progress_register_managed_thread(ErtsSchedulerData *esdp,
tpd->id = erts_atomic32_inc_read_nob(&intrnl->misc.data.managed_id);
ASSERT(tpd->id >= 0);
if (tpd->id >= intrnl->managed.no)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:%s(): Too many managed registered threads\n",
__FILE__, __LINE__, __func__);
@@ -1033,7 +1033,7 @@ has_reached_wakeup(ErtsThrPrgrVal wakeup)
limit += 1;
if (!erts_thr_progress_has_passed__(limit, wakeup))
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Invalid wakeup request value found:"
" current=%b64u, wakeup=%b64u, limit=%b64u",
current, wakeup, limit);
@@ -1102,7 +1102,7 @@ request_wakeup_managed(ErtsThrPrgrData *tpd, ErtsThrPrgrVal value)
ix = erts_atomic32_inc_read_nob(&mwd->len) - 1;
#if ERTS_THR_PRGR_DBG_CHK_WAKEUP_REQUEST_VALUE
if (ix >= intrnl->managed.no)
- erl_exit(ERTS_ABORT_EXIT, "Internal error: Too many wakeup requests\n");
+ erts_exit(ERTS_ABORT_EXIT, "Internal error: Too many wakeup requests\n");
#endif
mwd->id[ix] = tpd->id;
diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c
index 3a91ca9dbe..7ff456b915 100644
--- a/erts/emulator/beam/erl_thr_queue.c
+++ b/erts/emulator/beam/erl_thr_queue.c
@@ -224,7 +224,7 @@ ErtsThrQCleanState_t
erts_thr_q_destroy(ErtsThrQ_t *q)
{
if (!q->q.blk)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Trying to destroy not created thread queue\n");
return erts_thr_q_finalize(q);
}
@@ -589,7 +589,7 @@ enqueue(ErtsThrQ_t *q, void *data, ErtsThrQElement_t *this)
#if ERTS_THR_Q_DBG_CHK_DATA
if (!data)
- erl_exit(ERTS_ABORT_EXIT, "Missing data in enqueue\n");
+ erts_exit(ERTS_ABORT_EXIT, "Missing data in enqueue\n");
#endif
ASSERT(!q->q.finalizing);
@@ -771,7 +771,7 @@ erts_thr_q_dequeue(ErtsThrQ_t *q)
#if ERTS_THR_Q_DBG_CHK_DATA
head->data.ptr = NULL;
if (!res)
- erl_exit(ERTS_ABORT_EXIT, "Missing data in dequeue\n");
+ erts_exit(ERTS_ABORT_EXIT, "Missing data in dequeue\n");
#endif
clean(q,
(q->head.deq_fini.automatic
diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h
index 34f91e2ec8..e689547d1d 100644
--- a/erts/emulator/beam/erl_threads.h
+++ b/erts/emulator/beam/erl_threads.h
@@ -2056,6 +2056,8 @@ erts_atomic64_read_dirty(erts_atomic64_t *var)
#endif /* !USE_THREADS */
+#include "erl_msacc.h"
+
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void
@@ -2414,6 +2416,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx)
{
#ifdef USE_THREADS
int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_unlock(&mtx->lc);
#endif
@@ -2432,6 +2435,7 @@ erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx)
#endif
if (res != 0 && res != EINTR)
erts_thr_fatal_error(res, "wait on condition variable");
+ ERTS_MSACC_POP_STATE();
#endif
}
@@ -3488,7 +3492,11 @@ ERTS_GLB_INLINE void erts_tse_reset(erts_tse_t *ep)
ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep)
{
#ifdef USE_THREADS
- return ethr_event_wait(&((ethr_ts_event *) ep)->event);
+ int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
+ res = ethr_event_wait(&((ethr_ts_event *) ep)->event);
+ ERTS_MSACC_POP_STATE();
+ return res;
#else
return ENOTSUP;
#endif
@@ -3497,7 +3505,11 @@ ERTS_GLB_INLINE int erts_tse_wait(erts_tse_t *ep)
ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount)
{
#ifdef USE_THREADS
- return ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount);
+ int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
+ res = ethr_event_swait(&((ethr_ts_event *) ep)->event, spincount);
+ ERTS_MSACC_POP_STATE();
+ return res;
#else
return ENOTSUP;
#endif
@@ -3506,8 +3518,12 @@ ERTS_GLB_INLINE int erts_tse_swait(erts_tse_t *ep, int spincount)
ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo)
{
#ifdef USE_THREADS
- return ethr_event_twait(&((ethr_ts_event *) ep)->event,
- (ethr_sint64_t) tmo);
+ int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
+ res = ethr_event_twait(&((ethr_ts_event *) ep)->event,
+ (ethr_sint64_t) tmo);
+ ERTS_MSACC_POP_STATE();
+ return res;
#else
return ENOTSUP;
#endif
@@ -3516,9 +3532,13 @@ ERTS_GLB_INLINE int erts_tse_twait(erts_tse_t *ep, Sint64 tmo)
ERTS_GLB_INLINE int erts_tse_stwait(erts_tse_t *ep, int spincount, Sint64 tmo)
{
#ifdef USE_THREADS
- return ethr_event_stwait(&((ethr_ts_event *) ep)->event,
- spincount,
- (ethr_sint64_t) tmo);
+ int res;
+ ERTS_MSACC_PUSH_AND_SET_STATE(ERTS_MSACC_STATE_SLEEP);
+ res = ethr_event_stwait(&((ethr_ts_event *) ep)->event,
+ spincount,
+ (ethr_sint64_t) tmo);
+ ERTS_MSACC_POP_STATE();
+ return res;
#else
return ENOTSUP;
#endif
diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h
index 43e543e035..5242063550 100644
--- a/erts/emulator/beam/erl_time.h
+++ b/erts/emulator/beam/erl_time.h
@@ -133,11 +133,17 @@ typedef struct {
extern ErtsTimeSupData erts_time_sup__;
+ErtsMonotonicTime erts_napi_monotonic_time(int time_unit);
+ErtsMonotonicTime erts_napi_time_offset(int time_unit);
+ErtsMonotonicTime erts_napi_convert_time_unit(ErtsMonotonicTime val, int from, int to);
+
ERTS_GLB_INLINE Uint64
erts_time_unit_conversion(Uint64 value,
Uint32 from_time_unit,
Uint32 to_time_unit);
+ErtsSysPerfCounter erts_perf_counter_unit(void);
+
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE Uint64
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 7327e0b48c..f3f528eaf6 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -33,6 +33,8 @@
#include "global.h"
#define ERTS_WANT_TIMER_WHEEL_API
#include "erl_time.h"
+#include "erl_driver.h"
+#include "erl_nif.h"
static erts_smp_mtx_t erts_timeofday_mtx;
static erts_smp_mtx_t erts_get_time_mtx;
@@ -57,6 +59,7 @@ static int time_sup_initialized = 0;
#define ERTS_MONOTONIC_TIME_TERA \
(ERTS_MONOTONIC_TIME_GIGA*ERTS_MONOTONIC_TIME_KILO)
+static void init_time_napi(void);
static void
schedule_send_time_offset_changed_notifications(ErtsMonotonicTime new_offset);
@@ -286,7 +289,7 @@ read_corrected_time(int os_drift_corrected)
ci = time_sup.inf.c.parmon.cdata.insts.curr;
else {
if (os_mtime < time_sup.inf.c.parmon.cdata.insts.prev.os_mtime)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"OS monotonic time stepped backwards\n");
ci = time_sup.inf.c.parmon.cdata.insts.prev;
}
@@ -378,7 +381,7 @@ check_time_correction(void *vesdp)
erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
if (os_mtime < ci.os_mtime)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"OS monotonic time stepped backwards\n");
erl_mtime = calc_corrected_erl_mtime(os_mtime, &ci, &mdiff,
@@ -795,7 +798,7 @@ finalize_corrected_time_offset(ErtsSystemTime *stimep)
erts_smp_rwmtx_runlock(&time_sup.inf.c.parmon.rwmtx);
if (os_mtime < ci.os_mtime)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"OS monotonic time stepped backwards\n");
return calc_corrected_erl_mtime(os_mtime, &ci, NULL,
@@ -948,6 +951,8 @@ erts_init_time_sup(int time_correction, ErtsTimeWarpMode time_warp_mode)
ErtsMonotonicTime abs_native_offset, native_offset;
#endif
+ init_time_napi();
+
erts_hl_timer_init();
ASSERT(ERTS_MONOTONIC_TIME_MIN < ERTS_MONOTONIC_TIME_MAX);
@@ -1744,7 +1749,40 @@ erts_get_monotonic_time(ErtsSchedulerData *esdp)
{
ErtsMonotonicTime mtime = time_sup.r.o.get_time();
update_last_mtime(esdp, mtime);
- return mtime;
+ return mtime;
+}
+
+ErtsMonotonicTime
+erts_get_time_offset(void)
+{
+ return get_time_offset();
+}
+
+static ERTS_INLINE void
+make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec,
+ ErtsMonotonicTime mtime, ErtsMonotonicTime offset)
+{
+ ErtsMonotonicTime stime, as;
+ Uint ms;
+
+ stime = ERTS_MONOTONIC_TO_USEC(mtime + offset);
+
+ as = stime / ERTS_MONOTONIC_TIME_MEGA;
+ *megasec = ms = (Uint) (stime / ERTS_MONOTONIC_TIME_TERA);
+ *sec = (Uint) (as - (((ErtsMonotonicTime) ms)
+ * ERTS_MONOTONIC_TIME_MEGA));
+ *microsec = (Uint) (stime - as*ERTS_MONOTONIC_TIME_MEGA);
+
+ ASSERT(((ErtsMonotonicTime) ms)*ERTS_MONOTONIC_TIME_TERA
+ + ((ErtsMonotonicTime) *sec)*ERTS_MONOTONIC_TIME_MEGA
+ + *microsec == stime);
+}
+
+void
+erts_make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec,
+ ErtsMonotonicTime mtime, ErtsMonotonicTime offset)
+{
+ make_timestamp_value(megasec, sec, microsec, mtime, offset);
}
void
@@ -1919,15 +1957,16 @@ send_time_offset_changed_notifications(void *new_offsetp)
ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
if (erts_lookup_monitor(ERTS_P_MONITORS(rp), ref)) {
- ErlHeapFragment *bp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
Eterm message;
- hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks,
+ hsz, &hp, &ohp);
*patch_refp = ref;
ASSERT(hsz == size_object(message_template));
message = copy_struct(message_template, hsz, &hp, ohp);
- erts_queue_message(rp, &rp_locks, bp, message, NIL);
+ erts_queue_message(rp, &rp_locks, mp, message, NIL);
}
erts_smp_proc_unlock(rp, rp_locks);
}
@@ -2164,6 +2203,146 @@ time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonoto
return ret;
}
+
+/*
+ * Time Native API (drivers and NIFs)
+ */
+
+#define ERTS_NAPI_TIME_ERROR ((ErtsMonotonicTime) ERTS_NAPI_TIME_ERROR__)
+
+static void
+init_time_napi(void)
+{
+ /* Verify that time native api constants are as expected... */
+
+ ASSERT(sizeof(ErtsMonotonicTime) == sizeof(ErlDrvTime));
+ ASSERT(ERL_DRV_TIME_ERROR == (ErlDrvTime) ERTS_NAPI_TIME_ERROR);
+ ASSERT(ERL_DRV_TIME_ERROR < (ErlDrvTime) 0);
+ ASSERT(ERTS_NAPI_SEC__ == (int) ERL_DRV_SEC);
+ ASSERT(ERTS_NAPI_MSEC__ == (int) ERL_DRV_MSEC);
+ ASSERT(ERTS_NAPI_USEC__ == (int) ERL_DRV_USEC);
+ ASSERT(ERTS_NAPI_NSEC__ == (int) ERL_DRV_NSEC);
+
+ ASSERT(sizeof(ErtsMonotonicTime) == sizeof(ErlNifTime));
+ ASSERT(ERL_NIF_TIME_ERROR == (ErlNifTime) ERTS_NAPI_TIME_ERROR);
+ ASSERT(ERL_NIF_TIME_ERROR < (ErlNifTime) 0);
+ ASSERT(ERTS_NAPI_SEC__ == (int) ERL_NIF_SEC);
+ ASSERT(ERTS_NAPI_MSEC__ == (int) ERL_NIF_MSEC);
+ ASSERT(ERTS_NAPI_USEC__ == (int) ERL_NIF_USEC);
+ ASSERT(ERTS_NAPI_NSEC__ == (int) ERL_NIF_NSEC);
+}
+
+ErtsMonotonicTime
+erts_napi_monotonic_time(int time_unit)
+{
+ ErtsSchedulerData *esdp;
+ ErtsMonotonicTime mtime;
+
+ /* At least for now only allow schedulers to do this... */
+ esdp = erts_get_scheduler_data();
+ if (!esdp)
+ return ERTS_NAPI_TIME_ERROR;
+
+ mtime = time_sup.r.o.get_time();
+ update_last_mtime(esdp, mtime);
+
+ switch (time_unit) {
+ case ERTS_NAPI_SEC__:
+ mtime = ERTS_MONOTONIC_TO_SEC(mtime);
+ mtime += ERTS_MONOTONIC_OFFSET_SEC;
+ break;
+ case ERTS_NAPI_MSEC__:
+ mtime = ERTS_MONOTONIC_TO_MSEC(mtime);
+ mtime += ERTS_MONOTONIC_OFFSET_MSEC;
+ break;
+ case ERTS_NAPI_USEC__:
+ mtime = ERTS_MONOTONIC_TO_USEC(mtime);
+ mtime += ERTS_MONOTONIC_OFFSET_USEC;
+ break;
+ case ERTS_NAPI_NSEC__:
+ mtime = ERTS_MONOTONIC_TO_NSEC(mtime);
+ mtime += ERTS_MONOTONIC_OFFSET_NSEC;
+ break;
+ default:
+ return ERTS_NAPI_TIME_ERROR;
+ }
+
+ return mtime;
+}
+
+ErtsMonotonicTime
+erts_napi_time_offset(int time_unit)
+{
+ ErtsSchedulerData *esdp;
+ ErtsSystemTime offs;
+
+ /* At least for now only allow schedulers to do this... */
+ esdp = erts_get_scheduler_data();
+ if (!esdp)
+ return ERTS_NAPI_TIME_ERROR;
+
+ offs = get_time_offset();
+ switch (time_unit) {
+ case ERTS_NAPI_SEC__:
+ offs = ERTS_MONOTONIC_TO_SEC(offs);
+ offs -= ERTS_MONOTONIC_OFFSET_SEC;
+ break;
+ case ERTS_NAPI_MSEC__:
+ offs = ERTS_MONOTONIC_TO_MSEC(offs);
+ offs -= ERTS_MONOTONIC_OFFSET_MSEC;
+ break;
+ case ERTS_NAPI_USEC__:
+ offs = ERTS_MONOTONIC_TO_USEC(offs);
+ offs -= ERTS_MONOTONIC_OFFSET_USEC;
+ break;
+ case ERTS_NAPI_NSEC__:
+ offs = ERTS_MONOTONIC_TO_NSEC(offs);
+ offs -= ERTS_MONOTONIC_OFFSET_NSEC;
+ break;
+ default:
+ return ERTS_NAPI_TIME_ERROR;
+ }
+ return offs;
+}
+
+ErtsMonotonicTime
+erts_napi_convert_time_unit(ErtsMonotonicTime val, int from, int to)
+{
+ ErtsMonotonicTime ffreq, tfreq, denom;
+ /*
+ * Convertion between time units using floor function.
+ *
+ * Note that this needs to work also for negative
+ * values. Ordinary integer division on a negative
+ * value will give ceiling...
+ */
+
+ switch ((int) from) {
+ case ERTS_NAPI_SEC__: ffreq = 1; break;
+ case ERTS_NAPI_MSEC__: ffreq = 1000; break;
+ case ERTS_NAPI_USEC__: ffreq = 1000*1000; break;
+ case ERTS_NAPI_NSEC__: ffreq = 1000*1000*1000; break;
+ default: return ERTS_NAPI_TIME_ERROR;
+ }
+
+ switch ((int) to) {
+ case ERTS_NAPI_SEC__: tfreq = 1; break;
+ case ERTS_NAPI_MSEC__: tfreq = 1000; break;
+ case ERTS_NAPI_USEC__: tfreq = 1000*1000; break;
+ case ERTS_NAPI_NSEC__: tfreq = 1000*1000*1000; break;
+ default: return ERTS_NAPI_TIME_ERROR;
+ }
+
+ if (tfreq >= ffreq)
+ return val * (tfreq / ffreq);
+
+ denom = ffreq / tfreq;
+ if (val >= 0)
+ return val / denom;
+
+ return (val - (denom - 1)) / denom;
+}
+
/* Built in functions */
BIF_RETTYPE monotonic_time_0(BIF_ALIST_0)
@@ -2220,22 +2399,14 @@ BIF_RETTYPE time_offset_1(BIF_ALIST_1)
BIF_RETTYPE timestamp_0(BIF_ALIST_0)
{
Eterm *hp, res;
- ErtsMonotonicTime stime, mtime, all_sec, offset;
+ ErtsMonotonicTime mtime, offset;
Uint mega_sec, sec, micro_sec;
mtime = time_sup.r.o.get_time();
offset = get_time_offset();
update_last_mtime(ERTS_PROC_GET_SCHDATA(BIF_P), mtime);
- stime = ERTS_MONOTONIC_TO_USEC(mtime + offset);
- all_sec = stime / ERTS_MONOTONIC_TIME_MEGA;
- mega_sec = (Uint) (stime / ERTS_MONOTONIC_TIME_TERA);
- sec = (Uint) (all_sec - (((ErtsMonotonicTime) mega_sec)
- * ERTS_MONOTONIC_TIME_MEGA));
- micro_sec = (Uint) (stime - all_sec*ERTS_MONOTONIC_TIME_MEGA);
- ASSERT(((ErtsMonotonicTime) mega_sec)*ERTS_MONOTONIC_TIME_TERA
- + ((ErtsMonotonicTime) sec)*ERTS_MONOTONIC_TIME_MEGA
- + micro_sec == stime);
+ make_timestamp_value(&mega_sec, &sec, &micro_sec, mtime, offset);
/*
* Mega seconds is the only value that potentially
@@ -2264,9 +2435,19 @@ BIF_RETTYPE os_system_time_0(BIF_ALIST_0)
BIF_RET(make_time_val(BIF_P, stime));
}
-BIF_RETTYPE os_system_time_1(BIF_ALIST_0)
+BIF_RETTYPE os_system_time_1(BIF_ALIST_1)
{
ErtsSystemTime stime = erts_os_system_time();
BIF_RET(time_unit_conversion(BIF_P, BIF_ARG_1, stime, 0));
}
+BIF_RETTYPE
+os_perf_counter_0(BIF_ALIST_0)
+{
+ BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter()));
+}
+
+BIF_RETTYPE erts_internal_perf_counter_unit_0(BIF_ALIST_0)
+{
+ BIF_RET(make_time_val(BIF_P, erts_sys_perf_counter_unit()));
+}
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index e1b03a057f..41876b8c62 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -38,6 +38,7 @@
#include "erl_binary.h"
#include "erl_bits.h"
#include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
#if 0
#define DEBUG_PRINTOUTS
@@ -77,6 +78,264 @@ enum ErtsSysMsgType {
SYS_MSG_TYPE_SYSPROF
};
+#define ERTS_TRACE_TS_NOW_MAX_SIZE \
+ 4
+#define ERTS_TRACE_TS_MONOTONIC_MAX_SIZE \
+ ERTS_MAX_SINT64_HEAP_SIZE
+#define ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE \
+ (3 + ERTS_MAX_SINT64_HEAP_SIZE \
+ + ERTS_MAX_UINT64_HEAP_SIZE)
+
+#define ERTS_TRACE_PATCH_TS_MAX_SIZE \
+ (1 + ((ERTS_TRACE_TS_NOW_MAX_SIZE \
+ > ERTS_TRACE_TS_MONOTONIC_MAX_SIZE) \
+ ? ((ERTS_TRACE_TS_NOW_MAX_SIZE \
+ > ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE) \
+ ? ERTS_TRACE_TS_NOW_MAX_SIZE \
+ : ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE) \
+ : ((ERTS_TRACE_TS_MONOTONIC_MAX_SIZE \
+ > ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE) \
+ ? ERTS_TRACE_TS_MONOTONIC_MAX_SIZE \
+ : ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE)))
+
+#define TFLGS_TS_TYPE(p) ERTS_TFLGS2TSTYPE(ERTS_TRACE_FLAGS((p)))
+
+/*
+ * FUTURE CHANGES:
+ *
+ * The timestamp functionality has intentionally been
+ * split in two parts for future use even though it
+ * is not used like this today. take_timestamp() takes
+ * the timestamp and calculate heap need for it (which
+ * is not constant). write_timestamp() writes the
+ * timestamp to the allocated heap. That is, one typically
+ * want to take the timestamp before allocating the heap
+ * and then write it to the heap.
+ *
+ * The trace output functionality now use patch_ts_size(),
+ * write_ts(), and patch_ts(). write_ts() both takes the
+ * timestamp and writes it. Since we don't know the
+ * heap need when allocating the heap area we need to
+ * over allocate (maximum size from patch_ts_size()) and
+ * then potentially (often) shrink the heap area after the
+ * timestamp has been written. The only reason it is
+ * currently done this way is because we do not want to
+ * make major changes of the trace behavior in a patch.
+ * This is planned to be changed in next major release.
+ */
+
+typedef struct {
+ int ts_type_flag;
+ union {
+ struct {
+ Uint ms;
+ Uint s;
+ Uint us;
+ } now;
+ struct {
+ ErtsMonotonicTime time;
+ Sint64 raw_unique;
+ } monotonic;
+ } u;
+} ErtsTraceTimeStamp;
+
+static ERTS_INLINE Uint
+take_timestamp(ErtsTraceTimeStamp *tsp, int ts_type)
+{
+ int ts_type_flag = ts_type & -ts_type; /* least significant flag */
+
+ ASSERT(ts_type_flag == ERTS_TRACE_FLG_NOW_TIMESTAMP
+ || ts_type_flag == ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP
+ || ts_type_flag == ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP
+ || ts_type_flag == 0);
+
+ tsp->ts_type_flag = ts_type_flag;
+ switch (ts_type_flag) {
+ case 0:
+ return (Uint) 0;
+ case ERTS_TRACE_FLG_NOW_TIMESTAMP:
+#ifdef HAVE_ERTS_NOW_CPU
+ if (erts_cpu_timestamp)
+ erts_get_now_cpu(&tsp->u.now.ms, &tsp->u.now.s, &tsp->u.now.us);
+ else
+#endif
+ get_now(&tsp->u.now.ms, &tsp->u.now.s, &tsp->u.now.us);
+ return (Uint) 4;
+ case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP:
+ case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: {
+ Uint hsz = 0;
+ ErtsMonotonicTime mtime = erts_get_monotonic_time(NULL);
+ mtime = ERTS_MONOTONIC_TO_NSEC(mtime);
+ mtime += ERTS_MONOTONIC_OFFSET_NSEC;
+ hsz = (IS_SSMALL(mtime) ?
+ (Uint) 0
+ : ERTS_SINT64_HEAP_SIZE((Sint64) mtime));
+ tsp->u.monotonic.time = mtime;
+ if (ts_type_flag == ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP) {
+ Sint64 raw_unique;
+ hsz += 3; /* 2-tuple */
+ raw_unique = erts_raw_get_unique_monotonic_integer();
+ tsp->u.monotonic.raw_unique = raw_unique;
+ hsz += erts_raw_unique_monotonic_integer_heap_size(raw_unique);
+ }
+ return hsz;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("invalid timestamp type");
+ return 0;
+ }
+}
+
+static ERTS_INLINE Eterm
+write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp)
+{
+ int ts_type_flag = tsp->ts_type_flag;
+ Eterm res;
+
+ switch (ts_type_flag) {
+ case 0:
+ return NIL;
+ case ERTS_TRACE_FLG_NOW_TIMESTAMP:
+ res = TUPLE3(*hpp,
+ make_small(tsp->u.now.ms),
+ make_small(tsp->u.now.s),
+ make_small(tsp->u.now.us));
+ *hpp += 4;
+ return res;
+ case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP:
+ case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP: {
+ Sint64 mtime, raw;
+ Eterm unique, emtime;
+
+ mtime = (Sint64) tsp->u.monotonic.time;
+ emtime = (IS_SSMALL(mtime)
+ ? make_small((Sint64) mtime)
+ : erts_sint64_to_big((Sint64) mtime, hpp));
+
+ if (ts_type_flag == ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP)
+ return emtime;
+
+ raw = tsp->u.monotonic.raw_unique;
+ unique = erts_raw_make_unique_monotonic_integer_value(hpp,
+ raw);
+ res = TUPLE2(*hpp, emtime, unique);
+ *hpp += 3;
+ return res;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("invalid timestamp type");
+ return THE_NON_VALUE;
+ }
+}
+
+#define PATCH_TS_SIZE(p) patch_ts_size(TFLGS_TS_TYPE(p))
+
+static ERTS_INLINE Uint
+patch_ts_size(int ts_type)
+{
+ int ts_type_flag = ts_type & -ts_type; /* least significant flag */
+ switch (ts_type_flag) {
+ case 0:
+ return 0;
+ case ERTS_TRACE_FLG_NOW_TIMESTAMP:
+ return 1 + ERTS_TRACE_TS_NOW_MAX_SIZE;
+ case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP:
+ return 1 + ERTS_TRACE_TS_MONOTONIC_MAX_SIZE;
+ case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP:
+ return 1 + ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE;
+ default:
+ ERTS_INTERNAL_ERROR("invalid timestamp type");
+ return 0;
+ }
+}
+
+/*
+ * Write a timestamp. The timestamp MUST be the last
+ * thing built on the heap. This since write_ts() might
+ * adjust the size of the used area.
+ */
+static Eterm
+write_ts(int ts_type, Eterm *hp, ErlHeapFragment *bp, Process *tracer)
+{
+ ErtsTraceTimeStamp ts;
+ Sint shrink;
+ Eterm res, *ts_hp = hp;
+ Uint hsz;
+
+ ASSERT(ts_type);
+
+ hsz = take_timestamp(&ts, ts_type);
+
+ res = write_timestamp(&ts, &ts_hp);
+
+ ASSERT(ts_hp == hp + hsz);
+
+ switch (ts.ts_type_flag) {
+ case ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP:
+ shrink = ERTS_TRACE_TS_MONOTONIC_MAX_SIZE;
+ break;
+ case ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP:
+ shrink = ERTS_TRACE_TS_STRICT_MONOTONIC_MAX_SIZE;
+ break;
+ default:
+ return res;
+ }
+
+ shrink -= hsz;
+
+ ASSERT(shrink >= 0);
+
+ if (shrink) {
+ if (bp)
+ bp->used_size -= shrink;
+#ifndef ERTS_SMP
+ else if (tracer) {
+ Eterm *endp = ts_hp + shrink;
+ HRelease(tracer, endp, ts_hp);
+ }
+#endif
+ }
+
+ return res;
+}
+
+/*
+ * Patch a timestamp into a tuple. The tuple MUST be the last thing
+ * built on the heap before the call, and the timestamp MUST be
+ * the last thing after the call. This since patch_ts() might adjust
+ * the size of the used area.
+ */
+
+#define PATCH_TS__(Type, Tuple, Hp, Bp, Tracer) \
+ do { \
+ int ts_type__ = (Type); \
+ if (ts_type__) \
+ patch_ts(ts_type__, (Tuple), (Hp), (Bp), (Tracer)); \
+ } while (0)
+
+#ifdef ERTS_SMP
+#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \
+ PATCH_TS__((Type), (Tuple), (Hp), (Bp), NULL)
+#else
+#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \
+ PATCH_TS__((Type), (Tuple), (Hp), (Bp), (Tracer))
+#endif
+
+static ERTS_INLINE void
+patch_ts(int ts_type, Eterm tuple, Eterm* hp, ErlHeapFragment *bp, Process *tracer)
+{
+ Eterm *tptr = tuple_val(tuple);
+ int arity = arityval(*tptr);
+
+ ASSERT(ts_type);
+ ASSERT((tptr+arity+1) == hp);
+
+ tptr[0] = make_arityval(arity+1);
+ tptr[1] = am_trace_ts;
+
+ *hp = write_ts(ts_type, hp+1, bp, tracer);
+}
+
#ifdef ERTS_SMP
static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type,
Eterm from,
@@ -114,15 +373,10 @@ void erts_init_trace(void) {
static Eterm system_seq_tracer;
-#ifdef ERTS_SMP
#define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, UNUSED) \
(*(BPP) = new_message_buffer((SZ)), \
*(OHPP) = &(*(BPP))->off_heap, \
(*(BPP))->mem)
-#else
-#define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, RPP) \
- erts_alloc_message_heap((SZ), (BPP), (OHPP), (RPP), 0)
-#endif
#ifdef ERTS_SMP
#define ERTS_ENQ_TRACE_MSG(FPID, TPID, MSG, BP) \
@@ -131,8 +385,12 @@ do { \
enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \
} while(0)
#else
-#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \
- erts_queue_message((TPROC), NULL, (BP), (MSG), NIL)
+#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \
+ do { \
+ ErtsMessage *mp__ = erts_alloc_message(0, NULL); \
+ mp__->data.heap_frag = (BP); \
+ erts_queue_message((TPROC), NULL, mp__, (MSG), NIL); \
+ } while (0)
#endif
/*
@@ -365,23 +623,6 @@ erts_get_system_profile(void) {
return profile;
}
-
-#ifdef HAVE_ERTS_NOW_CPU
-# define GET_NOW(m, s, u) \
-do { \
- if (erts_cpu_timestamp) \
- erts_get_now_cpu(m, s, u); \
- else \
- get_now(m, s, u); \
-} while (0)
-#else
-# define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0)
-#endif
-
-
-
-static Eterm* patch_ts(Eterm tuple4, Eterm* hp);
-
#ifdef ERTS_SMP
static void
do_send_to_port(Eterm to,
@@ -420,7 +661,7 @@ WRITE_SYS_MSG_TO_PORT(Eterm unused_to,
erts_encode_ext(message, &ptr);
if (!(ptr <= buffer+size)) {
- erl_exit(1, "Internal error in do_send_to_port: %d\n", ptr-buffer);
+ erts_exit(ERTS_ERROR_EXIT, "Internal error in do_send_to_port: %d\n", ptr-buffer);
}
#ifndef ERTS_SMP
@@ -436,11 +677,11 @@ WRITE_SYS_MSG_TO_PORT(Eterm unused_to,
/* Send {trace_ts, Pid, out, 0, Timestamp}
* followed by {trace_ts, Pid, in, 0, NewTimestamp}
*
- * 'NewTimestamp' is fetched from GET_NOW() through patch_ts().
+ * 'NewTimestamp' through patch_ts().
*/
static void
-do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) {
-#define LOCAL_HEAP_SIZE (4+5+5)
+do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp, int ts_type) {
+#define LOCAL_HEAP_SIZE (5+5+ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
Eterm message;
Eterm *hp;
@@ -462,9 +703,11 @@ do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) {
SYS_MSG_TYPE_UNDEFINED,
message);
- message = TUPLE4(hp, am_trace_ts, pid, am_in, mfarity);
- hp += 5;
- hp = patch_ts(message, hp);
+
+ message = TUPLE5(hp, am_trace_ts, pid, am_in, mfarity,
+ NIL /* Will be overwritten by timestamp */);
+ hp += 6;
+ hp[-1] = write_ts(ts_type, hp, NULL, NULL);
do_send_to_port(trace_port->common.id,
trace_port,
@@ -481,7 +724,7 @@ do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) {
* It is assumed that 'message' is not an 'out' message.
*
* 'c_p' is the currently executing process, "tracee" is the traced process
- * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP),
+ * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP_MASK),
* 'message' must contain a timestamp.
*/
static void
@@ -489,8 +732,9 @@ send_to_port(Process *c_p, Eterm message,
Eterm *tracer_pid, Uint *tracee_flags) {
Port* trace_port;
#ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4)
- Eterm ts, *hp;
+ int ts_type;
+#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE
+ Eterm ts;
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
#endif
@@ -519,7 +763,7 @@ send_to_port(Process *c_p, Eterm message,
*/
if ( c_p == NULL ||
- (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) {
+ (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) {
#endif
do_send_to_port(*tracer_pid,
trace_port,
@@ -538,22 +782,12 @@ send_to_port(Process *c_p, Eterm message,
*/
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
- if (*tracee_flags & F_TIMESTAMP) {
- ASSERT(is_tuple(message));
- hp = tuple_val(message);
- ts = hp[arityval(hp[0])];
- } else {
- /* A fake schedule might be needed,
- * but this message does not contain a timestamp.
- * Create a dummy trace message with timestamp to be
- * passed to do_send_schedfix_to_port().
- */
- Uint ms,s,us;
- GET_NOW(&ms, &s, &us);
- hp = local_heap;
- ts = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
- hp += 4;
- }
+ /* A fake schedule might be needed.
+ * Create a dummy trace message with timestamp to be
+ * passed to do_send_schedfix_to_port().
+ */
+ ts_type = TFLGS_TS_TYPE(c_p);
+ ts = write_ts(ts_type, local_heap, NULL, NULL);
trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY;
do_send_to_port(*tracer_pid,
@@ -572,7 +806,7 @@ send_to_port(Process *c_p, Eterm message,
* just after writning the real trace message, and now gets scheduled
* in again.
*/
- do_send_schedfix_to_port(trace_port, c_p->common.id, ts);
+ do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type);
}
erts_port_release(trace_port);
@@ -591,11 +825,9 @@ send_to_port(Process *c_p, Eterm message,
static void
profile_send(Eterm from, Eterm message) {
Uint sz = 0;
- ErlHeapFragment *bp = NULL;
Uint *hp = NULL;
Eterm msg = NIL;
Process *profile_p = NULL;
- ErlOffHeap *off_heap = NULL;
Eterm profiler = erts_get_system_profile();
@@ -621,6 +853,7 @@ profile_send(Eterm from, Eterm message) {
}
} else {
+ ErtsMessage *mp;
ASSERT(is_internal_pid(profiler));
profile_p = erts_proc_lookup(profiler);
@@ -629,10 +862,13 @@ profile_send(Eterm from, Eterm message) {
return;
sz = size_object(message);
- hp = erts_alloc_message_heap(sz, &bp, &off_heap, profile_p, 0);
- msg = copy_struct(message, sz, &hp, &bp->off_heap);
-
- erts_queue_message(profile_p, NULL, bp, msg, NIL);
+ mp = erts_alloc_message(sz, &hp);
+ if (sz == 0)
+ msg = message;
+ else
+ msg = copy_struct(message, sz, &hp, &mp->hfrag.off_heap);
+
+ erts_queue_message(profile_p, NULL, mp, msg, NIL);
}
}
@@ -641,20 +877,19 @@ profile_send(Eterm from, Eterm message) {
/* A fake schedule out/in message pair will be sent,
* if the driver so requests.
- * If (timestamp == NIL), one is fetched from GET_NOW().
*
* 'c_p' is the currently executing process, may be NULL.
*/
static void
seq_trace_send_to_port(Process *c_p,
Eterm seq_tracer,
- Eterm message,
- Eterm timestamp)
+ Eterm message)
{
Port* trace_port;
#ifndef ERTS_SMP
- Eterm ts, *hp;
-#define LOCAL_HEAP_SIZE (4)
+ int ts_type;
+ Eterm ts;
+#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
#endif
@@ -679,7 +914,7 @@ seq_trace_send_to_port(Process *c_p,
}
if (c_p == NULL
- || (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) {
+ || (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) {
#endif
do_send_to_port(seq_tracer,
trace_port,
@@ -696,20 +931,12 @@ seq_trace_send_to_port(Process *c_p,
* with 'running' and 'timestamp'.
*/
- if (timestamp != NIL) {
- ts = timestamp;
- } else {
- /* A fake schedule might be needed,
- * but this message does not contain a timestamp.
- * Create a dummy trace message with timestamp to be
- * passed to do_send_schedfix_to_port().
- */
- Uint ms,s,us;
- GET_NOW(&ms, &s, &us);
- hp = local_heap;
- ts = TUPLE3(hp, make_small(ms), make_small(s), make_small(us));
- hp += 4;
- }
+ /* A fake schedule might be needed.
+ * Create a dummy trace message with timestamp to be
+ * passed to do_send_schedfix_to_port().
+ */
+ ts_type = TFLGS_TS_TYPE(c_p);
+ ts = write_ts(ts_type, local_heap, NULL, NULL);
trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY;
do_send_to_port(seq_tracer,
@@ -728,7 +955,7 @@ seq_trace_send_to_port(Process *c_p,
* just after writing the real trace message, and now gets scheduled
* in again.
*/
- do_send_schedfix_to_port(trace_port, c_p->common.id, ts);
+ do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type);
}
erts_port_release(trace_port);
@@ -738,32 +965,6 @@ seq_trace_send_to_port(Process *c_p,
#endif
}
-#define TS_HEAP_WORDS 5
-#define TS_SIZE(p) ((ERTS_TRACE_FLAGS((p)) & F_TIMESTAMP) \
- ? TS_HEAP_WORDS \
- : 0)
-
-/*
- * Patch a timestamp into a tuple. The tuple must be the last thing
- * built on the heap.
- *
- * Returns the new hp pointer.
-*/
-static Eterm*
-patch_ts(Eterm tuple, Eterm* hp)
-{
- Uint ms, s, us;
- Eterm* ptr = tuple_val(tuple);
- int arity = arityval(*ptr);
-
- ASSERT((ptr+arity+1) == hp);
- ptr[0] = make_arityval(arity+1);
- ptr[1] = am_trace_ts;
- GET_NOW(&ms, &s, &us);
- *hp = TUPLE3(hp+1, make_small(ms), make_small(s), make_small(us));
- return hp+5;
-}
-
static ERTS_INLINE void
send_to_tracer(Process *tracee,
ERTS_TRACER_REF_TYPE tracer_ref,
@@ -776,13 +977,13 @@ send_to_tracer(Process *tracee,
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(tracee) & F_TIMESTAMP)
- *hpp = patch_ts(msg, *hpp);
-
- if (is_internal_pid(ERTS_TRACER_PROC(tracee)))
+ if (is_internal_pid(ERTS_TRACER_PROC(tracee))) {
+ PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(tracee->common.id, tracer_ref, msg, bp);
+ }
else {
ASSERT(is_internal_port(ERTS_TRACER_PROC(tracee)));
+ PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, NULL, NULL);
send_to_port(no_fake_sched ? NULL : tracee,
msg,
&ERTS_TRACER_PROC(tracee),
@@ -796,7 +997,7 @@ send_to_tracer(Process *tracee,
static void
trace_sched_aux(Process *p, Eterm what, int never_fake_sched)
{
-#define LOCAL_HEAP_SIZE (5+4+1+TS_HEAP_WORDS)
+#define LOCAL_HEAP_SIZE (5+4+1+ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
Eterm tmp, mess, *hp;
ErlHeapFragment *bp = NULL;
@@ -852,7 +1053,7 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched)
size += 4;
if (sched_no)
size += 1;
- size += TS_SIZE(p);
+ size += PATCH_TS_SIZE(p);
hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
}
@@ -926,7 +1127,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
}
if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (11)
+#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -934,9 +1135,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
mess = TUPLE5(hp, am_trace, p->common.id, operation, msg, to);
hp += 6;
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
#undef LOCAL_HEAP_SIZE
@@ -955,7 +1154,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
sz_msg = size_object(msg);
sz_to = size_object(to);
- need = sz_msg + sz_to + 6 + TS_SIZE(p);
+ need = sz_msg + sz_to + 6 + PATCH_TS_SIZE(p);
hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
@@ -972,10 +1171,7 @@ trace_send(Process *p, Eterm to, Eterm msg)
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- patch_ts(mess, hp);
- }
-
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
}
@@ -992,7 +1188,7 @@ trace_receive(Process *rp, Eterm msg)
Eterm* hp;
if (is_internal_port(ERTS_TRACER_PROC(rp))) {
-#define LOCAL_HEAP_SIZE (10)
+#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -1000,9 +1196,7 @@ trace_receive(Process *rp, Eterm msg)
mess = TUPLE4(hp, am_trace, rp->common.id, am_receive, msg);
hp += 5;
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(rp) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, NULL, NULL);
send_to_port(rp, mess, &ERTS_TRACER_PROC(rp), &ERTS_TRACE_FLAGS(rp));
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
#undef LOCAL_HEAP_SIZE
@@ -1021,7 +1215,7 @@ trace_receive(Process *rp, Eterm msg)
sz_msg = size_object(msg);
- hsz = sz_msg + 5 + TS_SIZE(rp);
+ hsz = sz_msg + 5 + PATCH_TS_SIZE(rp);
hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, tracer_ref);
@@ -1031,10 +1225,7 @@ trace_receive(Process *rp, Eterm msg)
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(rp) & F_TIMESTAMP) {
- patch_ts(mess, hp);
- }
-
+ PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(rp->common.id, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
}
@@ -1045,11 +1236,7 @@ seq_trace_update_send(Process *p)
{
Eterm seq_tracer = erts_get_system_seq_tracer();
ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p))));
- if ( (p->common.id == seq_tracer) || (SEQ_TRACE_TOKEN(p) == NIL)
-#ifdef USE_VM_PROBES
- || (SEQ_TRACE_TOKEN(p) == am_have_dt_utag)
-#endif
- ) {
+ if ((p->common.id == seq_tracer) || have_no_seqtrace(SEQ_TRACE_TOKEN(p))) {
return 0;
}
SEQ_TRACE_TOKEN_SENDER(p) = p->common.id;
@@ -1084,6 +1271,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
Eterm type_atom;
int sz_exit;
Eterm seq_tracer;
+ int ts_type;
seq_tracer = erts_get_system_seq_tracer();
@@ -1098,7 +1286,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
case SEQ_TRACE_PRINT: type_atom = am_print; break;
case SEQ_TRACE_RECEIVE: type_atom = am_receive; break;
default:
- erl_exit(1, "invalid type in seq_trace_output_generic: %d:\n", type);
+ erts_exit(ERTS_ERROR_EXIT, "invalid type in seq_trace_output_generic: %d:\n", type);
return; /* To avoid warning */
}
@@ -1111,8 +1299,10 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
return; /* no need to send anything */
}
+ ts_type = ERTS_SEQTFLGS2TSTYPE(unsigned_val(SEQ_TRACE_T_FLAGS(token)));
+
if (is_internal_port(seq_tracer)) {
-#define LOCAL_HEAP_SIZE (64)
+#define LOCAL_HEAP_SIZE (60 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -1128,17 +1318,17 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token),
receiver, msg);
hp += 6;
+
erts_smp_mtx_lock(&smq_mtx);
- if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) == 0) {
+ if (!ts_type) {
mess = TUPLE3(hp, am_seq_trace, label, mess);
- seq_trace_send_to_port(NULL, seq_tracer, mess, NIL);
+ seq_trace_send_to_port(NULL, seq_tracer, mess);
} else {
- Uint ms,s,us,ts;
- GET_NOW(&ms, &s, &us);
- ts = TUPLE3(hp, make_small(ms),make_small(s), make_small(us));
- hp += 4;
- mess = TUPLE4(hp, am_seq_trace, label, mess, ts);
- seq_trace_send_to_port(process, seq_tracer, mess, ts);
+ mess = TUPLE4(hp, am_seq_trace, label, mess,
+ NIL /* Will be overwritten by timestamp */);
+ hp += 5;
+ hp[-1] = write_ts(ts_type, hp, NULL, NULL);
+ seq_trace_send_to_port(process, seq_tracer, mess);
}
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
#undef LOCAL_HEAP_SIZE
@@ -1173,8 +1363,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
sz_lastcnt_serial = 3; /* TUPLE2 */
sz_msg = size_object(msg);
- sz_ts = ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) ?
- 5 : 0);
+ sz_ts = patch_ts_size(ts_type);
if (exitfrom != NIL) {
sz_exit = 4; /* create {'EXIT',exitfrom,msg} */
sz_exitfrom = size_object(exitfrom);
@@ -1218,14 +1407,20 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
erts_smp_mtx_lock(&smq_mtx);
- if (sz_ts) {/* timestamp should be included */
- Uint ms,s,us,ts;
- GET_NOW(&ms, &s, &us);
- ts = TUPLE3(hp, make_small(ms),make_small(s), make_small(us));
- hp += 4;
- mess = TUPLE4(hp, am_seq_trace, label, mess, ts);
- } else {
+ if (!ts_type)
mess = TUPLE3(hp, am_seq_trace, label, mess);
+ else {
+ mess = TUPLE4(hp, am_seq_trace, label, mess,
+ NIL /* Will be overwritten by timestamp */);
+ hp += 5;
+ /* Write timestamp in element 6 of the 'msg' tuple */
+ hp[-1] = write_ts(ts_type, hp, bp,
+#ifndef ERTS_SMP
+ tracer
+#else
+ NULL
+#endif
+ );
}
#ifdef ERTS_SMP
@@ -1233,7 +1428,11 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
erts_smp_mtx_unlock(&smq_mtx);
#else
/* trace_token must be NIL here */
- erts_queue_message(tracer, NULL, bp, mess, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(tracer, NULL, mp, mess, NIL);
+ }
#endif
}
}
@@ -1244,7 +1443,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
void
erts_trace_return_to(Process *p, BeamInstr *pc)
{
-#define LOCAL_HEAP_SIZE (4+5+5)
+#define LOCAL_HEAP_SIZE (4+5+ERTS_TRACE_PATCH_TS_MAX_SIZE)
Eterm* hp;
Eterm mfa;
Eterm mess;
@@ -1269,9 +1468,7 @@ erts_trace_return_to(Process *p, BeamInstr *pc)
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
if (is_internal_port(ERTS_TRACER_PROC(p))) {
send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
@@ -1318,6 +1515,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
Eterm mod, name;
int arity;
Uint meta_flags, *tracee_flags;
+ int ts_type;
#ifdef ERTS_SMP
Eterm tracee;
#endif
@@ -1353,7 +1551,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
* meta trace =>
* use fixed flag set instead of process flags
*/
- meta_flags = F_TRACE_CALLS | F_TIMESTAMP;
+ meta_flags = F_TRACE_CALLS | F_NOW_TS;
tracee_flags = &meta_flags;
#ifdef ERTS_SMP
tracee = NIL;
@@ -1367,8 +1565,10 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
name = fi[1];
arity = fi[2];
+ ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags);
+
if (is_internal_port(*tracer_pid)) {
-#define LOCAL_HEAP_SIZE (4+6+5)
+#define LOCAL_HEAP_SIZE (4+6+ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
hp = local_heap;
@@ -1377,9 +1577,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
mess = TUPLE5(hp, am_trace, p->common.id, am_return_from, mfa, retval);
hp += 6;
erts_smp_mtx_lock(&smq_mtx);
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(ts_type, mess, hp, NULL, NULL);
send_to_port(p, mess, tracer_pid, tracee_flags);
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
#undef LOCAL_HEAP_SIZE
@@ -1390,24 +1588,15 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
ERTS_TRACER_REF_TYPE tracer_ref;
unsigned size;
unsigned retval_size;
-#ifdef DEBUG
- Eterm* limit;
-#endif
ASSERT(is_internal_pid(*tracer_pid));
ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags);
-
+
retval_size = size_object(retval);
- size = 6 + 4 + retval_size;
- if (*tracee_flags & F_TIMESTAMP) {
- size += 1+4;
- }
+ size = 6 + 4 + retval_size + patch_ts_size(ts_type);
hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
-#ifdef DEBUG
- limit = hp + size;
-#endif
/*
* Build the trace tuple and put it into receive queue of the tracer process.
@@ -1421,11 +1610,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid)
erts_smp_mtx_lock(&smq_mtx);
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
- ASSERT(hp == limit);
+ PATCH_TS(ts_type, mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
@@ -1448,6 +1633,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
Eterm cv;
Eterm mess;
Uint meta_flags, *tracee_flags;
+ int ts_type;
#ifdef ERTS_SMP
Eterm tracee;
#endif
@@ -1486,15 +1672,17 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
* meta trace =>
* use fixed flag set instead of process flags
*/
- meta_flags = F_TRACE_CALLS | F_TIMESTAMP;
+ meta_flags = F_TRACE_CALLS | F_NOW_TS;
tracee_flags = &meta_flags;
#ifdef ERTS_SMP
tracee = NIL;
#endif
}
+ ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags);
+
if (is_internal_port(*tracer_pid)) {
-#define LOCAL_HEAP_SIZE (4+3+6+5)
+#define LOCAL_HEAP_SIZE (4+3+6+ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -1507,10 +1695,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
hp += 6;
ASSERT((hp - local_heap) <= LOCAL_HEAP_SIZE);
erts_smp_mtx_lock(&smq_mtx);
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp); /* hp += 5 */
- ASSERT((hp - local_heap) == LOCAL_HEAP_SIZE);
- }
+ PATCH_TS(ts_type, mess, hp, NULL, NULL);
send_to_port(p, mess, tracer_pid, tracee_flags);
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
#undef LOCAL_HEAP_SIZE
@@ -1521,24 +1706,15 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
ERTS_TRACER_REF_TYPE tracer_ref;
unsigned size;
unsigned value_size;
-#ifdef DEBUG
- Eterm* limit;
-#endif
ASSERT(is_internal_pid(*tracer_pid));
ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags);
value_size = size_object(value);
- size = 6 + 4 + 3 + value_size;
- if (*tracee_flags & F_TIMESTAMP) {
- size += 1+4;
- }
+ size = 6 + 4 + 3 + value_size + patch_ts_size(ts_type);
hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
-#ifdef DEBUG
- limit = hp + size;
-#endif
/*
* Build the trace tuple and put it into receive queue of the tracer process.
@@ -1555,11 +1731,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value,
erts_smp_mtx_lock(&smq_mtx);
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
- ASSERT(hp == limit);
+ PATCH_TS(ts_type, mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
@@ -1592,6 +1764,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
Eterm pam_result = am_true;
Eterm mess;
Uint meta_flags, *tracee_flags;
+ int ts_type;
#ifdef ERTS_SMP
Eterm tracee;
#endif
@@ -1633,7 +1806,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
/* No trace messages for sensitive processes. */
return 0;
}
- meta_flags = F_TRACE_CALLS | F_TIMESTAMP;
+ meta_flags = F_TRACE_CALLS | F_NOW_TS;
tracee_flags = &meta_flags;
#ifdef ERTS_SMP
tracee = NIL;
@@ -1676,13 +1849,10 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
}
args = transformed_args;
+ ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags);
+
if (is_internal_port(*tracer_pid)) {
-#if HEAP_ON_C_STACK
- Eterm local_heap[64+MAX_ARG];
-#else
- Eterm *local_heap = erts_alloc(ERTS_ALC_T_TEMP_TERM,
- sizeof(Eterm)*(64+MAX_ARG));
-#endif
+ Eterm local_heap[64+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG];
hp = local_heap;
if (!erts_is_valid_tracer_port(*tracer_pid)) {
@@ -1697,9 +1867,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
if (is_not_nil(tracee))
erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
#endif
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return 0;
}
@@ -1727,9 +1894,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
ERTS_PAM_TMP_RESULT, &return_flags);
if (is_non_value(pam_result)) {
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return 0;
}
@@ -1738,9 +1902,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
/* Meta trace */
if (pam_result == am_false) {
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return return_flags;
}
@@ -1748,17 +1909,11 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
/* Non-meta trace */
if (*tracee_flags & F_TRACE_SILENT) {
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return 0;
}
if (pam_result == am_false) {
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return return_flags;
}
@@ -1796,15 +1951,10 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
*hp++ = pam_result;
}
erts_smp_mtx_lock(&smq_mtx);
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(ts_type, mess, hp, NULL, NULL);
send_to_port(p, mess, tracer_pid, tracee_flags);
erts_smp_mtx_unlock(&smq_mtx);
erts_match_set_release_result(p);
-#if !HEAP_ON_C_STACK
- erts_free(ERTS_ALC_T_TEMP_TERM,local_heap);
-#endif
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
return *tracer_pid == NIL ? 0 : return_flags;
@@ -1820,9 +1970,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
unsigned sizes[MAX_ARG];
unsigned pam_result_size = 0;
int invalid_tracer;
-#ifdef DEBUG
- Eterm* limit;
-#endif
ASSERT(is_internal_pid(*tracer_pid));
@@ -1915,10 +2062,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
size += sizes[i];
}
}
- if (*tracee_flags & F_TIMESTAMP) {
- size += 1 + 4;
- /* One element in trace tuple + timestamp tuple. */
- }
+ size += patch_ts_size(ts_type);
if (pam_result != am_true) {
pam_result_size = size_object(pam_result);
size += 1 + pam_result_size;
@@ -1926,9 +2070,6 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
}
hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
-#ifdef DEBUG
- limit = hp + size;
-#endif
/*
* Build the the {M,F,A} tuple in the message buffer.
@@ -1971,11 +2112,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec,
erts_smp_mtx_lock(&smq_mtx);
- if (*tracee_flags & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
- ASSERT(hp == limit);
+ PATCH_TS(ts_type, mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
UnUseTmpHeap(ERL_SUB_BIN_SIZE,p);
@@ -2010,9 +2147,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
mess = TUPLE4(hp, am_trace, t_p->common.id, what, data);
hp += 5;
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL);
send_to_port(
#ifndef ERTS_SMP
/* No fake schedule out and in again after an exit */
@@ -2042,7 +2177,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
sz_data = size_object(data);
- need = sz_data + 5 + TS_SIZE(t_p);
+ need = sz_data + 5 + PATCH_TS_SIZE(t_p);
hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
@@ -2052,9 +2187,7 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data)
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
@@ -2088,9 +2221,7 @@ trace_proc_spawn(Process *p, Eterm pid,
mess = TUPLE5(hp, am_trace, p->common.id, am_spawn, pid, mfa);
hp += 6;
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
#undef LOCAL_HEAP_SIZE
@@ -2111,7 +2242,7 @@ trace_proc_spawn(Process *p, Eterm pid,
sz_args = size_object(args);
sz_pid = size_object(pid);
- need = sz_args + 4 + 6 + TS_SIZE(p);
+ need = sz_args + 4 + 6 + PATCH_TS_SIZE(p);
hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref);
@@ -2124,9 +2255,7 @@ trace_proc_spawn(Process *p, Eterm pid,
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
@@ -2163,11 +2292,6 @@ void save_calls(Process *p, Export *e)
void
trace_gc(Process *p, Eterm what)
{
- ERTS_DECL_AM(bin_vheap_size);
- ERTS_DECL_AM(bin_vheap_block_size);
- ERTS_DECL_AM(bin_old_vheap_size);
- ERTS_DECL_AM(bin_old_vheap_block_size);
-
ErlHeapFragment *bp = NULL;
ErlOffHeap *off_heap;
ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; /* Initialized
@@ -2178,43 +2302,10 @@ trace_gc(Process *p, Eterm what)
Eterm msg = NIL;
Uint size;
- Eterm tags[] = {
- am_old_heap_block_size,
- am_heap_block_size,
- am_mbuf_size,
- am_recent_size,
- am_stack_size,
- am_old_heap_size,
- am_heap_size,
- AM_bin_vheap_size,
- AM_bin_vheap_block_size,
- AM_bin_old_vheap_size,
- AM_bin_old_vheap_block_size
- };
-
- UWord values[] = {
- OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0,
- HEAP_SIZE(p),
- MBUF_SIZE(p),
- HIGH_WATER(p) - HEAP_START(p),
- STACK_START(p) - p->stop,
- OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0,
- HEAP_TOP(p) - HEAP_START(p),
- MSO(p).overhead,
- BIN_VHEAP_SZ(p),
- BIN_OLD_VHEAP(p),
- BIN_OLD_VHEAP_SZ(p)
- };
#define LOCAL_HEAP_SIZE \
- (sizeof(values)/sizeof(*values)) * \
- (2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) + \
- 5/*4-tuple */ + TS_HEAP_WORDS
+ (ERTS_PROCESS_GC_INFO_MAX_SIZE) + \
+ 5/*4-tuple */ + ERTS_TRACE_PATCH_TS_MAX_SIZE
DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p);
-#ifdef DEBUG
- Eterm* limit;
-#endif
-
- ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(Eterm));
UseTmpHeap(LOCAL_HEAP_SIZE,p);
@@ -2222,12 +2313,9 @@ trace_gc(Process *p, Eterm what)
hp = local_heap;
#ifdef DEBUG
size = 0;
- (void) erts_bld_atom_uword_2tup_list(NULL,
- &size,
- sizeof(values)/sizeof(*values),
- tags,
- values);
- size += 5/*4-tuple*/ + TS_SIZE(p);
+ (void) erts_process_gc_info(p, &size, NULL);
+
+ size += 5/*4-tuple*/ + PATCH_TS_SIZE(p);
#endif
} else {
ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
@@ -2237,40 +2325,30 @@ trace_gc(Process *p, Eterm what)
ERTS_TRACE_FLAGS(p));
size = 0;
- (void) erts_bld_atom_uword_2tup_list(NULL,
- &size,
- sizeof(values)/sizeof(*values),
- tags,
- values);
- size += 5/*4-tuple*/ + TS_SIZE(p);
+ (void) erts_process_gc_info(p, &size, NULL);
+
+ size += 5/*4-tuple*/ + PATCH_TS_SIZE(p);
hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref);
}
-#ifdef DEBUG
- limit = hp + size;
ASSERT(size <= LOCAL_HEAP_SIZE);
-#endif
- msg = erts_bld_atom_uword_2tup_list(&hp,
- NULL,
- sizeof(values)/sizeof(*values),
- tags,
- values);
+ msg = erts_process_gc_info(p, NULL, &hp);
msg = TUPLE4(hp, am_trace, p->common.id, what, msg);
hp += 5;
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(msg, hp);
- }
- ASSERT(hp == limit);
- if (is_internal_port(ERTS_TRACER_PROC(p)))
+ if (is_internal_port(ERTS_TRACER_PROC(p))) {
+ PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, NULL, NULL);
send_to_port(p, msg, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
- else
+ }
+ else {
+ PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, msg, bp);
+ }
erts_smp_mtx_unlock(&smq_mtx);
UnUseTmpHeap(LOCAL_HEAP_SIZE,p);
#undef LOCAL_HEAP_SIZE
@@ -2332,7 +2410,11 @@ monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
void
@@ -2393,7 +2475,11 @@ monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time)
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
@@ -2464,7 +2550,11 @@ monitor_long_gc(Process *p, Uint time) {
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
@@ -2535,7 +2625,11 @@ monitor_large_heap(Process *p) {
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
@@ -2563,7 +2657,11 @@ monitor_generic(Process *p, Eterm type, Eterm spec) {
#ifdef ERTS_SMP
enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp);
#else
- erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(monitor_p, NULL, mp, msg, NIL);
+ }
#endif
}
@@ -2574,19 +2672,18 @@ monitor_generic(Process *p, Eterm type, Eterm spec) {
void
profile_scheduler(Eterm scheduler_id, Eterm state) {
- Eterm *hp, msg, timestamp;
- Uint Ms, s, us;
+ Eterm *hp, msg;
+ ErlHeapFragment *bp = NULL;
#ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4 + 7)
+#define LOCAL_HEAP_SIZE (7 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
hp = local_heap;
#else
- ErlHeapFragment *bp;
Uint hsz;
- hsz = 4 + 7;
+ hsz = 7 + patch_ts_size(erts_system_profile_ts_type)-1;
bp = new_message_buffer(hsz);
hp = bp->mem;
@@ -2606,10 +2703,13 @@ profile_scheduler(Eterm scheduler_id, Eterm state) {
break;
}
- GET_NOW(&Ms, &s, &us);
- timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4;
- msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state,
- make_small(active_sched), timestamp); hp += 7;
+ msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id,
+ state, make_small(active_sched),
+ NIL /* Will be overwritten by timestamp */);
+ hp += 7;
+
+ /* Write timestamp in element 6 of the 'msg' tuple */
+ hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
#ifndef ERTS_SMP
profile_send(NIL, msg);
@@ -2680,7 +2780,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
Eterm* hp;
if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (5+6)
+#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2689,9 +2789,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->common.id, drv_name);
hp += 6;
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
/* No fake schedule */
send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2705,7 +2803,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
ASSERT(is_internal_pid(ERTS_TRACER_PROC(p)));
- sz_data = 6 + TS_SIZE(p);
+ sz_data = 6 + PATCH_TS_SIZE(p);
ERTS_GET_TRACER_REF(tracer_ref,
ERTS_TRACER_PROC(p),
@@ -2718,9 +2816,7 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) {
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
@@ -2744,7 +2840,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
|| erts_thr_progress_is_blocking());
if (is_internal_port(ERTS_TRACER_PROC(t_p))) {
-#define LOCAL_HEAP_SIZE (5+5)
+#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2752,9 +2848,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
mess = TUPLE4(hp, am_trace, t_p->common.id, what, data);
hp += 5;
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL);
/* No fake schedule */
send_to_port(NULL,mess,&ERTS_TRACER_PROC(t_p),&ERTS_TRACE_FLAGS(t_p));
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2768,7 +2862,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p)));
- sz_data = 5 + TS_SIZE(t_p);
+ sz_data = 5 + PATCH_TS_SIZE(t_p);
ERTS_GET_TRACER_REF(tracer_ref,
ERTS_TRACER_PROC(t_p),
@@ -2781,9 +2875,7 @@ trace_port(Port *t_p, Eterm what, Eterm data) {
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(t_p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+ PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
@@ -2811,7 +2903,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
Eterm sched_id = am_undefined;
if (is_internal_port(ERTS_TRACER_PROC(p))) {
-#define LOCAL_HEAP_SIZE (5+6)
+#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2834,9 +2926,8 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
hp += ws;
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
+
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL);
/* No fake scheduling */
send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p));
@@ -2856,7 +2947,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
ERTS_TRACER_PROC(p),
ERTS_TRACE_FLAGS(p));
- hp = ERTS_ALLOC_SYSMSG_HEAP(ws+TS_SIZE(p), &bp, &off_heap, tracer_ref);
+ hp = ERTS_ALLOC_SYSMSG_HEAP(ws+PATCH_TS_SIZE(p), &bp, &off_heap, tracer_ref);
if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) {
#ifdef ERTS_SMP
@@ -2874,10 +2965,7 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
erts_smp_mtx_lock(&smq_mtx);
- if (ERTS_TRACE_FLAGS(p) & F_TIMESTAMP) {
- hp = patch_ts(mess, hp);
- }
-
+ PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref);
ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp);
erts_smp_mtx_unlock(&smq_mtx);
}
@@ -2887,13 +2975,12 @@ trace_sched_ports_where(Port *p, Eterm what, Eterm where) {
void
profile_runnable_port(Port *p, Eterm status) {
- Uint Ms, s, us;
- Eterm *hp, msg, timestamp;
-
+ Eterm *hp, msg;
+ ErlHeapFragment *bp = NULL;
Eterm count = make_small(0);
#ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4 + 6)
+#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -2901,10 +2988,9 @@ profile_runnable_port(Port *p, Eterm status) {
hp = local_heap;
#else
- ErlHeapFragment *bp;
Uint hsz;
- hsz = 4 + 6;
+ hsz = 6 + patch_ts_size(erts_system_profile_ts_type)-1;
bp = new_message_buffer(hsz);
hp = bp->mem;
@@ -2912,9 +2998,12 @@ profile_runnable_port(Port *p, Eterm status) {
erts_smp_mtx_lock(&smq_mtx);
- GET_NOW(&Ms, &s, &us);
- timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4;
- msg = TUPLE5(hp, am_profile, p->common.id, status, count, timestamp); hp += 6;
+ msg = TUPLE5(hp, am_profile, p->common.id, status, count,
+ NIL /* Will be overwritten by timestamp */);
+ hp += 6;
+
+ /* Write timestamp in element 5 of the 'msg' tuple */
+ hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
#ifndef ERTS_SMP
profile_send(p->common.id, msg);
@@ -2929,20 +3018,19 @@ profile_runnable_port(Port *p, Eterm status) {
/* Process profiling */
void
profile_runnable_proc(Process *p, Eterm status){
- Uint Ms, s, us;
- Eterm *hp, msg, timestamp;
+ Eterm *hp, msg;
Eterm where = am_undefined;
+ ErlHeapFragment *bp = NULL;
#ifndef ERTS_SMP
-#define LOCAL_HEAP_SIZE (4 + 6 + 4)
+#define LOCAL_HEAP_SIZE (4 + 6 + ERTS_TRACE_PATCH_TS_MAX_SIZE)
DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE);
UseTmpHeapNoproc(LOCAL_HEAP_SIZE);
hp = local_heap;
#else
- ErlHeapFragment *bp;
- Uint hsz = 4 + 6 + 4;
+ Uint hsz = 4 + 6 + patch_ts_size(erts_system_profile_ts_type)-1;
#endif
if (!p->current) {
@@ -2951,7 +3039,7 @@ profile_runnable_proc(Process *p, Eterm status){
#ifdef ERTS_SMP
if (!p->current) {
- hsz = 4 + 6;
+ hsz -= 4;
}
bp = new_message_buffer(hsz);
@@ -2966,9 +3054,13 @@ profile_runnable_proc(Process *p, Eterm status){
erts_smp_mtx_lock(&smq_mtx);
- GET_NOW(&Ms, &s, &us);
- timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4;
- msg = TUPLE5(hp, am_profile, p->common.id, status, where, timestamp); hp += 6;
+ msg = TUPLE5(hp, am_profile, p->common.id, status, where,
+ NIL /* Will be overwritten by timestamp */);
+ hp += 6;
+
+ /* Write timestamp in element 5 of the 'msg' tuple */
+ hp[-1] = write_ts(erts_system_profile_ts_type, hp, bp, NULL);
+
#ifndef ERTS_SMP
profile_send(p->common.id, msg);
UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE);
@@ -3297,8 +3389,6 @@ sys_msg_dispatcher_func(void *unused)
if (erts_thr_progress_update(NULL))
erts_thr_progress_leader_update(NULL);
- ERTS_SCHED_FAIR_YIELD();
-
#ifdef DEBUG_PRINTOUTS
print_msg_type(smqp);
#endif
@@ -3357,8 +3447,11 @@ sys_msg_dispatcher_func(void *unused)
goto failure;
}
else {
+ ErtsMessage *mp;
queue_proc_msg:
- erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL);
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = smqp->bp;
+ erts_queue_message(proc,&proc_locks,mp,smqp->msg,NIL);
#ifdef DEBUG_PRINTOUTS
erts_fprintf(stderr, "delivered\n");
#endif
@@ -3453,9 +3546,6 @@ static void
init_sys_msg_dispatcher(void)
{
erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER;
-#ifdef __OSE__
- thr_opts.coreNo = 0;
-#endif
thr_opts.detached = 1;
thr_opts.name = "sys_msg_dispatcher";
init_smq_element_alloc();
@@ -3463,7 +3553,6 @@ init_sys_msg_dispatcher(void)
sys_message_queue_end = NULL;
erts_smp_cnd_init(&smq_cnd);
erts_smp_mtx_init(&smq_mtx, "sys_msg_q");
-
erts_smp_thr_create(&sys_msg_dispatcher_tid,
sys_msg_dispatcher_func,
NULL,
diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h
index 7405490f76..a0058264d7 100644
--- a/erts/emulator/beam/erl_trace.h
+++ b/erts/emulator/beam/erl_trace.h
@@ -18,8 +18,38 @@
* %CopyrightEnd%
*/
+#ifndef ERL_TRACE_H__FLAGS__
+#define ERL_TRACE_H__FLAGS__
+/*
+ * NOTE! The bits used for these flags matter. The flag with
+ * the least significant bit will take precedence!
+ *
+ * The "now timestamp" has highest precedence due to
+ * compatibility reasons.
+ */
+#define ERTS_TRACE_FLG_NOW_TIMESTAMP (1 << 0)
+#define ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP (1 << 1)
+#define ERTS_TRACE_FLG_MONOTONIC_TIMESTAMP (1 << 2)
+
+/*
+ * The bits used effects trace flags (of processes and ports)
+ * as well as sequential trace flags. If changed make sure
+ * these arn't messed up...
+ */
+#define ERTS_TRACE_TS_TYPE_BITS 3
+#define ERTS_TRACE_TS_TYPE_MASK \
+ ((1 << ERTS_TRACE_TS_TYPE_BITS) - 1)
+
+#define ERTS_TFLGS2TSTYPE(TFLGS) \
+ ((int) (((TFLGS) >> ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) \
+ & ERTS_TRACE_TS_TYPE_MASK))
+#define ERTS_SEQTFLGS2TSTYPE(SEQTFLGS) \
+ ((int) (((SEQTFLGS) >> ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT) \
+ & ERTS_TRACE_TS_TYPE_MASK))
+
+#endif /* ERL_TRACE_H__FLAGS__ */
-#ifndef ERL_TRACE_H__
+#if !defined(ERL_TRACE_H__) && !defined(ERTS_ONLY_INCLUDE_TRACE_FLAGS)
#define ERL_TRACE_H__
struct binary;
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 551717139d..36d85b0a22 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -2507,7 +2507,7 @@ void erts_copy_utf8_to_utf16_little(byte *target, byte *bytes, int num_chars)
((Uint) (bytes[3] & ((byte) 0x3F)));
bytes += 4;
} else {
- erl_exit(1,"Internal unicode error in prim_file:internal_name2native/1");
+ erts_exit(ERTS_ERROR_EXIT,"Internal unicode error in prim_file:internal_name2native/1");
}
*target++ = (byte) (unipoint & 0xFF);
*target++ = (byte) ((unipoint >> 8) & 0xFF);
diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h
index 6dab3bf297..640969daf0 100644
--- a/erts/emulator/beam/erl_utils.h
+++ b/erts/emulator/beam/erl_utils.h
@@ -115,7 +115,7 @@ void erts_silence_warn_unused_result(long unused);
int erts_fit_in_bits_int64(Sint64);
int erts_fit_in_bits_int32(Sint32);
int erts_fit_in_bits_uint(Uint);
-int erts_list_length(Eterm);
+Sint erts_list_length(Eterm);
int erts_is_builtin(Eterm, Eterm, int);
Uint32 make_broken_hash(Eterm);
Uint32 block_hash(byte *, unsigned, Uint32);
@@ -157,51 +157,46 @@ void erts_init_utils_mem(void);
erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint);
void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *);
-#if HALFWORD_HEAP
-int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base);
-# define eq(A,B) eq_rel(A,NULL,B,NULL)
-#else
int eq(Eterm, Eterm);
-# define eq_rel(A,A_BASE,B,B_BASE) eq(A,B)
-#endif
#define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y))))
-#if HALFWORD_HEAP
-Sint erts_cmp_rel_opt(Eterm, Eterm*, Eterm, Eterm*, int, int);
-#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,0,0)
-#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp_rel_opt(A,A_BASE,B,B_BASE,1,0)
-#define CMP(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0,0)
-#define CMP_TERM(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,1,0)
-#define CMP_EQ_ONLY(A,B) erts_cmp_rel_opt(A,NULL,B,NULL,0,1)
-#else
+int erts_cmp_atoms(Eterm a, Eterm b);
Sint erts_cmp(Eterm, Eterm, int, int);
+Sint erts_cmp_compound(Eterm, Eterm, int, int);
Sint cmp(Eterm a, Eterm b);
-#define cmp_rel(A,A_BASE,B,B_BASE) erts_cmp(A,B,0,0)
-#define cmp_rel_term(A,A_BASE,B,B_BASE) erts_cmp(A,B,1,0)
#define CMP(A,B) erts_cmp(A,B,0,0)
#define CMP_TERM(A,B) erts_cmp(A,B,1,0)
#define CMP_EQ_ONLY(A,B) erts_cmp(A,B,0,1)
-#endif
-#define cmp_lt(a,b) (CMP((a),(b)) < 0)
-#define cmp_le(a,b) (CMP((a),(b)) <= 0)
-#define cmp_eq(a,b) (CMP_EQ_ONLY((a),(b)) == 0)
-#define cmp_ne(a,b) (CMP_EQ_ONLY((a),(b)) != 0)
-#define cmp_ge(a,b) (CMP((a),(b)) >= 0)
-#define cmp_gt(a,b) (CMP((a),(b)) > 0)
-
-#define cmp_lt_term(a,b) (CMP_TERM((a),(b)) < 0)
-#define cmp_le_term(a,b) (CMP_TERM((a),(b)) <= 0)
-#define cmp_ge_term(a,b) (CMP_TERM((a),(b)) >= 0)
-#define cmp_gt_term(a,b) (CMP_TERM((a),(b)) > 0)
-
-#define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b)))
-#define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b)))
-#define CMP_EQ(a,b) ((a) == (b) || cmp_eq((a),(b)))
-#define CMP_NE(a,b) ((a) != (b) && cmp_ne((a),(b)))
-
-#define CMP_LT_TERM(a,b) ((a) != (b) && cmp_lt_term((a),(b)))
-#define CMP_GE_TERM(a,b) ((a) == (b) || cmp_ge_term((a),(b)))
+#define CMP_LT(a,b) ((a) != (b) && CMP((a),(b)) < 0)
+#define CMP_LE(a,b) ((a) == (b) || CMP((a),(b)) <= 0)
+#define CMP_EQ(a,b) ((a) == (b) || CMP_EQ_ONLY((a),(b)) == 0)
+#define CMP_NE(a,b) ((a) != (b) && CMP_EQ_ONLY((a),(b)) != 0)
+#define CMP_GE(a,b) ((a) == (b) || CMP((a),(b)) >= 0)
+#define CMP_GT(a,b) ((a) != (b) && CMP((a),(b)) > 0)
+
+#define CMP_EQ_ACTION(X,Y,Action) \
+ if ((X) != (Y)) { CMP_SPEC((X),(Y),!=,Action,1); }
+#define CMP_NE_ACTION(X,Y,Action) \
+ if ((X) == (Y)) { Action; } else { CMP_SPEC((X),(Y),==,Action,1); }
+#define CMP_GE_ACTION(X,Y,Action) \
+ if ((X) != (Y)) { CMP_SPEC((X),(Y),<,Action,0); }
+#define CMP_LT_ACTION(X,Y,Action) \
+ if ((X) == (Y)) { Action; } else { CMP_SPEC((X),(Y),>=,Action,0); }
+
+#define CMP_SPEC(X,Y,Op,Action,EqOnly) \
+ if (is_atom(X) && is_atom(Y)) { \
+ if (erts_cmp_atoms(X, Y) Op 0) { Action; }; \
+ } else if (is_both_small(X, Y)) { \
+ if (signed_val(X) Op signed_val(Y)) { Action; }; \
+ } else if (is_float(X) && is_float(Y)) { \
+ FloatDef af, bf; \
+ GET_DOUBLE(X, af); \
+ GET_DOUBLE(Y, bf); \
+ if (af.fd Op bf.fd) { Action; }; \
+ } else { \
+ if (erts_cmp_compound(X,Y,0,EqOnly) Op 0) { Action; }; \
+ }
#endif
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 8948ca2ea9..98f27a1725 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -40,14 +40,6 @@
#define MAX_ARG 255 /* Max number of arguments allowed */
#define MAX_REG 1024 /* Max number of x(N) registers used */
-/* Scheduler stores data for temporary heaps if
- !HEAP_ON_C_STACK. Macros (*TmpHeap*) in global.h selects if we put temporary
- heap data on the C stack or if we use the buffers in the scheduler data. */
-#define TMP_HEAP_SIZE 128 /* Number of Eterm in the schedulers
- small heap for transient heap data */
-#define ERL_ARITH_TMP_HEAP_SIZE 4 /* as does erl_arith... */
-#define BEAM_EMU_TMP_HEAP_SIZE 2 /* and beam_emu... */
-
/*
* The new arithmetic operations need some extra X registers in the register array.
* so does the gc_bif's (i_gc_bif3 need 3 extra).
@@ -117,12 +109,8 @@
#define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p))
#if defined(DEBUG) || defined(CHECK_FOR_HOLES)
-#if HALFWORD_HEAP
-# define ERTS_HOLE_MARKER (0xdeadbeef)
-#else
# define ERTS_HOLE_MARKER (((0xdeadbeef << 24) << 8) | 0xdeadbeef)
-#endif
-#endif
+#endif /* egil: 32-bit ? */
/*
* Allocate heap memory on the ordinary heap, NEVER in a heap
@@ -153,6 +141,7 @@
typedef struct op_entry {
char* name; /* Name of instruction. */
Uint32 mask[3]; /* Signature mask. */
+ unsigned involves_r; /* Needs special attention when matching. */
int sz; /* Number of loaded words. */
char* pack; /* Instructions for packing engine. */
char* sign; /* Signature string. */
diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c
index 2420df36b5..581efe6eec 100644
--- a/erts/emulator/beam/export.c
+++ b/erts/emulator/beam/export.c
@@ -184,6 +184,9 @@ init_export_table(void)
f.cmp = (HCMP_FUN) export_cmp;
f.alloc = (HALLOC_FUN) export_alloc;
f.free = (HFREE_FUN) export_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
for (i=0; i<ERTS_NUM_CODE_IX; i++) {
erts_index_init(ERTS_ALC_T_EXPORT_TABLE, &export_tables[i], "export_list",
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index c6d7e3fcc5..aac1490f0c 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -570,7 +570,7 @@ void erts_encode_ext(Eterm term, byte **ext)
*ep++ = VERSION_MAGIC;
ep = enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS, NULL);
if (!ep)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d:erts_encode_ext(): Internal data structure error\n",
__FILE__, __LINE__);
*ext = ep;
@@ -1179,7 +1179,7 @@ typedef struct {
ErtsHeapFactory factory;
int remaining_n;
char* remaining_bytes;
- Eterm* maps_list;
+ ErtsWStack flat_maps;
ErtsPStack hamt_array;
} B2TDecodeContext;
@@ -1519,7 +1519,7 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar
ctx->u.dc.res = (Eterm) (UWord) NULL;
ctx->u.dc.next = &ctx->u.dc.res;
erts_factory_proc_prealloc_init(&ctx->u.dc.factory, p, ctx->heap_size);
- ctx->u.dc.maps_list = NULL;
+ ctx->u.dc.flat_maps.wstart = NULL;
ctx->u.dc.hamt_array.pstart = NULL;
ctx->state = B2TDecode;
/*fall through*/
@@ -1559,7 +1559,7 @@ static BIF_RETTYPE binary_to_term_int(Process* p, Uint32 flags, Eterm bin, Binar
b2t_destroy_context(ctx);
if (ctx->u.dc.factory.hp > ctx->u.dc.factory.hp_end) {
- erl_exit(1, ":%s, line %d: heap overrun by %d words(s)\n",
+ erts_exit(ERTS_ERROR_EXIT, ":%s, line %d: heap overrun by %d words(s)\n",
__FILE__, __LINE__, ctx->u.dc.factory.hp - ctx->u.dc.factory.hp_end);
}
erts_factory_close(&ctx->u.dc.factory);
@@ -1708,12 +1708,12 @@ erts_term_to_binary_simple(Process* p, Eterm Term, Uint size, int level, Uint fl
if ((endp = enc_term(NULL, Term, bytes, flags, NULL))
== NULL) {
- erl_exit(1, "%s, line %d: bad term: %x\n",
+ erts_exit(ERTS_ERROR_EXIT, "%s, line %d: bad term: %x\n",
__FILE__, __LINE__, Term);
}
real_size = endp - bytes;
if (real_size > size) {
- erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n",
+ erts_exit(ERTS_ERROR_EXIT, "%s, line %d: buffer overflow: %d word(s)\n",
__FILE__, __LINE__, real_size - size);
}
@@ -1753,12 +1753,12 @@ erts_term_to_binary_simple(Process* p, Eterm Term, Uint size, int level, Uint fl
bytes[0] = VERSION_MAGIC;
if ((endp = enc_term(NULL, Term, bytes+1, flags, NULL))
== NULL) {
- erl_exit(1, "%s, line %d: bad term: %x\n",
+ erts_exit(ERTS_ERROR_EXIT, "%s, line %d: bad term: %x\n",
__FILE__, __LINE__, Term);
}
real_size = endp - bytes;
if (real_size > size) {
- erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n",
+ erts_exit(ERTS_ERROR_EXIT, "%s, line %d: buffer overflow: %d word(s)\n",
__FILE__, __LINE__, endp - (bytes + size));
}
return erts_realloc_binary(bin, real_size);
@@ -2339,10 +2339,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
Eterm val;
FloatDef f;
Sint r = 0;
-#if HALFWORD_HEAP
- UWord wobj;
-#endif
-
if (ctx) {
WSTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
@@ -2362,11 +2358,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
outer_loop:
while (!WSTACK_ISEMPTY(s)) {
-#if HALFWORD_HEAP
- obj = (Eterm) (wobj = WSTACK_POP(s));
-#else
obj = WSTACK_POP(s);
-#endif
+
switch (val = WSTACK_POP(s)) {
case ENC_TERM:
break;
@@ -2384,11 +2377,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
break;
case ENC_PATCH_FUN_SIZE:
{
-#if HALFWORD_HEAP
- byte* size_p = (byte *) wobj;
-#else
byte* size_p = (byte *) obj;
-#endif
put_int32(ep - size_p, size_p);
}
goto outer_loop;
@@ -2435,21 +2424,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
case ENC_LAST_ARRAY_ELEMENT:
/* obj is the tuple */
{
-#if HALFWORD_HEAP
- Eterm* ptr = (Eterm *) wobj;
-#else
Eterm* ptr = (Eterm *) obj;
-#endif
obj = *ptr;
}
break;
default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */
{
-#if HALFWORD_HEAP
- Eterm* ptr = (Eterm *) wobj;
-#else
Eterm* ptr = (Eterm *) obj;
-#endif
obj = *ptr++;
WSTACK_PUSH2(s, val-1, (UWord)ptr);
}
@@ -2650,7 +2631,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ASSERT(node_sz < 17);
break;
default:
- erl_exit(1, "bad header\r\n");
+ erts_exit(ERTS_ERROR_EXIT, "bad header\r\n");
}
ptr++;
@@ -2938,7 +2919,7 @@ dec_term(ErtsDistExternal *edep,
int n;
ErtsAtomEncoding char_enc;
register Eterm* hp; /* Please don't take the address of hp */
- Eterm *maps_list; /* for preprocessing of small maps */
+ DECLARE_WSTACK(flat_maps); /* for preprocessing of small maps */
Eterm* next;
SWord reds;
#ifdef DEBUG
@@ -2950,7 +2931,6 @@ dec_term(ErtsDistExternal *edep,
next = ctx->u.dc.next;
ep = ctx->u.dc.ep;
factory = &ctx->u.dc.factory;
- maps_list = ctx->u.dc.maps_list;
if (ctx->state != B2TDecode) {
int n_limit = reds;
@@ -2977,7 +2957,7 @@ dec_term(ErtsDistExternal *edep,
case B2TDecodeList:
objp = next - 2;
while (n > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
objp[1] = make_list(next);
next = objp;
objp -= 2;
@@ -2988,7 +2968,7 @@ dec_term(ErtsDistExternal *edep,
case B2TDecodeTuple:
objp = next - 1;
while (n-- > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
next = objp;
objp--;
}
@@ -3026,22 +3006,25 @@ dec_term(ErtsDistExternal *edep,
}
}
PSTACK_CHANGE_ALLOCATOR(hamt_array, ERTS_ALC_T_SAVED_ESTACK);
+ WSTACK_CHANGE_ALLOCATOR(flat_maps, ERTS_ALC_T_SAVED_ESTACK);
if (ctx->u.dc.hamt_array.pstart) {
PSTACK_RESTORE(hamt_array, &ctx->u.dc.hamt_array);
}
+ if (ctx->u.dc.flat_maps.wstart) {
+ WSTACK_RESTORE(flat_maps, &ctx->u.dc.flat_maps);
+ }
}
else {
reds = ERTS_SWORD_MAX;
next = objp;
*next = (Eterm) (UWord) NULL;
- maps_list = NULL;
}
hp = factory->hp;
while (next != NULL) {
objp = next;
- next = (Eterm *) EXPAND_POINTER(*objp);
+ next = (Eterm *) *objp;
switch (*ep++) {
case INTEGER_EXT:
@@ -3049,7 +3032,7 @@ dec_term(ErtsDistExternal *edep,
Sint sn = get_int32(ep);
ep += 4;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
*objp = make_small(sn);
#else
if (MY_IS_SSMALL(sn)) {
@@ -3172,7 +3155,7 @@ dec_term_atom_common:
reds -= n;
}
while (n-- > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
next = objp;
objp--;
}
@@ -3190,8 +3173,8 @@ dec_term_atom_common:
*objp = make_list(hp);
hp += 2 * n;
objp = hp - 2;
- objp[0] = (Eterm) COMPRESS_POINTER((objp+1));
- objp[1] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) (objp+1);
+ objp[1] = (Eterm) next;
next = objp;
objp -= 2;
n--;
@@ -3204,7 +3187,7 @@ dec_term_atom_common:
reds -= n;
}
while (n > 0) {
- objp[0] = (Eterm) COMPRESS_POINTER(next);
+ objp[0] = (Eterm) next;
objp[1] = make_list(next);
next = objp;
objp -= 2;
@@ -3371,7 +3354,7 @@ dec_term_atom_common:
RefThing *rtp = (RefThing *) hp;
ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE);
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
hp += REF_THING_HEAD_SIZE + ref_words/2 + 1;
rtp->header = make_ref_thing_header(ref_words/2 + 1);
#else
@@ -3382,13 +3365,13 @@ dec_term_atom_common:
}
else {
ExternalThing *etp = (ExternalThing *) hp;
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
hp += EXTERNAL_THING_HEAD_SIZE + ref_words/2 + 1;
#else
hp += EXTERNAL_THING_HEAD_SIZE + ref_words;
#endif
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
etp->header = make_external_ref_header(ref_words/2 + 1);
#else
etp->header = make_external_ref_header(ref_words);
@@ -3401,7 +3384,7 @@ dec_term_atom_common:
ref_num = &(etp->data.ui32[0]);
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
*(ref_num++) = ref_words /* 32-bit arity */;
#endif
ref_num[0] = r0;
@@ -3409,7 +3392,7 @@ dec_term_atom_common:
ref_num[i] = get_int32(ep);
ep += 4;
}
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if ((1 + ref_words) % 2)
ref_num[ref_words] = 0;
#endif
@@ -3561,12 +3544,7 @@ dec_term_atom_common:
}
*objp = make_export(hp);
*hp++ = HEADER_EXPORT;
-#if HALFWORD_HEAP
- *((UWord *) (UWord) hp) = (UWord) erts_export_get_or_make_stub(mod, name, arity);
- hp += 2;
-#else
*hp++ = (Eterm) erts_export_get_or_make_stub(mod, name, arity);
-#endif
break;
}
break;
@@ -3595,21 +3573,15 @@ dec_term_atom_common:
* vptr, last word for values
*/
- /*
- * Use thing_word to link through decoded maps.
- * The list of maps is for later validation.
- */
-
- mp->thing_word = (Eterm) COMPRESS_POINTER(maps_list);
- maps_list = (Eterm *) mp;
-
+ WSTACK_PUSH(flat_maps, (UWord)mp);
+ mp->thing_word = MAP_HEADER_FLATMAP;
mp->size = size;
mp->keys = keys;
*objp = make_flatmap(mp);
for (n = size; n; n--) {
- *vptr = (Eterm) COMPRESS_POINTER(next);
- *kptr = (Eterm) COMPRESS_POINTER(vptr);
+ *vptr = (Eterm) next;
+ *kptr = (Eterm) vptr;
next = kptr;
vptr--;
kptr--;
@@ -3623,8 +3595,8 @@ dec_term_atom_common:
hamt->leaf_array = hp;
for (n = size; n; n--) {
- CDR(hp) = (Eterm) COMPRESS_POINTER(next);
- CAR(hp) = (Eterm) COMPRESS_POINTER(&CDR(hp));
+ CDR(hp) = (Eterm) next;
+ CAR(hp) = (Eterm) &CDR(hp);
next = &CAR(hp);
hp += 2;
}
@@ -3701,11 +3673,11 @@ dec_term_atom_common:
/* Environment */
for (i = num_free-1; i >= 0; i--) {
- funp->env[i] = (Eterm) COMPRESS_POINTER(next);
+ funp->env[i] = (Eterm) next;
next = funp->env + i;
}
/* Creator */
- funp->creator = (Eterm) COMPRESS_POINTER(next);
+ funp->creator = (Eterm) next;
next = &(funp->creator);
break;
}
@@ -3774,7 +3746,7 @@ dec_term_atom_common:
/* Environment */
for (i = num_free-1; i >= 0; i--) {
- funp->env[i] = (Eterm) COMPRESS_POINTER(next);
+ funp->env[i] = (Eterm) next;
next = funp->env + i;
}
break;
@@ -3851,7 +3823,9 @@ dec_term_atom_common:
ctx->u.dc.ep = ep;
ctx->u.dc.next = next;
ctx->u.dc.factory.hp = hp;
- ctx->u.dc.maps_list = maps_list;
+ if (!WSTACK_ISEMPTY(flat_maps)) {
+ WSTACK_SAVE(flat_maps, &ctx->u.dc.flat_maps);
+ }
if (!PSTACK_IS_EMPTY(hamt_array)) {
PSTACK_SAVE(hamt_array, &ctx->u.dc.hamt_array);
}
@@ -3865,18 +3839,6 @@ dec_term_atom_common:
}
}
- /* Iterate through all the maps and check for validity and sort keys
- * - done here for when we know it is complete.
- */
-
- while (maps_list) {
- next = (Eterm *)(EXPAND_POINTER(*maps_list));
- *maps_list = MAP_HEADER_FLATMAP;
- if (!erts_validate_and_sort_flatmap((flatmap_t*)maps_list))
- goto error;
- maps_list = next;
- }
-
ASSERT(hp <= factory->hp_end
|| (factory->mode == FACTORY_CLOSED && is_immed(*dbg_resultp)));
factory->hp = hp;
@@ -3885,22 +3847,33 @@ dec_term_atom_common:
*/
if (!PSTACK_IS_EMPTY(hamt_array)) {
- do {
- struct dec_term_hamt* hamt = PSTACK_TOP(hamt_array);
-
- *hamt->objp = erts_hashmap_from_array(factory,
- hamt->leaf_array,
- hamt->size,
- 1);
- if (is_non_value(*hamt->objp))
- goto error_hamt;
-
- (void) PSTACK_POP(hamt_array);
- } while (!PSTACK_IS_EMPTY(hamt_array));
- PSTACK_DESTROY(hamt_array);
+ do {
+ struct dec_term_hamt* hamt = PSTACK_TOP(hamt_array);
+
+ *hamt->objp = erts_hashmap_from_array(factory,
+ hamt->leaf_array,
+ hamt->size,
+ 1);
+ if (is_non_value(*hamt->objp))
+ goto error_hamt;
+
+ (void) PSTACK_POP(hamt_array);
+ } while (!PSTACK_IS_EMPTY(hamt_array));
+ PSTACK_DESTROY(hamt_array);
+ }
+
+ /* Iterate through all the (flat)maps and check for validity and sort keys
+ * - done here for when we know it is complete.
+ */
+
+ while(!WSTACK_ISEMPTY(flat_maps)) {
+ next = (Eterm *)WSTACK_POP(flat_maps);
+ if (!erts_validate_and_sort_flatmap((flatmap_t*)next))
+ goto error;
}
+ WSTACK_DESTROY(flat_maps);
- ASSERT((Eterm*)EXPAND_POINTER(*dbg_resultp) != NULL);
+ ASSERT((Eterm*)*dbg_resultp != NULL);
if (ctx) {
ctx->state = B2TDone;
@@ -3924,6 +3897,7 @@ error_hamt:
ctx->state = B2TDecodeFail;
ctx->reds = reds;
}
+ WSTACK_DESTROY(flat_maps);
return NULL;
}
@@ -4112,7 +4086,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
ASSERT(node_sz < 17);
break;
default:
- erl_exit(1, "bad header\r\n");
+ erts_exit(ERTS_ERROR_EXIT, "bad header\r\n");
}
ptr++;
@@ -4192,11 +4166,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
case EXPORT_DEF:
{
Export* ep = *((Export **) (export_val(obj) + 1));
-#if HALFWORD_HEAP
- result += 2;
-#else
result += 1;
-#endif
result += encode_size_struct2(acmp, ep->code[0], dflags);
result += encode_size_struct2(acmp, ep->code[1], dflags);
result += encode_size_struct2(acmp, make_small(ep->code[2]), dflags);
@@ -4204,7 +4174,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
break;
default:
- erl_exit(1,"Internal data structure error (in encode_size_struct2)%x\n",
+ erts_exit(ERTS_ERROR_EXIT,"Internal data structure error (in encode_size_struct2)%x\n",
obj);
}
@@ -4311,7 +4281,7 @@ init_done:
switch (tag) {
case INTEGER_EXT:
SKIP(4);
-#if !defined(ARCH_64) || HALFWORD_HEAP
+#if !defined(ARCH_64)
heap_size += BIG_UINT_HEAP_SIZE;
#endif
break;
@@ -4400,7 +4370,7 @@ init_done:
ep += 2;
atom_extra_skip = 1 + 4*id_words;
/* In case it is an external ref */
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
heap_size += EXTERNAL_THING_HEAD_SIZE + id_words/2 + 1;
#else
heap_size += EXTERNAL_THING_HEAD_SIZE + id_words;
@@ -4486,11 +4456,7 @@ init_done:
break;
case EXPORT_EXT:
terms += 3;
-#if HALFWORD_HEAP
- heap_size += 3;
-#else
heap_size += 2;
-#endif
break;
case NEW_FUN_EXT:
{
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index ec9296d034..d7edf451be 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -310,9 +310,6 @@ typedef union {
typedef struct proc_bin {
Eterm thing_word; /* Subtag REFC_BINARY_SUBTAG. */
Uint size; /* Binary size in bytes. */
-#if HALFWORD_HEAP
- void* dummy_ptr_padding__;
-#endif
struct erl_off_heap_header *next;
Binary *val; /* Pointer to Binary structure. */
byte *bytes; /* Pointer to the actual data bytes. */
@@ -383,7 +380,7 @@ extern int bif_reductions; /* reductions + fcalls (when doing call_bif) */
extern int stackdump_on_exit;
/*
- * Here is an implementation of a lightweiht stack.
+ * Here is an implementation of a lightweight stack.
*
* Use it like this:
*
@@ -428,7 +425,7 @@ void erl_grow_estack(ErtsEStack*, Uint need);
#define ESTACK_CHANGE_ALLOCATOR(s,t) \
do { \
if ((s).start != ESTK_DEF_STACK(s)) { \
- erl_exit(1, "Internal error - trying to change allocator " \
+ erts_exit(ERTS_ERROR_EXIT, "Internal error - trying to change allocator " \
"type of active estack\n"); \
} \
(s).alloc_type = (t); \
@@ -589,7 +586,7 @@ do { \
#define WSTACK_CHANGE_ALLOCATOR(s,t) \
do { \
if (s.wstart != WSTK_DEF_STACK(s)) { \
- erl_exit(1, "Internal error - trying to change allocator " \
+ erts_exit(ERTS_ERROR_EXIT, "Internal error - trying to change allocator " \
"type of active wstack\n"); \
} \
s.alloc_type = (t); \
@@ -781,7 +778,7 @@ ErtsPStack s = { (byte*)PSTK_DEF_STACK(s), /* pstart */ \
#define PSTACK_CHANGE_ALLOCATOR(s,t) \
do { \
if (s.pstart != (byte*)PSTK_DEF_STACK(s)) { \
- erl_exit(1, "Internal error - trying to change allocator " \
+ erts_exit(ERTS_ERROR_EXIT, "Internal error - trying to change allocator " \
"type of active pstack\n"); \
} \
s.alloc_type = (t); \
@@ -848,6 +845,94 @@ do {\
} while(0)
+/*
+ * An implementation of lightweight unbounded queues,
+ * using a circular dynamic array.
+ * It does not include support for change_allocator.
+ *
+ * Use it like this:
+ *
+ * DECLARE_EQUEUE(Queue) (At the start of a block)
+ * ...
+ * EQUEUE_PUT(Queue, Term)
+ * ...
+ * if (EQUEUE_ISEMPTY(Queue)) {
+ * Queue is empty
+ * } else {
+ * Term = EQUEUE_GET(Stack);
+ * Process popped Term here
+ * }
+ * ...
+ * DESTROY_EQUEUE(Queue)
+ */
+
+typedef struct {
+ Eterm* start;
+ Eterm* front;
+ Eterm* back;
+ int possibly_empty;
+ Eterm* end;
+ ErtsAlcType_t alloc_type;
+} ErtsEQueue;
+
+#define DEF_EQUEUE_SIZE (16)
+
+void erl_grow_equeue(ErtsEQueue*, Eterm* def_queue);
+#define EQUE_CONCAT(a,b) a##b
+#define EQUE_DEF_QUEUE(q) EQUE_CONCAT(q,_default_equeue)
+
+#define DECLARE_EQUEUE(q) \
+ UWord EQUE_DEF_QUEUE(q)[DEF_EQUEUE_SIZE]; \
+ ErtsEQueue q = { \
+ EQUE_DEF_QUEUE(q), /* start */ \
+ EQUE_DEF_QUEUE(q), /* front */ \
+ EQUE_DEF_QUEUE(q), /* back */ \
+ 1, /* possibly_empty */ \
+ EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }
+
+#define DESTROY_EQUEUE(q) \
+do { \
+ if (q.start != EQUE_DEF_QUEUE(q)) { \
+ erts_free(q.alloc_type, q.start); \
+ } \
+} while(0)
+
+#define EQUEUE_PUT_UNCHECKED(q, x) \
+do { \
+ q.possibly_empty = 0; \
+ *(q.back) = (x); \
+ if (++(q.back) == q.end) { \
+ q.back = q.start; \
+ } \
+} while(0)
+
+#define EQUEUE_PUT(q, x) \
+do { \
+ if (q.back == q.front && !q.possibly_empty) { \
+ erl_grow_equeue(&q, EQUE_DEF_QUEUE(q)); \
+ } \
+ EQUEUE_PUT_UNCHECKED(q, x); \
+} while(0)
+
+#define EQUEUE_ISEMPTY(q) (q.back == q.front && q.possibly_empty)
+
+ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE Eterm erts_equeue_get(ErtsEQueue *q) {
+ Eterm x;
+ q->possibly_empty = 1;
+ x = *(q->front);
+ if (++(q->front) == q->end) {
+ q->front = q->start;
+ }
+ return x;
+}
+#endif
+#define EQUEUE_GET(q) erts_equeue_get(&(q));
+
/* binary.c */
void erts_emasculate_writable_binary(ProcBin* pb);
@@ -900,8 +985,18 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg);
Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2);
/* beam_bif_load.c */
-Eterm erts_check_process_code(Process *c_p, Eterm module, int allow_gc, int *redsp);
+#define ERTS_CPC_ALLOW_GC (1 << 0)
+#define ERTS_CPC_COPY_LITERALS (1 << 1)
+#define ERTS_CPC_ALL (ERTS_CPC_ALLOW_GC | ERTS_CPC_COPY_LITERALS)
+Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp);
+typedef struct {
+ Eterm *ptr;
+ Uint sz;
+ Eterm pid;
+} copy_literals_t;
+
+extern copy_literals_t erts_clrange;
/* beam_load.c */
typedef struct {
@@ -913,6 +1008,7 @@ typedef struct {
Binary* erts_alloc_loader_state(void);
Eterm erts_module_for_prepared_code(Binary* magic);
+Eterm erts_has_code_on_load(Binary* magic);
Eterm erts_prepare_loading(Binary* loader_state, Process *c_p,
Eterm group_leader, Eterm* modp,
byte* code, Uint size);
@@ -931,7 +1027,7 @@ Eterm erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info);
/* beam_ranges.c */
void erts_init_ranges(void);
-void erts_start_staging_ranges(void);
+void erts_start_staging_ranges(int num_new);
void erts_end_staging_ranges(int commit);
void erts_update_ranges(BeamInstr* code, Uint size);
void erts_remove_from_ranges(BeamInstr* code);
@@ -952,39 +1048,75 @@ double erts_get_positive_zero_float(void);
/* config.c */
-__decl_noreturn void __noreturn erl_exit(int n, char*, ...);
-__decl_noreturn void __noreturn erl_exit_flush_async(int n, char*, ...);
+__decl_noreturn void __noreturn erts_exit(int n, char*, ...);
+__decl_noreturn void __noreturn erts_flush_async_exit(int n, char*, ...);
void erl_error(char*, va_list);
-/* copy.c */
-Eterm copy_object(Eterm, Process*);
+/* This controls whether sharing-preserving copy is used by Erlang */
-#if HALFWORD_HEAP
-Uint size_object_rel(Eterm, Eterm*);
-# define size_object(A) size_object_rel(A,NULL)
+#ifdef SHCOPY
+#define SHCOPY_SEND
+#define SHCOPY_SPAWN
+#endif
+
+/* The persistent state while the sharing-preserving copier works */
-Eterm copy_struct_rel(Eterm, Uint, Eterm**, ErlOffHeap*, Eterm* src_base, Eterm* dst_base);
-# define copy_struct(OBJ,SZ,HPP,OH) copy_struct_rel(OBJ,SZ,HPP,OH, NULL,NULL)
+typedef struct {
+ Eterm queue_default[DEF_EQUEUE_SIZE];
+ Eterm* queue_start;
+ Eterm* queue_end;
+ ErtsAlcType_t queue_alloc_type;
+ UWord bitstore_default[DEF_WSTACK_SIZE];
+ UWord* bitstore_start;
+ ErtsAlcType_t bitstore_alloc_type;
+ Eterm shtable_default[DEF_ESTACK_SIZE];
+ Eterm* shtable_start;
+ ErtsAlcType_t shtable_alloc_type;
+ Uint literal_size;
+ Eterm *range_ptr;
+ Uint range_sz;
+} erts_shcopy_t;
+
+#define INITIALIZE_SHCOPY(info) \
+do { \
+ info.queue_start = info.queue_default; \
+ info.bitstore_start = info.bitstore_default; \
+ info.shtable_start = info.shtable_default; \
+ info.literal_size = 0; \
+ info.range_ptr = erts_clrange.ptr; \
+ info.range_sz = erts_clrange.sz; \
+} while(0)
-Eterm copy_shallow_rel(Eterm*, Uint, Eterm**, ErlOffHeap*, Eterm* src_base);
-# define copy_shallow(A,B,C,D) copy_shallow_rel(A,B,C,D,NULL)
+#define DESTROY_SHCOPY(info) \
+do { \
+ if (info.queue_start != info.queue_default) { \
+ erts_free(info.queue_alloc_type, info.queue_start); \
+ } \
+ if (info.bitstore_start != info.bitstore_default) { \
+ erts_free(info.bitstore_alloc_type, info.bitstore_start); \
+ } \
+ if (info.shtable_start != info.shtable_default) { \
+ erts_free(info.shtable_alloc_type, info.shtable_start); \
+ } \
+} while(0)
-#else /* !HALFWORD_HEAP */
+/* copy.c */
+Eterm copy_object_x(Eterm, Process*, Uint);
+#define copy_object(Term, Proc) copy_object_x(Term,Proc,0)
Uint size_object(Eterm);
-# define size_object_rel(A,B) size_object(A)
+Uint copy_shared_calculate(Eterm, erts_shcopy_t*);
+Eterm copy_shared_perform(Eterm, Uint, erts_shcopy_t*, Eterm**, ErlOffHeap*);
-Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*);
-# define copy_struct_rel(OBJ,SZ,HPP,OH, SB,DB) copy_struct(OBJ,SZ,HPP,OH)
+Uint size_shared(Eterm);
+Eterm copy_struct_x(Eterm, Uint, Eterm**, ErlOffHeap*, Uint* bsz);
+#define copy_struct(Obj,Sz,HPP,OH) \
+ copy_struct_x(Obj,Sz,HPP,OH,NULL)
Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*);
-# define copy_shallow_rel(A,B,C,D, BASE) copy_shallow(A,B,C,D)
-#endif
-
-
-void move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first,
- Eterm* refs, unsigned nrefs);
+void erts_move_multi_frags(Eterm** hpp, ErlOffHeap*, ErlHeapFragment* first,
+ Eterm* refs, unsigned nrefs, int literals);
/* Utilities */
extern void erts_delete_nodes_monitors(Process *, ErtsProcLocks);
@@ -1037,6 +1169,9 @@ extern ErtsModifiedTimings erts_modified_timings[];
extern int erts_no_line_info;
extern Eterm erts_error_logger_warnings;
extern int erts_initialized;
+#if defined(USE_THREADS) && !defined(ERTS_SMP)
+extern erts_tid_t erts_main_thread;
+#endif
extern int erts_compat_rel;
extern int erts_use_sender_punish;
void erts_short_init(void);
@@ -1177,10 +1312,10 @@ int erts_utf8_to_latin1(byte* dest, const byte* source, int slen);
#define ERTS_UTF8_OK_MAX_CHARS 4
void bin_write(int, void*, byte*, size_t);
-int intlist_to_buf(Eterm, char*, int); /* most callers pass plain char*'s */
+Sint intlist_to_buf(Eterm, char*, Sint); /* most callers pass plain char*'s */
struct Sint_buf {
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
char s[22];
#else
char s[12];
@@ -1250,7 +1385,7 @@ ErlDrvSizeT erts_iolist_to_buf(Eterm, char*, ErlDrvSizeT);
ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *);
int erts_iolist_size_yielding(ErtsIOListState *state);
int erts_iolist_size(Eterm, ErlDrvSizeT *);
-int is_string(Eterm);
+Sint is_string(Eterm);
void erl_at_exit(void (*) (void*), void*);
Eterm collect_memory(Process *);
void dump_memory_to_fd(int);
@@ -1296,6 +1431,29 @@ int erts_print_system_version(int to, void *arg, Process *c_p);
int erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg);
+ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_FORCE_INLINE int erts_is_literal(Eterm tptr, Eterm *ptr)
+{
+ ASSERT(is_boxed(tptr) || is_list(tptr));
+ ASSERT(ptr == ptr_val(tptr));
+
+#if defined(ERTS_HAVE_IS_IN_LITERAL_RANGE)
+ return erts_is_in_literal_range(ptr);
+#elif defined(TAG_LITERAL_PTR)
+ return is_literal_ptr(tptr);
+#else
+# error Not able to detect literals...
+#endif
+
+}
+
+#endif
+
+Eterm erts_msacc_request(Process *c_p, int action, Eterm *threads);
+
/*
** Call_trace uses this API for the parameter matching functions
*/
@@ -1344,191 +1502,21 @@ extern void erts_match_prog_foreach_offheap(Binary *b,
extern erts_driver_t vanilla_driver;
extern erts_driver_t spawn_driver;
+extern erts_driver_t forker_driver;
extern erts_driver_t fd_driver;
int erts_beam_jump_table(void);
-/* Should maybe be placed in erl_message.h, but then we get an include mess. */
-ERTS_GLB_INLINE Eterm *
-erts_alloc_message_heap_state(Uint size,
- ErlHeapFragment **bpp,
- ErlOffHeap **ohpp,
- Process *receiver,
- ErtsProcLocks *receiver_locks,
- erts_aint32_t *statep);
-
-ERTS_GLB_INLINE Eterm *
-erts_alloc_message_heap(Uint size,
- ErlHeapFragment **bpp,
- ErlOffHeap **ohpp,
- Process *receiver,
- ErtsProcLocks *receiver_locks);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-/*
- * NOTE: erts_alloc_message_heap() releases msg q and status
- * lock on receiver without ensuring that other locks are
- * held. User is responsible to ensure that the receiver
- * pointer cannot become invalid until after message has
- * been passed. This is normal done either by increasing
- * reference count on process (preferred) or by holding
- * main or link lock over the whole message passing
- * operation.
- */
-
-ERTS_GLB_INLINE Eterm *
-erts_alloc_message_heap_state(Uint size,
- ErlHeapFragment **bpp,
- ErlOffHeap **ohpp,
- Process *receiver,
- ErtsProcLocks *receiver_locks,
- erts_aint32_t *statep)
-{
- Eterm *hp;
- erts_aint32_t state;
-#ifdef ERTS_SMP
- int locked_main = 0;
- state = erts_smp_atomic32_read_acqb(&receiver->state);
- if (statep)
- *statep = state;
- if (state & (ERTS_PSFLG_EXITING
- | ERTS_PSFLG_PENDING_EXIT))
- goto allocate_in_mbuf;
-#endif
-
- if (size > (Uint) INT_MAX)
- erl_exit(ERTS_ABORT_EXIT, "HUGE size (%beu)\n", size);
-
- if (
-#if defined(ERTS_SMP)
- *receiver_locks & ERTS_PROC_LOCK_MAIN
-#else
- 1
-#endif
- ) {
-#ifdef ERTS_SMP
- try_allocate_on_heap:
-#endif
- state = erts_smp_atomic32_read_nob(&receiver->state);
- if (statep)
- *statep = state;
- if ((state & (ERTS_PSFLG_EXITING
- | ERTS_PSFLG_PENDING_EXIT))
- || (receiver->flags & F_DISABLE_GC)
- || HEAP_LIMIT(receiver) - HEAP_TOP(receiver) <= size) {
- /*
- * The heap is either potentially in an inconsistent
- * state, or not large enough.
- */
-#ifdef ERTS_SMP
- if (locked_main) {
- *receiver_locks &= ~ERTS_PROC_LOCK_MAIN;
- erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MAIN);
- }
-#endif
- goto allocate_in_mbuf;
- }
- hp = HEAP_TOP(receiver);
- HEAP_TOP(receiver) = hp + size;
- *bpp = NULL;
- *ohpp = &MSO(receiver);
- }
-#ifdef ERTS_SMP
- else if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MAIN) == 0) {
- locked_main = 1;
- *receiver_locks |= ERTS_PROC_LOCK_MAIN;
- goto try_allocate_on_heap;
- }
-#endif
- else {
- ErlHeapFragment *bp;
- allocate_in_mbuf:
- bp = new_message_buffer(size);
- hp = bp->mem;
- *bpp = bp;
- *ohpp = &bp->off_heap;
- }
-
- return hp;
-}
-
-ERTS_GLB_INLINE Eterm *
-erts_alloc_message_heap(Uint size,
- ErlHeapFragment **bpp,
- ErlOffHeap **ohpp,
- Process *receiver,
- ErtsProcLocks *receiver_locks)
-{
- return erts_alloc_message_heap_state(size, bpp, ohpp, receiver,
- receiver_locks, NULL);
-}
-
-#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-
-#if !HEAP_ON_C_STACK
-# if defined(DEBUG)
-# define DeclareTmpHeap(VariableName,Size,Process) \
- Eterm *VariableName = erts_debug_allocate_tmp_heap(Size,Process)
-# define DeclareTypedTmpHeap(Type,VariableName,Process) \
- Type *VariableName = (Type *) erts_debug_allocate_tmp_heap(sizeof(Type)/sizeof(Eterm),Process)
-# define DeclareTmpHeapNoproc(VariableName,Size) \
- Eterm *VariableName = erts_debug_allocate_tmp_heap(Size,NULL)
-# define UseTmpHeap(Size,Proc) \
- do { \
- erts_debug_use_tmp_heap((Size),(Proc)); \
- } while (0)
-# define UnUseTmpHeap(Size,Proc) \
- do { \
- erts_debug_unuse_tmp_heap((Size),(Proc)); \
- } while (0)
-# define UseTmpHeapNoproc(Size) \
- do { \
- erts_debug_use_tmp_heap(Size,NULL); \
- } while (0)
-# define UnUseTmpHeapNoproc(Size) \
- do { \
- erts_debug_unuse_tmp_heap(Size,NULL); \
- } while (0)
-# else
-# define DeclareTmpHeap(VariableName,Size,Process) \
- Eterm *VariableName = (ERTS_PROC_GET_SCHDATA(Process)->tmp_heap)+(ERTS_PROC_GET_SCHDATA(Process)->num_tmp_heap_used)
-# define DeclareTypedTmpHeap(Type,VariableName,Process) \
- Type *VariableName = (Type *) (ERTS_PROC_GET_SCHDATA(Process)->tmp_heap)+(ERTS_PROC_GET_SCHDATA(Process)->num_tmp_heap_used)
-# define DeclareTmpHeapNoproc(VariableName,Size) \
- Eterm *VariableName = (erts_get_scheduler_data()->tmp_heap)+(erts_get_scheduler_data()->num_tmp_heap_used)
-# define UseTmpHeap(Size,Proc) \
- do { \
- ERTS_PROC_GET_SCHDATA(Proc)->num_tmp_heap_used += (Size); \
- } while (0)
-# define UnUseTmpHeap(Size,Proc) \
- do { \
- ERTS_PROC_GET_SCHDATA(Proc)->num_tmp_heap_used -= (Size); \
- } while (0)
-# define UseTmpHeapNoproc(Size) \
- do { \
- erts_get_scheduler_data()->num_tmp_heap_used += (Size); \
- } while (0)
-# define UnUseTmpHeapNoproc(Size) \
- do { \
- erts_get_scheduler_data()->num_tmp_heap_used -= (Size); \
- } while (0)
-
-
-# endif
-
-#else
-# define DeclareTmpHeap(VariableName,Size,Process) \
+#define DeclareTmpHeap(VariableName,Size,Process) \
Eterm VariableName[Size]
-# define DeclareTypedTmpHeap(Type,VariableName,Process) \
+#define DeclareTypedTmpHeap(Type,VariableName,Process) \
Type VariableName[1]
-# define DeclareTmpHeapNoproc(VariableName,Size) \
+#define DeclareTmpHeapNoproc(VariableName,Size) \
Eterm VariableName[Size]
-# define UseTmpHeap(Size,Proc) /* Nothing */
-# define UnUseTmpHeap(Size,Proc) /* Nothing */
-# define UseTmpHeapNoproc(Size) /* Nothing */
-# define UnUseTmpHeapNoproc(Size) /* Nothing */
-#endif /* HEAP_ON_C_STACK */
+#define UseTmpHeap(Size,Proc) /* Nothing */
+#define UnUseTmpHeap(Size,Proc) /* Nothing */
+#define UseTmpHeapNoproc(Size) /* Nothing */
+#define UnUseTmpHeapNoproc(Size) /* Nothing */
ERTS_GLB_INLINE void dtrace_pid_str(Eterm pid, char *process_buf);
ERTS_GLB_INLINE void dtrace_proc_str(Process *process, char *process_buf);
@@ -1576,6 +1564,7 @@ dtrace_fun_decode(Process *process,
erts_snprintf(mfa_buf, DTRACE_TERM_BUF_SIZE, "%T:%T/%d",
module, function, arity);
}
+
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
#endif /* !__GLOBAL_H__ */
diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c
index e0fde337f2..5a0b93f693 100644
--- a/erts/emulator/beam/hash.c
+++ b/erts/emulator/beam/hash.c
@@ -27,8 +27,6 @@
#endif
#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
#include "hash.h"
/*
@@ -66,6 +64,7 @@ void hash_get_info(HashInfo *hi, Hash *h)
int i;
int max_depth = 0;
int objects = 0;
+ int used = 0;
for (i = 0; i < size; i++) {
int depth = 0;
@@ -76,14 +75,18 @@ void hash_get_info(HashInfo *hi, Hash *h)
depth++;
b = b->next;
}
- if (depth > max_depth)
- max_depth = depth;
+ if (depth) {
+ used++;
+ if (depth > max_depth)
+ max_depth = depth;
+ }
}
+ ASSERT(objects == h->nobjs);
hi->name = h->name;
hi->size = h->size;
- hi->used = h->used;
- hi->objs = objects;
+ hi->used = used;
+ hi->objs = h->nobjs;
hi->depth = max_depth;
}
@@ -98,11 +101,11 @@ void hash_info(int to, void *arg, Hash* h)
hash_get_info(&hi, h);
- erts_print(to, arg, "=hash_table:%s\n", hi.name);
- erts_print(to, arg, "size: %d\n", hi.size);
- erts_print(to, arg, "used: %d\n", hi.used);
- erts_print(to, arg, "objs: %d\n", hi.objs);
- erts_print(to, arg, "depth: %d\n", hi.depth);
+ h->fun.meta_print(to, arg, "=hash_table:%s\n", hi.name);
+ h->fun.meta_print(to, arg, "size: %d\n", hi.size);
+ h->fun.meta_print(to, arg, "used: %d\n", hi.used);
+ h->fun.meta_print(to, arg, "objs: %d\n", hi.objs);
+ h->fun.meta_print(to, arg, "depth: %d\n", hi.depth);
}
@@ -119,47 +122,56 @@ hash_table_sz(Hash *h)
}
+static ERTS_INLINE void set_thresholds(Hash* h)
+{
+ h->grow_threshold = (8*h->size)/5; /* grow at 160% load */
+ if (h->size_ix > h->min_size_ix)
+ h->shrink_threshold = h->size / 5; /* shrink at 20% load */
+ else
+ h->shrink_threshold = -1; /* never shrink below inital size */
+}
+
/*
** init a pre allocated or static hash structure
** and allocate buckets.
*/
-Hash* hash_init(ErtsAlcType_t type, Hash* h, char* name, int size, HashFunctions fun)
+Hash* hash_init(int type, Hash* h, char* name, int size, HashFunctions fun)
{
int sz;
int ix = 0;
- h->type = type;
+ h->meta_alloc_type = type;
while (h_size_table[ix] != -1 && h_size_table[ix] < size)
ix++;
if (h_size_table[ix] == -1)
- erl_exit(1, "panic: too large hash table size (%d)\n", size);
+ return NULL;
size = h_size_table[ix];
sz = size*sizeof(HashBucket*);
- h->bucket = (HashBucket**) erts_alloc(h->type, sz);
+ h->bucket = (HashBucket**) fun.meta_alloc(h->meta_alloc_type, sz);
sys_memzero(h->bucket, sz);
h->is_allocated = 0;
h->name = name;
h->fun = fun;
h->size = size;
- h->size20percent = h->size/5;
- h->size80percent = (4*h->size)/5;
- h->ix = ix;
- h->used = 0;
+ h->size_ix = ix;
+ h->min_size_ix = ix;
+ h->nobjs = 0;
+ set_thresholds(h);
return h;
}
/*
** Create a new hash table
*/
-Hash* hash_new(ErtsAlcType_t type, char* name, int size, HashFunctions fun)
+Hash* hash_new(int type, char* name, int size, HashFunctions fun)
{
Hash* h;
- h = erts_alloc(type, sizeof(Hash));
+ h = fun.meta_alloc(type, sizeof(Hash));
h = hash_init(type, h, name, size, fun);
h->is_allocated = 1;
@@ -183,9 +195,9 @@ void hash_delete(Hash* h)
b = b_next;
}
}
- erts_free(h->type, h->bucket);
+ h->fun.meta_free(h->meta_alloc_type, h->bucket);
if (h->is_allocated)
- erts_free(h->type, (void*) h);
+ h->fun.meta_free(h->meta_alloc_type, (void*) h);
}
/*
@@ -199,39 +211,34 @@ static void rehash(Hash* h, int grow)
int i;
if (grow) {
- if ((h_size_table[h->ix+1]) == -1)
+ if ((h_size_table[h->size_ix+1]) == -1)
return;
- h->ix++;
+ h->size_ix++;
}
else {
- if (h->ix == 0)
+ if (h->size_ix == 0)
return;
- h->ix--;
+ h->size_ix--;
}
- h->size = h_size_table[h->ix];
- h->size20percent = h->size/5;
- h->size80percent = (4*h->size)/5;
+ h->size = h_size_table[h->size_ix];
sz = h->size*sizeof(HashBucket*);
- new_bucket = (HashBucket **) erts_alloc(h->type, sz);
+ new_bucket = (HashBucket **) h->fun.meta_alloc(h->meta_alloc_type, sz);
sys_memzero(new_bucket, sz);
- h->used = 0;
-
for (i = 0; i < old_size; i++) {
HashBucket* b = h->bucket[i];
while (b != (HashBucket*) 0) {
HashBucket* b_next = b->next;
int ix = b->hvalue % h->size;
- if (new_bucket[ix] == NULL)
- h->used++;
b->next = new_bucket[ix];
new_bucket[ix] = b;
b = b_next;
}
}
- erts_free(h->type, (void *) h->bucket);
+ h->fun.meta_free(h->meta_alloc_type, (void *) h->bucket);
h->bucket = new_bucket;
+ set_thresholds(h);
}
/*
@@ -268,68 +275,15 @@ void* hash_put(Hash* h, void* tmpl)
}
b = (HashBucket*) h->fun.alloc(tmpl);
- if (h->bucket[ix] == NULL)
- h->used++;
-
b->hvalue = hval;
b->next = h->bucket[ix];
h->bucket[ix] = b;
- if (h->used > h->size80percent) /* rehash at 80% */
+ if (++h->nobjs > h->grow_threshold)
rehash(h, 1);
return (void*) b;
}
-static void
-hash_insert_entry(Hash* h, HashBucket* entry)
-{
- HashValue hval = entry->hvalue;
- int ix = hval % h->size;
- HashBucket* b = h->bucket[ix];
-
- while (b != (HashBucket*) 0) {
- if ((b->hvalue == hval) && (h->fun.cmp((void*)entry, (void*)b) == 0)) {
- abort(); /* Should not happen */
- }
- b = b->next;
- }
-
- if (h->bucket[ix] == NULL)
- h->used++;
-
- entry->next = h->bucket[ix];
- h->bucket[ix] = entry;
-
- if (h->used > h->size80percent) /* rehash at 80% */
- rehash(h, 1);
-}
-
-
-/*
- * Move all entries in src into dst; empty src.
- * Entries in src must not exist in dst.
- */
-void
-erts_hash_merge(Hash* src, Hash* dst)
-{
- int limit = src->size;
- HashBucket** bucket = src->bucket;
- int i;
-
- src->used = 0;
- for (i = 0; i < limit; i++) {
- HashBucket* b = bucket[i];
- HashBucket* next;
-
- bucket[i] = NULL;
- while (b) {
- next = b->next;
- hash_insert_entry(dst, b);
- b = next;
- }
- }
-}
-
/*
** Erase hash entry return template if erased
** return 0 if not erased
@@ -348,9 +302,7 @@ void* hash_erase(Hash* h, void* tmpl)
else
h->bucket[ix] = b->next;
h->fun.free((void*)b);
- if (h->bucket[ix] == NULL)
- h->used--;
- if (h->used < h->size20percent) /* rehash at 20% */
+ if (--h->nobjs < h->shrink_threshold)
rehash(h, 0);
return tmpl;
}
@@ -381,9 +333,7 @@ hash_remove(Hash *h, void *tmpl)
prev->next = b->next;
else
h->bucket[ix] = b->next;
- if (h->bucket[ix] == NULL)
- h->used--;
- if (h->used < h->size20percent) /* rehash at 20% */
+ if (--h->nobjs < h->shrink_threshold)
rehash(h, 0);
return (void *) b;
}
diff --git a/erts/emulator/beam/hash.h b/erts/emulator/beam/hash.h
index 87fdb360e3..e94aaa0a84 100644
--- a/erts/emulator/beam/hash.h
+++ b/erts/emulator/beam/hash.h
@@ -29,14 +29,17 @@
#include "sys.h"
#endif
-#include "erl_alloc.h"
-
typedef unsigned long HashValue;
+typedef struct hash Hash;
typedef int (*HCMP_FUN)(void*, void*);
typedef HashValue (*H_FUN)(void*);
typedef void* (*HALLOC_FUN)(void*);
typedef void (*HFREE_FUN)(void*);
+/* Meta functions */
+typedef void* (*HMALLOC_FUN)(int,size_t);
+typedef void (*HMFREE_FUN)(int,void*);
+typedef int (*HMPRINT_FUN)(int,void*,char*, ...);
/*
** This bucket must be placed in top of
@@ -55,6 +58,9 @@ typedef struct hash_functions
HCMP_FUN cmp;
HALLOC_FUN alloc;
HFREE_FUN free;
+ HMALLOC_FUN meta_alloc;
+ HMFREE_FUN meta_free;
+ HMPRINT_FUN meta_print;
} HashFunctions;
typedef struct {
@@ -65,22 +71,23 @@ typedef struct {
int depth;
} HashInfo;
-typedef struct hash
+struct hash
{
HashFunctions fun; /* Function block */
int is_allocated; /* 0 iff hash structure is on stack or is static */
- ErtsAlcType_t type;
+ int meta_alloc_type; /* argument to pass to meta_alloc and meta_free */
char* name; /* Table name (static string, for debugging) */
int size; /* Number of slots */
- int size20percent; /* 20 percent of number of slots */
- int size80percent; /* 80 percent of number of slots */
- int ix; /* Size index in size table */
- int used; /* Number of slots used */
+ int shrink_threshold;
+ int grow_threshold;
+ int size_ix; /* Size index in size table */
+ int min_size_ix; /* Never shrink table smaller than this */
+ int nobjs; /* Number of objects in table */
HashBucket** bucket; /* Vector of bucket pointers (objects) */
-} Hash;
+};
-Hash* hash_new(ErtsAlcType_t, char*, int, HashFunctions);
-Hash* hash_init(ErtsAlcType_t, Hash*, char*, int, HashFunctions);
+Hash* hash_new(int, char*, int, HashFunctions);
+Hash* hash_init(int, Hash*, char*, int, HashFunctions);
void hash_delete(Hash*);
void hash_get_info(HashInfo*, Hash*);
@@ -93,6 +100,4 @@ void* hash_erase(Hash*, void*);
void* hash_remove(Hash*, void*);
void hash_foreach(Hash*, void (*func)(void *, void *), void *);
-void erts_hash_merge(Hash* src, Hash* dst);
-
#endif
diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c
index 06d0b5123d..5f6ea14732 100644
--- a/erts/emulator/beam/index.c
+++ b/erts/emulator/beam/index.c
@@ -84,7 +84,7 @@ index_put_entry(IndexTable* t, void* tmpl)
Uint sz;
if (ix >= t->limit) {
/* A core dump is unnecessary */
- erl_exit(ERTS_DUMP_EXIT, "no more index entries in %s (max=%d)\n",
+ erts_exit(ERTS_DUMP_EXIT, "no more index entries in %s (max=%d)\n",
t->htable.name, t->limit);
}
sz = INDEX_PAGE_SIZE*sizeof(IndexSlot*);
@@ -123,7 +123,7 @@ void erts_index_merge(Hash* src, IndexTable* dst)
ix = dst->entries++;
if (ix >= dst->size) {
if (ix >= dst->limit) {
- erl_exit(1, "no more index entries in %s (max=%d)\n",
+ erts_exit(ERTS_ERROR_EXIT, "no more index entries in %s (max=%d)\n",
dst->htable.name, dst->limit);
}
sz = INDEX_PAGE_SIZE*sizeof(IndexSlot*);
diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h
index 14fab41026..99b2bdfab0 100644
--- a/erts/emulator/beam/index.h
+++ b/erts/emulator/beam/index.h
@@ -30,6 +30,10 @@
#include "hash.h"
#endif
+#ifndef ERL_ALLOC_H__
+#include "erl_alloc.h"
+#endif
+
typedef struct index_slot
{
HashBucket bucket;
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 900616c981..797e4cdadc 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -50,12 +50,14 @@
#include "erl_map.h"
#include "erl_bif_unique.h"
#include "erl_hl_timer.h"
+#include "erl_time.h"
extern ErlDrvEntry fd_driver_entry;
-#ifndef __OSE__
extern ErlDrvEntry vanilla_driver_entry;
-#endif
extern ErlDrvEntry spawn_driver_entry;
+#ifndef __WIN32__
+extern ErlDrvEntry forker_driver_entry;
+#endif
extern ErlDrvEntry *driver_tab[]; /* table of static drivers, only used during initialization */
erts_driver_t *driver_list; /* List of all drivers, static and dynamic. */
@@ -73,6 +75,9 @@ const Port erts_invalid_port = {{ERTS_INVALID_PORT}};
erts_driver_t vanilla_driver;
erts_driver_t spawn_driver;
+#ifndef __WIN32__
+erts_driver_t forker_driver;
+#endif
erts_driver_t fd_driver;
int erts_port_synchronous_ops = 0;
@@ -86,6 +91,7 @@ static void deliver_result(Eterm sender, Eterm pid, Eterm res);
static int init_driver(erts_driver_t *, ErlDrvEntry *, DE_Handle *);
static void terminate_port(Port *p);
static void pdl_init(void);
+static int driver_failure_term(ErlDrvPort ix, Eterm term, int eof);
#ifdef ERTS_SMP
static void driver_monitor_lock_pdl(Port *p);
static void driver_monitor_unlock_pdl(Port *p);
@@ -307,12 +313,9 @@ static Port *create_port(char *name,
size_t port_size, busy_port_queue_size, size;
erts_aint32_t state = ERTS_PORT_SFLG_CONNECTED;
erts_aint32_t x_pts_flgs = 0;
-#ifdef DEBUG
- /* Make sure the debug flags survives until port is freed */
- state |= ERTS_PORT_SFLG_PORT_DEBUG;
-#endif
#ifdef ERTS_SMP
+ ErtsRunQueue *runq;
if (!driver_lock) {
/* Align size for mutex following port struct */
port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port));
@@ -322,6 +325,12 @@ static Port *create_port(char *name,
#endif
port_size = size = ERTS_ALC_DATA_ALIGN_SIZE(sizeof(Port));
+#ifdef DEBUG
+ /* Make sure the debug flags survives until port is freed */
+ state |= ERTS_PORT_SFLG_PORT_DEBUG;
+#endif
+
+
busy_port_queue_size
= ((driver->flags & ERL_DRV_FLAG_NO_BUSY_MSGQ)
? 0
@@ -357,8 +366,12 @@ static Port *create_port(char *name,
p += sizeof(erts_mtx_t);
state |= ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK;
}
- erts_smp_atomic_set_nob(&prt->run_queue,
- (erts_aint_t) erts_get_runq_current(NULL));
+ if (erts_get_scheduler_data())
+ runq = erts_get_runq_current(NULL);
+ else
+ runq = ERTS_RUNQ_IX(0);
+ erts_smp_atomic_set_nob(&prt->run_queue, (erts_aint_t) runq);
+
prt->xports = NULL;
#else
erts_atomic32_init_nob(&prt->refc, 1);
@@ -385,6 +398,7 @@ static Port *create_port(char *name,
ERTS_PTMR_INIT(prt);
erts_port_task_handle_init(&prt->timeout_task);
prt->psd = NULL;
+ prt->async_open_port = NULL;
prt->drv_data = (SWord) 0;
prt->os_pid = -1;
@@ -466,6 +480,11 @@ erts_port_free(Port *prt)
erts_port_task_fini_sched(&prt->sched);
+ if (prt->async_open_port) {
+ erts_free(ERTS_ALC_T_PRTSD, prt->async_open_port);
+ prt->async_open_port = NULL;
+ }
+
#ifdef ERTS_SMP
ASSERT(prt->lock);
if (state & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK)
@@ -687,6 +706,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
error_number = error_type = 0;
if (driver->start) {
+ ERTS_MSACC_PUSH_STATE_M();
if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(port, am_in, am_start);
}
@@ -697,6 +717,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
DTRACE3(driver_start, process_str, driver->name, port_str);
}
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
fpe_was_unmasked = erts_block_fpe();
drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts);
if (((SWord) drv_data) == -1)
@@ -716,6 +737,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */
}
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
port->caller = NIL;
if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(port, am_out, am_start);
@@ -1105,7 +1127,7 @@ io_list_vec_len(Eterm obj, int* vsize, Uint* csize,
Uint p_v_size = 0;
Uint p_c_size = 0;
Uint p_in_clist = 0;
- Uint total; /* Uint due to halfword emulator */
+ Uint total;
goto L_jump_start; /* avoid a push */
@@ -1412,7 +1434,7 @@ queue_port_sched_op_reply(Process *rp,
erts_factory_trim_and_close(factory, &msg, 1);
- erts_queue_message(rp, rp_locksp, factory->heap_frags, msg, NIL);
+ erts_queue_message(rp, rp_locksp, factory->message, msg, NIL);
}
static void
@@ -1420,12 +1442,9 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg)
{
Process *rp = erts_proc_lookup_raw(to);
if (rp) {
- ErlOffHeap *ohp;
- ErlHeapFragment* bp;
ErtsHeapFactory factory;
Eterm msg_copy;
Uint hsz, msg_sz;
- Eterm *hp;
ErtsProcLocks rp_locks = 0;
hsz = ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
@@ -1436,18 +1455,13 @@ port_sched_op_reply(Eterm to, Uint32 *ref_num, Eterm msg)
hsz += msg_sz;
}
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
- erts_factory_message_init(&factory, rp, hp, bp);
- if (is_immed(msg))
- msg_copy = msg;
- else {
- msg_copy = copy_struct(msg, msg_sz, &hp, ohp);
- factory.hp = hp;
- }
+ (void) erts_factory_message_create(&factory, rp,
+ &rp_locks, hsz);
+ msg_copy = (is_immed(msg)
+ ? msg
+ : copy_struct(msg, msg_sz,
+ &factory.hp,
+ factory.off_heap));
queue_port_sched_op_reply(rp,
&rp_locks,
@@ -1535,6 +1549,26 @@ erts_schedule_proc2port_signal(Process *c_p,
return ERTS_PORT_OP_SCHEDULED;
}
+static int
+erts_schedule_port2port_signal(Eterm port_num, ErtsProc2PortSigData *sigdp,
+ int task_flags,
+ ErtsProc2PortSigCallback callback)
+{
+ Port *prt = erts_port_lookup_raw(port_num);
+
+ if (!prt)
+ return -1;
+
+ sigdp->caller = ERTS_INVALID_PID;
+
+ return erts_port_task_schedule(prt->common.id,
+ NULL,
+ ERTS_PORT_TASK_PROC_SIG,
+ sigdp,
+ callback,
+ task_flags);
+}
+
static ERTS_INLINE void
send_badsig(Port *prt) {
ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND;
@@ -1679,6 +1713,7 @@ call_driver_outputv(int bang_op,
else {
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ErlDrvSizeT size = evp->size;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT);
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)
|| ERTS_IS_CRASH_DUMPING);
@@ -1699,6 +1734,8 @@ call_driver_outputv(int bang_op,
esdp->io.out += (Uint64) size;
else
erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size);
+
+ ERTS_MSACC_POP_STATE_M();
}
}
@@ -1779,6 +1816,7 @@ call_driver_output(int bang_op,
send_badsig(prt);
else {
ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT);
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)
|| ERTS_IS_CRASH_DUMPING);
@@ -1798,6 +1836,8 @@ call_driver_output(int bang_op,
esdp->io.out += (Uint64) size;
else
erts_atomic64_add_nob(&bytes_out, (erts_aint64_t) size);
+
+ ERTS_MSACC_POP_STATE_M();
}
}
@@ -2370,6 +2410,11 @@ erts_port_exit(Process *c_p,
| ERTS_PORT_SIG_FLG_BROKEN_LINK
| ERTS_PORT_SIG_FLG_FORCE_SCHED)) == 0);
+#ifndef __WIN32__
+ if (prt->drv_ptr == &forker_driver)
+ return ERTS_PORT_OP_DROPPED;
+#endif
+
if (!(flags & ERTS_PORT_SIG_FLG_FORCE_SCHED)) {
ErtsTryImmDrvCallState try_call_state
= ERTS_INIT_TRY_IMM_DRV_CALL_STATE(c_p,
@@ -2734,6 +2779,72 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp)
port_sig_link);
}
+static void
+init_ack_send_reply(Port *port, Eterm resp)
+{
+
+ if (!is_internal_port(resp)) {
+ Process *rp = erts_proc_lookup_raw(port->async_open_port->to);
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
+ erts_remove_link(&ERTS_P_LINKS(port), port->async_open_port->to);
+ erts_remove_link(&ERTS_P_LINKS(rp), port->common.id);
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ }
+ port_sched_op_reply(port->async_open_port->to,
+ port->async_open_port->ref,
+ resp);
+
+ erts_free(ERTS_ALC_T_PRTSD, port->async_open_port);
+ port->async_open_port = NULL;
+}
+
+void
+erl_drv_init_ack(ErlDrvPort ix, ErlDrvData res) {
+ Port *port = erts_drvport2port(ix);
+ SWord err_type = (SWord)res;
+ Eterm resp;
+
+ if (port == ERTS_INVALID_ERL_DRV_PORT && port->async_open_port)
+ return;
+
+ if (port->async_open_port) {
+ switch(err_type) {
+ case -3:
+ resp = am_badarg;
+ break;
+ case -2: {
+ char *str = erl_errno_id(errno);
+ resp = erts_atom_put((byte *) str, strlen(str),
+ ERTS_ATOM_ENC_LATIN1, 1);
+ break;
+ }
+ case -1:
+ resp = am_einval;
+ break;
+ default:
+ resp = port->common.id;
+ break;
+ }
+
+ init_ack_send_reply(port, resp);
+
+ if (err_type == -1 || err_type == -2 || err_type == -3)
+ driver_failure_term(ix, am_normal, 0);
+ port->drv_data = err_type;
+ }
+}
+
+void
+erl_drv_set_os_pid(ErlDrvPort ix, ErlDrvSInt pid) {
+ Port *port = erts_drvport2port(ix);
+
+ if (port == ERTS_INVALID_ERL_DRV_PORT)
+ return;
+
+ port->os_pid = (SWord)pid;
+
+}
+
void erts_init_io(int port_tab_size,
int port_tab_size_ignore_files,
int legacy_port_tab)
@@ -2794,10 +2905,11 @@ void erts_init_io(int port_tab_size,
erts_smp_rwmtx_rwlock(&erts_driver_list_lock);
init_driver(&fd_driver, &fd_driver_entry, NULL);
-#ifndef __OSE__
init_driver(&vanilla_driver, &vanilla_driver_entry, NULL);
-#endif
init_driver(&spawn_driver, &spawn_driver_entry, NULL);
+#ifndef __WIN32__
+ init_driver(&forker_driver, &forker_driver_entry, NULL);
+#endif
erts_init_static_drivers();
for (dp = driver_tab; *dp != NULL; dp++)
erts_add_driver_entry(*dp, NULL, 1);
@@ -2859,6 +2971,9 @@ void erts_lcnt_enable_io_lock_count(int enable) {
lcnt_enable_drv_lock_count(&vanilla_driver, enable);
lcnt_enable_drv_lock_count(&spawn_driver, enable);
+#ifndef __WIN32__
+ lcnt_enable_drv_lock_count(&forker_driver, enable);
+#endif
lcnt_enable_drv_lock_count(&fd_driver, enable);
/* enable lock counting in all drivers */
for (dp = driver_list; dp; dp = dp->next) {
@@ -3054,16 +3169,17 @@ deliver_result(Eterm sender, Eterm pid, Eterm res)
if (rp) {
Eterm tuple;
- ErlHeapFragment *bp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
Eterm* hp;
Uint sz_res;
sz_res = size_object(res);
- hp = erts_alloc_message_heap(sz_res + 3, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks,
+ sz_res + 3, &hp, &ohp);
res = copy_struct(res, sz_res, &hp, ohp);
tuple = TUPLE2(hp, sender, res);
- erts_queue_message(rp, &rp_locks, bp, tuple, NIL);
+ erts_queue_message(rp, &rp_locks, mp, tuple, NIL);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
@@ -3091,7 +3207,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
Eterm tuple;
Process* rp;
Eterm* hp;
- ErlHeapFragment *bp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
ErtsProcLocks rp_locks = 0;
int scheduler = erts_get_scheduler_id() != 0;
@@ -3117,7 +3233,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
if (!rp)
return;
- hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, need, &hp, &ohp);
listp = NIL;
if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) {
@@ -3159,7 +3275,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
tuple = TUPLE2(hp, prt->common.id, tuple);
hp += 3;
- erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+ erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined);
if (rp_locks)
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
@@ -3233,7 +3349,7 @@ deliver_vec_message(Port* prt, /* Port */
Eterm tuple;
Process* rp;
Eterm* hp;
- ErlHeapFragment *bp;
+ ErtsMessage *mp;
ErlOffHeap *ohp;
ErtsProcLocks rp_locks = 0;
int scheduler = erts_get_scheduler_id() != 0;
@@ -3265,7 +3381,7 @@ deliver_vec_message(Port* prt, /* Port */
need += (hlen+csize)*2;
}
- hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, need, &hp, &ohp);
listp = NIL;
iov += vsize;
@@ -3326,7 +3442,7 @@ deliver_vec_message(Port* prt, /* Port */
tuple = TUPLE2(hp, prt->common.id, tuple);
hp += 3;
- erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+ erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined);
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
erts_proc_dec_refc(rp);
@@ -3366,6 +3482,7 @@ static void flush_port(Port *p)
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
if (p->drv_ptr->flush != NULL) {
+ ERTS_MSACC_PUSH_STATE_M();
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_flush)) {
DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p)
@@ -3375,9 +3492,11 @@ static void flush_port(Port *p)
if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(p, am_in, am_flush);
}
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
fpe_was_unmasked = erts_block_fpe();
(*p->drv_ptr->flush)((ErlDrvData)p->drv_data);
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) {
trace_sched_ports_where(p, am_out, am_flush);
}
@@ -3425,6 +3544,7 @@ terminate_port(Port *prt)
drv = prt->drv_ptr;
if ((drv != NULL) && (drv->stop != NULL)) {
int fpe_was_unmasked = erts_block_fpe();
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT);
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_stop)) {
DTRACE_FORMAT_COMMON_PID_AND_PORT(connected_id, prt)
@@ -3433,6 +3553,7 @@ terminate_port(Port *prt)
#endif
(*drv->stop)((ErlDrvData)prt->drv_data);
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
#ifdef ERTS_SMP
if (prt->xports)
erts_port_handle_xports(prt);
@@ -3466,7 +3587,7 @@ terminate_port(Port *prt)
if ((state & ERTS_PORT_SFLG_HALT)
&& (erts_smp_atomic32_dec_read_nob(&erts_halt_progress) == 0)) {
erts_port_release(prt); /* We will exit and never return */
- erl_exit_flush_async(erts_halt_code, "");
+ erts_flush_async_exit(erts_halt_code, "");
}
if (is_internal_port(send_closed_port_id))
deliver_result(send_closed_port_id, connected_id, am_closed);
@@ -3743,6 +3864,7 @@ call_driver_control(Eterm caller,
ErlDrvSizeT *from_size)
{
ErlDrvSSizeT cres;
+ ERTS_MSACC_PUSH_STATE_M();
if (!prt->drv_ptr->control)
return ERTS_PORT_OP_BADARG;
@@ -3756,6 +3878,8 @@ call_driver_control(Eterm caller,
command, size);
}
#endif
+
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
prt->caller = caller;
cres = prt->drv_ptr->control((ErlDrvData) prt->drv_data,
@@ -3766,6 +3890,8 @@ call_driver_control(Eterm caller,
*from_size);
prt->caller = NIL;
+ ERTS_MSACC_POP_STATE_M();
+
if (cres < 0)
return ERTS_PORT_OP_BADARG;
@@ -3817,7 +3943,6 @@ write_port_control_result(int control_flags,
ErlDrvSizeT resp_size,
char *pre_alloc_buf,
Eterm **hpp,
- ErlHeapFragment *bp,
ErlOffHeap *ohp)
{
Eterm res;
@@ -3891,16 +4016,13 @@ port_sig_control(Port *prt,
if (res == ERTS_PORT_OP_DONE) {
Eterm msg;
- Eterm *hp;
- ErlHeapFragment *bp;
- ErlOffHeap *ohp;
ErtsHeapFactory factory;
Process *rp;
ErtsProcLocks rp_locks = 0;
Uint hsz, rsz;
int control_flags;
- rp = erts_proc_lookup_raw(sigdp->caller);
+ rp = sigdp->caller == ERTS_INVALID_PID ? NULL : erts_proc_lookup_raw(sigdp->caller);
if (!rp)
goto done;
@@ -3913,22 +4035,15 @@ port_sig_control(Port *prt,
hsz = rsz + ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
- erts_factory_message_init(&factory, rp, hp, bp);
+ (void) erts_factory_message_create(&factory, rp,
+ &rp_locks, hsz);
msg = write_port_control_result(control_flags,
resp_bufp,
resp_size,
&resp_buf[0],
- &hp,
- bp,
- ohp);
- factory.hp = hp;
-
+ &factory.hp,
+ factory.off_heap);
queue_port_sched_op_reply(rp,
&rp_locks,
&factory,
@@ -3943,7 +4058,8 @@ port_sig_control(Port *prt,
/* failure */
- port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg);
+ if (sigdp->caller != ERTS_INVALID_PID)
+ port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg);
done:
@@ -3953,6 +4069,23 @@ done:
return ERTS_PORT_REDS_CONTROL;
}
+/*
+ * This is an asynchronous control call. I.e. it will not return anything
+ * to the caller.
+ */
+int
+erl_drv_port_control(Eterm port_num, char cmd, char* buff, ErlDrvSizeT size)
+{
+ ErtsProc2PortSigData *sigdp = erts_port_task_alloc_p2p_sig_data();
+
+ sigdp->flags = ERTS_P2P_SIG_TYPE_CONTROL | ERTS_P2P_SIG_DATA_FLG_REPLY;
+ sigdp->u.control.binp = NULL;
+ sigdp->u.control.command = cmd;
+ sigdp->u.control.bufp = buff;
+ sigdp->u.control.size = size;
+
+ return erts_schedule_port2port_signal(port_num, sigdp, 0, port_sig_control);
+}
ErtsPortOpResult
erts_port_control(Process* c_p,
@@ -4069,7 +4202,6 @@ erts_port_control(Process* c_p,
resp_size,
&resp_buf[0],
&hp,
- NULL,
&c_p->off_heap);
BUMP_REDS(c_p, ERTS_PORT_REDS_CONTROL);
return ERTS_PORT_OP_DONE;
@@ -4091,10 +4223,10 @@ erts_port_control(Process* c_p,
binp = NULL;
if (is_binary(data) && binary_bitoffset(data) == 0) {
- Eterm *ebinp = binary_val_rel(data, NULL);
+ Eterm *ebinp = binary_val(data);
ASSERT(!tmp_alloced);
if (*ebinp == HEADER_SUB_BIN)
- ebinp = binary_val_rel(((ErlSubBin *) ebinp)->orig, NULL);
+ ebinp = binary_val(((ErlSubBin *) ebinp)->orig);
if (*ebinp != HEADER_PROC_BIN)
copy = 1;
else {
@@ -4147,6 +4279,7 @@ call_driver_call(Eterm caller,
unsigned *ret_flagsp)
{
ErlDrvSSizeT cres;
+ ERTS_MSACC_PUSH_STATE_M();
if (!prt->drv_ptr->call)
return ERTS_PORT_OP_BADARG;
@@ -4162,6 +4295,8 @@ call_driver_call(Eterm caller,
}
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
+
prt->caller = caller;
cres = prt->drv_ptr->call((ErlDrvData) prt->drv_data,
command,
@@ -4172,6 +4307,8 @@ call_driver_call(Eterm caller,
ret_flagsp);
prt->caller = NIL;
+ ERTS_MSACC_POP_STATE_M();
+
if (cres <= 0
|| ((byte) (*resp_bufp)[0]) != VERSION_MAGIC)
return ERTS_PORT_OP_BADARG;
@@ -4228,21 +4365,14 @@ port_sig_call(Port *prt,
hsz = erts_decode_ext_size((byte *) resp_bufp, resp_size);
if (hsz >= 0) {
- ErlHeapFragment* bp;
- ErlOffHeap* ohp;
ErtsHeapFactory factory;
byte *endp;
hsz += 3; /* ok tuple */
hsz += ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE;
- hp = erts_alloc_message_heap(hsz,
- &bp,
- &ohp,
- rp,
- &rp_locks);
+ (void) erts_factory_message_create(&factory, rp, &rp_locks, hsz);
endp = (byte *) resp_bufp;
- erts_factory_message_init(&factory, rp, hp, bp);
msg = erts_decode_ext(&factory, &endp);
if (is_value(msg)) {
hp = erts_produce_heap(&factory,
@@ -4503,7 +4633,9 @@ port_sig_info(Port *prt,
sigdp->u.info.item);
if (is_value(value)) {
ErtsHeapFactory factory;
- erts_factory_message_init(&factory, NULL, hp, bp);
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_factory_selfcontained_message_init(&factory, mp, hp);
queue_port_sched_op_reply(rp,
&rp_locks,
&factory,
@@ -4591,8 +4723,8 @@ reply_io_bytes(void *vreq)
rp = erts_proc_lookup(req->pid);
if (rp) {
- ErlOffHeap *ohp = NULL;
- ErlHeapFragment *bp = NULL;
+ ErlOffHeap *ohp;
+ ErtsMessage *mp;
ErtsProcLocks rp_locks;
Eterm ref, msg, ein, eout, *hp;
Uint64 in, out;
@@ -4614,7 +4746,7 @@ reply_io_bytes(void *vreq)
erts_bld_uint64(NULL, &hsz, in);
erts_bld_uint64(NULL, &hsz, out);
- hp = erts_alloc_message_heap(hsz, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp);
ref = make_internal_ref(hp);
write_ref_thing(hp, req->refn[0], req->refn[1], req->refn[2]);
@@ -4624,7 +4756,7 @@ reply_io_bytes(void *vreq)
eout = erts_bld_uint64(&hp, NULL, out);
msg = TUPLE4(hp, ref, make_small(sched_id), ein, eout);
- erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+ erts_queue_message(rp, &rp_locks, mp, msg, NIL);
if (req->sched_id == sched_id)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -4730,6 +4862,10 @@ print_port_info(Port *p, int to, void *arg)
erts_print(to, arg, "Port is a file: %s\n",p->name);
} else if (p->drv_ptr == &spawn_driver) {
erts_print(to, arg, "Port controls external process: %s\n",p->name);
+#ifndef __WIN32__
+ } else if (p->drv_ptr == &forker_driver) {
+ erts_print(to, arg, "Port controls forker process: %s\n",p->name);
+#endif
} else {
erts_print(to, arg, "Port controls linked-in driver: %s\n",p->name);
}
@@ -4876,12 +5012,13 @@ int get_port_flags(ErlDrvPort ix)
void erts_raw_port_command(Port* p, byte* buf, Uint len)
{
int fpe_was_unmasked;
+ ERTS_MSACC_PUSH_STATE_M();
ERTS_SMP_CHK_NO_PROC_LOCKS;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
if (len > (Uint) INT_MAX)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Absurdly large data buffer (%beu bytes) passed to"
"output callback of %s driver.\n",
len,
@@ -4896,9 +5033,11 @@ void erts_raw_port_command(Port* p, byte* buf, Uint len)
DTRACE4(driver_output, "-raw-", port_str, p->name, len);
}
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
fpe_was_unmasked = erts_block_fpe();
(*p->drv_ptr->output)((ErlDrvData)p->drv_data, (char*) buf, (int) len);
erts_unblock_fpe(fpe_was_unmasked);
+ ERTS_MSACC_POP_STATE_M();
}
int async_ready(Port *p, void* data)
@@ -4910,6 +5049,7 @@ int async_ready(Port *p, void* data)
if (p) {
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
if (p->drv_ptr->ready_async != NULL) {
+ ERTS_MSACC_PUSH_AND_SET_STATE_M(ERTS_MSACC_STATE_PORT);
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_ready_async)) {
DTRACE_FORMAT_COMMON_PID_AND_PORT(ERTS_PORT_GET_CONNECTED(p), p)
@@ -4918,6 +5058,7 @@ int async_ready(Port *p, void* data)
#endif
(*p->drv_ptr->ready_async)((ErlDrvData)p->drv_data, data);
need_free = 0;
+ ERTS_MSACC_POP_STATE_M();
}
erts_port_driver_callback_epilogue(p, NULL);
@@ -5069,11 +5210,11 @@ ErlDrvTermData driver_mk_term_nil(void)
void driver_report_exit(ErlDrvPort ix, int status)
{
Eterm* hp;
+ ErlOffHeap *ohp;
Eterm tuple;
Process *rp;
Eterm pid;
- ErlHeapFragment *bp = NULL;
- ErlOffHeap *ohp;
+ ErtsMessage *mp;
ErtsProcLocks rp_locks = 0;
int scheduler = erts_get_scheduler_id() != 0;
Port* prt = erts_drvport2port(ix);
@@ -5093,13 +5234,13 @@ void driver_report_exit(ErlDrvPort ix, int status)
if (!rp)
return;
- hp = erts_alloc_message_heap(3+3, &bp, &ohp, rp, &rp_locks);
+ mp = erts_alloc_message_heap(rp, &rp_locks, 3+3, &hp, &ohp);
tuple = TUPLE2(hp, am_exit_status, make_small(status));
hp += 3;
tuple = TUPLE2(hp, prt->common.id, tuple);
- erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+ erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined);
erts_smp_proc_unlock(rp, rp_locks);
if (!scheduler)
@@ -5209,7 +5350,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
ErtsProcLocks rp_locks = 0;
struct b2t_states__ b2t;
int scheduler;
- int is_heap_need_limited = 1;
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ERTS_UNDEF(mess,NIL);
@@ -5248,25 +5388,17 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
break;
case ERL_DRV_INT: /* signed int argument */
ERTS_DDT_CHK_ENOUGH_ARGS(1);
-#if HALFWORD_HEAP
- erts_bld_sint64(NULL, &need, (Sint64)ptr[0]);
-#else
/* check for bignum */
if (!IS_SSMALL((Sint)ptr[0]))
need += BIG_UINT_HEAP_SIZE; /* use small_to_big */
-#endif
ptr++;
depth++;
break;
case ERL_DRV_UINT: /* unsigned int argument */
ERTS_DDT_CHK_ENOUGH_ARGS(1);
-#if HALFWORD_HEAP
- erts_bld_uint64(NULL, &need, (Uint64)ptr[0]);
-#else
/* check for bignum */
if (!IS_USMALL(0, (Uint)ptr[0]))
need += BIG_UINT_HEAP_SIZE; /* use small_to_big */
-#endif
ptr++;
depth++;
break;
@@ -5386,9 +5518,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
need += hsz;
ptr += 2;
depth++;
- if (size > MAP_SMALL_MAP_LIMIT*3) { /* may contain big map */
- is_heap_need_limited = 0;
- }
break;
}
case ERL_DRV_MAP: { /* int */
@@ -5396,7 +5525,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
if ((int) ptr[0] < 0) ERTS_DDT_FAIL;
if (ptr[0] > MAP_SMALL_MAP_LIMIT) {
need += HASHMAP_ESTIMATED_HEAP_SIZE(ptr[0]);
- is_heap_need_limited = 0;
} else {
need += MAP_HEADER_FLATMAP_SZ + 1 + 2*ptr[0];
}
@@ -5435,17 +5563,7 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
goto done;
}
- /* Try copy directly to destination heap if we know there are no big maps */
- if (is_heap_need_limited) {
- ErlOffHeap *ohp;
- ErlHeapFragment* bp;
- Eterm* hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks);
- erts_factory_message_init(&factory, rp, hp, bp);
- }
- else {
- erts_factory_message_init(&factory, NULL, NULL,
- new_message_buffer(need));
- }
+ (void) erts_factory_message_create(&factory, rp, &rp_locks, need);
/*
* Interpret the instructions and build the term.
@@ -5465,10 +5583,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
break;
case ERL_DRV_INT: /* signed int argument */
-#if HALFWORD_HEAP
- erts_reserve_heap(&factory, BIG_NEED_SIZE(2));
- mess = erts_bld_sint64(&factory.hp, NULL, (Sint64)ptr[0]);
-#else
erts_reserve_heap(&factory, BIG_UINT_HEAP_SIZE);
if (IS_SSMALL((Sint)ptr[0]))
mess = make_small((Sint)ptr[0]);
@@ -5476,15 +5590,10 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
mess = small_to_big((Sint)ptr[0], factory.hp);
factory.hp += BIG_UINT_HEAP_SIZE;
}
-#endif
ptr++;
break;
case ERL_DRV_UINT: /* unsigned int argument */
-#if HALFWORD_HEAP
- erts_reserve_heap(&factory, BIG_NEED_FOR_BITS(64));
- mess = erts_bld_uint64(&factory.hp, NULL, (Uint64)ptr[0]);
-#else
erts_reserve_heap(&factory, BIG_UINT_HEAP_SIZE);
if (IS_USMALL(0, (Uint)ptr[0]))
mess = make_small((Uint)ptr[0]);
@@ -5492,7 +5601,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
mess = uint_to_big((Uint)ptr[0], factory.hp);
factory.hp += BIG_UINT_HEAP_SIZE;
}
-#endif
ptr++;
break;
@@ -5724,9 +5832,9 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
if (res > 0) {
mess = ESTACK_POP(stack); /* get resulting value */
- erts_factory_close(&factory);
+ erts_factory_trim_and_close(&factory, &mess, 1);
/* send message */
- erts_queue_message(rp, &rp_locks, factory.heap_frags, mess, am_undefined);
+ erts_queue_message(rp, &rp_locks, factory.message, mess, am_undefined);
}
else {
if (b2t.ix > b2t.used)
@@ -6762,6 +6870,28 @@ driver_get_now(ErlDrvNowData *now_data)
return 0;
}
+ErlDrvTime
+erl_drv_monotonic_time(ErlDrvTimeUnit time_unit)
+{
+ return (ErlDrvTime) erts_napi_monotonic_time((int) time_unit);
+}
+
+ErlDrvTime
+erl_drv_time_offset(ErlDrvTimeUnit time_unit)
+{
+ return (ErlDrvTime) erts_napi_time_offset((int) time_unit);
+}
+
+ErlDrvTime
+erl_drv_convert_time_unit(ErlDrvTime val,
+ ErlDrvTimeUnit from,
+ ErlDrvTimeUnit to)
+{
+ return (ErlDrvTime) erts_napi_convert_time_unit((ErtsMonotonicTime) val,
+ (int) from,
+ (int) to);
+}
+
static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon)
{
RefThing *refp;
@@ -6809,7 +6939,7 @@ int driver_monitor_process(ErlDrvPort drvport,
{
Port *prt;
int ret;
-#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK))
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -6820,16 +6950,6 @@ int driver_monitor_process(ErlDrvPort drvport,
/* Now (in SMP) we should have either the port lock (if we have a scheduler) or the port data lock
(if we're a driver thread) */
ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock));
-
-#if !HEAP_ON_C_STACK
- if (!sched) {
- /* Need a separate allocation for the ref :( */
- Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM,
- sizeof(Eterm)*REF_THING_SIZE);
- ret = do_driver_monitor_process(prt,buf,process,monitor);
- erts_free(ERTS_ALC_T_TEMP_TERM,buf);
- } else
-#endif
{
DeclareTmpHeapNoproc(buf,REF_THING_SIZE);
UseTmpHeapNoproc(REF_THING_SIZE);
@@ -6882,7 +7002,7 @@ int driver_demonitor_process(ErlDrvPort drvport,
{
Port *prt;
int ret;
-#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK))
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -6893,15 +7013,6 @@ int driver_demonitor_process(ErlDrvPort drvport,
/* Now we should have either the port lock (if we have a scheduler) or the port data lock
(if we're a driver thread) */
ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock));
-#if !HEAP_ON_C_STACK
- if (!sched) {
- /* Need a separate allocation for the ref :( */
- Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM,
- sizeof(Eterm)*REF_THING_SIZE);
- ret = do_driver_demonitor_process(prt,buf,monitor);
- erts_free(ERTS_ALC_T_TEMP_TERM,buf);
- } else
-#endif
{
DeclareTmpHeapNoproc(buf,REF_THING_SIZE);
UseTmpHeapNoproc(REF_THING_SIZE);
@@ -6937,7 +7048,7 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport,
{
Port *prt;
ErlDrvTermData ret;
-#if !HEAP_ON_C_STACK || (defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK))
+#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK)
ErtsSchedulerData *sched = erts_get_scheduler_data();
#endif
@@ -6948,16 +7059,6 @@ ErlDrvTermData driver_get_monitored_process(ErlDrvPort drvport,
/* Now we should have either the port lock (if we have a scheduler) or the port data lock
(if we're a driver thread) */
ERTS_SMP_LC_ASSERT((sched != NULL || prt->port_data_lock));
-
-#if !HEAP_ON_C_STACK
- if (!sched) {
- /* Need a separate allocation for the ref :( */
- Eterm *buf = erts_alloc(ERTS_ALC_T_TEMP_TERM,
- sizeof(Eterm)*REF_THING_SIZE);
- ret = do_driver_get_monitored_process(prt,buf,monitor);
- erts_free(ERTS_ALC_T_TEMP_TERM,buf);
- } else
-#endif
{
DeclareTmpHeapNoproc(buf,REF_THING_SIZE);
UseTmpHeapNoproc(REF_THING_SIZE);
@@ -6981,6 +7082,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
void (*callback)(ErlDrvData drv_data, ErlDrvMonitor *monitor);
ErlDrvMonitor drv_monitor;
int fpe_was_unmasked;
+ ERTS_MSACC_PUSH_STATE_M();
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
ASSERT(prt->drv_ptr != NULL);
@@ -6992,6 +7094,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
callback = prt->drv_ptr->process_exit;
ASSERT(callback != NULL);
ref_to_driver_monitor(ref,&drv_monitor);
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
DRV_MONITOR_UNLOCK_PDL(prt);
#ifdef USE_VM_PROBES
if (DTRACE_ENABLED(driver_process_exit)) {
@@ -7003,6 +7106,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
(*callback)((ErlDrvData) (prt->drv_data), &drv_monitor);
erts_unblock_fpe(fpe_was_unmasked);
DRV_MONITOR_LOCK_PDL(prt);
+ ERTS_MSACC_POP_STATE_M();
/* remove monitor *after* callback */
rmon = erts_remove_monitor(&ERTS_P_MONITORS(prt), ref);
DRV_MONITOR_UNLOCK_PDL(prt);
@@ -7023,6 +7127,9 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof)
if (prt == ERTS_INVALID_ERL_DRV_PORT)
return -1;
ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt));
+
+ if (prt->async_open_port)
+ init_ack_send_reply(prt, prt->common.id);
if (eof)
flush_linebuf_messages(prt, state);
if (state & ERTS_PORT_SFLG_CLOSING) {
@@ -7289,7 +7396,7 @@ driver_system_info(ErlDrvSysInfo *sip, size_t si_size)
* of ErlDrvSysInfo (introduced in driver version 1.0).
*/
if (!sip || si_size < ERL_DRV_SYS_INFO_SIZE(smp_support))
- erl_exit(1,
+ erts_exit(ERTS_ERROR_EXIT,
"driver_system_info(%p, %ld) called with invalid arguments\n",
sip, si_size);
@@ -7596,15 +7703,15 @@ int null_func(void)
}
int
-erl_drv_putenv(char *key, char *value)
+erl_drv_putenv(const char *key, char *value)
{
- return erts_sys_putenv_raw(key, value);
+ return erts_sys_putenv_raw((char*)key, value);
}
int
-erl_drv_getenv(char *key, char *value, size_t *value_size)
+erl_drv_getenv(const char *key, char *value, size_t *value_size)
{
- return erts_sys_getenv_raw(key, value, value_size);
+ return erts_sys_getenv_raw((char*)key, value, value_size);
}
/* get heart_port
diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c
index 86dd3b5aac..f5c7b177d3 100644
--- a/erts/emulator/beam/module.c
+++ b/erts/emulator/beam/module.c
@@ -74,8 +74,8 @@ static Module* module_alloc(Module* tmpl)
erts_smp_atomic_add_nob(&tot_module_bytes, sizeof(Module));
obj->module = tmpl->module;
- obj->curr.code = 0;
- obj->old.code = 0;
+ obj->curr.code_hdr = 0;
+ obj->old.code_hdr = 0;
obj->curr.code_length = 0;
obj->old.code_length = 0;
obj->slot.index = -1;
@@ -103,6 +103,9 @@ void init_module_table(void)
f.cmp = (HCMP_FUN) module_cmp;
f.alloc = (HALLOC_FUN) module_alloc;
f.free = (HFREE_FUN) module_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
for (i = 0; i < ERTS_NUM_CODE_IX; i++) {
erts_index_init(ERTS_ALC_T_MODULE_TABLE, &module_tables[i], "module_code",
diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h
index c8a6351b04..b7468b0926 100644
--- a/erts/emulator/beam/module.h
+++ b/erts/emulator/beam/module.h
@@ -26,7 +26,7 @@
#endif
struct erl_module_instance {
- BeamInstr* code;
+ BeamCodeHeader* code_hdr;
int code_length; /* Length of loaded code in bytes. */
unsigned catches;
struct erl_module_nif* nif;
@@ -37,6 +37,7 @@ struct erl_module_instance {
typedef struct erl_module {
IndexSlot slot; /* Must be located at top of struct! */
int module; /* Atom index for module (not tagged). */
+ int seen; /* Used by finish_loading() */
struct erl_module_instance curr;
struct erl_module_instance old; /* protected by "old_code" rwlock */
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 1d32e72247..9e53b4bfcc 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -39,8 +39,8 @@ too_old_compiler | never() =>
# necessary.) Since the instructions don't work correctly in R12B, simply
# refuse to load the module.
-func_info M=a a==am_module_info A=u==0 | label L | move n r => too_old_compiler
-func_info M=a a==am_module_info A=u==1 | label L | move n r => too_old_compiler
+func_info M=a a==am_module_info A=u==0 | label L | move n x==0 => too_old_compiler
+func_info M=a a==am_module_info A=u==1 | label L | move n x==0 => too_old_compiler
# The undocumented and unsupported guard BIF is_constant/1 was removed
# in R13. The is_constant/2 operation is marked as obsolete in genop.tab,
@@ -76,17 +76,6 @@ return
# with the following call instruction, we need to make sure that
# there is no line/1 instruction between the move and the call.
#
-
-move S r | line Loc | call_ext Ar Func => \
- line Loc | move S r | call_ext Ar Func
-move S r | line Loc | call_ext_last Ar Func=u$is_bif D => \
- line Loc | move S r | call_ext_last Ar Func D
-move S r | line Loc | call_ext_only Ar Func=u$is_bif => \
- line Loc | move S r | call_ext_only Ar Func
-move S r | line Loc | call Ar Func => \
- line Loc | move S r | call Ar Func
-
-#
# A tail-recursive call to an external function (non-BIF) will
# never be saved on the stack, so there is no reason to keep
# the line instruction. (The compiler did not remove the line
@@ -94,10 +83,14 @@ move S r | line Loc | call Ar Func => \
# BIFs and ordinary Erlang functions.)
#
-line Loc | call_ext_last Ar Func=u$is_not_bif D => \
- call_ext_last Ar Func D
-line Loc | call_ext_only Ar Func=u$is_not_bif => \
- call_ext_only Ar Func
+move S X0=x==0 | line Loc | call_ext Ar Func => \
+ line Loc | move S X0 | call_ext Ar Func
+move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_not_bif D => \
+ move S X0 | call_ext_last Ar Func D
+move S X0=x==0 | line Loc | call_ext_only Ar Func=u$is_not_bif => \
+ move S X0 | call_ext_only Ar Func
+move S X0=x==0 | line Loc | call Ar Func => \
+ line Loc | move S X0 | call Ar Func
line Loc | func_info M F A => func_info M F A | line Loc
@@ -167,31 +160,24 @@ is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \
select_tuple_arity S=d Fail=f Size=u Rest=* => \
gen_select_tuple_arity(S, Fail, Size, Rest)
-i_select_val_bins r f I
i_select_val_bins x f I
i_select_val_bins y f I
-i_select_val_lins r f I
i_select_val_lins x f I
i_select_val_lins y f I
-i_select_val2 r f c c f f
i_select_val2 x f c c f f
i_select_val2 y f c c f f
-i_select_tuple_arity r f I
i_select_tuple_arity x f I
i_select_tuple_arity y f I
-i_select_tuple_arity2 r f A A f f
i_select_tuple_arity2 x f A A f f
i_select_tuple_arity2 y f A A f f
-i_jump_on_val_zero r f I
i_jump_on_val_zero x f I
i_jump_on_val_zero y f I
-i_jump_on_val r f I I
i_jump_on_val x f I I
i_jump_on_val y f I I
@@ -203,30 +189,21 @@ is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \
%macro: get_list GetList -pack
get_list x x x
get_list x x y
-get_list x x r
get_list x y x
get_list x y y
-get_list x y r
-get_list x r x
-get_list x r y
get_list y x x
get_list y x y
-get_list y x r
get_list y y x
get_list y y y
-get_list y y r
-get_list y r x
-get_list y r y
+# The following get_list instructions using x(0) are frequently used.
get_list r x x
+get_list r r y
+get_list x r x
get_list r x y
-get_list r x r
-get_list r y x
-get_list r y y
get_list r y r
-get_list r r x
-get_list r r y
+get_list r x r
# Old-style catch.
catch y f
@@ -237,33 +214,31 @@ try Y F => catch Y F
try_case Y => try_end Y
try_end y
-try_case_end Literal=q => move Literal x | try_case_end x
try_case_end s
# Destructive set tuple element
-set_tuple_element Lit=q Tuple Pos => move Lit x | set_tuple_element x Tuple Pos
set_tuple_element s d P
# Get tuple element
%macro: i_get_tuple_element GetTupleElement -pack
i_get_tuple_element x P x
-i_get_tuple_element r P x
i_get_tuple_element y P x
-i_get_tuple_element x P r
-i_get_tuple_element y P r
%cold
-i_get_tuple_element r P r
i_get_tuple_element x P y
-i_get_tuple_element r P y
i_get_tuple_element y P y
%hot
+%macro: i_get_tuple_element2 GetTupleElement2 -pack
+i_get_tuple_element2 x P x
+
+%macro: i_get_tuple_element3 GetTupleElement3 -pack
+i_get_tuple_element3 x P x
+
%macro: is_number IsNumber -fail_action
%cold
-is_number f r
is_number f x
is_number f y
%hot
@@ -273,16 +248,12 @@ is_number Fail Literal=q => move Literal x | is_number Fail x
jump f
-case_end Literal=cq => move Literal x | case_end x
-badmatch Literal=cq => move Literal x | badmatch x
+case_end NotInX=cy => move NotInX x | case_end x
+badmatch NotInX=cy => move NotInX x | badmatch x
-case_end r
case_end x
-case_end y
-badmatch r
badmatch x
-badmatch y
if_end
raise s s
@@ -291,7 +262,7 @@ raise s s
badarg j
system_limit j
-move C=cxy r | jump Lbl => move_jump Lbl C
+move C=cxy x==0 | jump Lbl => move_jump Lbl C
%macro: move_jump MoveJump -nonext
move_jump f n
@@ -309,8 +280,6 @@ move_window/6
# x -> y
-move S1=r S2=y | move X1=x Y1=y => move2 S1 S2 X1 Y1
-
move X1=x Y1=y | move X2=x Y2=y | move X3=x Y3=y | succ(Y1,Y2) | succ(Y2,Y3) => \
move_window X1 X2 X3 Y1 Y3
@@ -323,24 +292,76 @@ move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \
move_window X1=x X2=x X3=x Y1=y Y3=y => move_window3 X1 X2 X3 Y1
move_window X1=x X2=x X3=x X4=x Y1=y Y4=y => move_window4 X1 X2 X3 X4 Y1
+%macro: move_window3 MoveWindow3 -pack
+%macro: move_window4 MoveWindow4 -pack
+%macro: move_window5 MoveWindow5 -pack
+
move_window3 x x x y
move_window4 x x x x y
move_window5 x x x x x y
-move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2
-move Y1=y X1=x | move Y2=y X2=x => move2 Y1 X1 Y2 X2
-move X1=x X2=x | move X3=x X4=x => move2 X1 X2 X3 X4
+# Swap registers.
+move R1=x Tmp=x | move R2=xy R1 | move Tmp R2 => swap_temp R1 R2 Tmp
+
+swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed(Tmp, Live) => \
+ swap R1 R2 | line Loc | apply Live
+
+swap_temp R1 R2 Tmp | line Loc | call Live Addr | is_killed(Tmp, Live) => \
+ swap R1 R2 | line Loc | call Live Addr
+swap_temp R1 R2 Tmp | call_only Live Addr | \
+ is_killed(Tmp, Live) => swap R1 R2 | call_only Live Addr
+swap_temp R1 R2 Tmp | call_last Live Addr D | \
+ is_killed(Tmp, Live) => swap R1 R2 | call_last Live Addr D
-move S1=x S2=r | move S3=x S4=x => move2 S1 S2 S3 S4
-move S1=x S2=r | move X1=x Y1=y => move2 S1 S2 X1 Y1
-move S1=y S2=r | move X1=x Y1=y => move2 S1 S2 X1 Y1
+swap_temp R1 R2 Tmp | line Loc | call_ext Live Addr | is_killed(Tmp, Live) => \
+ swap R1 R2 | line Loc | call_ext Live Addr
+swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \
+ is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_only Live Addr
+swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \
+ is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D
-move Y1=y X1=x | move S1=r D1=x => move2 Y1 X1 S1 D1
-move S1=r D1=x | move Y1=y X1=x => move2 S1 D1 Y1 X1
+%macro: swap_temp SwapTemp -pack
+swap_temp x x x
+swap_temp x y x
-move2 X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3
-move2 Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3
-move2 X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6
+%macro: swap Swap -pack
+swap x x
+swap x y
+
+move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2
+move Src=x SD=x | move SD=x D=x => move_dup Src SD D
+move Src=x D1=x | move Src=x D2=y => move_dup Src D1 D2
+move Src=y SD=x | move SD=x D=y => move_dup Src SD D
+move Src=x SD=x | move SD=x D=y => move_dup Src SD D
+move Src=y SD=x | move SD=x D=x => move_dup Src SD D
+
+move SD=x D=x | move Src=xy SD=x => move_shift Src SD D
+move SD=y D=x | move Src=x SD=y => move_shift Src SD D
+move SD=x D=y | move Src=x SD=x => move_shift Src SD D
+
+# The transformations above guarantee that the source for
+# the second move is not the same as the destination for
+# the first move. That means that we can do the moves in
+# parallel (fetch both values, then store them) which could
+# be faster.
+
+move X1=x Y1=y | move X2=x Y2=y => move2_par X1 Y1 X2 Y2
+move Y1=y X1=x | move Y2=y X2=x => move2_par Y1 X1 Y2 X2
+
+move X1=x X2=x | move X3=x X4=x => move2_par X1 X2 X3 X4
+
+move X1=x X2=x | move X3=x Y1=y => move2_par X1 X2 X3 Y1
+
+move S1=x S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1
+
+move S1=y S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1
+
+move Y1=y X1=x | move S1=x D1=x => move2_par Y1 X1 S1 D1
+move S1=x D1=x | move Y1=y X1=x => move2_par S1 D1 Y1 X1
+
+move2_par X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3
+move2_par Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3
+move2_par X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6
move C=aiq X=x==1 => move_x1 C
move C=aiq X=x==2 => move_x2 C
@@ -348,21 +369,32 @@ move C=aiq X=x==2 => move_x2 C
move_x1 c
move_x2 c
-%macro: move2 Move2 -pack
-move2 x y x y
-move2 y x y x
-move2 x x x x
+%macro: move_shift MoveShift -pack
+move_shift x x x
+move_shift y x x
+move_shift x y x
+move_shift x x y
+
+%macro: move_dup MoveDup -pack
+move_dup x x x
+move_dup x x y
+move_dup y x x
+move_dup y x y
-move2 x r x x
+%macro: move2_par Move2Par -pack
-move2 x r x y
-move2 r y x y
-move2 y r x y
+move2_par x y x y
+move2_par y x y x
+move2_par x x x x
-move2 r x y x
-move2 y x r x
+move2_par x x x y
-%macro: move3 Move3
+move2_par y x x y
+
+move2_par x x y x
+move2_par y x x x
+
+%macro: move3 Move3 -pack
move3 x y x y x y
move3 y x y x y x
move3 x x x x x x
@@ -375,20 +407,22 @@ move S=c D=y => move S x | move x D
%macro:move Move -pack -gen_dest
move x x
move x y
-move x r
move y x
-move y r
-move r x
-move r y
-move c r
move c x
move n x
-move n r
move y y
+# The following move instructions using x(0) are frequently used.
+
+move x r
+move r x
+move y r
+move c r
+move r y
+
# Receive operations.
-loop_rec Fail Src | smp_mark_target_label(Fail) => i_loop_rec Fail Src
+loop_rec Fail x==0 | smp_mark_target_label(Fail) => i_loop_rec Fail
label L | wait_timeout Fail Src | smp_already_locked(L) => label L | i_wait_timeout_locked Fail Src
wait_timeout Fail Src => i_wait_timeout Fail Src
@@ -403,7 +437,7 @@ label L | timeout | smp_already_locked(L) => label L | timeout_locked
remove_message
timeout
timeout_locked
-i_loop_rec f r
+i_loop_rec f
loop_rec_end f
wait f
wait_locked f
@@ -421,93 +455,57 @@ send
# Optimized comparisons with one immediate/literal operand.
#
-is_eq_exact Lbl R=rxy C=ian => i_is_eq_exact_immed Lbl R C
-is_eq_exact Lbl R=rxy C=q => i_is_eq_exact_literal R Lbl C
+is_eq_exact Lbl R=xy C=ian => i_is_eq_exact_immed Lbl R C
+is_eq_exact Lbl R=xy C=q => i_is_eq_exact_literal Lbl R C
-is_ne_exact Lbl R=rxy C=ian => i_is_ne_exact_immed Lbl R C
-is_ne_exact Lbl R=rxy C=q => i_is_ne_exact_literal R Lbl C
+is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C
+is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C
%macro: i_is_eq_exact_immed EqualImmed -fail_action
i_is_eq_exact_immed f r c
i_is_eq_exact_immed f x c
i_is_eq_exact_immed f y c
-i_is_eq_exact_literal r f c
-i_is_eq_exact_literal x f c
-i_is_eq_exact_literal y f c
+i_is_eq_exact_literal f x c
+i_is_eq_exact_literal f y c
%macro: i_is_ne_exact_immed NotEqualImmed -fail_action
-i_is_ne_exact_immed f r c
i_is_ne_exact_immed f x c
i_is_ne_exact_immed f y c
-i_is_ne_exact_literal r f c
-i_is_ne_exact_literal x f c
-i_is_ne_exact_literal y f c
+i_is_ne_exact_literal f x c
+i_is_ne_exact_literal f y c
-#
-# Common Compare Specializations
-# We don't do all of them since we want
-# to keep the instruction set small-ish
-#
-
-is_eq_exact Lbl S1=xy S2=r => is_eq_exact Lbl S2 S1
-is_eq_exact Lbl S1=rx S2=xy => i_is_eq_exact_spec Lbl S1 S2
-%macro: i_is_eq_exact_spec EqualExact -fail_action
+is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y
+%macro: is_eq_exact EqualExact -fail_action -pack
+is_eq_exact f x x
+is_eq_exact f x y
+is_eq_exact f s s
-i_is_eq_exact_spec f x x
-i_is_eq_exact_spec f x y
-i_is_eq_exact_spec f r x
-i_is_eq_exact_spec f r y
+%macro: is_lt IsLessThan -fail_action
+is_lt f x x
+is_lt f x c
+is_lt f c x
%cold
-i_is_eq_exact_spec f r r
+is_lt f s s
%hot
-is_lt Lbl S1=rxc S2=rxc => i_is_lt_spec Lbl S1 S2
-
-%macro: i_is_lt_spec IsLessThan -fail_action
-
-i_is_lt_spec f x x
-i_is_lt_spec f x r
-i_is_lt_spec f x c
-i_is_lt_spec f r x
-i_is_lt_spec f r c
-i_is_lt_spec f c x
-i_is_lt_spec f c r
+%macro: is_ge IsGreaterEqual -fail_action
+is_ge f x x
+is_ge f x c
+is_ge f c x
%cold
-i_is_lt_spec f r r
-i_is_lt_spec f c c
+is_ge f s s
%hot
-is_ge Lbl S1=xc S2=xc => i_is_ge_spec Lbl S1 S2
-
-%macro: i_is_ge_spec IsGreaterEqual -fail_action
-
-i_is_ge_spec f x x
-i_is_ge_spec f x c
-i_is_ge_spec f c x
-%cold
-i_is_ge_spec f c c
-%hot
-
-#
-# All other comparisons.
-#
-
-is_eq_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl
-is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl
+%macro: is_ne_exact NotEqualExact -fail_action
+is_ne_exact f s s
-is_lt Lbl S1 S2 => i_fetch S1 S2 | i_is_lt Lbl
-is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl
-is_eq Lbl S1 S2 => i_fetch S1 S2 | i_is_eq Lbl
-is_ne Lbl S1 S2 => i_fetch S1 S2 | i_is_ne Lbl
+%macro: is_eq Equal -fail_action
+is_eq f s s
-i_is_eq_exact f
-i_is_ne_exact f
-i_is_lt f
-i_is_ge f
-i_is_eq f
-i_is_ne f
+%macro: is_ne NotEqual -fail_action
+is_ne f s s
#
# Putting things.
@@ -525,7 +523,6 @@ i_put_tuple Dst Arity Puts=* | put S => \
i_put_tuple/2
%macro:i_put_tuple PutTuple -pack -goto:do_put_tuple
-i_put_tuple r I
i_put_tuple x I
i_put_tuple y I
@@ -542,74 +539,36 @@ put_list x n x
put_list y n x
put_list x x x
put_list y x x
-put_list x x r
-put_list y r r
put_list y y x
put_list x y x
-put_list r x x
-put_list r y x
-put_list r x r
-put_list y y r
-put_list y r x
-put_list r n x
-put_list x r x
-put_list x y r
-put_list y x r
put_list y x x
-put_list x r r
-
# put_list SrcReg Constant Dst
-put_list r c r
-put_list r c x
-put_list r c y
-put_list x c r
put_list x c x
put_list x c y
-put_list y c r
put_list y c x
-put_list y c y
# put_list Constant SrcReg Dst
-put_list c r r
-put_list c r x
-put_list c r y
-put_list c x r
put_list c x x
-put_list c x y
-
-put_list c y r
put_list c y x
-put_list c y y
-%cold
-put_list s s d
-%hot
+# The following put_list instructions using x(0) are frequently used.
-%macro: i_fetch FetchArgs -pack
-i_fetch c r
-i_fetch c x
-i_fetch c y
-i_fetch r c
-i_fetch r x
-i_fetch r y
-i_fetch x c
-i_fetch x r
-i_fetch x x
-i_fetch x y
-i_fetch y c
-i_fetch y r
-i_fetch y x
-i_fetch y y
+put_list y r r
+put_list x r r
+put_list r n r
+put_list r n x
+put_list r x x
+put_list r x r
+put_list x x r
%cold
-i_fetch c c
-i_fetch s s
+put_list s s d
%hot
#
@@ -631,27 +590,27 @@ return_trace
# Note: There is no 'move_return y r', since there never are any y registers
# when we do move_return (if we have y registers, we must do move_deallocate_return).
-move S r | return => move_return S r
+move S x==0 | return => move_return S
%macro: move_return MoveReturn -nonext
-move_return x r
-move_return c r
-move_return n r
+move_return x
+move_return c
+move_return n
-move S r | deallocate D | return => move_deallocate_return S r D
+move S x==0 | deallocate D | return => move_deallocate_return S D
%macro: move_deallocate_return MoveDeallocateReturn -pack -nonext
-move_deallocate_return x r Q
-move_deallocate_return y r Q
-move_deallocate_return c r Q
-move_deallocate_return n r Q
+move_deallocate_return x Q
+move_deallocate_return y Q
+move_deallocate_return c Q
+move_deallocate_return n Q
deallocate D | return => deallocate_return D
%macro: deallocate_return DeallocateReturn -nonext
deallocate_return Q
-test_heap Need u==1 | put_list Y=y r r => test_heap_1_put_list Need Y
+test_heap Need u==1 | put_list Y=y x==0 x==0 => test_heap_1_put_list Need Y
%macro: test_heap_1_put_list TestHeapPutList -pack
test_heap_1_put_list I y
@@ -660,18 +619,18 @@ test_heap_1_put_list I y
is_tuple Fail Literal=q => move Literal x | is_tuple Fail x
is_tuple Fail=f c => jump Fail
-is_tuple Fail=f S=rxy | test_arity Fail=f S=rxy Arity => is_tuple_of_arity Fail S Arity
+is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S Arity
%macro:is_tuple_of_arity IsTupleOfArity -fail_action
+is_tuple_of_arity f r A
is_tuple_of_arity f x A
is_tuple_of_arity f y A
-is_tuple_of_arity f r A
%macro: is_tuple IsTuple -fail_action
+is_tuple f r
is_tuple f x
is_tuple f y
-is_tuple f r
test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity
test_arity Fail=f c Arity => jump Fail
@@ -679,95 +638,63 @@ test_arity Fail=f c Arity => jump Fail
%macro: test_arity IsArity -fail_action
test_arity f x A
test_arity f y A
-test_arity f r A
-
-is_tuple_of_arity Fail=f Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \
- is_tuple_of_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P
-
-test_arity Fail Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \
- test_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P
-
-original_reg Reg P1 | get_tuple_element Reg P2 Dst=xy | succ(P1, P2) => \
- extract_next_element Dst | original_reg Reg P2
-
-get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg P
-
-original_reg Reg Pos =>
-original_reg/2
+get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
+ get_tuple_element Reg=x P3 D3=x | \
+ succ(P1, P2) | succ(P2, P3) | \
+ succ(D1, D2) | succ(D2, D3) => i_get_tuple_element3 Reg P1 D1
-extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
-succ(P1, P2) | succ(D1, D2) => \
- extract_next_element2 D1 | original_reg Reg P2
+get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
+ succ(P1, P2) | succ(D1, D2) => i_get_tuple_element2 Reg P1 D1
-extract_next_element2 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
-succ(P1, P2) | succ2(D1, D2) => \
- extract_next_element3 D1 | original_reg Reg P2
-
-#extract_next_element3 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \
-#succ(P1, P2) | succ3(D1, D2) => \
-# extract_next_element4 D1 | original_reg Reg P2
-
-%macro: extract_next_element ExtractNextElement -pack
-extract_next_element x
-extract_next_element y
-
-%macro: extract_next_element2 ExtractNextElement2 -pack
-extract_next_element2 x
-extract_next_element2 y
-
-%macro: extract_next_element3 ExtractNextElement3 -pack
-extract_next_element3 x
-extract_next_element3 y
-
-#%macro: extract_next_element4 ExtractNextElement4 -pack
-#extract_next_element4 x
-#extract_next_element4 y
+get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst
is_integer Fail=f i =>
is_integer Fail=f an => jump Fail
is_integer Fail Literal=q => move Literal x | is_integer Fail x
-is_integer Fail=f S=rx | allocate Need Regs => is_integer_allocate Fail S Need Regs
+is_integer Fail=f S=x | allocate Need Regs => is_integer_allocate Fail S Need Regs
%macro: is_integer_allocate IsIntegerAllocate -fail_action
is_integer_allocate f x I I
-is_integer_allocate f r I I
%macro: is_integer IsInteger -fail_action
is_integer f x
is_integer f y
-is_integer f r
is_list Fail=f n =>
is_list Fail Literal=q => move Literal x | is_list Fail x
is_list Fail=f c => jump Fail
%macro: is_list IsList -fail_action
-is_list f r
is_list f x
%cold
is_list f y
%hot
-is_nonempty_list Fail=f S=rx | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs
+is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs
%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action -pack
-is_nonempty_list_allocate f x I t
is_nonempty_list_allocate f r I t
+is_nonempty_list_allocate f x I t
-is_nonempty_list F=f r | test_heap I1 I2 => is_non_empty_list_test_heap F r I1 I2
+is_nonempty_list F=f x==0 | test_heap I1 I2 => is_non_empty_list_test_heap F I1 I2
%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action -pack
-is_non_empty_list_test_heap f r I t
+is_non_empty_list_test_heap f I t
+
+is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \
+ is_nonempty_list_get_list Fail S D1 D2
+
+%macro: is_nonempty_list_get_list IsNonemptyListGetList -fail_action -pack
+is_nonempty_list_get_list f r x x
+is_nonempty_list_get_list f x x x
%macro: is_nonempty_list IsNonemptyList -fail_action
is_nonempty_list f x
is_nonempty_list f y
-is_nonempty_list f r
%macro: is_atom IsAtom -fail_action
is_atom f x
-is_atom f r
%cold
is_atom f y
%hot
@@ -775,7 +702,6 @@ is_atom Fail=f a =>
is_atom Fail=f niq => jump Fail
%macro: is_float IsFloat -fail_action
-is_float f r
is_float f x
%cold
is_float f y
@@ -789,12 +715,10 @@ is_nil Fail=f qia => jump Fail
%macro: is_nil IsNil -fail_action
is_nil f x
is_nil f y
-is_nil f r
is_binary Fail Literal=q => move Literal x | is_binary Fail x
is_binary Fail=f c => jump Fail
%macro: is_binary IsBinary -fail_action
-is_binary f r
is_binary f x
%cold
is_binary f y
@@ -806,7 +730,6 @@ is_bitstr Fail Term => is_bitstring Fail Term
is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x
is_bitstring Fail=f c => jump Fail
%macro: is_bitstring IsBitstring -fail_action
-is_bitstring f r
is_bitstring f x
%cold
is_bitstring f y
@@ -814,7 +737,6 @@ is_bitstring f y
is_reference Fail=f cq => jump Fail
%macro: is_reference IsRef -fail_action
-is_reference f r
is_reference f x
%cold
is_reference f y
@@ -822,7 +744,6 @@ is_reference f y
is_pid Fail=f cq => jump Fail
%macro: is_pid IsPid -fail_action
-is_pid f r
is_pid f x
%cold
is_pid f y
@@ -830,7 +751,6 @@ is_pid f y
is_port Fail=f cq => jump Fail
%macro: is_port IsPort -fail_action
-is_port f r
is_port f x
%cold
is_port f y
@@ -842,14 +762,12 @@ is_boolean Fail=f ac => jump Fail
%cold
%macro: is_boolean IsBoolean -fail_action
-is_boolean f r
is_boolean f x
is_boolean f y
%hot
is_function2 Fail=f acq Arity => jump Fail
is_function2 Fail=f Fun a => jump Fail
-is_function2 Fail Fun Literal=q => move Literal x | is_function2 Fail Fun x
is_function2 f s s
%macro: is_function2 IsFunction2 -fail_action
@@ -989,76 +907,76 @@ call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate
%unless USE_VM_PROBES
call_ext Arity u$func:erlang:dt_get_tag/0 => \
- move a=am_undefined r
+ move a=am_undefined x=0
call_ext_last Arity u$func:erlang:dt_get_tag/0 D => \
- move a=am_undefined r | deallocate D | return
+ move a=am_undefined x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_get_tag/0 => \
- move a=am_undefined r | return
-
-move Any r | call_ext Arity u$func:erlang:dt_put_tag/1 => \
- move a=am_undefined r
-move Any r | call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \
- move a=am_undefined r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_put_tag/1 => \
- move a=am_undefined r | return
+ move a=am_undefined x=0 | return
+
+move Any x==0 | call_ext Arity u$func:erlang:dt_put_tag/1 => \
+ move a=am_undefined x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \
+ move a=am_undefined x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_put_tag/1 => \
+ move a=am_undefined x=0 | return
call_ext Arity u$func:erlang:dt_put_tag/1 => \
- move a=am_undefined r
+ move a=am_undefined x=0
call_ext_last Arity u$func:erlang:dt_put_tag/1 D => \
- move a=am_undefined r | deallocate D | return
+ move a=am_undefined x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_put_tag/1 => \
- move a=am_undefined r | return
+ move a=am_undefined x=0 | return
call_ext Arity u$func:erlang:dt_get_tag_data/0 => \
- move a=am_undefined r
+ move a=am_undefined x=0
call_ext_last Arity u$func:erlang:dt_get_tag_data/0 D => \
- move a=am_undefined r | deallocate D | return
+ move a=am_undefined x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_get_tag_data/0 => \
- move a=am_undefined r | return
-
-move Any r | call_ext Arity u$func:erlang:dt_spread_tag/1 => \
- move a=am_true r
-move Any r | call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \
- move a=am_true r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \
- move a=am_true r | return
+ move a=am_undefined x=0 | return
+
+move Any x==0 | call_ext Arity u$func:erlang:dt_spread_tag/1 => \
+ move a=am_true x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \
+ move a=am_true x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \
+ move a=am_true x=0 | return
call_ext Arity u$func:erlang:dt_spread_tag/1 => \
- move a=am_true r
+ move a=am_true x=0
call_ext_last Arity u$func:erlang:dt_spread_tag/1 D => \
- move a=am_true r | deallocate D | return
+ move a=am_true x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_spread_tag/1 => \
- move a=am_true r | return
-
-move Any r | call_ext Arity u$func:erlang:dt_restore_tag/1 => \
- move a=am_true r
-move Any r | call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \
- move a=am_true r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \
- move a=am_true r | return
+ move a=am_true x=0 | return
+
+move Any x==0 | call_ext Arity u$func:erlang:dt_restore_tag/1 => \
+ move a=am_true x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \
+ move a=am_true x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \
+ move a=am_true x=0 | return
call_ext Arity u$func:erlang:dt_restore_tag/1 => \
- move a=am_true r
+ move a=am_true x=0
call_ext_last Arity u$func:erlang:dt_restore_tag/1 D => \
- move a=am_true r | deallocate D | return
+ move a=am_true x=0 | deallocate D | return
call_ext_only Arity u$func:erlang:dt_restore_tag/1 => \
- move a=am_true r | return
-
-move Any r | call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
- move Any r
-move Any r | call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \
- move Any r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
- move Any r | return
+ move a=am_true x=0 | return
+
+move Any x==0 | call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
+ move Any x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \
+ move Any x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
+ move Any x=0 | return
call_ext Arity u$func:erlang:dt_prepend_vm_tag_data/1 =>
call_ext_last Arity u$func:erlang:dt_prepend_vm_tag_data/1 D => \
deallocate D | return
call_ext_only Arity u$func:erlang:dt_prepend_vm_tag_data/1 => \
return
-move Any r | call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => \
- move Any r
-move Any r | call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \
- move Any r | deallocate D | return
-move Any r | call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \
- move Any r | return
+move Any x==0 | call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 => \
+ move Any x=0
+move Any x==0 | call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \
+ move Any x=0 | deallocate D | return
+move Any x==0 | call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \
+ move Any x=0 | return
call_ext Arity u$func:erlang:dt_append_vm_tag_data/1 =>
call_ext_last Arity u$func:erlang:dt_append_vm_tag_data/1 D => \
deallocate D | return
@@ -1066,10 +984,17 @@ call_ext_only Arity u$func:erlang:dt_append_vm_tag_data/1 => \
return
# Can happen after one of the transformations above.
-move Discarded r | move Something r => move Something r
+move Discarded x==0 | move Something x==0 => move Something x=0
%endif
+call_ext u==0 u$func:os:perf_counter/0 => \
+ i_perf_counter
+call_ext_last u==0 u$func:os:perf_counter/0 D => \
+ i_perf_counter | deallocate_return D
+call_ext_only u==0 u$func:os:perf_counter/0 => \
+ i_perf_counter | return
+
#
# The general case for BIFs that have no special instructions.
# A BIF used in the tail must be followed by a return instruction.
@@ -1091,9 +1016,9 @@ call_ext_only Ar=u Bif=u$is_bif => \
# with call instructions.
#
-move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func
-move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r
-move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r
+move S=c x==0 | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S Func
+move S=c x==0 | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S
+move S=c x==0 | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S
call_ext Ar Func => i_call_ext Func
call_ext_last Ar Func D => i_call_ext_last Func D
@@ -1109,6 +1034,8 @@ i_apply_fun_only
i_hibernate
+i_perf_counter
+
call_bif e
#
@@ -1118,80 +1045,74 @@ call_bif e
bif0 u$bif:erlang:self/0 Dst=d => self Dst
bif0 u$bif:erlang:node/0 Dst=d => node Dst
-bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => i_get Src Dst
+bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => gen_get(Src, Dst)
-bif2 Jump=j u$bif:erlang:element/2 S1=s S2=rxy Dst=d => gen_element(Jump, S1, S2, Dst)
+bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, Dst)
-bif1 Fail Bif Literal=q Dst => move Literal x | bif1 Fail Bif x Dst
bif1 p Bif S1 Dst => bif1_body Bif S1 Dst
-bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst
-
-bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst
-bif2 Fail Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst
+bif2 p Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst
+bif2 Fail Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst
+i_get_hash c I d
i_get s d
%macro: self Self
-self r
self x
self y
%macro: node Node
-node r
node x
%cold
node y
%hot
-i_fast_element r j I d
-i_fast_element x j I d
-i_fast_element y j I d
+i_fast_element j x I d
+i_fast_element j y I d
-i_element r j s d
-i_element x j s d
-i_element y j s d
+i_element j x s d
+i_element j y s d
bif1 f b s d
bif1_body b s d
-i_bif2 f b d
-i_bif2_body b d
+i_bif2 f b s s d
+i_bif2_body b s s d
#
# Internal calls.
#
-move S=c r | call Ar P=f => i_move_call S r P
-move S=s r | call Ar P=f => move_call S r P
+move S=c x==0 | call Ar P=f => i_move_call S P
+move S=s x==0 | call Ar P=f => move_call S P
-i_move_call c r f
+i_move_call c f
%macro:move_call MoveCall -arg_f -size -nonext
-move_call/3
+move_call/2
-move_call x r f
-move_call y r f
+move_call x f
+move_call y f
-move S=c r | call_last Ar P=f D => i_move_call_last P D S r
-move S r | call_last Ar P=f D => move_call_last S r P D
+move S=c x==0 | call_last Ar P=f D => i_move_call_last P D S
+move S x==0 | call_last Ar P=f D => move_call_last S P D
-i_move_call_last f P c r
+i_move_call_last f P c
%macro:move_call_last MoveCallLast -arg_f -nonext -pack
-move_call_last/4
-move_call_last x r f Q
-move_call_last y r f Q
+move_call_last/3
+move_call_last x f Q
+move_call_last y f Q
-move S=c r | call_only Ar P=f => i_move_call_only P S r
-move S=x r | call_only Ar P=f => move_call_only S r P
+move S=c x==0 | call_only Ar P=f => i_move_call_only P S
+move S=x x==0 | call_only Ar P=f => move_call_only S P
-i_move_call_only f c r
+i_move_call_only f c
%macro:move_call_only MoveCallOnly -arg_f -nonext
-move_call_only/3
+move_call_only/2
-move_call_only x r f
+move_call_only x f
call Ar Func => i_call Func
call_last Ar Func D => i_call_last Func D
@@ -1205,9 +1126,9 @@ i_call_ext e
i_call_ext_last e P
i_call_ext_only e
-i_move_call_ext c r e
-i_move_call_ext_last e P c r
-i_move_call_ext_only e c r
+i_move_call_ext c e
+i_move_call_ext_last e P c
+i_move_call_ext_only e c
# Fun calls.
@@ -1227,7 +1148,6 @@ i_make_fun I t
%macro: is_function IsFunction -fail_action
is_function f x
is_function f y
-is_function f r
is_function Fail=f c => jump Fail
func_info M F A => i_func_info u M F A
@@ -1239,131 +1159,105 @@ func_info M F A => i_func_info u M F A
%cold
bs_start_match2 Fail=f ica X Y D => jump Fail
bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D
-i_bs_start_match2 r f I I d
i_bs_start_match2 x f I I d
i_bs_start_match2 y f I I d
bs_save2 Reg Index => gen_bs_save(Reg, Index)
-i_bs_save2 r I
i_bs_save2 x I
bs_restore2 Reg Index => gen_bs_restore(Reg, Index)
-i_bs_restore2 r I
i_bs_restore2 x I
# Matching integers
bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val
-i_bs_match_string r f I I
i_bs_match_string x f I I
# Fetching integers from binaries.
-bs_get_integer2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \
+bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \
gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
-i_bs_get_integer_small_imm r I f I d
i_bs_get_integer_small_imm x I f I d
-i_bs_get_integer_imm r I I f I d
i_bs_get_integer_imm x I I f I d
-i_bs_get_integer f I I d
-i_bs_get_integer_8 r f d
+i_bs_get_integer f I I s s d
i_bs_get_integer_8 x f d
-i_bs_get_integer_16 r f d
i_bs_get_integer_16 x f d
-i_bs_get_integer_32 r f I d
i_bs_get_integer_32 x f I d
# Fetching binaries from binaries.
-bs_get_binary2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \
+bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \
gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
%macro: i_bs_get_binary_imm2 BsGetBinaryImm_2 -fail_action -gen_dest
%macro: i_bs_get_binary2 BsGetBinary_2 -fail_action -gen_dest
%macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action -gen_dest
-i_bs_get_binary_imm2 f r I I I d
i_bs_get_binary_imm2 f x I I I d
-i_bs_get_binary2 f r I s I d
i_bs_get_binary2 f x I s I d
-i_bs_get_binary_all2 f r I I d
i_bs_get_binary_all2 f x I I d
-i_bs_get_binary_all_reuse r f I
i_bs_get_binary_all_reuse x f I
# Fetching float from binaries.
-bs_get_float2 Fail=f Ms=rx Live=u Sz=s Unit=u Flags=u Dst=d => \
+bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \
gen_get_float2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
-bs_get_float2 Fail=f Ms=rx Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail
+bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail
%macro: i_bs_get_float2 BsGetFloat2 -fail_action -gen_dest
-i_bs_get_float2 f r I s I d
i_bs_get_float2 f x I s I d
# Miscellanous
-bs_skip_bits2 Fail=f Ms=rx Sz=s Unit=u Flags=u => \
- gen_skip_bits2(Fail, Ms, Sz, Unit, Flags)
-bs_skip_bits2 Fail=f Ms=rx Sz=q Unit=u Flags=u => \
+bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \
gen_skip_bits2(Fail, Ms, Sz, Unit, Flags)
%macro: i_bs_skip_bits_imm2 BsSkipBitsImm2 -fail_action
-i_bs_skip_bits_imm2 f r I
i_bs_skip_bits_imm2 f x I
%macro: i_bs_skip_bits2 BsSkipBits2 -fail_action
-i_bs_skip_bits2 f r x I
-i_bs_skip_bits2 f r y I
i_bs_skip_bits2 f x x I
-i_bs_skip_bits2 f x r I
i_bs_skip_bits2 f x y I
%macro: i_bs_skip_bits_all2 BsSkipBitsAll2 -fail_action
-i_bs_skip_bits_all2 f r I
i_bs_skip_bits_all2 f x I
-bs_test_tail2 Fail=f Ms=rx Bits=u==0 => bs_test_zero_tail2 Fail Ms
-bs_test_tail2 Fail=f Ms=rx Bits=u => bs_test_tail_imm2 Fail Ms Bits
-bs_test_zero_tail2 f r
+bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms
+bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits
bs_test_zero_tail2 f x
-bs_test_tail_imm2 f r I
bs_test_tail_imm2 f x I
bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms
-bs_test_unit f r I
bs_test_unit f x I
-bs_test_unit8 f r
bs_test_unit8 f x
-bs_context_to_binary r
+# An y register operand for bs_context_to_binary is rare,
+# but can happen because of inlining.
+
+bs_context_to_binary Y=y => move Y x | bs_context_to_binary x
+
bs_context_to_binary x
-bs_context_to_binary y
#
# Utf8/utf16/utf32 support. (R12B-5)
#
-bs_get_utf8 Fail=f Ms=rx u u Dst=d => i_bs_get_utf8 Ms Fail Dst
-i_bs_get_utf8 r f d
+bs_get_utf8 Fail=f Ms=x u u Dst=d => i_bs_get_utf8 Ms Fail Dst
i_bs_get_utf8 x f d
-bs_skip_utf8 Fail=f Ms=rx u u => i_bs_get_utf8 Ms Fail x
+bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail x
-bs_get_utf16 Fail=f Ms=rx u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst
-bs_skip_utf16 Fail=f Ms=rx u Flags=u => i_bs_get_utf16 Ms Fail Flags x
+bs_get_utf16 Fail=f Ms=x u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst
+bs_skip_utf16 Fail=f Ms=x u Flags=u => i_bs_get_utf16 Ms Fail Flags x
-i_bs_get_utf16 r f I d
i_bs_get_utf16 x f I d
-bs_get_utf32 Fail=f Ms=rx Live=u Flags=u Dst=d => \
+bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \
bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \
- i_fetch Dst Ms | \
- i_bs_validate_unicode_retract Fail
-bs_skip_utf32 Fail=f Ms=rx Live=u Flags=u => \
+ i_bs_validate_unicode_retract Fail Dst Ms
+bs_skip_utf32 Fail=f Ms=x Live=u Flags=u => \
bs_get_integer2 Fail Ms Live i=32 u=1 Flags x | \
- i_fetch x Ms | \
- i_bs_validate_unicode_retract Fail
+ i_bs_validate_unicode_retract Fail x Ms
-i_bs_validate_unicode_retract j
+i_bs_validate_unicode_retract j s s
%hot
#
@@ -1385,13 +1279,12 @@ bs_init2 Fail Sz=u Words Regs Flags Dst => \
bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \
i_bs_init_fail Sz Fail Regs Dst
bs_init2 Fail Sz Words Regs Flags Dst => \
- i_fetch Sz r | i_bs_init_fail_heap Words Fail Regs Dst
+ i_bs_init_fail_heap Sz Words Fail Regs Dst
-i_bs_init_fail r j I d
i_bs_init_fail x j I d
i_bs_init_fail y j I d
-i_bs_init_fail_heap I j I d
+i_bs_init_fail_heap s I j I d
i_bs_init I I d
i_bs_init_heap_bin I I d
@@ -1408,39 +1301,35 @@ bs_init_bits Fail Sz=u Words Regs Flags Dst => i_bs_init_bits_heap Sz Words Reg
bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \
i_bs_init_bits_fail Sz Fail Regs Dst
bs_init_bits Fail Sz Words Regs Flags Dst => \
- i_fetch Sz r | i_bs_init_bits_fail_heap Words Fail Regs Dst
+ i_bs_init_bits_fail_heap Sz Words Fail Regs Dst
-i_bs_init_bits_fail r j I d
i_bs_init_bits_fail x j I d
i_bs_init_bits_fail y j I d
-i_bs_init_bits_fail_heap I j I d
+i_bs_init_bits_fail_heap s I j I d
i_bs_init_bits I I d
i_bs_init_bits_heap I I I d
bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D
-bs_add Fail S1 S2 Unit D => i_fetch S1 S2 | i_bs_add Fail Unit D
-i_bs_add j I d
+bs_add j s s I d
bs_append Fail Size Extra Live Unit Bin Flags Dst => \
- i_fetch Size Bin | i_bs_append Fail Extra Live Unit Dst
+ move Bin x | i_bs_append Fail Extra Live Unit Size Dst
bs_private_append Fail Size Unit Bin Flags Dst => \
- i_fetch Size Bin | i_bs_private_append Fail Unit Dst
+ i_bs_private_append Fail Unit Size Bin Dst
bs_init_writable
-i_bs_append j I I I d
-i_bs_private_append j I d
+i_bs_append j I I I s d
+i_bs_private_append j I s s d
#
# Storing integers into binaries.
#
-bs_put_integer Fail=j Sz=s Unit=u Flags=u Literal=q => \
- move Literal x | bs_put_integer Fail Sz Unit Flags x
bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \
gen_put_integer(Fail, Sz, Unit, Flags, Src)
@@ -1454,32 +1343,22 @@ i_new_bs_put_integer_imm j I I s
# Utf8/utf16/utf32 support. (R12B-5)
#
-bs_utf8_size Fail Literal=q Dst=d => \
- move Literal x | bs_utf8_size Fail x Dst
bs_utf8_size j Src=s Dst=d => i_bs_utf8_size Src Dst
i_bs_utf8_size s d
-bs_utf16_size Fail Literal=q Dst=d => \
- move Literal x | bs_utf16_size Fail x Dst
bs_utf16_size j Src=s Dst=d => i_bs_utf16_size Src Dst
i_bs_utf16_size s d
-bs_put_utf8 Fail=j Flags=u Literal=q => \
- move Literal x | bs_put_utf8 Fail Flags x
bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src
i_bs_put_utf8 j s
-bs_put_utf16 Fail=j Flags=u Literal=q => \
- move Literal x | bs_put_utf16 Fail Flags x
bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src
i_bs_put_utf16 j I s
-bs_put_utf32 Fail=j Flags=u Literal=q => \
- move Literal x | bs_put_utf32 Fail Flags x
bs_put_utf32 Fail=j Flags=u Src=s => \
i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src
@@ -1490,9 +1369,6 @@ i_bs_validate_unicode j s
#
bs_put_float Fail Sz=q Unit Flags Val => badarg Fail
-bs_put_float Fail=j Sz Unit=u Flags=u Literal=q => \
- move Literal x | bs_put_float Fail Sz Unit Flags x
-
bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_float(Fail, Sz, Unit, Flags, Src)
@@ -1506,8 +1382,6 @@ i_new_bs_put_float_imm j I I s
# Storing binaries into binaries.
#
-bs_put_binary Fail Sz Unit Flags Literal=q => \
- move Literal x | bs_put_binary Fail Sz Unit Flags x
bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_binary(Fail, Sz, Unit, Flags, Src)
@@ -1600,7 +1474,6 @@ is_map Fail Lit=q | literal_is_map(Lit) =>
is_map Fail cq => jump Fail
%macro: is_map IsMap -fail_action
-is_map f r
is_map f x
is_map f y
@@ -1611,101 +1484,120 @@ has_map_fields Fail Src Size Rest=* => \
## Transform get_map_elements(s) #{ K1 := V1, K2 := V2 }
-get_map_elements Fail Src=rxy Size=u==2 Rest=* => \
+get_map_elements Fail Src=xy Size=u==2 Rest=* => \
gen_get_map_element(Fail, Src, Size, Rest)
get_map_elements Fail Src Size Rest=* | map_key_sort(Size, Rest) => \
gen_get_map_elements(Fail, Src, Size, Rest)
i_get_map_elements f s I
-i_get_map_element Fail Src=rxy Key=ry Dst => \
+i_get_map_element Fail Src=xy Key=y Dst => \
move Key x | i_get_map_element Fail Src x Dst
%macro: i_get_map_element_hash GetMapElementHash -fail_action
-i_get_map_element_hash f r c I r
-i_get_map_element_hash f x c I r
-i_get_map_element_hash f y c I r
-i_get_map_element_hash f r c I x
i_get_map_element_hash f x c I x
i_get_map_element_hash f y c I x
-i_get_map_element_hash f r c I y
i_get_map_element_hash f x c I y
i_get_map_element_hash f y c I y
%macro: i_get_map_element GetMapElement -fail_action
-i_get_map_element f r x r
-i_get_map_element f x x r
-i_get_map_element f y x r
-i_get_map_element f r x x
i_get_map_element f x x x
i_get_map_element f y x x
-i_get_map_element f r x y
i_get_map_element f x x y
i_get_map_element f y x y
#
+# Convert the plus operations to a generic plus instruction.
+#
+gen_plus/5
+gen_minus/5
+
+gc_bif1 Fail Live u$bif:erlang:splus/1 Src Dst => \
+ gen_plus Fail Live Src i Dst
+gc_bif2 Fail Live u$bif:erlang:splus/2 S1 S2 Dst => \
+ gen_plus Fail Live S1 S2 Dst
+
+gc_bif1 Fail Live u$bif:erlang:sminus/1 Src Dst => \
+ gen_minus Fail Live i Src Dst
+gc_bif2 Fail Live u$bif:erlang:sminus/2 S1 S2 Dst => \
+ gen_minus Fail Live S1 S2 Dst
+
+#
# Optimize addition and subtraction of small literals using
# the i_increment/4 instruction (in bodies, not in guards).
#
-gc_bif2 p Live u$bif:erlang:splus/2 Int=i Reg=d Dst => \
+gen_plus p Live Int=i Reg=d Dst => \
gen_increment(Reg, Int, Live, Dst)
-gc_bif2 p Live u$bif:erlang:splus/2 Reg=d Int=i Dst => \
+gen_plus p Live Reg=d Int=i Dst => \
gen_increment(Reg, Int, Live, Dst)
-gc_bif2 p Live u$bif:erlang:sminus/2 Reg=d Int=i Dst | \
- negation_is_small(Int) => \
+gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \
gen_increment_from_minus(Reg, Int, Live, Dst)
#
# GCing arithmetic instructions.
#
-gc_bif2 Fail I u$bif:erlang:splus/2 S1=x S2=x Dst=d => i_plus Fail I S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:splus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_plus Fail I Dst
-gc_bif2 Fail I u$bif:erlang:sminus/2 S1=x S2=x Dst=d => i_minus Fail I S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:sminus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_minus Fail I Dst
-gc_bif2 Fail I u$bif:erlang:stimes/2 S1 S2 Dst=d => i_fetch S1 S2 | i_times Fail I Dst
-gc_bif2 Fail I u$bif:erlang:div/2 S1 S2 Dst=d => i_fetch S1 S2 | i_m_div Fail I Dst
+gen_plus Fail Live Y=y X=x Dst => i_plus Fail Live X Y Dst
+gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:intdiv/2 S1 S2 Dst=d => i_fetch S1 S2 | i_int_div Fail I Dst
-gc_bif2 Fail I u$bif:erlang:rem/2 S1=x S2=x Dst=d => i_rem Fail I S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:rem/2 S1 S2 Dst=d => i_fetch S1 S2 | i_rem Fail I Dst
+gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:bsl/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsl Fail I Dst
-gc_bif2 Fail I u$bif:erlang:bsr/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsr Fail I Dst
+gc_bif2 Fail Live u$bif:erlang:stimes/2 S1 S2 Dst => \
+ i_times Fail Live S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:band/2 S1=x S2=c Dst=d => i_band Fail I S1 S2 Dst
-gc_bif2 Fail I u$bif:erlang:band/2 S1 S2 Dst=d => i_fetch S1 S2 | i_band Fail I Dst
-gc_bif2 Fail I u$bif:erlang:bor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bor Fail I Dst
-gc_bif2 Fail I u$bif:erlang:bxor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bxor Fail I Dst
+gc_bif2 Fail Live u$bif:erlang:div/2 S1 S2 Dst => \
+ i_m_div Fail Live S1 S2 Dst
+gc_bif2 Fail Live u$bif:erlang:intdiv/2 S1 S2 Dst => \
+ i_int_div Fail Live S1 S2 Dst
-gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst
+gc_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \
+ i_rem Fail Live S1 S2 Dst
+
+gc_bif2 Fail Live u$bif:erlang:bsl/2 S1 S2 Dst => \
+ i_bsl Fail Live S1 S2 Dst
+gc_bif2 Fail Live u$bif:erlang:bsr/2 S1 S2 Dst => \
+ i_bsr Fail Live S1 S2 Dst
+
+gc_bif2 Fail Live u$bif:erlang:band/2 S1 S2 Dst => \
+ i_band Fail Live S1 S2 Dst
+
+gc_bif2 Fail Live u$bif:erlang:bor/2 S1 S2 Dst => \
+ i_bor Fail Live S1 S2 Dst
-gc_bif1 Fail I u$bif:erlang:sminus/1 Src Dst=d => i_fetch i Src | i_minus Fail I Dst
-gc_bif1 Fail I u$bif:erlang:splus/1 Src Dst=d => i_fetch i Src | i_plus Fail I Dst
+gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \
+ i_bxor Fail Live S1 S2 Dst
+
+gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst
i_increment r I I d
i_increment x I I d
i_increment y I I d
i_plus j I x x d
-i_plus j I d
+i_plus j I x y d
+i_plus j I s s d
+
i_minus j I x x d
-i_minus j I d
-i_times j I d
-i_m_div j I d
-i_int_div j I d
+i_minus j I s s d
+
+i_times j I s s d
+
+i_m_div j I s s d
+i_int_div j I s s d
+
i_rem j I x x d
-i_rem j I d
+i_rem j I s s d
-i_bsl j I d
-i_bsr j I d
+i_bsl j I s s d
+i_bsr j I s s d
i_band j I x c d
-i_band j I d
-i_bor j I d
-i_bxor j I d
+i_band j I s s d
+
+i_bor j I s s d
+i_bxor j I s s d
i_int_bnot j s I d
@@ -1731,21 +1623,18 @@ gc_bif2 Fail I Bif S1 S2 Dst => \
gc_bif3 Fail I Bif S1 S2 S3 Dst => \
gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst)
-i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D
-
i_gc_bif1 j I s I d
-ii_gc_bif2/6
-
-ii_gc_bif2 Fail Bif S1 S2 Live D => i_fetch S1 S2 | i_gc_bif2 Fail Bif Live D
-
-i_gc_bif2 j I I d
+i_gc_bif2 j I I s s d
ii_gc_bif3/7
-ii_gc_bif3 Fail Bif S1 S2 S3 Live D => move S1 x | i_fetch S2 S3 | i_gc_bif3 Fail Bif x Live D
+# A specific instruction can only have 6 operands, so we must
+# pass one of the arguments in an x register.
+ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \
+ move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst
-i_gc_bif3 j I s I d
+i_gc_bif3 j I I s s d
#
# The following instruction is specially handled in beam_load.c
diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c
index 7ade8bca0f..ebc35b0c4d 100644
--- a/erts/emulator/beam/register.c
+++ b/erts/emulator/beam/register.c
@@ -125,7 +125,7 @@ static RegProc* reg_alloc(RegProc *tmpl)
{
RegProc* obj = (RegProc*) erts_alloc(ERTS_ALC_T_REG_PROC, sizeof(RegProc));
if (!obj) {
- erl_exit(1, "Can't allocate %d bytes of memory\n", sizeof(RegProc));
+ erts_exit(ERTS_ERROR_EXIT, "Can't allocate %d bytes of memory\n", sizeof(RegProc));
}
obj->name = tmpl->name;
obj->p = tmpl->p;
@@ -151,6 +151,9 @@ void init_register_table(void)
f.cmp = (HCMP_FUN) reg_cmp;
f.alloc = (HALLOC_FUN) reg_alloc;
f.free = (HFREE_FUN) reg_free;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_REG_TABLE, &process_reg, "process_reg",
PREG_HASH_SIZE, f);
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index bb871b05ba..03b9088adc 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -21,6 +21,19 @@
#ifndef __SYS_H__
#define __SYS_H__
+#if !defined(__GNUC__)
+# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
+#elif !defined(__GNUC_MINOR__)
+# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#elif !defined(__GNUC_PATCHLEVEL__)
+# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#else
+# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
+ (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
+#endif
+
#ifdef ERTS_INLINE
# ifndef ERTS_CAN_INLINE
# define ERTS_CAN_INLINE 1
@@ -38,6 +51,17 @@
# endif
#endif
+#ifndef ERTS_FORCE_INLINE
+# if ERTS_AT_LEAST_GCC_VSN__(3,1,1)
+# define ERTS_FORCE_INLINE __inline__ __attribute__((__always_inline__))
+# elif defined(__WIN32__)
+# define ERTS_FORCE_INLINE __forceinline
+# endif
+# ifndef ERTS_FORCE_INLINE
+# define ERTS_FORCE_INLINE ERTS_INLINE
+# endif
+#endif
+
#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK)
# undef ERTS_CAN_INLINE
# define ERTS_CAN_INLINE 0
@@ -46,8 +70,10 @@
#endif
#if ERTS_CAN_INLINE
+#define ERTS_GLB_FORCE_INLINE static ERTS_FORCE_INLINE
#define ERTS_GLB_INLINE static ERTS_INLINE
#else
+#define ERTS_GLB_FORCE_INLINE
#define ERTS_GLB_INLINE
#endif
@@ -61,22 +87,14 @@
# define NO_FPE_SIGNALS
#endif
-#ifdef DISABLE_CHILD_WAITER_THREAD
-#undef ENABLE_CHILD_WAITER_THREAD
-#endif
-
-#if defined(ERTS_SMP) && !defined(DISABLE_CHILD_WAITER_THREAD)
-#undef ENABLE_CHILD_WAITER_THREAD
-#define ENABLE_CHILD_WAITER_THREAD 1
-#endif
-
#define ERTS_I64_LITERAL(X) X##LL
+#define ErtsInArea(ptr,start,nbytes) \
+ ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
+
#if defined (__WIN32__)
# include "erl_win_sys.h"
-#elif defined (__OSE__)
-# include "erl_ose_sys.h"
-#else
+#else
# include "erl_unix_sys.h"
#ifndef UNIX
# define UNIX 1
@@ -111,19 +129,6 @@ typedef int ErtsSysFdType;
typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
#endif
-#if !defined(__GNUC__)
-# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) 0
-#elif !defined(__GNUC_MINOR__)
-# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- ((__GNUC__ << 24) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#elif !defined(__GNUC_PATCHLEVEL__)
-# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12)) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#else
-# define ERTS_AT_LEAST_GCC_VSN__(MAJ, MIN, PL) \
- (((__GNUC__ << 24) | (__GNUC_MINOR__ << 12) | __GNUC_PATCHLEVEL__) >= (((MAJ) << 24) | ((MIN) << 12) | (PL)))
-#endif
-
#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0)
# define ERTS_LIKELY(BOOL) __builtin_expect((BOOL), !0)
# define ERTS_UNLIKELY(BOOL) __builtin_expect((BOOL), 0)
@@ -131,6 +136,17 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType;
# define ERTS_LIKELY(BOOL) (BOOL)
# define ERTS_UNLIKELY(BOOL) (BOOL)
#endif
+
+#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0)
+#ifndef __llvm__
+# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("ERTS_LOW_WRITE") ))
+#else
+# define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("__DATA,ERTS_LOW_WRITE") ))
+#endif
+#else
+# define ERTS_WRITE_UNLIKELY(X) X
+#endif
+
#ifdef __GNUC__
# if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ > 5)
# define ERTS_DECLARE_DUMMY(X) X __attribute__ ((unused))
@@ -191,6 +207,12 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f
# define ASSERT(e) ((void) 1)
#endif
+#ifdef ERTS_SMP
+# define ERTS_SMP_ASSERT(e) ASSERT(e)
+#else
+# define ERTS_SMP_ASSERT(e) ((void)1)
+#endif
+
/* ERTS_UNDEF can be used to silence false warnings about
* "variable may be used uninitialized" while keeping the variable
* marked as undefined by valgrind.
@@ -285,62 +307,11 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f
#else
#error Neither 32 nor 64 bit architecture
#endif
-#if defined(ARCH_64) && defined(HALFWORD_HEAP_EMULATOR)
-# define HALFWORD_HEAP 1
-# define HALFWORD_ASSERT 0
-# define ASSERT_HALFWORD(COND) ASSERT(COND)
-# undef ERTS_SIZEOF_TERM
-# define ERTS_SIZEOF_TERM 4
-#else
-# define HALFWORD_HEAP 0
-# define HALFWORD_ASSERT 0
-# define ASSERT_HALFWORD(COND)
-#endif
#if SIZEOF_VOID_P != SIZEOF_SIZE_T
#error sizeof(void*) != sizeof(size_t)
#endif
-#if HALFWORD_HEAP
-
-#if SIZEOF_INT == 4
-typedef unsigned int Eterm;
-typedef unsigned int Uint;
-typedef int Sint;
-#define ERTS_UINT_MAX UINT_MAX
-#define ERTS_SIZEOF_ETERM SIZEOF_INT
-#define ErtsStrToSint strtol
-#else
-#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint'
-#endif
-
-#if SIZEOF_VOID_P == SIZEOF_LONG
-typedef unsigned long UWord;
-typedef long SWord;
-#define SWORD_CONSTANT(Const) Const##L
-#define UWORD_CONSTANT(Const) Const##UL
-#define ERTS_UWORD_MAX ULONG_MAX
-#define ERTS_SWORD_MAX LONG_MAX
-#elif SIZEOF_VOID_P == SIZEOF_INT
-typedef unsigned int UWord;
-typedef int SWord;
-#define SWORD_CONSTANT(Const) Const
-#define UWORD_CONSTANT(Const) Const##U
-#define ERTS_UWORD_MAX UINT_MAX
-#define ERTS_SWORD_MAX INT_MAX
-#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
-typedef unsigned long long UWord;
-typedef long long SWord;
-#define SWORD_CONSTANT(Const) Const##LL
-#define UWORD_CONSTANT(Const) Const##ULL
-#define ERTS_UWORD_MAX ULLONG_MAX
-#define ERTS_SWORD_MAX LLONG_MAX
-#else
-#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint'
-#endif
-
-#else /* !HALFWORD_HEAP */
-
#if SIZEOF_VOID_P == SIZEOF_LONG
typedef unsigned long Eterm;
typedef unsigned long Uint;
@@ -383,8 +354,6 @@ typedef Uint UWord;
typedef Sint SWord;
#define ERTS_UINT_MAX ERTS_UWORD_MAX
-#endif /* HALFWORD_HEAP */
-
typedef UWord BeamInstr;
#ifndef HAVE_INT64
@@ -611,15 +580,16 @@ static unsigned long zero_value = 0, one_value = 1;
# endif /* !__WIN32__ */
#endif /* WANT_NONBLOCKING */
-__decl_noreturn void __noreturn erl_exit(int n, char*, ...);
+__decl_noreturn void __noreturn erts_exit(int n, char*, ...);
-/* Some special erl_exit() codes: */
-#define ERTS_INTR_EXIT INT_MIN /* called from signal handler */
-#define ERTS_ABORT_EXIT (INT_MIN + 1) /* no crash dump; only abort() */
-#define ERTS_DUMP_EXIT (INT_MIN + 2) /* crash dump; then exit() */
+/* Some special erts_exit() codes: */
+#define ERTS_INTR_EXIT -1 /* called from signal handler */
+#define ERTS_ABORT_EXIT -2 /* no crash dump; only abort() */
+#define ERTS_DUMP_EXIT -3 /* crash dump; then exit() */
+#define ERTS_ERROR_EXIT -4 /* crash dump; then abort() */
#define ERTS_INTERNAL_ERROR(What) \
- erl_exit(ERTS_ABORT_EXIT, "%s:%d:%s(): Internal error: %s\n", \
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d:%s(): Internal error: %s\n", \
__FILE__, __LINE__, __func__, What)
Eterm erts_check_io_info(void *p);
@@ -634,7 +604,6 @@ Uint erts_sys_misc_mem_sz(void);
/* Io constants to erts_print and erts_putc */
#define ERTS_PRINT_STDERR (2)
#define ERTS_PRINT_STDOUT (1)
-#define ERTS_PRINT_INVALID (0) /* Don't want to use 0 since CBUF was 0 */
#define ERTS_PRINT_FILE (-1)
#define ERTS_PRINT_SBUF (-2)
#define ERTS_PRINT_SNBUF (-3)
@@ -786,6 +755,7 @@ void erts_sys_main_thread(void);
extern int erts_sys_prepare_crash_dump(int secs);
extern void erts_sys_pre_init(void);
extern void erl_sys_init(void);
+extern void erl_sys_late_init(void);
extern void erl_sys_args(int *argc, char **argv);
extern void erl_sys_schedule(int);
void sys_tty_reset(int);
@@ -820,6 +790,10 @@ int local_to_univ(Sint *year, Sint *month, Sint *day,
void get_now(Uint*, Uint*, Uint*);
struct ErtsSchedulerData_;
ErtsMonotonicTime erts_get_monotonic_time(struct ErtsSchedulerData_ *);
+ErtsMonotonicTime erts_get_time_offset(void);
+void
+erts_make_timestamp_value(Uint* megasec, Uint* sec, Uint* microsec,
+ ErtsMonotonicTime mtime, ErtsMonotonicTime offset);
void get_sys_now(Uint*, Uint*, Uint*);
void set_break_quit(void (*)(void), void (*)(void));
@@ -930,7 +904,7 @@ erts_refc_inc(erts_refc_t *refcp, erts_aint_t min_val)
#ifdef ERTS_REFC_DEBUG
erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp);
if (val < min_val)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"erts_refc_inc(): Bad refc found (refc=%ld < %ld)!\n",
val, min_val);
#else
@@ -944,7 +918,7 @@ erts_refc_inctest(erts_refc_t *refcp, erts_aint_t min_val)
erts_aint_t val = erts_smp_atomic_inc_read_nob((erts_smp_atomic_t *) refcp);
#ifdef ERTS_REFC_DEBUG
if (val < min_val)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"erts_refc_inctest(): Bad refc found (refc=%ld < %ld)!\n",
val, min_val);
#endif
@@ -957,7 +931,7 @@ erts_refc_dec(erts_refc_t *refcp, erts_aint_t min_val)
#ifdef ERTS_REFC_DEBUG
erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp);
if (val < min_val)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"erts_refc_dec(): Bad refc found (refc=%ld < %ld)!\n",
val, min_val);
#else
@@ -971,7 +945,7 @@ erts_refc_dectest(erts_refc_t *refcp, erts_aint_t min_val)
erts_aint_t val = erts_smp_atomic_dec_read_nob((erts_smp_atomic_t *) refcp);
#ifdef ERTS_REFC_DEBUG
if (val < min_val)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"erts_refc_dectest(): Bad refc found (refc=%ld < %ld)!\n",
val, min_val);
#endif
@@ -984,7 +958,7 @@ erts_refc_add(erts_refc_t *refcp, erts_aint_t diff, erts_aint_t min_val)
#ifdef ERTS_REFC_DEBUG
erts_aint_t val = erts_smp_atomic_add_read_nob((erts_smp_atomic_t *) refcp, diff);
if (val < min_val)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"erts_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n",
diff, val, min_val);
#else
@@ -998,7 +972,7 @@ erts_refc_read(erts_refc_t *refcp, erts_aint_t min_val)
erts_aint_t val = erts_smp_atomic_read_nob((erts_smp_atomic_t *) refcp);
#ifdef ERTS_REFC_DEBUG
if (val < min_val)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"erts_refc_read(): Bad refc found (refc=%ld < %ld)!\n",
val, min_val);
#endif
@@ -1099,7 +1073,6 @@ extern int erts_use_kernel_poll;
#define put_int8(i, s) do {((unsigned char*)(s))[0] = (i) & 0xff;} while (0)
-
/*
* Use DEBUGF as you would use printf, but use double parentheses:
*
diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c
index 0ab6661c9f..0ce4f443f3 100644
--- a/erts/emulator/beam/time.c
+++ b/erts/emulator/beam/time.c
@@ -278,9 +278,14 @@ ErtsMonotonicTime
erts_check_next_timeout_time(ErtsSchedulerData *esdp)
{
ErtsTimerWheel *tiw = esdp->timer_wheel;
+ ErtsMonotonicTime time;
+ ERTS_MSACC_DECLARE_CACHE_X();
if (tiw->true_next_timeout_time)
return tiw->next_timeout_time;
- return find_next_timeout(esdp, tiw, 1, 0, 0);
+ ERTS_MSACC_PUSH_AND_SET_STATE_CACHED_X(ERTS_MSACC_STATE_TIMERS);
+ time = find_next_timeout(esdp, tiw, 1, 0, 0);
+ ERTS_MSACC_POP_STATE_M_X();
+ return time;
}
#ifndef ERTS_TW_DEBUG
@@ -336,6 +341,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
{
int tiw_pos_ix, slots, yielded_slot_restarted, yield_count;
ErtsMonotonicTime bump_to, tmp_slots, old_pos;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
yield_count = ERTS_TWHEEL_BUMP_YIELD_LIMIT;
@@ -371,6 +377,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
tiw->next_timeout_time = curr_time + ERTS_MONOTONIC_DAY;
tiw->pos = bump_to;
tiw->yield_slot = ERTS_TWHEEL_SLOT_INACTIVE;
+ ERTS_MSACC_POP_STATE_M_X();
return;
}
@@ -382,6 +389,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
tiw->yield_slot = ERTS_TWHEEL_SLOT_AT_ONCE;
tiw->true_next_timeout_time = 1;
tiw->next_timeout_time = ERTS_CLKTCKS_TO_MONOTONIC(old_pos);
+ ERTS_MSACC_POP_STATE_M_X();
return;
}
@@ -400,8 +408,10 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
p = tiw->at_once.head;
}
- if (tiw->pos >= bump_to)
+ if (tiw->pos >= bump_to) {
+ ERTS_MSACC_POP_STATE_M_X();
break;
+ }
if (tiw->nto == 0)
goto empty_wheel;
@@ -478,6 +488,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
tiw->yield_slot = tiw_pos_ix;
tiw->yield_slots_left = slots;
tiw->yield_start_pos = old_pos;
+ ERTS_MSACC_POP_STATE_M_X();
return; /* Yield! */
}
@@ -500,6 +511,7 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time)
/* Search at most two seconds ahead... */
(void) find_next_timeout(NULL, tiw, 0, curr_time, ERTS_SEC_TO_MONOTONIC(2));
+ ERTS_MSACC_POP_STATE_M_X();
}
Uint
@@ -555,7 +567,7 @@ erts_init_time(int time_correction, ErtsTimeWarpMode time_warp_mode)
itime = erts_init_time_sup(time_correction, time_warp_mode);
#ifdef TIW_ITIME_IS_CONSTANT
if (itime != TIW_ITIME) {
- erl_exit(ERTS_ABORT_EXIT, "timer resolution mismatch %d != %d", itime, TIW_ITIME);
+ erts_exit(ERTS_ABORT_EXIT, "timer resolution mismatch %d != %d", itime, TIW_ITIME);
}
#else
tiw_itime = itime;
@@ -569,6 +581,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw,
ErtsMonotonicTime timeout_pos)
{
ErtsMonotonicTime timeout_time;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
p->u.func.timeout = timeout;
p->u.func.cancel = cancel;
@@ -612,6 +625,7 @@ erts_twheel_set_timer(ErtsTimerWheel *tiw,
tiw->true_next_timeout_time = 1;
tiw->next_timeout_time = timeout_time;
}
+ ERTS_MSACC_POP_STATE_M_X();
}
void
@@ -620,11 +634,13 @@ erts_twheel_cancel_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p)
if (p->slot != ERTS_TWHEEL_SLOT_INACTIVE) {
ErlCancelProc cancel;
void *arg;
+ ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_TIMERS);
remove_timer(tiw, p);
cancel = p->u.func.cancel;
arg = p->u.func.arg;
if (cancel)
(*cancel)(arg);
+ ERTS_MSACC_POP_STATE_M_X();
}
}
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index e9d7c91ac9..66fcfcf6ce 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -110,7 +110,6 @@ Eterm*
erts_heap_alloc(Process* p, Uint need, Uint xtra)
{
ErlHeapFragment* bp;
- Eterm* htop;
Uint n;
#if defined(DEBUG) || defined(CHECK_FOR_HOLES)
Uint i;
@@ -156,16 +155,6 @@ erts_heap_alloc(Process* p, Uint need, Uint xtra)
n--;
#endif
- /*
- * When we have created a heap fragment, we are no longer allowed
- * to store anything more on the heap.
- */
- htop = HEAP_TOP(p);
- if (htop < HEAP_LIMIT(p)) {
- *htop = make_pos_bignum_header(HEAP_LIMIT(p)-htop-1);
- HEAP_TOP(p) = HEAP_LIMIT(p);
- }
-
bp->next = MBUF(p);
MBUF(p) = bp;
bp->alloc_size = n;
@@ -269,6 +258,31 @@ erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes)
s->psp = s->pstart + sp_offs;
}
+/*
+ * Helper function for the EQUEUE macros defined in global.h.
+ */
+
+void
+erl_grow_equeue(ErtsEQueue* q, Eterm* default_equeue)
+{
+ Uint old_size = (q->end - q->start);
+ Uint new_size = old_size * 2;
+ Uint first_part = (q->end - q->front);
+ Uint second_part = (q->back - q->start);
+ Eterm* new_ptr = erts_alloc(q->alloc_type, new_size*sizeof(Eterm));
+ ASSERT(q->back == q->front); // of course the queue is full now!
+ if (first_part > 0)
+ sys_memcpy(new_ptr, q->front, first_part*sizeof(Eterm));
+ if (second_part > 0)
+ sys_memcpy(new_ptr+first_part, q->start, second_part*sizeof(Eterm));
+ if (q->start != default_equeue)
+ erts_free(q->alloc_type, q->start);
+ q->start = new_ptr;
+ q->end = q->start + new_size;
+ q->front = q->start;
+ q->back = q->start + old_size;
+}
+
/* CTYPE macros */
#define LATIN1
@@ -303,10 +317,10 @@ erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes)
* Calculate length of a list.
* Returns -1 if not a proper list (i.e. not terminated with NIL)
*/
-int
+Sint
erts_list_length(Eterm list)
{
- int i = 0;
+ Sint i = 0;
while(is_list(list)) {
i++;
@@ -399,9 +413,6 @@ erts_print(int to, void *arg, char *format, ...)
case ERTS_PRINT_DSBUF:
res = erts_vdsprintf((erts_dsprintf_buf_t *) arg, format, arg_list);
break;
- case ERTS_PRINT_INVALID:
- res = -EINVAL;
- break;
default:
res = erts_vfdprintf((int) to, format, arg_list);
break;
@@ -897,7 +908,7 @@ tail_recur:
Uint y2 = y1 < 0 ? -(Uint)y1 : y1;
UINT32_HASH_STEP(y2, FUNNY_NUMBER2);
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (y2 >> 32)
UINT32_HASH_STEP(y2 >> 32, FUNNY_NUMBER2);
#endif
@@ -1018,7 +1029,7 @@ tail_recur:
}
d = BIG_DIGIT(ptr, k);
k = sizeof(ErtsDigit);
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
if (!(d >> 32))
k /= 2;
#endif
@@ -1058,7 +1069,7 @@ tail_recur:
}
default:
- erl_exit(1, "Invalid tag in make_hash(0x%X,0x%X)\n", term, op);
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash(0x%X,0x%X)\n", term, op);
return 0;
}
if (WSTACK_ISEMPTY(stack)) break;
@@ -1331,7 +1342,7 @@ make_hash2(Eterm term)
i = hashmap_bitcount(MAP_HEADER_VAL(hdr));
break;
default:
- erl_exit(1, "bad header");
+ erts_exit(ERTS_ERROR_EXIT, "bad header");
}
while (i) {
if (is_list(*ptr)) {
@@ -1494,7 +1505,7 @@ make_hash2(Eterm term)
break;
default:
- erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term);
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash2(0x%X)\n", term);
}
}
break;
@@ -1525,7 +1536,7 @@ make_hash2(Eterm term)
UINT32_HASH(NIL_DEF, HCONST_2);
goto hash2_common;
default:
- erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term);
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash2(0x%X)\n", term);
}
case _TAG_IMMED1_SMALL:
{
@@ -1541,7 +1552,7 @@ make_hash2(Eterm term)
}
break;
default:
- erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term);
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash2(0x%X)\n", term);
hash2_common:
/* Uint32 hash always has the hash value of the previous term,
@@ -1736,7 +1747,7 @@ make_internal_hash(Eterm term)
i = hashmap_bitcount(MAP_HEADER_VAL(hdr));
break;
default:
- erl_exit(1, "bad header");
+ erts_exit(ERTS_ERROR_EXIT, "bad header");
}
while (i) {
if (is_list(*ptr)) {
@@ -1912,7 +1923,7 @@ make_internal_hash(Eterm term)
goto pop_next;
}
default:
- erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term);
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash2(0x%X)\n", term);
}
}
break;
@@ -1925,7 +1936,7 @@ make_internal_hash(Eterm term)
goto pop_next;
default:
- erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term);
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash2(0x%X)\n", term);
pop_next:
if (ESTACK_ISEMPTY(s)) {
@@ -1988,7 +1999,7 @@ tail_recur:
(atom_tab(atom_val(term))->slot.bucket.hvalue);
break;
case SMALL_DEF:
-#if defined(ARCH_64) && !HALFWORD_HEAP
+#if defined(ARCH_64)
{
Sint y1 = signed_val(term);
Uint y2 = y1 < 0 ? -(Uint)y1 : y1;
@@ -2208,7 +2219,7 @@ tail_recur:
}
default:
- erl_exit(1, "Invalid tag in make_broken_hash\n");
+ erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_broken_hash\n");
return 0;
}
if (WSTACK_ISEMPTY(stack)) break;
@@ -2284,7 +2295,11 @@ static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment *
erts_queue_error_logger_message(from, message, bp);
}
#else
- erts_queue_message(p, NULL /* only used for smp build */, bp, message, NIL);
+ {
+ ErtsMessage *mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = bp;
+ erts_queue_message(p, NULL /* only used for smp build */, mp, message, NIL);
+ }
#endif
}
@@ -2597,11 +2612,7 @@ erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp)
* Test for equality of two terms.
* Returns 0 if not equal, or a non-zero value otherwise.
*/
-#if HALFWORD_HEAP
-int eq_rel(Eterm a, Eterm* a_base, Eterm b, Eterm* b_base)
-#else
int eq(Eterm a, Eterm b)
-#endif
{
DECLARE_WSTACK(stack);
Sint sz;
@@ -2609,18 +2620,18 @@ int eq(Eterm a, Eterm b)
Eterm* bb;
tailrecur:
- if (is_same(a, a_base, b, b_base)) goto pop_next;
+ if (is_same(a, b)) goto pop_next;
tailrecur_ne:
switch (primary_tag(a)) {
case TAG_PRIMARY_LIST:
if (is_list(b)) {
- Eterm* aval = list_val_rel(a, a_base);
- Eterm* bval = list_val_rel(b, b_base);
+ Eterm* aval = list_val(a);
+ Eterm* bval = list_val(b);
while (1) {
Eterm atmp = CAR(aval);
Eterm btmp = CAR(bval);
- if (!is_same(atmp,a_base,btmp,b_base)) {
+ if (!is_same(atmp,btmp)) {
WSTACK_PUSH2(stack,(UWord) CDR(bval),(UWord) CDR(aval));
a = atmp;
b = btmp;
@@ -2628,7 +2639,7 @@ tailrecur_ne:
}
atmp = CDR(aval);
btmp = CDR(bval);
- if (is_same(atmp,a_base,btmp,b_base)) {
+ if (is_same(atmp,btmp)) {
goto pop_next;
}
if (is_not_list(atmp) || is_not_list(btmp)) {
@@ -2636,22 +2647,22 @@ tailrecur_ne:
b = btmp;
goto tailrecur_ne;
}
- aval = list_val_rel(atmp, a_base);
- bval = list_val_rel(btmp, b_base);
+ aval = list_val(atmp);
+ bval = list_val(btmp);
}
}
break; /* not equal */
case TAG_PRIMARY_BOXED:
{
- Eterm hdr = *boxed_val_rel(a,a_base);
+ Eterm hdr = *boxed_val(a);
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
- aa = tuple_val_rel(a, a_base);
- if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa)
+ aa = tuple_val(a);
+ if (!is_boxed(b) || *boxed_val(b) != *aa)
goto not_equal;
- bb = tuple_val_rel(b,b_base);
+ bb = tuple_val(b);
if ((sz = arityval(*aa)) == 0) goto pop_next;
++aa;
++bb;
@@ -2670,16 +2681,16 @@ tailrecur_ne:
Uint a_bitoffs;
Uint b_bitoffs;
- if (!is_binary_rel(b,b_base)) {
+ if (!is_binary(b)) {
goto not_equal;
}
- a_size = binary_size_rel(a,a_base);
- b_size = binary_size_rel(b,b_base);
+ a_size = binary_size(a);
+ b_size = binary_size(b);
if (a_size != b_size) {
goto not_equal;
}
- ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base);
- ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base);
+ ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
+ ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next;
} else if (a_bitsize == b_bitsize) {
@@ -2690,9 +2701,9 @@ tailrecur_ne:
}
case EXPORT_SUBTAG:
{
- if (is_export_rel(b,b_base)) {
- Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1));
- Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1));
+ if (is_export(b)) {
+ Export* a_exp = *((Export **) (export_val(a) + 1));
+ Export* b_exp = *((Export **) (export_val(b) + 1));
if (a_exp == b_exp) goto pop_next;
}
break; /* not equal */
@@ -2702,10 +2713,10 @@ tailrecur_ne:
ErlFunThing* f1;
ErlFunThing* f2;
- if (!is_fun_rel(b,b_base))
+ if (!is_fun(b))
goto not_equal;
- f1 = (ErlFunThing *) fun_val_rel(a,a_base);
- f2 = (ErlFunThing *) fun_val_rel(b,b_base);
+ f1 = (ErlFunThing *) fun_val(a);
+ f2 = (ErlFunThing *) fun_val(b);
if (f1->fe->module != f2->fe->module ||
f1->fe->old_index != f2->fe->old_index ||
f1->fe->old_uniq != f2->fe->old_uniq ||
@@ -2723,15 +2734,15 @@ tailrecur_ne:
ExternalThing *ap;
ExternalThing *bp;
- if(!is_external_rel(b,b_base))
+ if(!is_external(b))
goto not_equal;
- ap = external_thing_ptr_rel(a,a_base);
- bp = external_thing_ptr_rel(b,b_base);
+ ap = external_thing_ptr(a);
+ bp = external_thing_ptr(b);
if(ap->header == bp->header && ap->node == bp->node) {
- ASSERT(1 == external_data_words_rel(a,a_base));
- ASSERT(1 == external_data_words_rel(b,b_base));
+ ASSERT(1 == external_data_words(a));
+ ASSERT(1 == external_data_words(b));
if (ap->data.ui[0] == bp->data.ui[0]) goto pop_next;
}
@@ -2752,11 +2763,11 @@ tailrecur_ne:
ExternalThing* athing;
ExternalThing* bthing;
- if(!is_external_ref_rel(b,b_base))
+ if(!is_external_ref(b))
goto not_equal;
- athing = external_thing_ptr_rel(a,a_base);
- bthing = external_thing_ptr_rel(b,b_base);
+ athing = external_thing_ptr(a);
+ bthing = external_thing_ptr(b);
if(athing->node != bthing->node)
goto not_equal;
@@ -2768,12 +2779,12 @@ tailrecur_ne:
goto ref_common;
case REF_SUBTAG:
- if (!is_internal_ref_rel(b,b_base))
+ if (!is_internal_ref(b))
goto not_equal;
{
- RefThing* athing = ref_thing_ptr_rel(a,a_base);
- RefThing* bthing = ref_thing_ptr_rel(b,b_base);
+ RefThing* athing = ref_thing_ptr(a);
+ RefThing* bthing = ref_thing_ptr(b);
alen = internal_thing_ref_no_of_numbers(athing);
blen = internal_thing_ref_no_of_numbers(bthing);
anum = internal_thing_ref_numbers(athing);
@@ -2823,10 +2834,10 @@ tailrecur_ne:
{
int i;
- if (!is_big_rel(b,b_base))
+ if (!is_big(b))
goto not_equal;
- aa = big_val_rel(a,a_base);
- bb = big_val_rel(b,b_base);
+ aa = big_val(a);
+ bb = big_val(b);
if (*aa != *bb)
goto not_equal;
i = BIG_ARITY(aa);
@@ -2841,19 +2852,19 @@ tailrecur_ne:
FloatDef af;
FloatDef bf;
- if (is_float_rel(b,b_base)) {
- GET_DOUBLE_REL(a, af, a_base);
- GET_DOUBLE_REL(b, bf, b_base);
+ if (is_float(b)) {
+ GET_DOUBLE(a, af);
+ GET_DOUBLE(b, bf);
if (af.fd == bf.fd) goto pop_next;
}
break; /* not equal */
}
case MAP_SUBTAG:
- if (is_flatmap_rel(a, a_base)) {
- aa = flatmap_val_rel(a, a_base);
- if (!is_boxed(b) || *boxed_val_rel(b,b_base) != *aa)
+ if (is_flatmap(a)) {
+ aa = flatmap_val(a);
+ if (!is_boxed(b) || *boxed_val(b) != *aa)
goto not_equal;
- bb = flatmap_val_rel(b,b_base);
+ bb = flatmap_val(b);
sz = flatmap_get_size((flatmap_t*)aa);
if (sz != flatmap_get_size((flatmap_t*)bb)) goto not_equal;
@@ -2865,11 +2876,11 @@ tailrecur_ne:
goto term_array;
} else {
- if (!is_boxed(b) || *boxed_val_rel(b,b_base) != hdr)
+ if (!is_boxed(b) || *boxed_val(b) != hdr)
goto not_equal;
- aa = hashmap_val_rel(a, a_base) + 1;
- bb = hashmap_val_rel(b, b_base) + 1;
+ aa = hashmap_val(a) + 1;
+ bb = hashmap_val(b) + 1;
switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
case HAMT_SUBTAG_HEAD_ARRAY:
aa++; bb++;
@@ -2882,7 +2893,7 @@ tailrecur_ne:
ASSERT(sz > 0 && sz < 17);
break;
default:
- erl_exit(1, "Unknown hashmap subsubtag\n");
+ erts_exit(ERTS_ERROR_EXIT, "Unknown hashmap subsubtag\n");
}
goto term_array;
}
@@ -2902,7 +2913,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'sz' */
Eterm* bp = bb;
Sint i = sz;
for (;;) {
- if (!is_same(*ap,a_base,*bp,b_base)) break;
+ if (!is_same(*ap,*bp)) break;
if (--i == 0) goto pop_next;
++ap;
++bp;
@@ -2980,7 +2991,7 @@ static int cmpbytes(byte *s1, int l1, byte *s2, int l2)
#define float_comp(x,y) (((x)<(y)) ? -1 : (((x)==(y)) ? 0 : 1))
-static int cmp_atoms(Eterm a, Eterm b)
+int erts_cmp_atoms(Eterm a, Eterm b)
{
Atom *aa = atom_tab(atom_val(a));
Atom *bb = atom_tab(atom_val(b));
@@ -2991,7 +3002,6 @@ static int cmp_atoms(Eterm a, Eterm b)
bb->name+3, bb->len-3);
}
-#if !HALFWORD_HEAP
/* cmp(Eterm a, Eterm b)
* For compatibility with HiPE - arith-based compare.
*/
@@ -2999,39 +3009,22 @@ Sint cmp(Eterm a, Eterm b)
{
return erts_cmp(a, b, 0, 0);
}
-#endif
-#if HALFWORD_HEAP
-static Sint erts_cmp_compound_rel_opt(Eterm a, Eterm* a_base,
- Eterm b, Eterm* b_base,
- int exact, int eq_only);
-#else
-static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only);
-#endif
+Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only);
-#if HALFWORD_HEAP
-Sint erts_cmp_rel_opt(Eterm a, Eterm* a_base,
- Eterm b, Eterm* b_base,
- int exact, int eq_only)
-#else
Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only)
-#endif
{
if (is_atom(a) && is_atom(b)) {
- return cmp_atoms(a, b);
+ return erts_cmp_atoms(a, b);
} else if (is_both_small(a, b)) {
return (signed_val(a) - signed_val(b));
- } else if (is_float_rel(a, a_base) && is_float_rel(b, b_base)) {
+ } else if (is_float(a) && is_float(b)) {
FloatDef af, bf;
- GET_DOUBLE_REL(a, af, a_base);
- GET_DOUBLE_REL(b, bf, b_base);
+ GET_DOUBLE(a, af);
+ GET_DOUBLE(b, bf);
return float_comp(af.fd, bf.fd);
}
-#if HALFWORD_HEAP
- return erts_cmp_compound_rel_opt(a,a_base,b,b_base,exact,eq_only);
-#else
return erts_cmp_compound(a,b,exact,eq_only);
-#endif
}
@@ -3039,13 +3032,7 @@ Sint erts_cmp(Eterm a, Eterm b, int exact, int eq_only)
* exact = 1 -> term-based compare
* exact = 0 -> arith-based compare
*/
-#if HALFWORD_HEAP
-static Sint erts_cmp_compound_rel_opt(Eterm a, Eterm* a_base,
- Eterm b, Eterm* b_base,
- int exact, int eq_only)
-#else
-static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
-#endif
+Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
{
#define PSTACK_TYPE struct erts_cmp_hashmap_state
struct erts_cmp_hashmap_state {
@@ -3102,7 +3089,7 @@ static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
do { \
if((AN) != (BN)) { \
if((AN)->sysname != (BN)->sysname) \
- RETURN_NEQ(cmp_atoms((AN)->sysname, (BN)->sysname)); \
+ RETURN_NEQ(erts_cmp_atoms((AN)->sysname, (BN)->sysname)); \
ASSERT((AN)->creation != (BN)->creation); \
RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \
} \
@@ -3112,7 +3099,7 @@ static Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
bodyrecur:
j = 0;
tailrecur:
- if (is_same(a,a_base,b,b_base)) { /* Equal values or pointers. */
+ if (is_same(a,b)) { /* Equal values or pointers. */
goto pop_next;
}
tailrecur_ne:
@@ -3120,7 +3107,7 @@ tailrecur_ne:
/* deal with majority (?) cases by brute-force */
if (is_atom(a)) {
if (is_atom(b)) {
- ON_CMP_GOTO(cmp_atoms(a, b));
+ ON_CMP_GOTO(erts_cmp_atoms(a, b));
}
} else if (is_both_small(a, b)) {
ON_CMP_GOTO(signed_val(a) - signed_val(b));
@@ -3138,9 +3125,9 @@ tailrecur_ne:
if (is_internal_port(b)) {
bnode = erts_this_node;
bdata = internal_port_data(b);
- } else if (is_external_port_rel(b,b_base)) {
- bnode = external_port_node_rel(b,b_base);
- bdata = external_port_data_rel(b,b_base);
+ } else if (is_external_port(b)) {
+ bnode = external_port_node(b);
+ bdata = external_port_data(b);
} else {
a_tag = PORT_DEF;
goto mixed_types;
@@ -3156,9 +3143,9 @@ tailrecur_ne:
if (is_internal_pid(b)) {
bnode = erts_this_node;
bdata = internal_pid_data(b);
- } else if (is_external_pid_rel(b,b_base)) {
- bnode = external_pid_node_rel(b,b_base);
- bdata = external_pid_data_rel(b,b_base);
+ } else if (is_external_pid(b)) {
+ bnode = external_pid_node(b);
+ bdata = external_pid_data(b);
} else {
a_tag = PID_DEF;
goto mixed_types;
@@ -3191,12 +3178,12 @@ tailrecur_ne:
a_tag = LIST_DEF;
goto mixed_types;
}
- aa = list_val_rel(a,a_base);
- bb = list_val_rel(b,b_base);
+ aa = list_val(a);
+ bb = list_val(b);
while (1) {
Eterm atmp = CAR(aa);
Eterm btmp = CAR(bb);
- if (!is_same(atmp,a_base,btmp,b_base)) {
+ if (!is_same(atmp,btmp)) {
WSTACK_PUSH2(stack,(UWord) CDR(bb),(UWord) CDR(aa));
a = atmp;
b = btmp;
@@ -3204,7 +3191,7 @@ tailrecur_ne:
}
atmp = CDR(aa);
btmp = CDR(bb);
- if (is_same(atmp,a_base,btmp,b_base)) {
+ if (is_same(atmp,btmp)) {
goto pop_next;
}
if (is_not_list(atmp) || is_not_list(btmp)) {
@@ -3212,20 +3199,20 @@ tailrecur_ne:
b = btmp;
goto tailrecur_ne;
}
- aa = list_val_rel(atmp,a_base);
- bb = list_val_rel(btmp,b_base);
+ aa = list_val(atmp);
+ bb = list_val(btmp);
}
case TAG_PRIMARY_BOXED:
{
- Eterm ahdr = *boxed_val_rel(a,a_base);
+ Eterm ahdr = *boxed_val(a);
switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE):
- if (!is_tuple_rel(b,b_base)) {
+ if (!is_tuple(b)) {
a_tag = TUPLE_DEF;
goto mixed_types;
}
- aa = tuple_val_rel(a,a_base);
- bb = tuple_val_rel(b,b_base);
+ aa = tuple_val(a);
+ bb = tuple_val(b);
/* compare the arities */
i = arityval(ahdr); /* get the arity*/
if (i != arityval(*bb)) {
@@ -3241,18 +3228,18 @@ tailrecur_ne:
{
struct erts_cmp_hashmap_state* sp;
if (is_flatmap_header(ahdr)) {
- if (!is_flatmap_rel(b,b_base)) {
- if (is_hashmap_rel(b,b_base)) {
- aa = (Eterm *)flatmap_val_rel(a,a_base);
- i = flatmap_get_size((flatmap_t*)aa) - hashmap_size_rel(b,b_base);
+ if (!is_flatmap(b)) {
+ if (is_hashmap(b)) {
+ aa = (Eterm *)flatmap_val(a);
+ i = flatmap_get_size((flatmap_t*)aa) - hashmap_size(b);
ASSERT(i != 0);
RETURN_NEQ(i);
}
a_tag = MAP_DEF;
goto mixed_types;
}
- aa = (Eterm *)flatmap_val_rel(a,a_base);
- bb = (Eterm *)flatmap_val_rel(b,b_base);
+ aa = (Eterm *)flatmap_val(a);
+ bb = (Eterm *)flatmap_val(b);
i = flatmap_get_size((flatmap_t*)aa);
if (i != flatmap_get_size((flatmap_t*)bb)) {
@@ -3279,21 +3266,21 @@ tailrecur_ne:
goto bodyrecur;
}
}
- if (!is_hashmap_rel(b,b_base)) {
- if (is_flatmap_rel(b,b_base)) {
- bb = (Eterm *)flatmap_val_rel(b,b_base);
- i = hashmap_size_rel(a,a_base) - flatmap_get_size((flatmap_t*)bb);
+ if (!is_hashmap(b)) {
+ if (is_flatmap(b)) {
+ bb = (Eterm *)flatmap_val(b);
+ i = hashmap_size(a) - flatmap_get_size((flatmap_t*)bb);
ASSERT(i != 0);
RETURN_NEQ(i);
}
a_tag = MAP_DEF;
goto mixed_types;
}
- i = hashmap_size_rel(a,a_base) - hashmap_size_rel(b,b_base);
+ i = hashmap_size(a) - hashmap_size(b);
if (i) {
RETURN_NEQ(i);
}
- if (hashmap_size_rel(a,a_base) == 0) {
+ if (hashmap_size(a) == 0) {
goto pop_next;
}
@@ -3328,48 +3315,48 @@ tailrecur_ne:
goto bodyrecur;
}
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- if (!is_float_rel(b,b_base)) {
+ if (!is_float(b)) {
a_tag = FLOAT_DEF;
goto mixed_types;
} else {
FloatDef af;
FloatDef bf;
- GET_DOUBLE_REL(a, af, a_base);
- GET_DOUBLE_REL(b, bf, b_base);
+ GET_DOUBLE(a, af);
+ GET_DOUBLE(b, bf);
ON_CMP_GOTO(float_comp(af.fd, bf.fd));
}
case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- if (!is_big_rel(b,b_base)) {
+ if (!is_big(b)) {
a_tag = BIG_DEF;
goto mixed_types;
}
- ON_CMP_GOTO(big_comp(rterm2wterm(a,a_base), rterm2wterm(b,b_base)));
+ ON_CMP_GOTO(big_comp(a, b));
case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE):
- if (!is_export_rel(b,b_base)) {
+ if (!is_export(b)) {
a_tag = EXPORT_DEF;
goto mixed_types;
} else {
- Export* a_exp = *((Export **) (export_val_rel(a,a_base) + 1));
- Export* b_exp = *((Export **) (export_val_rel(b,b_base) + 1));
+ Export* a_exp = *((Export **) (export_val(a) + 1));
+ Export* b_exp = *((Export **) (export_val(b) + 1));
- if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) {
+ if ((j = erts_cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) {
RETURN_NEQ(j);
}
- if ((j = cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) {
+ if ((j = erts_cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) {
RETURN_NEQ(j);
}
ON_CMP_GOTO((Sint) a_exp->code[2] - (Sint) b_exp->code[2]);
}
break;
case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE):
- if (!is_fun_rel(b,b_base)) {
+ if (!is_fun(b)) {
a_tag = FUN_DEF;
goto mixed_types;
} else {
- ErlFunThing* f1 = (ErlFunThing *) fun_val_rel(a,a_base);
- ErlFunThing* f2 = (ErlFunThing *) fun_val_rel(b,b_base);
+ ErlFunThing* f1 = (ErlFunThing *) fun_val(a);
+ ErlFunThing* f2 = (ErlFunThing *) fun_val(b);
Sint diff;
diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name,
@@ -3401,29 +3388,29 @@ tailrecur_ne:
if (is_internal_pid(b)) {
bnode = erts_this_node;
bdata = internal_pid_data(b);
- } else if (is_external_pid_rel(b,b_base)) {
- bnode = external_pid_node_rel(b,b_base);
- bdata = external_pid_data_rel(b,b_base);
+ } else if (is_external_pid(b)) {
+ bnode = external_pid_node(b);
+ bdata = external_pid_data(b);
} else {
a_tag = EXTERNAL_PID_DEF;
goto mixed_types;
}
- anode = external_pid_node_rel(a,a_base);
- adata = external_pid_data_rel(a,a_base);
+ anode = external_pid_node(a);
+ adata = external_pid_data(a);
goto pid_common;
case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE):
if (is_internal_port(b)) {
bnode = erts_this_node;
bdata = internal_port_data(b);
- } else if (is_external_port_rel(b,b_base)) {
- bnode = external_port_node_rel(b,b_base);
- bdata = external_port_data_rel(b,b_base);
+ } else if (is_external_port(b)) {
+ bnode = external_port_node(b);
+ bdata = external_port_data(b);
} else {
a_tag = EXTERNAL_PORT_DEF;
goto mixed_types;
}
- anode = external_port_node_rel(a,a_base);
- adata = external_port_data_rel(a,a_base);
+ anode = external_port_node(a);
+ adata = external_port_data(a);
goto port_common;
case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
/*
@@ -3431,14 +3418,13 @@ tailrecur_ne:
* (32-bit words), *not* ref data words.
*/
-
- if (is_internal_ref_rel(b,b_base)) {
- RefThing* bthing = ref_thing_ptr_rel(b,b_base);
+ if (is_internal_ref(b)) {
+ RefThing* bthing = ref_thing_ptr(b);
bnode = erts_this_node;
bnum = internal_thing_ref_numbers(bthing);
blen = internal_thing_ref_no_of_numbers(bthing);
- } else if(is_external_ref_rel(b,b_base)) {
- ExternalThing* bthing = external_thing_ptr_rel(b,b_base);
+ } else if(is_external_ref(b)) {
+ ExternalThing* bthing = external_thing_ptr(b);
bnode = bthing->node;
bnum = external_thing_ref_numbers(bthing);
blen = external_thing_ref_no_of_numbers(bthing);
@@ -3447,7 +3433,7 @@ tailrecur_ne:
goto mixed_types;
}
{
- RefThing* athing = ref_thing_ptr_rel(a,a_base);
+ RefThing* athing = ref_thing_ptr(a);
anode = erts_this_node;
anum = internal_thing_ref_numbers(athing);
alen = internal_thing_ref_no_of_numbers(athing);
@@ -3480,13 +3466,13 @@ tailrecur_ne:
RETURN_NEQ((Sint32) (anum[i] - bnum[i]));
goto pop_next;
case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE):
- if (is_internal_ref_rel(b,b_base)) {
- RefThing* bthing = ref_thing_ptr_rel(b,b_base);
+ if (is_internal_ref(b)) {
+ RefThing* bthing = ref_thing_ptr(b);
bnode = erts_this_node;
bnum = internal_thing_ref_numbers(bthing);
blen = internal_thing_ref_no_of_numbers(bthing);
- } else if (is_external_ref_rel(b,b_base)) {
- ExternalThing* bthing = external_thing_ptr_rel(b,b_base);
+ } else if (is_external_ref(b)) {
+ ExternalThing* bthing = external_thing_ptr(b);
bnode = bthing->node;
bnum = external_thing_ref_numbers(bthing);
blen = external_thing_ref_no_of_numbers(bthing);
@@ -3495,7 +3481,7 @@ tailrecur_ne:
goto mixed_types;
}
{
- ExternalThing* athing = external_thing_ptr_rel(a,a_base);
+ ExternalThing* athing = external_thing_ptr(a);
anode = athing->node;
anum = external_thing_ref_numbers(athing);
alen = external_thing_ref_no_of_numbers(athing);
@@ -3503,13 +3489,13 @@ tailrecur_ne:
goto ref_common;
default:
/* Must be a binary */
- ASSERT(is_binary_rel(a,a_base));
- if (!is_binary_rel(b,b_base)) {
+ ASSERT(is_binary(a));
+ if (!is_binary(b)) {
a_tag = BINARY_DEF;
goto mixed_types;
} else {
- Uint a_size = binary_size_rel(a,a_base);
- Uint b_size = binary_size_rel(b,b_base);
+ Uint a_size = binary_size(a);
+ Uint b_size = binary_size(b);
Uint a_bitsize;
Uint b_bitsize;
Uint a_bitoffs;
@@ -3518,8 +3504,8 @@ tailrecur_ne:
int cmp;
byte* a_ptr;
byte* b_ptr;
- ERTS_GET_BINARY_BYTES_REL(a, a_ptr, a_bitoffs, a_bitsize, a_base);
- ERTS_GET_BINARY_BYTES_REL(b, b_ptr, b_bitoffs, b_bitsize, b_base);
+ ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
+ ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
min_size = (a_size < b_size) ? a_size : b_size;
if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) {
@@ -3550,13 +3536,8 @@ tailrecur_ne:
{
FloatDef f1, f2;
Eterm big;
-#if HALFWORD_HEAP
- Wterm aw = is_immed(a) ? a : rterm2wterm(a,a_base);
- Wterm bw = is_immed(b) ? b : rterm2wterm(b,b_base);
-#else
Eterm aw = a;
Eterm bw = b;
-#endif
#define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2))
#define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1))
#define BIG_ARITY_FLOAT_MAX (1024 / D_EXP) /* arity of max float as a bignum */
@@ -3628,7 +3609,7 @@ tailrecur_ne:
}
} else {
big = double_to_big(f2.fd, big_buf, sizeof(big_buf)/sizeof(Eterm));
- j = big_comp(aw, rterm2wterm(big,big_buf));
+ j = big_comp(aw, big);
}
if (_NUMBER_CODE(a_tag, b_tag) == FLOAT_BIG) {
j = -j;
@@ -3676,9 +3657,9 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */
while (--i) {
a = *aa++;
b = *bb++;
- if (!is_same(a,a_base, b,b_base)) {
+ if (!is_same(a, b)) {
if (is_atom(a) && is_atom(b)) {
- if ((j = cmp_atoms(a, b)) != 0) {
+ if ((j = erts_cmp_atoms(a, b)) != 0) {
goto not_equal;
}
} else if (is_both_small(a, b)) {
@@ -3949,11 +3930,11 @@ void bin_write(int to, void *to_arg, byte* buf, size_t sz)
/* Fill buf with the contents of bytelist list
return number of chars in list or -1 for error */
-int
-intlist_to_buf(Eterm list, char *buf, int len)
+Sint
+intlist_to_buf(Eterm list, char *buf, Sint len)
{
Eterm* listptr;
- int sz = 0;
+ Sint sz = 0;
if (is_nil(list))
return 0;
@@ -4368,7 +4349,7 @@ iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSi
{
int res, init_yield_count, yield_count;
Eterm* objp;
- Uint size = (Uint) *sizep; /* Intentionally Uint due to halfword heap */
+ Uint size = (Uint) *sizep;
DECLARE_ESTACK(s);
if (!yield_support)
@@ -4500,11 +4481,12 @@ int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
return iolist_size(0, NULL, obj, sizep);
}
-/* return 0 if item is not a non-empty flat list of bytes */
-int
+/* return 0 if item is not a non-empty flat list of bytes
+ otherwise return the nonzero length of the list */
+Sint
is_string(Eterm list)
{
- int len = 0;
+ Sint len = 0;
while(is_list(list)) {
Eterm* consp = list_val(list);
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index 8aff6c1865..3088dfd572 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -101,15 +101,9 @@
# include "config.h"
#endif
-#ifndef __OSE__
#include <ctype.h>
#include <sys/types.h>
#include <stdlib.h>
-#else
-#include "ctype.h"
-#include "sys/types.h"
-#include "stdlib.h"
-#endif
/* Need (NON)BLOCKING macros for sendfile */
#ifndef WANT_NONBLOCKING
@@ -125,8 +119,6 @@
#include "dtrace-wrapper.h"
-void erl_exit(int n, char *fmt, ...);
-
static ErlDrvSysInfo sys_info;
/* For explanation of this var, see comment for same var in erl_async.c */
@@ -515,21 +507,10 @@ struct t_data
static void *ef_safe_alloc(Uint s)
{
void *p = EF_ALLOC(s);
- if (!p) erl_exit(1, "efile drv: Can't allocate %lu bytes of memory\n", (unsigned long)s);
- return p;
-}
-
-#if 0 /* Currently not used */
-
-static void *ef_safe_realloc(void *op, Uint s)
-{
- void *p = EF_REALLOC(op, s);
- if (!p) erl_exit(1, "efile drv: Can't reallocate %lu bytes of memory\n", (unsigned long)s);
+ if (!p) erts_exit(ERTS_ERROR_EXIT, "efile drv: Can't allocate %lu bytes of memory\n", (unsigned long)s);
return p;
}
-#endif
-
/*********************************************************************
* ErlIOVec manipulation functions.
*/
@@ -895,7 +876,7 @@ static void reply_Uint_posix_error(file_descriptor *desc, Uint num,
TRACE_C('N');
response[0] = FILE_RESP_NUMERR;
-#if SIZEOF_VOID_P == 4 || HALFWORD_HEAP
+#if SIZEOF_VOID_P == 4
put_int32(0, response+1);
#else
put_int32(num>>32, response+1);
@@ -964,7 +945,7 @@ static int reply_Uint(file_descriptor *desc, Uint result) {
TRACE_C('R');
tmp[0] = FILE_RESP_NUMBER;
-#if SIZEOF_VOID_P == 4 || HALFWORD_HEAP
+#if SIZEOF_VOID_P == 4
put_int32(0, tmp+1);
#else
put_int32(result>>32, tmp+1);
@@ -1532,10 +1513,10 @@ static void invoke_writev(void *data) {
* with errno.
*/
errno = EINVAL;
- if (! (status =
- erts_gzwrite((ErtsGzFile)d->fd,
- iov[i].iov_base,
- iov[i].iov_len)) == iov[i].iov_len) {
+ status = erts_gzwrite((ErtsGzFile)d->fd,
+ iov[i].iov_base,
+ iov[i].iov_len) == iov[i].iov_len;
+ if (! status) {
d->errInfo.posix_errno =
d->errInfo.os_errno = errno; /* XXX Correct? */
break;
@@ -2581,7 +2562,6 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data)
case FILE_CLOSE_ON_PORT_EXIT:
/* See file_stop. However this is never invoked after the port is killed. */
free_data(data);
- EF_FREE(desc);
desc = NULL;
/* This is it for this port, so just send dtrace and return, avoid doing anything to the freed data */
DTRACE6(efile_drv_return, sched_i1, sched_i2, sched_utag,
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index a829599fe5..b219669ce5 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1997-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1997-2015. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -94,10 +94,6 @@ typedef unsigned long long llu_t;
#define INT16_MAX (32767)
#endif
-#ifdef __OSE__
-#include "inet.h"
-#endif
-
#ifdef __WIN32__
#define STRNCASECMP strncasecmp
@@ -298,139 +294,7 @@ static unsigned long one_value = 1;
#define TCP_SHUT_RD SD_RECEIVE
#define TCP_SHUT_RDWR SD_BOTH
-#elif defined (__OSE__)
-
-/*
- * Some notes about how inet (currently only tcp) works on OSE.
- * The driver uses OSE signals to communicate with the one_inet
- * process. Because of the difference in how signals and file descriptors
- * work the whole select/deselect mechanic is very different.
- * In ose when a sock_select is done a function is called. That function
- * notes the changes that the driver want to do, but does not act on it.
- * later when the function returns the new desired state is compared
- * to the previous state and the apprioriate actions are taken. The action
- * is usually to either request more data from the stack or stop requesting
- * data.
- *
- * One thing to note is that the driver never does select/deselect. It always
- * listens for the signals. Flow of data is regulated by sending or not sending
- * signals to the ose inet process.
- *
- * The interesting functions to look at are:
- * * inet_driver_select : called when sock_select is called
- * * tcp_inet_ose_dispatch_signal : checks state changes and sends new signals
- * * tcp_inet_drv_output_ose : ready output callback, reads signals and calls
- * dispatch_signal
- * * tcp_inet_drv_input_ose : ready input callback.
- */
-
-#include "efs.h"
-#include "sys/socket.h"
-#include "sys/uio.h"
-#include "sfk/sys/sfk_uio.h"
-#include "netinet/in.h"
-#include "netinet/tcp.h"
-#include "netdb.h"
-#include "ose_spi/socket.sig"
-
-
-static ssize_t writev_fallback(int fd, const struct iovec *iov, int iovcnt, int max_sz);
-
-#define INVALID_SOCKET -1
-#define INVALID_EVENT -1
-#define SOCKET_ERROR -1
-
-#define SOCKET int
-#define HANDLE int
-#define FD_READ ERL_DRV_READ
-#define FD_WRITE ERL_DRV_WRITE
-#define FD_CLOSE 0
-#define FD_CONNECT (1<<4)
-#define FD_ACCEPT (1<<5)
-#define SOCK_FD_ERROR (1<<6)
-
-#define sock_connect(s, addr, len) connect((s), (addr), (len))
-#define sock_listen(s, b) listen((s), (b))
-#define sock_bind(s, addr, len) bind((s), (addr), (len))
-#define sock_getopt(s,t,n,v,l) getsockopt((s),(t),(n),(v),(l))
-#define sock_setopt(s,t,n,v,l) setsockopt((s),(t),(n),(v),(l))
-#define sock_name(s, addr, len) getsockname((s), (addr), (len))
-#define sock_peer(s, addr, len) getpeername((s), (addr), (len))
-#define sock_ntohs(x) ntohs((x))
-#define sock_ntohl(x) ntohl((x))
-#define sock_htons(x) htons((x))
-#define sock_htonl(x) htonl((x))
-
-#define sock_accept(s, addr, len) accept((s), (addr), (len))
-#define sock_send(s,buf,len,flag) inet_send((s),(buf),(len),(flag))
-#define sock_sendto(s,buf,blen,flag,addr,alen) \
- sendto((s),(buf),(blen),(flag),(addr),(alen))
-#define sock_sendv(s, vec, size, np, flag) \
- (*(np) = writev_fallback((s), (struct iovec*)(vec), (size), (*(np))))
-#define sock_sendmsg(s,msghdr,flag) sendmsg((s),(msghdr),(flag))
-
-#define sock_open(af, type, proto) socket((af), (type), (proto))
-#define sock_close(s) close((s))
-#define sock_dup(s) dup((s))
-#define sock_shutdown(s, how) shutdown((s), (how))
-
-#define sock_hostname(buf, len) gethostname((buf), (len))
-#define sock_getservbyname(name,proto) getservbyname((name), (proto))
-#define sock_getservbyport(port,proto) getservbyport((port), (proto))
-
-#define sock_recv(s,buf,len,flag) recv((s),(buf),(len),(flag))
-#define sock_recvfrom(s,buf,blen,flag,addr,alen) \
- recvfrom((s),(buf),(blen),(flag),(addr),(alen))
-#define sock_recvmsg(s,msghdr,flag) recvmsg((s),(msghdr),(flag))
-
-#define sock_errno() errno
-#define sock_create_event(d) ((d)->s) /* return file descriptor */
-#define sock_close_event(e) /* do nothing */
-
-#ifndef WANT_NONBLOCKING
-#define WANT_NONBLOCKING
-#endif
-#include "sys.h"
-
-typedef unsigned long u_long;
-#define IN_CLASSA(a) ((((in_addr_t)(a)) & 0x80000000) == 0)
-#define IN_CLASSA_NET 0xff000000
-#define IN_CLASSA_NSHIFT 24
-#define IN_CLASSA_HOST (0xffffffff & ~IN_CLASSA_NET)
-#define IN_CLASSA_MAX 128
-
-#define IN_CLASSB(a) ((((in_addr_t)(a)) & 0xc0000000) == 0x80000000)
-#define IN_CLASSB_NET 0xffff0000
-#define IN_CLASSB_NSHIFT 16
-#define IN_CLASSB_HOST (0xffffffff & ~IN_CLASSB_NET)
-#define IN_CLASSB_MAX 65536
-
-#define IN_CLASSC(a) ((((in_addr_t)(a)) & 0xe0000000) == 0xc0000000)
-#define IN_CLASSC_NET 0xffffff00
-#define IN_CLASSC_NSHIFT 8
-#define IN_CLASSC_HOST (0xffffffff & ~IN_CLASSC_NET)
-
-#define IN_CLASSD(a) ((((in_addr_t)(a)) & 0xf0000000) == 0xe0000000)
-#define IN_MULTICAST(a) IN_CLASSD(a)
-
-#define IN_EXPERIMENTAL(a) ((((in_addr_t)(a)) & 0xe0000000) == 0xe0000000)
-#define IN_BADCLASS(a) ((((in_addr_t)(a)) & 0xf0000000) == 0xf0000000)
-
-#define sock_select(d, flags, onoff) do { \
- ASSERT(!(d)->is_ignored); \
- (d)->event_mask = (onoff) ? \
- ((d)->event_mask | (flags)) : \
- ((d)->event_mask & ~(flags)); \
- DEBUGF(("(%s / %d) sock_select(%ld): flags=%02X, onoff=%d, event_mask=%02lX, s=%d\r\n", \
- __FILE__, __LINE__, (long) (d)->port, (flags), (onoff), (unsigned long) (d)->event_mask, (d)->s)); \
- inet_driver_select((d), (flags), (onoff)); \
- } while(0)
-
-#define TCP_SHUT_WR SHUT_WR
-#define TCP_SHUT_RD SHUT_RD
-#define TCP_SHUT_RDWR SHUT_RDWR
-
-#else /* !__OSE__ && !__WIN32__ */
+#else /* !__WIN32__ */
#include <sys/time.h>
#ifdef NETDB_H_NEEDS_IN_H
@@ -704,7 +568,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
#define TCP_SHUT_RD SHUT_RD
#define TCP_SHUT_RDWR SHUT_RDWR
-#endif /* !__WIN32__ && !__OSE__ */
+#endif /* !__WIN32__ */
#ifdef HAVE_SOCKLEN_T
# define SOCKLEN_T socklen_t
@@ -1048,7 +912,7 @@ typedef union {
#endif
typedef struct _multi_timer_data {
- ErlDrvNowData when;
+ ErlDrvTime when;
ErlDrvTermData caller;
void (*timeout_function)(ErlDrvData drv_data, ErlDrvTermData caller);
struct _multi_timer_data *next;
@@ -1168,13 +1032,6 @@ typedef struct {
char *netns; /* Socket network namespace name
as full file path */
#endif
-#ifdef __OSE__
- int select_state; /* state to keep track of whether we
- should trigger another read/write
- request at end of ready_input/output */
- ErlDrvEvent events[6];
-#endif
-
} inet_descriptor;
@@ -1190,10 +1047,8 @@ static void tcp_inet_stop(ErlDrvData);
static void tcp_inet_command(ErlDrvData, char*, ErlDrvSizeT);
static void tcp_inet_commandv(ErlDrvData, ErlIOVec*);
static void tcp_inet_flush(ErlDrvData drv_data);
-#ifndef __OSE__
static void tcp_inet_drv_input(ErlDrvData, ErlDrvEvent);
static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event);
-#endif
static ErlDrvData tcp_inet_start(ErlDrvPort, char* command);
static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData, unsigned int,
char*, ErlDrvSizeT, char**, ErlDrvSizeT);
@@ -1206,71 +1061,6 @@ static void tcp_inet_event(ErlDrvData, ErlDrvEvent);
static void find_dynamic_functions(void);
#endif
-#ifdef __OSE__
-/* The structure of the signal used for requesting asynchronous
- * notification from the stack. Under normal circumstances the network stack
- * shouldn't overwrite the value set in the fd field by the sender
- * of the request */
-struct OseAsyncSig {
- struct FmEvent event;
- int fd;
-};
-
-union SIGNAL {
- SIGSELECT signo;
- struct OseAsyncSig async;
-};
-
-static ErlDrvSSizeT tcp_inet_ctl_ose(ErlDrvData e, unsigned int cmd,
- char* buf, ErlDrvSizeT len,
- char** rbuf, ErlDrvSizeT rsize);
-static void tcp_inet_commandv_ose(ErlDrvData e, ErlIOVec* ev);
-static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event);
-static void tcp_inet_drv_input_ose(ErlDrvData data, ErlDrvEvent event);
-static ErlDrvOseEventId inet_resolve_signal(union SIGNAL *sig);
-
-#ifdef INET_DRV_DEBUG
-
-static char *read_req = "SO_EVENT_READ_REQUEST";
-static char *read_rep = "SO_EVENT_READ_REPLY";
-static char *write_req = "SO_EVENT_WRITE_REQUEST";
-static char *write_rep = "SO_EVENT_WRITE_REPLY";
-static char *eof_req = "SO_EVENT_EOF_REQUEST";
-static char *eof_rep = "SO_EVENT_EOF_REPLY";
-static char *accept_req = "SO_EVENT_ACCEPT_REQUEST";
-static char *accept_rep = "SO_EVENT_ACCEPT_REPLY";
-static char *connect_req = "SO_EVENT_CONNECT_REQUEST";
-static char *connect_rep = "SO_EVENT_CONNECT_REPLY";
-static char *error_req = "SO_EVENT_ERROR_REQUEST";
-static char *error_rep = "SO_EVENT_ERROR_REPLY";
-static char signo_tmp[32];
-
-static char *signo_to_string(SIGSELECT signo) {
- switch (signo) {
- case SO_EVENT_READ_REQUEST: { return read_req; }
- case SO_EVENT_READ_REPLY: { return read_rep; }
- case SO_EVENT_WRITE_REQUEST: { return write_req; }
- case SO_EVENT_WRITE_REPLY: { return write_rep; }
- case SO_EVENT_EOF_REQUEST: { return eof_req; }
- case SO_EVENT_EOF_REPLY: { return eof_rep; }
- case SO_EVENT_ACCEPT_REQUEST: { return accept_req; }
- case SO_EVENT_ACCEPT_REPLY: { return accept_rep; }
- case SO_EVENT_CONNECT_REQUEST: { return connect_req; }
- case SO_EVENT_CONNECT_REPLY: { return connect_rep; }
- case SO_EVENT_ERROR_REQUEST: { return error_req; }
- case SO_EVENT_ERROR_REPLY: { return error_rep; }
- }
-
- snprintf(signo_tmp,32,"0x%x",signo);
-
- return signo_tmp;
-}
-
-#endif
-
-#endif /* __OSE__ */
-
-
static struct erl_drv_entry tcp_inet_driver_entry =
{
tcp_inet_init, /* inet_init will add this driver !! */
@@ -1280,9 +1070,6 @@ static struct erl_drv_entry tcp_inet_driver_entry =
#ifdef __WIN32__
tcp_inet_event,
NULL,
-#elif defined(__OSE__)
- tcp_inet_drv_input_ose, /*ready_input*/
- tcp_inet_drv_output_ose, /*ready_output*/
#else
tcp_inet_drv_input,
tcp_inet_drv_output,
@@ -1290,17 +1077,9 @@ static struct erl_drv_entry tcp_inet_driver_entry =
"tcp_inet",
NULL,
NULL,
-#ifdef __OSE__
- tcp_inet_ctl_ose,
-#else
tcp_inet_ctl,
-#endif
tcp_inet_timeout,
-#ifdef __OSE__
- tcp_inet_commandv_ose,
-#else
tcp_inet_commandv,
-#endif
NULL,
tcp_inet_flush,
NULL,
@@ -1452,14 +1231,6 @@ static int packet_inet_output(udp_descriptor* udesc, HANDLE event);
/* convert descriptor pointer to inet_descriptor pointer */
#define INETP(d) (&(d)->inet)
-#ifdef __OSE__
-static void inet_driver_select(inet_descriptor* desc,
- int flags, int onoff);
-static void tcp_inet_ose_dispatch_signals(tcp_descriptor *desc,
- int prev_select_state,
- union SIGNAL *sig);
-#endif
-
static int async_ref = 0; /* async reference id generator */
#define NEW_ASYNC_ID() ((async_ref++) & 0xffff)
@@ -1574,7 +1345,7 @@ static const struct in6_addr in6addr_loopback =
#endif /* HAVE_IN6 */
/* XXX: is this a driver interface function ??? */
-void erl_exit(int n, char*, ...);
+void erts_exit(int n, char*, ...);
/*
* Malloc wrapper,
@@ -1587,7 +1358,7 @@ void erl_exit(int n, char*, ...);
static void *alloc_wrapper(ErlDrvSizeT size){
void *ret = driver_alloc(size);
if(ret == NULL)
- erl_exit(1,"Out of virtual memory in malloc (%s)", __FILE__);
+ erts_exit(ERTS_ERROR_EXIT,"Out of virtual memory in malloc (%s)", __FILE__);
return ret;
}
#define ALLOC(X) alloc_wrapper(X)
@@ -1595,7 +1366,7 @@ static void *alloc_wrapper(ErlDrvSizeT size){
static void *realloc_wrapper(void *current, ErlDrvSizeT size){
void *ret = driver_realloc(current,size);
if(ret == NULL)
- erl_exit(1,"Out of virtual memory in realloc (%s)", __FILE__);
+ erts_exit(ERTS_ERROR_EXIT,"Out of virtual memory in realloc (%s)", __FILE__);
return ret;
}
#define REALLOC(X,Y) realloc_wrapper(X,Y)
@@ -1856,7 +1627,7 @@ check_double_release(InetDrvBufStk *bs, ErlDrvBinary* buf)
int i;
for (i = 0; i < bs->buf.pos; ++i) {
if (bs->buf.stk[i] == buf) {
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Multiple buffer release in inet_drv, this "
"is a bug, save the core and send it to "
@@ -4355,16 +4126,6 @@ static void desc_close(inet_descriptor* desc)
desc->forced_events = 0;
desc->send_would_block = 0;
#endif
-#ifdef __OSE__
- if (desc->events[0]) {
- driver_select(desc->port,desc->events[0],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[1],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[2],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[3],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[4],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- driver_select(desc->port,desc->events[5],FD_READ|FD_WRITE|ERL_DRV_USE,0);
- }
-#else
/*
* We should close the fd here, but the other driver might still
* be selecting on it.
@@ -4374,7 +4135,6 @@ static void desc_close(inet_descriptor* desc)
ERL_DRV_USE, 0);
else
inet_stop_select((ErlDrvEvent)(long)desc->event,NULL);
-#endif
desc->event = INVALID_EVENT; /* closed by stop_select callback */
desc->s = INVALID_SOCKET;
desc->event_mask = 0;
@@ -4416,65 +4176,6 @@ static int erl_inet_close(inet_descriptor* desc)
return 0;
}
-#ifdef __OSE__
-static void inet_select_init(inet_descriptor* desc)
-{
- desc->events[0] =
- erl_drv_ose_event_alloc(SO_EVENT_READ_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[0],
- ERL_DRV_READ|ERL_DRV_USE, 1);
-
- desc->events[1] =
- erl_drv_ose_event_alloc(SO_EVENT_EOF_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[1],
- ERL_DRV_READ|ERL_DRV_USE, 1);
-
- desc->events[2] =
- erl_drv_ose_event_alloc(SO_EVENT_ACCEPT_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[2],
- ERL_DRV_READ|ERL_DRV_USE, 1);
-
- /* trigger tcp_inet_input */
- desc->events[3] =
- erl_drv_ose_event_alloc(SO_EVENT_WRITE_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[3],
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
-
- desc->events[4] =
- erl_drv_ose_event_alloc(SO_EVENT_CONNECT_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[4],
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
-
- desc->events[5] =
- erl_drv_ose_event_alloc(SO_EVENT_ERROR_REPLY,
- desc->s,
- inet_resolve_signal,
- NULL);
- driver_select(desc->port, desc->events[5],
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
-
- /* Issue a select on error event before any other select to be sure we are
- prepared to receive error notifications from the stack, even in the
- situations when select isn't issued */
- sock_select(desc, SOCK_FD_ERROR, 1);
-}
-#endif
-
static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type,
char** rbuf, ErlDrvSizeT rsize)
{
@@ -4557,9 +4258,6 @@ static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type,
#ifdef __WIN32__
driver_select(desc->port, desc->event, ERL_DRV_READ, 1);
#endif
-#ifdef __OSE__
- inet_select_init(desc);
-#endif
desc->state = INET_STATE_OPEN;
desc->stype = type;
@@ -4583,13 +4281,7 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type,
if (name.sa.sa_family != domain)
return ctl_error(EINVAL, rbuf, rsize);
}
-#ifdef __OSE__
- /* for fdopen duplicating the sd will allow to uniquely identify
- the signal from OSE with erlang port */
- desc->s = sock_dup(s);
-#else
desc->s = s;
-#endif
if ((desc->event = sock_create_event(desc)) == INVALID_EVENT)
return ctl_error(sock_errno(), rbuf, rsize);
@@ -4607,12 +4299,6 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type,
sz = sizeof(name);
if (!IS_SOCKET_ERROR(sock_peer(s, (struct sockaddr*) &name, &sz))) {
desc->state = INET_STATE_CONNECTED;
-#ifdef __OSE__
- /* since we are dealing with different descriptors (i.e. inet and
- socket) the select part should be initialized with the right
- values */
- inet_select_init(desc);
-#endif
}
}
@@ -6076,9 +5762,9 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
int arg_sz;
enum PacketParseType old_htype = desc->htype;
int old_active = desc->active;
- int propagate = 0; /* Set to 1 if failure to set this option
- should be propagated to erlang (not all
- errors can be propagated for BC reasons) */
+ int propagate; /* Set to 1 if failure to set this option
+ should be propagated to erlang (not all
+ errors can be propagated for BC reasons) */
int res;
#ifdef HAVE_SCTP
/* SCTP sockets are treated completely separately: */
@@ -6095,6 +5781,7 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
arg_ptr = (char*) &ival;
arg_sz = sizeof(ival);
proto = SOL_SOCKET;
+ propagate = 0;
switch(opt) {
case INET_LOPT_HEADER:
@@ -7116,7 +6803,7 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc,
do { \
ErlDrvSizeT new_need = ((Ptr) - (*dest)) + (Size); \
if (new_need > dest_used) { \
- erl_exit(1,"Internal error in inet_drv, " \
+ erts_exit(ERTS_ERROR_EXIT,"Internal error in inet_drv, " \
"miscalculated buffer size"); \
} \
dest_used = new_need; \
@@ -7493,7 +7180,7 @@ static ErlDrvSSizeT sctp_fill_opts(inet_descriptor* desc,
do { \
int need; \
if ((Index) > spec_allocated) { \
- erl_exit(1,"Internal error in inet_drv, " \
+ erts_exit(ERTS_ERROR_EXIT,"Internal error in inet_drv, " \
"miscalculated buffer size"); \
} \
need = (Index) + (N); \
@@ -8413,15 +8100,6 @@ static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol)
#ifdef HAVE_SETNS
desc->netns = NULL;
#endif
-#ifdef __OSE__
- desc->select_state = 0;
- desc->events[0] = NULL;
- desc->events[1] = NULL;
- desc->events[2] = NULL;
- desc->events[3] = NULL;
- desc->events[4] = NULL;
- desc->events[5] = NULL;
-#endif
return (ErlDrvData)desc;
}
@@ -9148,10 +8826,6 @@ static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s,
copy_desc->inet.port = port;
copy_desc->inet.dport = driver_mk_port(port);
-#ifdef __OSE__
- inet_select_init(&copy_desc->inet);
-#endif
-
*err = 0;
return copy_desc;
}
@@ -9213,23 +8887,6 @@ static void tcp_inet_stop(ErlDrvData e)
inet_stop(INETP(desc));
}
-#ifdef __OSE__
-
-static ErlDrvSSizeT tcp_inet_ctl_ose(ErlDrvData e, unsigned int cmd,
- char* buf, ErlDrvSizeT len,
- char** rbuf, ErlDrvSizeT rsize) {
-
- tcp_descriptor* desc = (tcp_descriptor*)e;
- int prev_select_state = INETP(desc)->select_state;
-
- ErlDrvSSizeT res = tcp_inet_ctl(e,cmd,buf,len,rbuf,rsize);
-
- tcp_inet_ose_dispatch_signals((tcp_descriptor*)e,prev_select_state,NULL);
-
- return res;
-}
-#endif
-
/* TCP requests from Erlang */
static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
char* buf, ErlDrvSizeT len,
@@ -9671,17 +9328,6 @@ static void tcp_inet_command(ErlDrvData e, char *buf, ErlDrvSizeT len)
DEBUGF(("tcp_inet_command(%ld) }\r\n", (long)desc->inet.port));
}
-#ifdef __OSE__
-
-static void tcp_inet_commandv_ose(ErlDrvData e, ErlIOVec* ev) {
- int prev_select_state = INETP((tcp_descriptor*)e)->select_state;
- tcp_inet_commandv(e, ev);
- tcp_inet_ose_dispatch_signals((tcp_descriptor*)e,prev_select_state,NULL);
-}
-
-#endif
-
-
static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev)
{
tcp_descriptor* desc = (tcp_descriptor*)e;
@@ -9754,22 +9400,6 @@ static void inet_stop_select(ErlDrvEvent event, void* _)
{
#ifdef __WIN32__
WSACloseEvent((HANDLE)event);
-#elif defined(__OSE__)
- ErlDrvOseEventId id;
- union SIGNAL *sig;
- erl_drv_ose_event_fetch(event, NULL, &id,NULL);
- DEBUGF(("inet_stop_select(?#?) {s=%d\n",id));
- sock_close((int)id);
- /* On socket close all the signals waiting to be processed as part of the
- select should be deallocated */
- while((sig = erl_drv_ose_get_signal(event))) {
- DEBUGF(("inet_stop_select(?#?): Freeing signal %s\n",
- signo_to_string(sig->signo)));
- free_buf(&sig);
- }
- erl_drv_ose_event_free(event);
- DEBUGF(("inet_stop_select(?#?) }\n"));
-
#else
sock_close((SOCKET)(long)event);
#endif
@@ -10318,146 +9948,7 @@ static void tcp_inet_event(ErlDrvData e, ErlDrvEvent event)
return;
}
-#elif defined(__OSE__) /* !__WIN32__ */
-/* The specific resolve signal function. It will return the socket descriptor
- for which the select was issued */
-static ErlDrvOseEventId inet_resolve_signal(union SIGNAL *sig) {
- DEBUGF(("%s(?#?): s=%d got signal %s, status = %d, extra = %d, sender = 0x%x\n",
- __FUNCTION__,sig->async.fd,signo_to_string(sig->signo),
- sig->async.event.status,
- sig->async.event.extra,sender(&sig)));
- if (sig->signo == SO_EVENT_READ_REPLY ||
- sig->signo == SO_EVENT_ACCEPT_REPLY ||
- sig->signo == SO_EVENT_EOF_REPLY ||
- sig->signo == SO_EVENT_WRITE_REPLY ||
- sig->signo == SO_EVENT_ERROR_REPLY ||
- sig->signo == SO_EVENT_CONNECT_REPLY ) {
- return sig->async.fd;
- }
-
- return -1;
-}
-
-static void inet_driver_select(inet_descriptor* desc,
- int flags, int onoff) {
- ASSERT(!desc->is_ignored);
-
- if(onoff) {
- desc->select_state |= flags;
- } else {
- desc->select_state &= ~flags;
- }
-}
-
-static ssize_t writev_fallback(int fd, const struct iovec *iov, int iovcnt, int max_sz)
-{
- size_t data_len = 0;
- size_t sent = 0;
- ssize_t n;
- int i;
-
- for(i = 0; i < iovcnt; i++)
- {
- data_len = iov[i].iov_len;
-tryagain:
- n = sock_send(fd, iov[i].iov_base, data_len, 0);
- if (IS_SOCKET_ERROR(n)) {
- /* If buffer length is greater than the amount stack is able to
- * send out then try to send at least max_sz (this comes with
- * SO_EVENT_WRITE_REPLY signal*/
- if ((errno == EMSGSIZE) && (max_sz > 0) && (data_len > max_sz)) {
- data_len = max_sz;
- goto tryagain;
- }
- break;
- }
- sent += n;
- }
- return sent;
-}
-
-#define OSE_EVENT_REQ(TCP_DESC,EVENT) do { \
- union SIGNAL *sig = alloc(sizeof(struct OseAsyncSig), EVENT); \
- sig->async.fd = INETP(TCP_DESC)->s; \
- ose_request_event(INETP(TCP_DESC)->s, &sig, 1); \
- DEBUGF(("%s(%ld): s=%d sent %s\r\n",__FUNCTION__, \
- INETP(TCP_DESC)->port,INETP(TCP_DESC)->s,signo_to_string(EVENT))); \
- } while(0)
-
-static void tcp_inet_ose_dispatch_signals(tcp_descriptor *desc,
- int prev_select_state,
- union SIGNAL *sig) {
- if (sig) {
- DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) {s=%d resend\r\n",
- (long)INETP(desc)->port,INETP(desc)->s));
- /* We are reacting to a signal, which means that if
- the select_state for that signal is still activated
- we should send a new signal */
- switch (sig->signo) {
- case SO_EVENT_READ_REPLY: {
- if (INETP(desc)->select_state & FD_READ)
- OSE_EVENT_REQ(desc,SO_EVENT_READ_REQUEST);
- break;
- }
- case SO_EVENT_WRITE_REPLY: {
- if (INETP(desc)->select_state & FD_WRITE)
- OSE_EVENT_REQ(desc,SO_EVENT_WRITE_REQUEST);
- break;
- }
- case SO_EVENT_CONNECT_REPLY: {
- if (INETP(desc)->select_state & FD_CONNECT)
- OSE_EVENT_REQ(desc,SO_EVENT_CONNECT_REQUEST);
- break;
- }
- case SO_EVENT_ACCEPT_REPLY: {
- if (INETP(desc)->select_state & FD_ACCEPT)
- OSE_EVENT_REQ(desc,SO_EVENT_ACCEPT_REQUEST);
- break;
- }
- case SO_EVENT_ERROR_REPLY: {
- if (INETP(desc)->select_state & SOCK_FD_ERROR)
- OSE_EVENT_REQ(desc,SO_EVENT_ERROR_REQUEST);
- break;
- }
-
- }
- DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) }\r\n",
- (long)INETP(desc)->port));
- }
-
- if (INETP(desc)->select_state != prev_select_state) {
- /* If the select state has changed we have to issue signals for
- the state parts that have changed. */
- int xor_select_state = INETP(desc)->select_state ^ prev_select_state;
- DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) {s=%d select change\r\n",
- (long)INETP(desc)->port,INETP(desc)->s));
- if ((xor_select_state & FD_READ) &&
- (INETP(desc)->select_state & FD_READ)) {
- OSE_EVENT_REQ(desc,SO_EVENT_READ_REQUEST);
- }
- if ((xor_select_state & FD_WRITE) &&
- (INETP(desc)->select_state & FD_WRITE)) {
- OSE_EVENT_REQ(desc,SO_EVENT_WRITE_REQUEST);
- }
- if ((xor_select_state & FD_CONNECT) &&
- (INETP(desc)->select_state & FD_CONNECT)) {
- OSE_EVENT_REQ(desc,SO_EVENT_CONNECT_REQUEST);
- }
- if ((xor_select_state & FD_ACCEPT) &&
- (INETP(desc)->select_state & FD_ACCEPT)) {
- OSE_EVENT_REQ(desc,SO_EVENT_ACCEPT_REQUEST);
- }
- if ((xor_select_state & SOCK_FD_ERROR) &&
- (INETP(desc)->select_state & SOCK_FD_ERROR)) {
- OSE_EVENT_REQ(desc,SO_EVENT_ERROR_REQUEST);
- }
-
- DEBUGF(("tcp_inet_ose_dispatch_signals(%ld) }\r\n",
- (long)INETP(desc)->port));
- }
-}
-
-#endif /* __OSE__ */
+#endif /* __WIN32__ */
/* socket has input:
@@ -10944,49 +10435,6 @@ static void tcp_shutdown_async(tcp_descriptor* desc)
desc->tcp_add_flags |= TCP_ADDF_SHUTDOWN_WR_DONE;
}
-#ifdef __OSE__
-
-static void tcp_inet_drv_output_ose(ErlDrvData data, ErlDrvEvent event)
-{
- union SIGNAL *event_sig = erl_drv_ose_get_signal(event);
-
- while (event_sig) {
- int prev_select_state = INETP((tcp_descriptor*)data)->select_state;
- int res = tcp_inet_output((tcp_descriptor*)data, (HANDLE)event_sig);
- if (res != -1) {
- tcp_inet_ose_dispatch_signals((tcp_descriptor*)data,
- prev_select_state,event_sig);
- free_buf(&event_sig);
- event_sig = erl_drv_ose_get_signal(event);
- } else {
- /* NOTE: here the event object could have been deallocated!!!!
- inet_stop_select is called when doing driver_select(ERL_DRV_USE,0)
- */
- free_buf(&event_sig);
- return;
- }
- }
-}
-
-static void tcp_inet_drv_input_ose(ErlDrvData data, ErlDrvEvent event)
-{
- union SIGNAL *event_sig = erl_drv_ose_get_signal(event);
-
- while (event_sig) {
- int prev_select_state = INETP((tcp_descriptor*)data)->select_state;
- int res = tcp_inet_input((tcp_descriptor*)data, (HANDLE)event);
- if (res != -1) {
- tcp_inet_ose_dispatch_signals((tcp_descriptor*)data, prev_select_state,
- event_sig);
- free_buf(&event_sig);
- event_sig = erl_drv_ose_get_signal(event);
- } else {
- free_buf(&event_sig);
- return;
- }
- }
-}
-#else
static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event)
{
(void)tcp_inet_output((tcp_descriptor*)data, (HANDLE)event);
@@ -10996,7 +10444,6 @@ static void tcp_inet_drv_input(ErlDrvData data, ErlDrvEvent event)
{
(void)tcp_inet_input((tcp_descriptor*)data, (HANDLE)event);
}
-#endif
/* socket ready for ouput:
** 1. INET_STATE_CONNECTING => non block connect ?
@@ -11062,13 +10509,6 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
ssize_t n;
SysIOVec* iov;
-#ifdef __OSE__
- /* For large size buffers case the amount of data that the stack is
- able to send out (received in the .extra field) should be passed
- down to writev_fallback */
- n = event ? ((union SIGNAL*)event)->async.event.extra : 0;
-#endif
-
if ((iov = driver_peekq(ix, &vsize)) == NULL) {
sock_select(INETP(desc), FD_WRITE, 0);
send_empty_out_q_msgs(INETP(desc));
@@ -11096,12 +10536,6 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
sizes > (max 32 bit signed int) */
size_t howmuch = 0x7FFFFFFF; /* max signed 32 bit */
int x;
-#ifdef __OSE__
- /* For EWOULDBLOCK sock_sendv returns 0 so we have to be sure it
- wasn't the case */
- if(sock_errno() == ERRNO_BLOCK)
- goto done;
-#endif
for(x = 0; x < vsize && iov[x].iov_len == 0; ++x)
;
if (x < vsize) {
@@ -12143,115 +11577,18 @@ make_noninheritable_handle(SOCKET s)
* Multi-timers
*/
-static void absolute_timeout(unsigned millis, ErlDrvNowData *out)
-{
- unsigned rest;
- unsigned long millipart;
- unsigned long secpart;
- unsigned long megasecpart;
- unsigned tmo_secs = (millis / 1000U);
- unsigned tmo_millis = (millis % 1000);
- driver_get_now(out);
- rest = (out->microsecs) % 1000;
- millipart = ((out->microsecs) / 1000UL);
- if (rest >= 500) {
- ++millipart;
- }
- secpart = out->secs;
- megasecpart = out->megasecs;
- millipart += tmo_millis;
- secpart += (millipart / 1000000UL);
- millipart %= 1000000UL;
- secpart += tmo_secs;
- megasecpart += (secpart / 1000000UL);
- secpart %= 1000000UL;
- out->megasecs = megasecpart;
- out->secs = secpart;
- out->microsecs = (millipart * 1000UL);
-}
-
-static unsigned relative_timeout(ErlDrvNowData *in)
-{
- ErlDrvNowData now;
- unsigned rest;
- unsigned long millipart, in_millis, in_secs, in_megasecs;
-
- driver_get_now(&now);
-
- in_secs = in->secs;
- in_megasecs = in->megasecs;
-
- rest = (now.microsecs) % 1000;
- millipart = ((now.microsecs) / 1000UL);
- if (rest >= 500) {
- ++millipart;
- }
- in_millis = ((in->microsecs) / 1000UL);
- if ( in_millis < millipart ) {
- if (in_secs > 0) {
- --in_secs;
- } else {
- in_secs = (1000000UL - 1UL);
- if (in_megasecs <= now.megasecs) {
- return 0;
- } else {
- --in_megasecs;
- }
- }
- in_millis += 1000UL;
- }
- in_millis -= millipart;
-
- if (in_secs < now.secs) {
- if (in_megasecs <= now.megasecs) {
- return 0;
- } else {
- --in_megasecs;
- }
- in_secs += 1000000;
- }
- in_secs -= now.secs;
- if (in_megasecs < now.megasecs) {
- return 0;
- } else {
- in_megasecs -= now.megasecs;
- }
- return (unsigned) ((in_megasecs * 1000000000UL) +
- (in_secs * 1000UL) +
- in_millis);
-}
-
-#ifdef DEBUG
-static int nowcmp(ErlDrvNowData *d1, ErlDrvNowData *d2)
-{
- /* Assume it's not safe to do signed conversion on megasecs... */
- if (d1->megasecs < d2->megasecs) {
- return -1;
- } else if (d1->megasecs > d2->megasecs) {
- return 1;
- } else if (d1->secs != d2->secs) {
- return ((int) d1->secs) - ((int) d2->secs);
- }
- return ((int) d1->microsecs) - ((int) d2->microsecs);
-}
-#endif
-
static void fire_multi_timers(MultiTimerData **first, ErlDrvPort port,
ErlDrvData data)
{
- unsigned next_timeout;
+ ErlDrvTime next_timeout;
if (!*first) {
ASSERT(0);
return;
}
#ifdef DEBUG
{
- ErlDrvNowData chk;
- driver_get_now(&chk);
- chk.microsecs /= 10000UL;
- chk.microsecs *= 10000UL;
- chk.microsecs += 10000;
- ASSERT(nowcmp(&chk,&((*first)->when)) >= 0);
+ ErlDrvTime chk = erl_drv_monotonic_time(ERL_DRV_MSEC);
+ ASSERT(chk >= (*first)->when);
}
#endif
do {
@@ -12263,9 +11600,9 @@ static void fire_multi_timers(MultiTimerData **first, ErlDrvPort port,
return;
}
(*first)->prev = NULL;
- next_timeout = relative_timeout(&((*first)->when));
- } while (next_timeout == 0);
- driver_set_timer(port,next_timeout);
+ next_timeout = (*first)->when - erl_drv_monotonic_time(ERL_DRV_MSEC);
+ } while (next_timeout <= 0);
+ driver_set_timer(port, (unsigned long) next_timeout);
}
static void clean_multi_timers(MultiTimerData **first, ErlDrvPort port)
@@ -12288,8 +11625,10 @@ static void remove_multi_timer(MultiTimerData **first, ErlDrvPort port, MultiTim
driver_cancel_timer(port);
*first = p->next;
if (*first) {
- unsigned ntmo = relative_timeout(&((*first)->when));
- driver_set_timer(port,ntmo);
+ ErlDrvTime ntmo = (*first)->when - erl_drv_monotonic_time(ERL_DRV_MSEC);
+ if (ntmo < 0)
+ ntmo = 0;
+ driver_set_timer(port, (unsigned long) ntmo);
}
}
if (p->next != NULL) {
@@ -12303,26 +11642,14 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port,
void (*timeout_fun)(ErlDrvData drv_data,
ErlDrvTermData caller))
{
-#define eq_mega(a, b) ((a)->when.megasecs == (b)->when.megasecs)
-#define eq_sec(a, b) ((a)->when.secs == (b)->when.secs)
MultiTimerData *mtd, *p, *s;
mtd = ALLOC(sizeof(MultiTimerData));
- absolute_timeout(timeout, &(mtd->when));
+ mtd->when = erl_drv_monotonic_time(ERL_DRV_MSEC) + ((ErlDrvTime) timeout) + 1;
mtd->timeout_function = timeout_fun;
mtd->caller = caller;
mtd->next = mtd->prev = NULL;
for(p = *first,s = NULL; p != NULL; s = p, p = p->next) {
- if (p->when.megasecs >= mtd->when.megasecs) {
- break;
- }
- }
- for (; p!= NULL && eq_mega(p, mtd); s = p, p = p->next) {
- if (p->when.secs >= mtd->when.secs) {
- break;
- }
- }
- for (; p!= NULL && eq_mega(p, mtd) && eq_sec(p, mtd); s = p, p = p->next) {
- if (p->when.microsecs >= mtd->when.microsecs) {
+ if (p->when >= mtd->when) {
break;
}
}
@@ -12352,12 +11679,6 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port,
}
return mtd;
}
-#undef eq_mega
-#undef eq_sec
-
-
-
-
/*-----------------------------------------------------------------------------
diff --git a/erts/emulator/drivers/ose/ose_efile.c b/erts/emulator/drivers/ose/ose_efile.c
deleted file mode 100644
index c8337a95d5..0000000000
--- a/erts/emulator/drivers/ose/ose_efile.c
+++ /dev/null
@@ -1,1125 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2012. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Purpose: Provides file and directory operations for OSE.
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#if defined(HAVE_POSIX_FALLOCATE) && !defined(__sun) && !defined(__sun__)
-#define _XOPEN_SOURCE 600
-#endif
-#if !defined(_GNU_SOURCE) && defined(HAVE_LINUX_FALLOC_H)
-#define _GNU_SOURCE
-#endif
-#include "sys.h"
-#include "erl_driver.h"
-#include "erl_efile.h"
-#if defined(DARWIN) || defined(HAVE_LINUX_FALLOC_H) || defined(HAVE_POSIX_FALLOCATE)
-#include "fcntl.h"
-#endif
-#include "ose.h"
-#include "unistd.h"
-#include "sys/stat.h"
-#include "dirent.h"
-#include "sys/time.h"
-#include "time.h"
-#include "assert.h"
-
-/* Find a definition of MAXIOV, that is used in the code later. */
-#if defined IOV_MAX
-#define MAXIOV IOV_MAX
-#elif defined UIO_MAXIOV
-#define MAXIOV UIO_MAXIOV
-#else
-#define MAXIOV 16
-#endif
-
-/*
- * Macros for testing file types.
- */
-
-#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR)
-#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG)
-#define ISDEV(st) \
- (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK)
-#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK)
-#ifdef NO_UMASK
-#define FILE_MODE 0644
-#define DIR_MODE 0755
-#else
-#define FILE_MODE 0666
-#define DIR_MODE 0777
-#endif
-
-#define IS_DOT_OR_DOTDOT(s) \
- (s[0] == '.' && (s[1] == '\0' || (s[1] == '.' && s[2] == '\0')))
-
-/*
- * Macros for handling local file descriptors
- * and mutexes.
- *
- * Handling of files like this is necessary because OSE
- * does not allow seeking after the end of a file. So
- * what we do it emulate this by keeping track of the size
- * of the file and where the file's positions is. If a
- * write happens after eof then we pad it.
- *
- * Given time this should be rewritten to get rid of the
- * mutex and use the port lock to protect the data. This
- * could be done be done by adapting the efile api for some
- * calls to allow some meta-data to be associated with the
- * open file.
- */
-
-#define L_FD_IS_VALID(fd_data) ((fd_data)->beyond_eof > 0)
-#define L_FD_INVALIDATE(fd_data) (fd_data)->beyond_eof = 0
-#define L_FD_CUR(fd_data) (fd_data)->pos
-#define L_FD_OFFS_BEYOND_EOF(fd_data, offs) \
- (((fd_data)->size > offs) ? 0 : 1)
-
-#define L_FD_FAIL -1
-#define L_FD_SUCCESS 1
-#define L_FD_PAD_SIZE 255
-
-struct fd_meta {
- ErlDrvMutex *meta_mtx;
- struct fd_data *fd_data_list;
-};
-
-struct fd_data {
- int fd;
- struct fd_data *next;
- struct fd_data *prev;
- int pos;
- int beyond_eof;
- size_t size;
-#ifdef DEBUG
- PROCESS owner;
-#endif
-};
-
-static int l_invalidate_local_fd(int fd);
-static int l_pad_file(struct fd_data *fd_data, off_t offset);
-static int check_error(int result, Efile_error* errInfo);
-static struct fd_data* l_new_fd(void);
-static int l_remove_local_fd(int fd);
-static struct fd_data* l_find_local_fd(int fd);
-static int l_update_local_fd(int fd, int pos, int size);
-
-static struct fd_meta* fdm = NULL;
-
-
-/***************************************************************************/
-
-static int
-l_remove_local_fd(int fd)
-{
- struct fd_data *fd_data;
- fd_data = l_find_local_fd(fd);
-
- if (fd_data == NULL) {
- return L_FD_FAIL;
- }
-#ifdef DEBUG
- assert(fd_data->owner == current_process());
-#endif
- erl_drv_mutex_lock(fdm->meta_mtx);
- /* head ? */
- if (fd_data == fdm->fd_data_list) {
- if (fd_data->next != NULL) {
- /* remove link to head */
- fd_data->next->prev = NULL;
- /* set new head */
- fdm->fd_data_list = fd_data->next;
- }
- else {
- /* head is lonely */
- fdm->fd_data_list = NULL;
- }
- }
- else { /* not head */
- if (fd_data->prev == NULL) {
- erl_drv_mutex_unlock(fdm->meta_mtx);
- return L_FD_FAIL;
- }
- else {
- if (fd_data->next != NULL) {
- fd_data->next->prev = fd_data->prev;
- fd_data->prev->next = fd_data->next;
- }
- else {
- fd_data->prev->next = NULL;
- }
- }
- }
-
- /* scramble values */
- fd_data->beyond_eof = -1;
- fd_data->next = NULL;
- fd_data->prev = NULL;
- fd_data->fd = -1;
-
- /* unlock and clean */
- driver_free(fd_data);
- erl_drv_mutex_unlock(fdm->meta_mtx);
-
- return L_FD_SUCCESS;
-}
-
-/***************************************************************************/
-
-static int
-l_invalidate_local_fd(int fd) {
- struct fd_data *fd_data;
-
- if ((fd_data = l_find_local_fd(fd)) == NULL) {
- return L_FD_FAIL;
- }
-
- fd_data->beyond_eof = 0;
- return L_FD_SUCCESS;
-}
-
-/****************************************************************************/
-
-static struct fd_data*
-l_find_local_fd(int fd) {
- struct fd_data *fd_data;
-
- fd_data = NULL;
- erl_drv_mutex_lock(fdm->meta_mtx);
- for (fd_data = fdm->fd_data_list; fd_data != NULL; ) {
- if (fd_data->fd == fd) {
-#ifdef DEBUG
- assert(fd_data->owner == current_process());
-#endif
- break;
- }
- fd_data = fd_data->next;
- }
- erl_drv_mutex_unlock(fdm->meta_mtx);
- return fd_data;
-}
-
-/***************************************************************************/
-
-static struct fd_data*
-l_new_fd(void) {
- struct fd_data *fd_data;
-
- fd_data = driver_alloc(sizeof(struct fd_data));
- if (fd_data == NULL) {
- return NULL;
- }
- erl_drv_mutex_lock(fdm->meta_mtx);
- if (fdm->fd_data_list == NULL) {
- fdm->fd_data_list = fd_data;
- fdm->fd_data_list->prev = NULL;
- fdm->fd_data_list->next = NULL;
- }
- else {
- fd_data->next = fdm->fd_data_list;
- fdm->fd_data_list = fd_data;
- fdm->fd_data_list->prev = NULL;
- }
-#ifdef DEBUG
- fd_data->owner = current_process();
-#endif
- erl_drv_mutex_unlock(fdm->meta_mtx);
- return fd_data;
-}
-
-/***************************************************************************/
-
-static int
-l_update_local_fd(int fd, int pos, int size) {
- struct fd_data *fd_data = NULL;
-
- fd_data = l_find_local_fd(fd);
- /* new fd to handle? */
- if (fd_data == NULL) {
- fd_data = l_new_fd();
- if (fd_data == NULL) {
- /* out of memory */
- return L_FD_FAIL;
- }
- }
- fd_data->size = size;
- fd_data->pos = pos;
- fd_data->fd = fd;
- fd_data->beyond_eof = 1;
-
- return L_FD_SUCCESS;
-}
-
-/***************************************************************************/
-
-static int
-l_pad_file(struct fd_data *fd_data, off_t offset) {
- int size_dif;
- int written = 0;
- int ret_val = L_FD_SUCCESS;
- char padding[L_FD_PAD_SIZE];
-
- size_dif = (offset - fd_data->size);
- memset(&padding, '\0', L_FD_PAD_SIZE);
-
- while (size_dif > 0) {
- written = write(fd_data->fd, padding,
- (size_dif < L_FD_PAD_SIZE) ?
- size_dif : L_FD_PAD_SIZE);
- if (written < 0 && errno != EINTR && errno != EAGAIN) {
- ret_val = -1;
- break;
- }
- size_dif -= written;
- }
- L_FD_INVALIDATE(fd_data);
- return ret_val;
-}
-
-/***************************************************************************/
-
-static int
-check_error(int result, Efile_error *errInfo) {
- if (result < 0) {
- errInfo->posix_errno = errInfo->os_errno = errno;
- return 0;
- }
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_init() {
- fdm = driver_alloc(sizeof(struct fd_meta));
- if (fdm == NULL) {
- return L_FD_FAIL;
- }
- fdm->meta_mtx = erl_drv_mutex_create("ose_efile local fd mutex\n");
- erl_drv_mutex_lock(fdm->meta_mtx);
- fdm->fd_data_list = NULL;
- erl_drv_mutex_unlock(fdm->meta_mtx);
- return L_FD_SUCCESS;
-}
-
-/***************************************************************************/
-
-int
-efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to create. */
-{
-#ifdef NO_MKDIR_MODE
- return check_error(mkdir(name), errInfo);
-#else
- int res = mkdir(name, DIR_MODE);
- if (res < 0 && errno == EINVAL) {
- errno = ENOENT;
- }
- return check_error(res, errInfo);
-#endif
-}
-
-/***************************************************************************/
-
-int
-efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to delete. */
-{
- if (rmdir(name) == 0) {
- return 1;
- }
- if (errno == ENOTEMPTY) {
- errno = EEXIST;
- }
- if (errno == EEXIST || errno == EINVAL) {
- int saved_errno = errno;
- struct stat file_stat;
- struct stat cwd_stat;
-
- if(stat(name, &file_stat) != 0) {
- errno = ENOENT;
- return check_error(-1, errInfo);
- }
- /*
- * The error code might be wrong if this is the current directory.
- */
- if (stat(name, &file_stat) == 0 && stat(".", &cwd_stat) == 0 &&
- file_stat.st_ino == cwd_stat.st_ino &&
- file_stat.st_dev == cwd_stat.st_dev) {
- saved_errno = EACCES;
- }
- errno = saved_errno;
- }
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of file to delete. */
-{
- struct stat statbuf;
-
- if (stat(name, &statbuf) >= 0) {
- /* Do not let unlink() remove directories */
- if (ISDIR(statbuf)) {
- errno = EPERM;
- return check_error(-1, errInfo);
- }
-
- if (unlink(name) == 0) {
- return 1;
- }
-
- if (errno == EISDIR) {
- errno = EPERM;
- return check_error(-1, errInfo);
- }
- }
- else {
- if (errno == EINVAL) {
- errno = ENOENT;
- return check_error(-1, errInfo);
- }
- }
- return check_error(-1, errInfo);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Changes the name of an existing file or directory, from src to dst.
- * If src and dst refer to the same file or directory, does nothing
- * and returns success. Otherwise if dst already exists, it will be
- * deleted and replaced by src subject to the following conditions:
- * If src is a directory, dst may be an empty directory.
- * If src is a file, dst may be a file.
- * In any other situation where dst already exists, the rename will
- * fail.
- *
- * Results:
- * If the directory was successfully created, returns 1.
- * Otherwise the return value is 0 and errno is set to
- * indicate the error. Some possible values for errno are:
- *
- * EACCES: src or dst parent directory can't be read and/or written.
- * EEXIST: dst is a non-empty directory.
- * EINVAL: src is a root directory or dst is a subdirectory of src.
- * EISDIR: dst is a directory, but src is not.
- * ENOENT: src doesn't exist, or src or dst is "".
- * ENOTDIR: src is a directory, but dst is not.
- * EXDEV: src and dst are on different filesystems.
- *
- * Side effects:
- * The implementation of rename may allow cross-filesystem renames,
- * but the caller should be prepared to emulate it with copy and
- * delete if errno is EXDEV.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-efile_rename(Efile_error* errInfo, /* Where to return error codes. */
- char* src, /* Original name. */
- char* dst) /* New name. */
-{
-
- /* temporary fix AFM does not recognize ./<file name>
- * in destination remove pending on adaption of AFM fix
- */
-
- char *dot_str;
- if (dst != NULL) {
- dot_str = strchr(dst, '.');
- if (dot_str && dot_str == dst && dot_str[1] == '/') {
- dst = dst+2;
- }
- }
-
- if (rename(src, dst) == 0) {
- return 1;
- }
- if (errno == ENOTEMPTY) {
- errno = EEXIST;
- }
- if (errno == EINVAL) {
- struct stat file_stat;
-
- if (stat(dst, &file_stat)== 0) {
- if (ISDIR(file_stat)) {
- errno = EISDIR;
- }
- else if (ISREG(file_stat)) {
- errno = ENOTDIR;
- }
- else {
- errno = EINVAL;
- }
- }
- else {
- errno = EINVAL;
- }
- }
-
- if (strcmp(src, "/") == 0) {
- errno = EINVAL;
- }
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_chdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name) /* Name of directory to make current. */
-{
- return check_error(chdir(name), errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_getdcwd(Efile_error* errInfo, /* Where to return error codes. */
- int drive, /* 0 - current, 1 - A, 2 - B etc. */
- char* buffer, /* Where to return the current
- directory. */
- size_t size) /* Size of buffer. */
-{
- if (drive == 0) {
- if (getcwd(buffer, size) == NULL)
- return check_error(-1, errInfo);
-
- return 1;
- }
-
- /*
- * Drives other than 0 is not supported on Unix.
- */
-
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_readdir(Efile_error* errInfo, /* Where to return error codes. */
- char* name, /* Name of directory to open. */
- EFILE_DIR_HANDLE* p_dir_handle, /* Pointer to directory
- handle of
- open directory.*/
- char* buffer, /* Pointer to buffer for
- one filename. */
- size_t *size) /* in-out Size of buffer, length
- of name. */
-{
- DIR *dp; /* Pointer to directory structure. */
- struct dirent* dirp; /* Pointer to directory entry. */
-
- /*
- * If this is the first call, we must open the directory.
- */
-
- if (*p_dir_handle == NULL) {
- dp = opendir(name);
- if (dp == NULL)
- return check_error(-1, errInfo);
- *p_dir_handle = (EFILE_DIR_HANDLE) dp;
- }
-
- /*
- * Retrieve the name of the next file using the directory handle.
- */
-
- dp = *((DIR **)((void *)p_dir_handle));
- for (;;) {
- dirp = readdir(dp);
- if (dirp == NULL) {
- closedir(dp);
- return 0;
- }
- if (IS_DOT_OR_DOTDOT(dirp->d_name))
- continue;
- buffer[0] = '\0';
- strncat(buffer, dirp->d_name, (*size)-1);
- *size = strlen(dirp->d_name);
- return 1;
- }
-}
-
-/***************************************************************************/
-
-int
-efile_openfile(Efile_error* errInfo, /* Where to return error codes. */
- char* name, /* Name of directory to open. */
- int flags, /* Flags to user for opening. */
- int* pfd, /* Where to store the file
- descriptor. */
- Sint64 *pSize) /* Where to store the size of the
- file. */
-{
- struct stat statbuf;
- int fd;
- int mode; /* Open mode. */
-
- if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) {
- errno = EISDIR;
- return check_error(-1, errInfo);
- }
-
- switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) {
- case EFILE_MODE_READ:
- mode = O_RDONLY;
- break;
- case EFILE_MODE_WRITE:
- if (flags & EFILE_NO_TRUNCATE)
- mode = O_WRONLY | O_CREAT;
- else
- mode = O_WRONLY | O_CREAT | O_TRUNC;
- break;
- case EFILE_MODE_READ_WRITE:
- mode = O_RDWR | O_CREAT;
- break;
- default:
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
-
- if (flags & EFILE_MODE_APPEND) {
- mode &= ~O_TRUNC;
- mode |= O_APPEND;
- }
-
- if (flags & EFILE_MODE_EXCL) {
- mode |= O_EXCL;
- }
-
- fd = open(name, mode, FILE_MODE);
-
- if (!check_error(fd, errInfo))
- return 0;
-
- *pfd = fd;
- if (pSize) {
- *pSize = statbuf.st_size;
- }
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_may_openfile(Efile_error* errInfo, char *name) {
- struct stat statbuf; /* Information about the file */
- int result;
-
- result = stat(name, &statbuf);
- if (!check_error(result, errInfo))
- return 0;
- if (!ISREG(statbuf)) {
- errno = EISDIR;
- return check_error(-1, errInfo);
- }
- return 1;
-}
-
-/***************************************************************************/
-
-void
-efile_closefile(int fd)
-{
- if (l_find_local_fd(fd) != NULL) {
- l_remove_local_fd(fd);
- }
- close(fd);
-}
-
-/***************************************************************************/
-
-int
-efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */
- int fd) /* File descriptor for file to sync data. */
-{
- return efile_fsync(errInfo, fd);
-}
-
-/***************************************************************************/
-
-int
-efile_fsync(Efile_error *errInfo, /* Where to return error codes. */
- int fd) /* File descriptor for file to sync. */
-{
- return check_error(fsync(fd), errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo,
- char* name, int info_for_link)
-{
- struct stat statbuf; /* Information about the file */
- int result;
-
- result = stat(name, &statbuf);
- if (!check_error(result, errInfo)) {
- return 0;
- }
-
-#if SIZEOF_OFF_T == 4
- pInfo->size_high = 0;
-#else
- pInfo->size_high = (Uint32)(statbuf.st_size >> 32);
-#endif
- pInfo->size_low = (Uint32)statbuf.st_size;
-
-#ifdef NO_ACCESS
- /* Just look at read/write access for owner. */
-
- pInfo->access = ((statbuf.st_mode >> 6) & 07) >> 1;
-
-#else
- pInfo->access = FA_NONE;
- if (access(name, R_OK) == 0)
- pInfo->access |= FA_READ;
- if (access(name, W_OK) == 0)
- pInfo->access |= FA_WRITE;
-
-#endif
-
- if (ISDEV(statbuf))
- pInfo->type = FT_DEVICE;
- else if (ISDIR(statbuf))
- pInfo->type = FT_DIRECTORY;
- else if (ISREG(statbuf))
- pInfo->type = FT_REGULAR;
- else if (ISLNK(statbuf))
- pInfo->type = FT_SYMLINK;
- else
- pInfo->type = FT_OTHER;
-
- pInfo->accessTime = statbuf.st_atime;
- pInfo->modifyTime = statbuf.st_mtime;
- pInfo->cTime = statbuf.st_ctime;
-
- pInfo->mode = statbuf.st_mode;
- pInfo->links = statbuf.st_nlink;
- pInfo->major_device = statbuf.st_dev;
- pInfo->inode = statbuf.st_ino;
- pInfo->uid = statbuf.st_uid;
- pInfo->gid = statbuf.st_gid;
-
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name)
-{
- /*
- * On some systems chown will always fail for a non-root user unless
- * POSIX_CHOWN_RESTRICTED is not set. Others will succeed as long as
- * you don't try to chown a file to someone besides youself.
- */
- if (pInfo->mode != -1) {
- mode_t newMode = pInfo->mode & (S_ISUID | S_ISGID |
- S_IRWXU | S_IRWXG | S_IRWXO);
- if (chmod(name, newMode)) {
- newMode &= ~(S_ISUID | S_ISGID);
- if (chmod(name, newMode)) {
- return check_error(-1, errInfo);
- }
- }
- }
-
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_write(Efile_error* errInfo, /* Where to return error codes. */
- int flags, /* Flags given when file was
- opened. */
- int fd, /* File descriptor to write to. */
- char* buf, /* Buffer to write. */
- size_t count) /* Number of bytes to write. */
-{
- ssize_t written; /* Bytes written in last operation. */
- struct fd_data *fd_data;
-
- if ((fd_data = l_find_local_fd(fd)) != NULL) {
- if (L_FD_IS_VALID(fd_data)) {
- /* we are beyond eof and need to pad*/
- if (l_pad_file(fd_data, L_FD_CUR(fd_data)) < 0) {
- return check_error(-1, errInfo);
- }
- }
- }
-
- while (count > 0) {
- if ((written = write(fd, buf, count)) < 0) {
- if (errno != EINTR) {
- return check_error(-1, errInfo);
- }
- else {
- written = 0;
- }
- }
- ASSERT(written <= count);
- buf += written;
- count -= written;
- }
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_writev(Efile_error* errInfo, /* Where to return error codes */
- int flags, /* Flags given when file was
- * opened */
- int fd, /* File descriptor to write to */
- SysIOVec* iov, /* Vector of buffer structs.
- * The structs may be changed i.e.
- * due to incomplete writes */
- int iovcnt) /* Number of structs in vector */
-{
- struct fd_data *fd_data;
- int cnt = 0; /* Buffers so far written */
-
- ASSERT(iovcnt >= 0);
- if ((fd_data = l_find_local_fd(fd)) != NULL) {
- if (L_FD_IS_VALID(fd_data)) {
- /* we are beyond eof and need to pad*/
- if (l_pad_file(fd_data, L_FD_CUR(fd_data)) < 0) {
- return check_error(-1, errInfo);
- }
- }
- }
- while (cnt < iovcnt) {
- if ((! iov[cnt].iov_base) || (iov[cnt].iov_len <= 0)) {
- /* Empty buffer - skip */
- cnt++;
- }
- else { /* Non-empty buffer */
- ssize_t w; /* Bytes written in this call */
- do {
- w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len);
- } while (w < 0 && errno == EINTR);
-
- ASSERT(w <= iov[cnt].iov_len || w == -1);
-
- if (w < 0) {
- return check_error(-1, errInfo);
- }
- /* Move forward to next buffer to write */
- for (; cnt < iovcnt && w > 0; cnt++) {
- if (iov[cnt].iov_base && iov[cnt].iov_len > 0) {
- if (w < iov[cnt].iov_len) {
- /* Adjust the buffer for next write */
- iov[cnt].iov_len -= w;
- iov[cnt].iov_base += w;
- w = 0;
- break;
- }
- else {
- w -= iov[cnt].iov_len;
- }
- }
- }
- ASSERT(w == 0);
- } /* else Non-empty buffer */
- } /* while (cnt< iovcnt) */
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_read(Efile_error* errInfo, /* Where to return error codes. */
- int flags, /* Flags given when file was opened. */
- int fd, /* File descriptor to read from. */
- char* buf, /* Buffer to read into. */
- size_t count, /* Number of bytes to read. */
- size_t *pBytesRead) /* Where to return number of
- bytes read. */
-{
- ssize_t n;
- struct fd_data *fd_data;
-
- if ((fd_data = l_find_local_fd(fd)) != NULL) {
- if (L_FD_IS_VALID(fd_data)) {
- *pBytesRead = 0;
- return 1;
- }
- }
- for (;;) {
- if ((n = read(fd, buf, count)) >= 0) {
- break;
- }
- else if (errno != EINTR) {
- return check_error(-1, errInfo);
- }
- }
- if (fd_data != NULL && L_FD_IS_VALID(fd_data)) {
- L_FD_INVALIDATE(fd_data);
- }
- *pBytesRead = (size_t) n;
- return 1;
-}
-
-/* pread() and pwrite() */
-/* Some unix systems, notably Solaris has these syscalls */
-/* It is especially nice for i.e. the dets module to have support */
-/* for this, even if the underlying OS dosn't support it, it is */
-/* reasonably easy to work around by first calling seek, and then */
-/* calling read(). */
-/* This later strategy however changes the file pointer, which pread() */
-/* does not do. We choose to ignore this and say that the location */
-/* of the file pointer is undefined after a call to any of the p functions*/
-
-
-int
-efile_pread(Efile_error* errInfo, /* Where to return error codes. */
- int fd, /* File descriptor to read from. */
- Sint64 offset, /* Offset in bytes from BOF. */
- char* buf, /* Buffer to read into. */
- size_t count, /* Number of bytes to read. */
- size_t *pBytesRead) /* Where to return
- number of bytes read. */
-{
- int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL);
- if (res) {
- return efile_read(errInfo, 0, fd, buf, count, pBytesRead);
- } else {
- return res;
- }
-}
-
-
-/***************************************************************************/
-
-int
-efile_pwrite(Efile_error* errInfo, /* Where to return error codes. */
- int fd, /* File descriptor to write to. */
- char* buf, /* Buffer to write. */
- size_t count, /* Number of bytes to write. */
- Sint64 offset) /* where to write it */
-{
- int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL);
-
- if (res) {
- return efile_write(errInfo, 0, fd, buf, count);
- } else {
- return res;
- }
-}
-
-/***************************************************************************/
-
-int
-efile_seek(Efile_error* errInfo, /* Where to return error codes. */
- int fd, /* File descriptor to do the seek on. */
- Sint64 offset, /* Offset in bytes from the given
- origin. */
- int origin, /* Origin of seek (SEEK_SET, SEEK_CUR,
- SEEK_END). */
- Sint64 *new_location) /* Resulting new location in file. */
-{
- off_t off, result;
- off = (off_t) offset;
-
- switch (origin) {
- case EFILE_SEEK_SET:
- origin = SEEK_SET;
- break;
- case EFILE_SEEK_CUR:
- origin = SEEK_CUR;
- break;
- case EFILE_SEEK_END:
- origin = SEEK_END;
- break;
- default:
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
- if (off != offset) {
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
- errno = 0;
- result = lseek(fd, off, origin);
-
- if (result >= 0) {
- l_invalidate_local_fd(fd);
- }
-
- if (result < 0)
- {
- if (errno == ENOSYS) {
- int size, cur_pos;
-
- if (off < 0) {
- errno = EINVAL;
- return check_error(-1, errInfo);
- }
-
- cur_pos = lseek(fd, 0, SEEK_CUR);
- size = lseek(fd, 0, SEEK_END);
-
- if (origin == SEEK_SET) {
- result = offset;
- }
- else if (origin == SEEK_CUR) {
- result = offset + cur_pos;
- }
- else if (origin == SEEK_END) {
- result = size + offset;
- }
-
- /* sanity check our result */
- if (size > result) {
- return check_error(-1, errInfo);
- }
-
- /* store the data localy */
- l_update_local_fd(fd, result, size);
-
- /* reset the original file position */
- if (origin != SEEK_END) {
- lseek(fd, cur_pos, SEEK_SET);
- }
- }
- else if (errno == 0) {
- errno = EINVAL;
- }
- }
-
- if (new_location) {
- *new_location = result;
- }
-
- return 1;
-}
-
-/***************************************************************************/
-
-int
-efile_truncate_file(Efile_error* errInfo, int *fd, int flags)
-{
- off_t offset;
- struct fd_data *fd_data;
-
- if ((fd_data = l_find_local_fd(*fd)) != NULL && L_FD_IS_VALID(fd_data)) {
- offset = L_FD_CUR(fd_data);
- }
- else {
- offset = lseek(*fd, 0, SEEK_CUR);
- }
-
- return check_error(((offset >= 0) &&
- (ftruncate(*fd, offset) == 0)) ? 1 : -1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size)
-{
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_altname(Efile_error* errInfo, char* name, char* buffer, size_t size)
-{
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_link(Efile_error* errInfo, char* old, char* new)
-{
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_symlink(Efile_error* errInfo, char* old, char* new)
-{
- errno = ENOTSUP;
- return check_error(-1, errInfo);
-}
-
-/***************************************************************************/
-
-int
-efile_fadvise(Efile_error* errInfo, int fd, Sint64 offset,
- Sint64 length, int advise)
-{
- return check_error(posix_fadvise(fd, offset, length, advise), errInfo);
-}
-
-/***************************************************************************/
-
-static int
-call_posix_fallocate(int fd, Sint64 offset, Sint64 length)
-{
- int ret;
-
- /*
- * On Linux and Solaris for example, posix_fallocate() returns
- * a positive error number on error and it does not set errno.
- * On FreeBSD however (9.0 at least), it returns -1 on error
- * and it sets errno.
- */
- do {
- ret = posix_fallocate(fd, (off_t) offset, (off_t) length);
- if (ret > 0) {
- errno = ret;
- ret = -1;
- }
- } while (ret != 0 && errno == EINTR);
-
- return ret;
-}
-
-/***************************************************************************/
-
-int
-efile_fallocate(Efile_error* errInfo, int fd, Sint64 offset, Sint64 length)
-{
- return check_error(call_posix_fallocate(fd, offset, length), errInfo);
-}
diff --git a/erts/emulator/drivers/ose/ose_signal_drv.c b/erts/emulator/drivers/ose/ose_signal_drv.c
deleted file mode 100644
index 2be9462a47..0000000000
--- a/erts/emulator/drivers/ose/ose_signal_drv.c
+++ /dev/null
@@ -1,897 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "errno.h"
-#include "stdio.h"
-#include "string.h"
-#include "stddef.h"
-
-#include "sys.h"
-#include "erl_driver.h"
-#include "ose.h"
-
-
-#ifdef HAVE_OSE_SPI_H
-#include "ose_spi/ose_spi.h"
-#endif
-
-#define DEBUG_ATTACH 0
-#define DEBUG_HUNT 0
-#define DEBUG_SEND 0
-#define DEBUG_LISTEN 0
-
-#if 0
-#define DEBUGP(FMT,...) printf(FMT, __VA_ARGS__)
-#else
-#define DEBUGP(FMT,...)
-#endif
-
-#if DEBUG_ATTACH
-#define DEBUGP_ATTACH(...) DEBUGP( __VA_ARGS__)
-#else
-#define DEBUGP_ATTACH(...)
-#endif
-
-#if DEBUG_HUNT
-#define DEBUGP_HUNT(...) DEBUGP( __VA_ARGS__)
-#else
-#define DEBUGP_HUNT(...)
-#endif
-
-#if DEBUG_LISTEN
-#define DEBUGP_LISTEN(...) DEBUGP( __VA_ARGS__)
-#else
-#define DEBUGP_LISTEN(...)
-#endif
-
-#if DEBUG_SEND
-#define DEBUGP_SEND(...) DEBUGP( __VA_ARGS__)
-#else
-#define DEBUGP_SEND(...)
-#endif
-
-
-#define DRIVER_NAME "ose_signal_drv"
-#define GET_SPID 1
-#define GET_NAME 2
-#define HUNT 100
-#define DEHUNT 101
-#define ATTACH 102
-#define DETACH 103
-#define SEND 104
-#define SEND_W_S 105
-#define LISTEN 106
-#define OPEN 200
-
-#define REF_SEGMENT_SIZE 8
-
-struct async {
- SIGSELECT signo;
- ErlDrvTermData port;
- ErlDrvTermData proc;
- PROCESS spid;
- PROCESS target;
- Uint32 ref;
-};
-
-/**
- * OSE signals
- **/
-union SIGNAL {
- SIGSELECT signo;
- struct async async;
-};
-
-/**
- * The driver's context
- **/
-typedef struct _driver_context {
- ErlDrvPort port;
- PROCESS spid;
- ErlDrvEvent perm_events[2];
- ErlDrvEvent *events;
- Uint32 event_cnt;
- Uint32 ref;
- Uint32 *outstanding_refs;
- Uint32 outstanding_refs_max;
- Uint32 outstanding_refs_cnt;
-} driver_context_t;
-
-/**
- * Global variables
- **/
-static ErlDrvTermData a_ok;
-static ErlDrvTermData a_error;
-static ErlDrvTermData a_enomem;
-static ErlDrvTermData a_enoent;
-static ErlDrvTermData a_badarg;
-static ErlDrvTermData a_mailbox_up;
-static ErlDrvTermData a_mailbox_down;
-static ErlDrvTermData a_ose_drv_reply;
-static ErlDrvTermData a_message;
-static PROCESS proxy_proc;
-
-
-/**
- * Serialize/unserialize unsigned 32-bit values
- **/
-static char *put_u32(unsigned int value, char *ptr) {
- *ptr++ = (value & 0xff000000) >> 24;
- *ptr++ = (value & 0x00ff0000) >> 16;
- *ptr++ = (value & 0x0000ff00) >> 8;
- *ptr++ = (value & 0xff);
-
- return ptr;
-}
-
-static unsigned int get_u32(char *ptr) {
- unsigned int result = 0;
- result += (ptr[0] & 0xff) << 24;
- result += (ptr[1] & 0xff) << 16;
- result += (ptr[2] & 0xff) << 8;
- result += (ptr[3] & 0xff);
-
- return result;
-}
-
-
-/* Stolen from efile_drv.c */
-
-/* char EV_CHAR_P(ErlIOVec *ev, int p, int q) */
-#define EV_CHAR_P(ev, p, q) \
- (((char *)(ev)->iov[(q)].iov_base) + (p))
-
-/* int EV_GET_CHAR(ErlIOVec *ev, char *p, int *pp, int *qp) */
-#define EV_GET_CHAR(ev, p, pp, qp) ev_get_char(ev, p ,pp, qp)
-static int
-ev_get_char(ErlIOVec *ev, char *p, int *pp, int *qp) {
- if (*(pp)+1 <= (ev)->iov[*(qp)].iov_len) {
- *(p) = *EV_CHAR_P(ev, *(pp), *(qp));
- if (*(pp)+1 < (ev)->iov[*(qp)].iov_len)
- *(pp) = *(pp)+1;
- else {
- (*(qp))++;
- *pp = 0;
- }
- return !0;
- }
- return 0;
-}
-
-/* Uint32 EV_UINT32(ErlIOVec *ev, int p, int q)*/
-#define EV_UINT32(ev, p, q) \
- ((Uint32) *(((unsigned char *)(ev)->iov[(q)].iov_base) + (p)))
-
-/* int EV_GET_UINT32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) */
-#define EV_GET_UINT32(ev, p, pp, qp) ev_get_uint32(ev,(Uint32*)(p),pp,qp)
-static int
-ev_get_uint32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) {
- if (*(pp)+4 <= (ev)->iov[*(qp)].iov_len) {
- *(p) = (EV_UINT32(ev, *(pp), *(qp)) << 24)
- | (EV_UINT32(ev, *(pp)+1, *(qp)) << 16)
- | (EV_UINT32(ev, *(pp)+2, *(qp)) << 8)
- | (EV_UINT32(ev, *(pp)+3, *(qp)));
- if (*(pp)+4 < (ev)->iov[*(qp)].iov_len)
- *(pp) = *(pp)+4;
- else {
- (*(qp))++;
- *pp = 0;
- }
- return !0;
- }
- return 0;
-}
-
-/**
- * Convinience macros
- **/
-#define send_response(port,output) erl_drv_send_term(driver_mk_port(port),\
- driver_caller(port), output, sizeof(output) / sizeof(output[0]));
-
-void iov_memcpy(void *dest,ErlIOVec *ev,int ind,int off);
-void iov_memcpy(void *dest,ErlIOVec *ev,int ind,int off) {
- int i;
- memcpy(dest,ev->iov[ind].iov_base+off,ev->iov[ind].iov_len-off);
- for (i = ind+1; i < ev->vsize; i++)
- memcpy(dest,ev->iov[i].iov_base,ev->iov[i].iov_len);
-}
-
-/**
- * Reference handling
- **/
-
-static int add_reference(driver_context_t *ctxt, Uint32 ref) {
-
- /*
- * Premature optimizations may be evil, but they sure are fun.
- */
-
- if (ctxt->outstanding_refs == NULL) {
- /* First ref to be ignored */
- ctxt->outstanding_refs = driver_alloc(REF_SEGMENT_SIZE*sizeof(Uint32));
- if (!ctxt->outstanding_refs)
- return 1;
-
- memset(ctxt->outstanding_refs,0,REF_SEGMENT_SIZE*sizeof(Uint32));
- ctxt->outstanding_refs_max += REF_SEGMENT_SIZE;
- ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref;
- } else if (ctxt->outstanding_refs_cnt == ctxt->outstanding_refs_max) {
- /* Expand ref array */
- Uint32 *new_array;
- ctxt->outstanding_refs_max += REF_SEGMENT_SIZE;
- new_array = driver_realloc(ctxt->outstanding_refs,
- ctxt->outstanding_refs_max*sizeof(Uint32));
-
- if (!new_array) {
- ctxt->outstanding_refs_max -= REF_SEGMENT_SIZE;
- return 1;
- }
-
- ctxt->outstanding_refs = new_array;
-
- memset(ctxt->outstanding_refs+ctxt->outstanding_refs_cnt,0,
- REF_SEGMENT_SIZE*sizeof(Uint32));
- ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref;
-
- } else {
- /* Find an empty slot:
- * First we try current index,
- * then we scan for a slot.
- */
- if (!ctxt->outstanding_refs[ctxt->outstanding_refs_cnt]) {
- ctxt->outstanding_refs[ctxt->outstanding_refs_cnt++] = ref;
- } else {
- int i;
- ASSERT(ctxt->outstanding_refs_cnt < ctxt->outstanding_refs_max);
- for (i = 0; i < ctxt->outstanding_refs_max; i++)
- if (!ctxt->outstanding_refs[i])
- break;
- ASSERT(ctxt->outstanding_refs[i] == 0);
- ctxt->outstanding_refs[i] = ref;
- ctxt->outstanding_refs_cnt++;
- }
- }
- return 0;
-}
-
-/* Return 0 if removed, 1 if does not exist, */
-static int remove_reference(driver_context_t *ctxt, Uint32 ref) {
- int i,j;
-
- if (ctxt->outstanding_refs_max == 0 && ctxt->outstanding_refs_cnt == 0) {
- ASSERT(ctxt->outstanding_refs == NULL);
- return 1;
- }
-
- for (i = 0; i < ctxt->outstanding_refs_max; i++) {
- if (ctxt->outstanding_refs[i] == ref) {
- ctxt->outstanding_refs[i] = 0;
- ctxt->outstanding_refs_cnt--;
- i = -1;
- break;
- }
- }
-
- if (i != -1)
- return 1;
-
- if (ctxt->outstanding_refs_cnt == 0) {
- driver_free(ctxt->outstanding_refs);
- ctxt->outstanding_refs = NULL;
- ctxt->outstanding_refs_max = 0;
- } else if (ctxt->outstanding_refs_cnt == (ctxt->outstanding_refs_max - REF_SEGMENT_SIZE)) {
- Uint32 *new_array;
- for (i = 0, j = 0; i < ctxt->outstanding_refs_cnt; i++) {
- if (ctxt->outstanding_refs[i] == 0) {
- for (j = i+1; j < ctxt->outstanding_refs_max; j++)
- if (ctxt->outstanding_refs[j]) {
- ctxt->outstanding_refs[i] = ctxt->outstanding_refs[j];
- ctxt->outstanding_refs[j] = 0;
- break;
- }
- }
- }
- ctxt->outstanding_refs_max -= REF_SEGMENT_SIZE;
- new_array = driver_realloc(ctxt->outstanding_refs,
- ctxt->outstanding_refs_max*sizeof(Uint32));
- if (!new_array) {
- ctxt->outstanding_refs_max += REF_SEGMENT_SIZE;
- return 2;
- }
-
- ctxt->outstanding_refs = new_array;
-
- }
-
- return 0;
-}
-
-/**
- * The OSE proxy process. This only handles ERTS_SIGNAL_OSE_DRV_ATTACH.
- * The process is needed because signals triggered by attach ignore
- * redir tables.
- *
- * We have one global proxy process to save memory. An attempt to make each
- * port phantom into a proxy was made, but that used way to much memory.
- */
-static OS_PROCESS(driver_proxy_process) {
- SIGSELECT sigs[] = {1,ERTS_SIGNAL_OSE_DRV_ATTACH};
- PROCESS master = 0;
-
- while (1) {
- union SIGNAL *sig = receive(sigs);
-
- if (sig->signo == ERTS_SIGNAL_OSE_DRV_ATTACH) {
-
- /* The first message is used to determine who to send messages to. */
- if (master == 0)
- master = sender(&sig);
-
- if (sig->async.target == 0) {
- PROCESS from = sender(&sig);
- restore(sig);
- DEBUGP_ATTACH("0x%x: got attach 0x%x, sending to 0x%x\n",
- current_process(),from,master);
- sig->async.target = from;
- send(&sig,master);
- } else {
- PROCESS target = sig->async.target;
- restore(sig);
- sig->async.target = 0;
- DEBUGP_ATTACH("0x%x: doing attach on 0x%x\n",current_process(),target);
- attach(&sig,target);
- }
- }
- }
-}
-
-
-/**
- * Init routine for the driver
- **/
-static int drv_init(void) {
-
- a_ok = driver_mk_atom("ok");
- a_error = driver_mk_atom("error");
- a_enomem = driver_mk_atom("enomem");
- a_enoent = driver_mk_atom("enoent");
- a_badarg = driver_mk_atom("badarg");
- a_mailbox_up = driver_mk_atom("mailbox_up");
- a_mailbox_down = driver_mk_atom("mailbox_down");
- a_ose_drv_reply = driver_mk_atom("ose_drv_reply");
- a_message = driver_mk_atom("message");
-
- proxy_proc = create_process(get_ptype(current_process()),
- "ose_signal_driver_proxy",
- driver_proxy_process, 10000,
- get_pri(current_process()),
- 0, 0, NULL, 0, 0);
-
-#ifdef DEBUG
- efs_clone(proxy_proc);
-#endif
- start(proxy_proc);
-
- return 0;
-}
-
-/* Signal resolution callback */
-static ErlDrvOseEventId resolve_signal(union SIGNAL* osig) {
- union SIGNAL *sig = osig;
- if (sig->signo == ERTS_SIGNAL_OSE_DRV_HUNT ||
- sig->signo == ERTS_SIGNAL_OSE_DRV_ATTACH) {
- return sig->async.spid;
- }
- DEBUGP("%p: Got signal %d sent to %p from 0x%p\n",
- current_process(),sig->signo,addressee(&sig),sender(&sig));
- return addressee(&sig);
-}
-
-
-/**
- * Start routine for the driver
- **/
-static ErlDrvData drv_start(ErlDrvPort port, char *command)
-{
- driver_context_t *ctxt = driver_alloc(sizeof(driver_context_t));
-
- ctxt->perm_events[0] = NULL;
- ctxt->perm_events[1] = NULL;
-
- ctxt->spid = 0;
- ctxt->port = port;
- ctxt->event_cnt = 0;
- ctxt->events = NULL;
- ctxt->ref = 0;
- ctxt->outstanding_refs = NULL;
- ctxt->outstanding_refs_max = 0;
- ctxt->outstanding_refs_cnt = 0;
-
-
- /* Set the communication protocol to Erlang to be binary */
- set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY);
-
- /* Everything ok */
- return (ErlDrvData)ctxt;
-}
-
-/**
- * Stop routine for the driver
- **/
-static void drv_stop(ErlDrvData driver_data)
-{
- driver_context_t *ctxt = (driver_context_t *)driver_data;
- int i;
-
- /* HUNT + ATTACH */
- if (ctxt->perm_events[0])
- driver_select(ctxt->port, ctxt->perm_events[0],
- ERL_DRV_USE|ERL_DRV_READ, 0);
- if (ctxt->perm_events[1])
- driver_select(ctxt->port, ctxt->perm_events[1],
- ERL_DRV_USE|ERL_DRV_READ, 0);
-
- for (i = 0; i < ctxt->event_cnt; i++) {
- driver_select(ctxt->port, ctxt->events[i], ERL_DRV_USE|ERL_DRV_READ, 0);
- }
-
- if (ctxt->spid != 0)
- kill_proc(ctxt->spid);
- DEBUGP("0x%x: stopped\n",ctxt->spid);
- if (ctxt->events)
- driver_free(ctxt->events);
- if (ctxt->outstanding_refs)
- driver_free(ctxt->outstanding_refs);
-
- driver_free(ctxt);
-}
-
-/**
- * Output from Erlang
- **/
-static void outputv(ErlDrvData driver_data, ErlIOVec *ev)
-{
- driver_context_t *ctxt = (driver_context_t *)driver_data;
- int p = 0, q = 1;
- char cmd;
-
- if (! EV_GET_CHAR(ev,&cmd,&p,&q)) {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_badarg,
- ERL_DRV_TUPLE, 3};
- send_response(ctxt->port, output);
- return;
- }
-
- /* Command is in the buffer's first byte */
- switch(cmd) {
-
- case OPEN: {
- char *name = driver_alloc(ev->size - 1+1);
- struct OS_redir_entry redir[2];
-
- redir[0].sig = 1;
- redir[0].pid = current_process();
-
- iov_memcpy(name,ev,q,p);
- name[ev->size-1] = '\0';
-
- ctxt->spid = create_process(OS_PHANTOM, name, NULL, 0,
- 0, 0, 0, redir, 0, 0);
-
- DEBUGP("0x%x: open\n",ctxt->spid);
-
- ctxt->perm_events[1] =
- erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_ATTACH,(int)ctxt->spid,
- resolve_signal, NULL);
- driver_select(ctxt->port,ctxt->perm_events[1],ERL_DRV_READ|ERL_DRV_USE,1);
-
- ctxt->perm_events[0] =
- erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_HUNT,(int)ctxt->spid,
- resolve_signal, NULL);
- driver_select(ctxt->port,ctxt->perm_events[0],ERL_DRV_READ|ERL_DRV_USE,1);
-
- start(ctxt->spid);
-
- {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_ok,
- ERL_DRV_TUPLE, 3};
-
- send_response(ctxt->port, output);
- }
-
- break;
-
- }
-
- case ATTACH:
- case HUNT:
- {
- union SIGNAL *sig = alloc(sizeof(union SIGNAL),
- cmd == HUNT ? ERTS_SIGNAL_OSE_DRV_HUNT:ERTS_SIGNAL_OSE_DRV_ATTACH);
-
- sig->async.port = driver_mk_port(ctxt->port);
- sig->async.proc = driver_caller(ctxt->port);
- sig->async.spid = ctxt->spid;
- sig->async.ref = ++ctxt->ref;
-
- if (add_reference(ctxt,ctxt->ref)) {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_enomem,
- ERL_DRV_TUPLE, 3};
- send_response(ctxt->port, output);
- free_buf(&sig);
- } else {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_INT, (ErlDrvUInt)ctxt->ref,
- ERL_DRV_TUPLE, 2,
- ERL_DRV_TUPLE, 3};
- send_response(ctxt->port, output);
-
- if (cmd == HUNT) {
- char *huntname = driver_alloc(sizeof(char)*((ev->size-1)+1));
-
- iov_memcpy(huntname,ev,q,p);
- huntname[ev->size-1] = '\0';
-
- DEBUGP_HUNT("0x%x: hunt %s -> %u (%u,%u)\n",
- ctxt->spid,huntname,ctxt->ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
-
- hunt(huntname, 0, NULL, &sig);
-
- driver_free(huntname);
- } else {
- EV_GET_UINT32(ev,&sig->async.target,&p,&q);
- DEBUGP_ATTACH("0x%x: attach %u -> %u (%u,%u)\n",
- ctxt->spid,sig->async.target,
- ctxt->ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
-
- send(&sig,proxy_proc);
- }
-
- }
-
- break;
- }
-
- case DETACH:
- case DEHUNT:
- {
-
- Uint32 ref;
-
- EV_GET_UINT32(ev,&ref,&p,&q);
- if (cmd == DETACH) {
- DEBUGP_ATTACH("0x%x: detach %u (%u,%u)\n",ctxt->spid,ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- } else {
- DEBUGP_HUNT("0x%x: dehunt %u (%u,%u)\n",ctxt->spid,ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- }
-
- if (remove_reference(ctxt,ref)) {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_error,
- ERL_DRV_ATOM, a_enoent,
- ERL_DRV_TUPLE, 2,
- ERL_DRV_TUPLE, 3};
-
- send_response(ctxt->port, output);
- } else {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_ok,
- ERL_DRV_TUPLE, 3};
-
- send_response(ctxt->port, output);
- }
-
- break;
- }
-
- case SEND:
- case SEND_W_S:
- {
- PROCESS spid;
- PROCESS sender;
- SIGSELECT signo;
- OSBUFSIZE size = ev->size-9;
- union SIGNAL *sig;
-
- EV_GET_UINT32(ev,&spid,&p,&q);
-
- if (cmd == SEND_W_S) {
- EV_GET_UINT32(ev,&sender,&p,&q);
- size -= 4;
- } else {
- sender = ctxt->spid;
- }
-
- EV_GET_UINT32(ev,&signo,&p,&q);
-
- sig = alloc(size + sizeof(SIGSELECT),signo);
-
- if (cmd == SEND_W_S) {
- DEBUGP_SEND("0x%x: send_w_s(%u,%u,%u)\n",ctxt->spid,spid,signo,sender);
- } else {
- DEBUGP_SEND("0x%x: send(%u,%u)\n",ctxt->spid,spid,signo);
- }
-
- iov_memcpy(((char *)&sig->signo) + sizeof(SIGSELECT),ev,q,p);
-
- send_w_s(&sig, sender, spid);
-
- break;
- }
-
- case LISTEN:
- {
- int i,j,event_cnt = (ev->size - 1)/4;
- ErlDrvEvent *events = NULL;
- SIGSELECT signo,tmp_signo;
-
- if (event_cnt == 0) {
- for (i = 0; i < ctxt->event_cnt; i++)
- driver_select(ctxt->port,ctxt->events[i],ERL_DRV_READ|ERL_DRV_USE,0);
- if (ctxt->events)
- driver_free(ctxt->events);
- } else {
- events = driver_alloc(sizeof(ErlDrvEvent)*event_cnt);
- EV_GET_UINT32(ev,&signo,&p,&q);
- for (i = 0, j = 0; i < event_cnt || j < ctxt->event_cnt; ) {
-
- if (ctxt->events)
- erl_drv_ose_event_fetch(ctxt->events[j],&tmp_signo,NULL,NULL);
-
- if (signo == tmp_signo) {
- events[i++] = ctxt->events[j++];
- EV_GET_UINT32(ev,&signo,&p,&q);
- } else if (signo < tmp_signo || !ctxt->events) {
- /* New signal to select on */
- events[i] = erl_drv_ose_event_alloc(signo,(int)ctxt->spid,
- resolve_signal, NULL);
- driver_select(ctxt->port,events[i++],ERL_DRV_READ|ERL_DRV_USE,1);
- EV_GET_UINT32(ev,&signo,&p,&q);
- } else {
- /* Remove old signal to select on */
- driver_select(ctxt->port,ctxt->events[j++],ERL_DRV_READ|ERL_DRV_USE,0);
- }
- }
- if (ctxt->events)
- driver_free(ctxt->events);
- }
- ctxt->events = events;
- ctxt->event_cnt = event_cnt;
-
- {
- ErlDrvTermData output[] = {
- ERL_DRV_ATOM, a_ose_drv_reply,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_ATOM, a_ok,
- ERL_DRV_TUPLE, 3};
- send_response(ctxt->port, output);
- }
- break;
- }
-
- default:
- {
- DEBUGP("Warning: 'ose_signal_drv' unknown command '%d'\n", cmd);
- break;
- }
- }
-}
-
-/**
- * Handler for when OSE signal arrives
- **/
-static void ready_input(ErlDrvData driver_data, ErlDrvEvent event)
-{
- driver_context_t *ctxt = (driver_context_t *)driver_data;
- union SIGNAL *sig = erl_drv_ose_get_signal(event);
-
- while (sig != NULL) {
-
- switch(sig->signo)
- {
- /* Remote process is available */
- case ERTS_SIGNAL_OSE_DRV_HUNT:
- {
- const PROCESS spid = sender(&sig);
-
- if (remove_reference(ctxt,sig->async.ref)) {
- DEBUGP_HUNT("0x%x: Got hunt from 0x%x -> %u (CANCELLED) (%u,%u)\n",
- ctxt->spid,spid,sig->async.ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- /* Already removed by dehunt */
- } else {
- ErlDrvTermData reply[] = {
- ERL_DRV_ATOM, a_mailbox_up,
- ERL_DRV_PORT, sig->async.port,
- ERL_DRV_PORT, sig->async.port,
- ERL_DRV_UINT, (ErlDrvUInt)sig->async.ref,
- ERL_DRV_TUPLE, 2,
- ERL_DRV_UINT, (ErlDrvUInt)spid,
- ERL_DRV_TUPLE, 4};
- DEBUGP_HUNT("0x%x: Got hunt from 0x%x -> %u (%u,%u)\n",
- ctxt->spid,spid,sig->async.ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- erl_drv_send_term(sig->async.port, sig->async.proc, reply,
- sizeof(reply) / sizeof(reply[0]));
- }
- break;
- }
-
- /* Remote process is down */
- case ERTS_SIGNAL_OSE_DRV_ATTACH:
- {
- PROCESS spid = sig->async.target;
-
- if (remove_reference(ctxt,sig->async.ref)) {
- DEBUGP_ATTACH("0x%x: Got attach from 0x%x -> %u (CANCELLED) (%u,%u)\n",
- ctxt->spid,spid,sig->async.ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- /* Already removed by detach */
- } else {
- ErlDrvTermData reply[] = {
- ERL_DRV_ATOM, a_mailbox_down,
- ERL_DRV_PORT, sig->async.port,
- ERL_DRV_PORT, sig->async.port,
- ERL_DRV_UINT, sig->async.ref,
- ERL_DRV_TUPLE, 2,
- ERL_DRV_UINT, (ErlDrvUInt)spid,
- ERL_DRV_TUPLE, 4};
- DEBUGP_ATTACH("0x%x: Got attach from 0x%x -> %u (%u,%u)\n",
- ctxt->spid,spid,sig->async.ref,
- ctxt->outstanding_refs_cnt,
- ctxt->outstanding_refs_max);
- erl_drv_send_term(sig->async.port, sig->async.proc, reply,
- sizeof(reply) / sizeof(reply[0]));
- }
- break;
- }
-
- /* Received user defined signal */
- default:
- {
- const PROCESS spid = sender(&sig);
- const OSBUFSIZE size = sigsize(&sig) - sizeof(SIGSELECT);
- const char *sig_data = ((char *)&sig->signo) + sizeof(SIGSELECT);
-
- ErlDrvTermData reply[] = {
- ERL_DRV_ATOM, a_message,
- ERL_DRV_PORT, driver_mk_port(ctxt->port),
- ERL_DRV_UINT, (ErlDrvUInt)spid,
- ERL_DRV_UINT, (ErlDrvUInt)ctxt->spid,
- ERL_DRV_UINT, (ErlDrvUInt)sig->signo,
- ERL_DRV_BUF2BINARY, (ErlDrvTermData)sig_data, (ErlDrvUInt)size,
- ERL_DRV_TUPLE, 4,
- ERL_DRV_TUPLE, 3};
-
- DEBUGP_SEND("0x%x: Got 0x%u\r\n", spid, sig->signo);
-
- erl_drv_output_term(driver_mk_port(ctxt->port), reply,
- sizeof(reply) / sizeof(reply[0]));
- break;
- }
- }
-
- free_buf(&sig);
- sig = erl_drv_ose_get_signal(event);
- }
-}
-
-/**
- * Handler for 'port_control'
- **/
-static ErlDrvSSizeT control(ErlDrvData driver_data, unsigned int cmd,
- char *buf, ErlDrvSizeT len,
- char **rbuf, ErlDrvSizeT rlen)
-{
- driver_context_t *ctxt = (driver_context_t *)driver_data;
-
- switch(cmd)
- {
- case GET_SPID:
- {
- const PROCESS spid = ctxt->spid;
- put_u32(spid, *rbuf);
- return sizeof(PROCESS);
- }
-
-#ifdef HAVE_OSE_SPI_H
- case GET_NAME:
- {
- const PROCESS spid = get_u32(buf);
- char *name = (char*)get_pid_info(spid,OSE_PI_NAME);
- int n;
- if (!name) {
- *rbuf = NULL;
- return 0;
- }
-
- if (rlen < (n = strlen(name))) {
- ErlDrvBinary *bin = driver_alloc_binary(n);
- strncpy(bin->orig_bytes,name,n);
- *rbuf = (char*)bin;
- } else
- strncpy(*rbuf,name,n);
- free_buf((union SIGNAL**)&name);
-
- return n;
- }
-#endif
- default:
- {
- /* Unknown command */
- return (ErlDrvSSizeT)ERL_DRV_ERROR_GENERAL;
- break;
- }
- }
-}
-
-static void stop_select(ErlDrvEvent event, void *reserved)
-{
- erl_drv_ose_event_free(event);
-}
-
-/**
- * Setup the driver entry for the Erlang runtime
- **/
-ErlDrvEntry ose_signal_driver_entry = {
- .init = drv_init,
- .start = drv_start,
- .stop = drv_stop,
- .outputv = outputv,
- .ready_input = ready_input,
- .driver_name = DRIVER_NAME,
- .control = control,
- .extended_marker = ERL_DRV_EXTENDED_MARKER,
- .major_version = ERL_DRV_EXTENDED_MAJOR_VERSION,
- .minor_version = ERL_DRV_EXTENDED_MINOR_VERSION,
- .driver_flags = ERL_DRV_FLAG_USE_PORT_LOCKING,
- .stop_select = stop_select
-};
-
diff --git a/erts/emulator/drivers/ose/ttsl_drv.c b/erts/emulator/drivers/ose/ttsl_drv.c
deleted file mode 100644
index f759b47984..0000000000
--- a/erts/emulator/drivers/ose/ttsl_drv.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Stub tty driver because group/user depend on this.
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "erl_driver.h"
-
-static int ttysl_init(void);
-static ErlDrvData ttysl_start(ErlDrvPort, char*);
-
-/* Define the driver table entry. */
-struct erl_drv_entry ttsl_driver_entry = {
- ttysl_init,
- ttysl_start,
- NULL,
- NULL,
- NULL,
- NULL,
- "tty_sl",
- NULL,
- NULL,
- NULL,
- NULL, /* timeout */
- NULL, /* outputv */
- NULL, /* ready_async */
- NULL, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL,
- NULL, /* process_exit */
- NULL
-};
-
-
-static int ttysl_init(void)
-{
- return 0;
-}
-
-static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
-{
- return ERL_DRV_ERROR_GENERAL;
-}
diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c
index 25cad37e25..abfc52d3bc 100644
--- a/erts/emulator/drivers/unix/ttsl_drv.c
+++ b/erts/emulator/drivers/unix/ttsl_drv.c
@@ -199,7 +199,7 @@ static void my_debug_printf(char *fmt, ...)
erts_vsnprintf(buffer,1024,fmt,args);
va_end(args);
erts_fprintf(debuglog,"%s\n",buffer);
- //erts_printf("Debuglog = %s\n",buffer);
+ /*erts_printf("Debuglog = %s\n",buffer);*/
}
#else
@@ -261,15 +261,17 @@ static int ttysl_init(void)
if (debuglog != NULL)
setbuf(debuglog,NULL);
}
- DEBUGLOG(("Debuglog = %s(0x%ld)\n",dl,(long) debuglog));
+ DEBUGLOG(("ttysl_init: Debuglog = %s(0x%ld)\n",dl,(long) debuglog));
}
#endif
+ DEBUGLOG(("ttysl_init: ttysl_port = %d\n", ttysl_port));
return 0;
}
static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
{
#ifndef HAVE_TERMCAP
+ DEBUGLOG(("ttysl_start: failure - no TERMCAP configured!\n"));
return ERL_DRV_ERROR_GENERAL;
#else
char *s, *t, *l;
@@ -277,36 +279,46 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
int flag;
extern int using_oldshell; /* set this to let the rest of erts know */
+ DEBUGLOG(("ttysl_start: driver input \"%s\", ttysl_port = %d (-1 expected)", buf, ttysl_port));
utf8buf_size = 0;
- if (ttysl_port != (ErlDrvPort)-1)
- return ERL_DRV_ERROR_GENERAL;
+ if (ttysl_port != (ErlDrvPort)-1) {
+ DEBUGLOG(("ttysl_start: failure with ttysl_port = %d, not initialized properly?\n", ttysl_port));
+ return ERL_DRV_ERROR_GENERAL;
+ }
- if (!isatty(0) || !isatty(1))
+ DEBUGLOG(("ttysl_start: isatty(0) = %d (1 expected), isatty(1) = %d (1 expected)", isatty(0), isatty(1)));
+ if (!isatty(0) || !isatty(1)) {
+ DEBUGLOG(("ttysl_start: failure in isatty, isatty(0) = %d, isatty(1) = %d", isatty(0), isatty(1)));
return ERL_DRV_ERROR_GENERAL;
+ }
/* Set the terminal modes to default leave as is. */
canon = echo = sig = 0;
/* Parse the input parameters. */
for (s = strchr(buf, ' '); s; s = t) {
- s++;
- /* Find end of this argument (start of next) and insert NUL. */
- if ((t = strchr(s, ' '))) {
- *t = '\0';
- }
- if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) {
- if (s[1] == 'c') canon = flag;
- if (s[1] == 'e') echo = flag;
- if (s[1] == 's') sig = flag;
- }
- else if ((ttysl_fd = open(s, O_RDWR, 0)) < 0)
- return ERL_DRV_ERROR_GENERAL;
+ s++;
+ /* Find end of this argument (start of next) and insert NUL. */
+ if ((t = strchr(s, ' '))) {
+ *t = '\0';
+ }
+ if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) {
+ if (s[1] == 'c') canon = flag;
+ if (s[1] == 'e') echo = flag;
+ if (s[1] == 's') sig = flag;
+ }
+ else if ((ttysl_fd = open(s, O_RDWR, 0)) < 0) {
+ DEBUGLOG(("ttysl_start: failed to open ttysl_fd, open(%s, O_RDWR, 0)) = %d\n", s, ttysl_fd));
+ return ERL_DRV_ERROR_GENERAL;
+ }
}
+
if (ttysl_fd < 0)
ttysl_fd = 0;
if (tty_init(ttysl_fd, canon, echo, sig) < 0 ||
- tty_set(ttysl_fd) < 0) {
+ tty_set(ttysl_fd) < 0) {
+ DEBUGLOG(("ttysl_start: failed init tty or set tty\n"));
ttysl_port = (ErlDrvPort)-1;
tty_reset(ttysl_fd);
return ERL_DRV_ERROR_GENERAL;
@@ -314,6 +326,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
/* Set up smart line and termcap stuff. */
if (!start_lbuf() || !start_termcap()) {
+ DEBUGLOG(("ttysl_start: failed to start_lbuf or start_termcap\n"));
stop_lbuf(); /* Must free this */
tty_reset(ttysl_fd);
return ERL_DRV_ERROR_GENERAL;
@@ -335,10 +348,10 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
l = setlocale(LC_CTYPE, ""); /* Set international environment */
if (l != NULL) {
utf8_mode = (strcmp(nl_langinfo(CODESET), "UTF-8") == 0);
- DEBUGLOG(("setlocale: %s\n",l));
+ DEBUGLOG(("ttysl_start: setlocale: %s",l));
}
#endif
- DEBUGLOG(("utf8_mode is %s\n",(utf8_mode) ? "on" : "off"));
+ DEBUGLOG(("ttysl_start: utf8_mode is %s",(utf8_mode) ? "on" : "off"));
sys_signal(SIGCONT, cont);
sys_signal(SIGWINCH, winch);
@@ -348,6 +361,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
/* we need to know this when we enter the break handler */
using_oldshell = 0;
+ DEBUGLOG(("ttysl_start: successful start\n"));
return (ErlDrvData)ttysl_port; /* Nothing important to return */
#endif /* HAVE_TERMCAP */
}
@@ -418,6 +432,7 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data,
static void ttysl_stop(ErlDrvData ttysl_data)
{
+ DEBUGLOG(("ttysl_stop: ttysl_port = %d\n",ttysl_port));
if (ttysl_port != (ErlDrvPort)-1) {
stop_lbuf();
stop_termcap();
@@ -617,12 +632,13 @@ static int check_buf_size(byte *s, int n)
int ch;
int size = 10;
+ DEBUGLOG(("check_buf_size: n = %d",n));
while(pos < n) {
/* Indata is always UTF-8 */
if ((ch = pick_utf8(s,n,&pos)) < 0) {
/* XXX temporary allow invalid chars */
ch = (int) s[pos];
- DEBUGLOG(("Invalid UTF8:%d",ch));
+ DEBUGLOG(("check_buf_size: Invalid UTF8:%d",ch));
++pos;
}
if (utf8_mode) { /* That is, terminal is UTF8 compliant */
@@ -630,7 +646,7 @@ static int check_buf_size(byte *s, int n)
#ifdef HAVE_WCWIDTH
int width;
#endif
- DEBUGLOG(("Printable(UTF-8:%d):%d",pos,ch));
+ DEBUGLOG(("check_buf_size: Printable(UTF-8:%d):%d",pos,ch));
size++;
#ifdef HAVE_WCWIDTH
if ((width = wcwidth(ch)) > 1) {
@@ -640,21 +656,21 @@ static int check_buf_size(byte *s, int n)
} else if (ch == '\t') {
size += 8;
} else {
- DEBUGLOG(("Magic(UTF-8:%d):%d",pos,ch));
+ DEBUGLOG(("check_buf_size: Magic(UTF-8:%d):%d",pos,ch));
size += 2;
}
} else {
if (ch <= 255 && isprint(ch)) {
- DEBUGLOG(("Printable:%d",ch));
+ DEBUGLOG(("check_buf_size: Printable:%d",ch));
size++;
} else if (ch == '\t')
size += 8;
else if (ch >= 128) {
- DEBUGLOG(("Non printable:%d",ch));
+ DEBUGLOG(("check_buf_size: Non printable:%d",ch));
size += (octal_or_hex_positions(ch) + 1);
}
else {
- DEBUGLOG(("Magic:%d",ch));
+ DEBUGLOG(("check_buf_size: Magic:%d",ch));
size += 2;
}
}
@@ -664,10 +680,12 @@ static int check_buf_size(byte *s, int n)
lbuf_size = size + lpos + BUFSIZ;
if ((lbuf = driver_realloc(lbuf, lbuf_size * sizeof(Uint32))) == NULL) {
+ DEBUGLOG(("check_buf_size: alloc failure of %d bytes", lbuf_size * sizeof(Uint32)));
driver_failure(ttysl_port, -1);
return(0);
}
}
+ DEBUGLOG(("check_buf_size: success\n"));
return(1);
}
@@ -685,6 +703,8 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
if (lpos > MAXSIZE)
put_chars((byte*)"\n", 1);
+ DEBUGLOG(("ttysl_from_erlang: OP = %d", buf[0]));
+
switch (buf[0]) {
case OP_PUTC_SYNC:
/* Using sync means that we have to send an ok to the
@@ -695,7 +715,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
the port_command. */
/* fall through */
case OP_PUTC:
- DEBUGLOG(("OP: Putc(%lu)",(unsigned long) count-1));
+ DEBUGLOG(("ttysl_from_erlang: OP: Putc(%lu)",(unsigned long) count-1));
if (check_buf_size((byte*)buf+1, count-1) == 0)
return;
put_chars((byte*)buf+1, count-1);
@@ -738,6 +758,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
ERL_DRV_USE|ERL_DRV_WRITE,1);
break;
} else {
+ DEBUGLOG(("ttysl_from_erlang: driver failure in writev(%d,..) = %d (errno = %d)\n", ttysl_fd, written, errno));
driver_failure_posix(ttysl_port, errno);
return;
}
@@ -774,6 +795,9 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) {
ErlDrvSizeT sz;
iov = driver_peekq(ttysl_port,&qlen);
+
+ DEBUGLOG(("ttysl_to_tty: qlen = %d", qlen));
+
if (iov)
written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen);
else
@@ -782,6 +806,7 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) {
if (errno == EINTR) {
continue;
} else if (errno != ERRNO_BLOCK){
+ DEBUGLOG(("ttysl_to_tty: driver failure in writev(%d,..) = %d (errno = %d)\n", ttysl_fd, written, errno));
driver_failure_posix(ttysl_port, errno);
}
break;
@@ -804,6 +829,7 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) {
/* flush has been called, which means we should terminate
when queue is empty. This will not send any exit
message */
+ DEBUGLOG(("ttysl_to_tty: ttysl_terminate normal\n"));
driver_failure_atom(ttysl_port, "normal");
break;
}
@@ -814,6 +840,7 @@ static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) {
}
static void ttysl_flush_tty(ErlDrvData ttysl_data) {
+ DEBUGLOG(("ttysl_flush_tty: .."));
ttysl_terminate = 1;
return;
}
@@ -834,6 +861,8 @@ static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd)
p += utf8buf_size;
utf8buf_size = 0;
}
+
+ DEBUGLOG(("ttysl_from_tty: remainder = %d", left));
if ((i = read((int)(SWord)fd, (char *) p, left)) >= 0) {
if (p != b) {
@@ -847,7 +876,7 @@ static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd)
utf8buf_size = i -pos;
memcpy(utf8buf,b+pos,utf8buf_size);
} else if (ch == -1) {
- DEBUGLOG(("Giving up on UTF8 mode, invalid character"));
+ DEBUGLOG(("ttysl_from_tty: Giving up on UTF8 mode, invalid character"));
utf8_mode = 0;
goto latin_terminal;
}
@@ -864,6 +893,7 @@ static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd)
}
}
} else {
+ DEBUGLOG(("ttysl_from_tty: driver failure in read(%d,..) = %d\n", (int)(SWord)fd, i));
driver_failure(ttysl_port, -1);
}
}
@@ -1155,7 +1185,7 @@ static int write_buf(Uint32 *s, int n)
byte *octbuff;
byte octtmp[256];
int octbytes;
- DEBUGLOG(("Escaped: %d", ch));
+ DEBUGLOG(("write_buf: Escaped: %d", ch));
octbytes = octal_or_hex_positions(ch);
if (octbytes > 256) {
octbuff = driver_alloc(octbytes);
@@ -1164,11 +1194,11 @@ static int write_buf(Uint32 *s, int n)
}
octbytes = 0;
octal_or_hex_format(ch, octbuff, &octbytes);
- DEBUGLOG(("octbytes: %d", octbytes));
+ DEBUGLOG(("write_buf: octbytes: %d", octbytes));
outc('\\');
for (i = 0; i < octbytes; ++i) {
outc(lastput = octbuff[i]);
- DEBUGLOG(("outc: %d", (int) lastput));
+ DEBUGLOG(("write_buf: outc: %d", (int) lastput));
}
n -= octbytes+1;
s += octbytes+1;
@@ -1180,7 +1210,7 @@ static int write_buf(Uint32 *s, int n)
--n; s++;
#endif
} else {
- DEBUGLOG(("Very unexpected character %d",(int) *s));
+ DEBUGLOG(("write_buf: Very unexpected character %d",(int) *s));
++n;
--s;
}
@@ -1242,6 +1272,9 @@ static int start_termcap(void)
size_t envsz = 1024;
char *env = NULL;
char *c;
+ int tres;
+
+ DEBUGLOG(("start_termcap: .."));
capbuf = driver_alloc(1024);
if (!capbuf)
@@ -1249,9 +1282,10 @@ static int start_termcap(void)
eres = erl_drv_getenv("TERM", capbuf, &envsz);
if (eres == 0)
env = capbuf;
- else if (eres < 0)
+ else if (eres < 0) {
+ DEBUGLOG(("start_termcap: failure in erl_drv_getenv(\"TERM\", ..) = %d\n", eres));
goto false;
- else /* if (eres > 1) */ {
+ } else /* if (eres > 1) */ {
char *envbuf = driver_alloc(envsz);
if (!envbuf)
goto false;
@@ -1261,7 +1295,8 @@ static int start_termcap(void)
if (eres == 0)
break;
newenvbuf = driver_realloc(envbuf, envsz);
- if (eres < 0 || !newenvbuf) {
+ if (eres < 0 || !newenvbuf) {
+ DEBUGLOG(("start_termcap: failure in erl_drv_getenv(\"TERM\", ..) = %d or realloc buf == %p\n", eres, newenvbuf));
env = newenvbuf ? newenvbuf : envbuf;
goto false;
}
@@ -1269,8 +1304,10 @@ static int start_termcap(void)
}
env = envbuf;
}
- if (tgetent((char*)lbuf, env) <= 0)
- goto false;
+ if ((tres = tgetent((char*)lbuf, env)) <= 0) {
+ DEBUGLOG(("start_termcap: failure in tgetent(..) = %d\n", tres));
+ goto false;
+ }
if (env != capbuf) {
env = NULL;
driver_free(env);
@@ -1286,8 +1323,11 @@ static int start_termcap(void)
if (!(left = tgetflag("bs") ? "\b" : tgetstr("bc", &c)))
left = "\b"; /* Can't happen - but does on Solaris 2 */
right = tgetstr("nd", &c);
- if (up && down && left && right)
- return TRUE;
+ if (up && down && left && right) {
+ DEBUGLOG(("start_termcap: successful start\n"));
+ return TRUE;
+ }
+ DEBUGLOG(("start_termcap: failed start\n"));
false:
if (env && env != capbuf)
driver_free(env);
@@ -1364,10 +1404,13 @@ static void update_cols(void)
static struct termios tty_smode, tty_rmode;
-static int tty_init(int fd, int canon, int echo, int sig)
-{
- if (tcgetattr(fd, &tty_rmode) < 0)
- return -1;
+static int tty_init(int fd, int canon, int echo, int sig) {
+ int tres;
+ DEBUGLOG(("tty_init: fd = %d, canon = %d, echo = %d, sig = %d", fd, canon, echo, sig));
+ if ((tres = tcgetattr(fd, &tty_rmode)) < 0) {
+ DEBUGLOG(("tty_init: failure in tcgetattr(%d,..) = %d\n", fd, tres));
+ return -1;
+ }
tty_smode = tty_rmode;
/* Default characteristics for all usage including termcap output. */
@@ -1420,6 +1463,7 @@ static int tty_init(int fd, int canon, int echo, int sig)
#endif
tty_smode.c_lflag &= ~(ISIG|IEXTEN);
}
+ DEBUGLOG(("tty_init: successful init\n"));
return 0;
}
@@ -1430,20 +1474,25 @@ static int tty_init(int fd, int canon, int echo, int sig)
static int tty_set(int fd)
{
- DEBUGF(("Setting tty...\n"));
+ int tres;
+ DEBUGF(("tty_set: Setting tty...\n"));
- if (tcsetattr(fd, TCSANOW, &tty_smode) < 0)
+ if ((tres = tcsetattr(fd, TCSANOW, &tty_smode)) < 0) {
+ DEBUGLOG(("tty_set: failure in tcgetattr(%d,..) = %d\n", fd, tres));
return(-1);
+ }
return(0);
}
static int tty_reset(int fd) /* of terminal device */
{
- DEBUGF(("Resetting tty...\n"));
+ int tres;
+ DEBUGF(("tty_reset: Resetting tty...\n"));
- if (tcsetattr(fd, TCSANOW, &tty_rmode) < 0)
+ if ((tres = tcsetattr(fd, TCSANOW, &tty_rmode)) < 0) {
+ DEBUGLOG(("tty_reset: failure in tcsetattr(%d,..) = %d\n", fd, tres));
return(-1);
-
+ }
return(0);
}
@@ -1458,6 +1507,7 @@ static int tty_reset(int fd) /* of terminal device */
static RETSIGTYPE suspend(int sig)
{
if (tty_reset(ttysl_fd) < 0) {
+ DEBUGLOG(("signal: failure in suspend(%d), can't reset tty %d\n", sig, ttysl_fd));
fprintf(stderr,"Can't reset tty \n");
exit(1);
}
@@ -1469,6 +1519,7 @@ static RETSIGTYPE suspend(int sig)
sys_signal(sig, suspend); /* Reset signal handler */
if (tty_set(ttysl_fd) < 0) {
+ DEBUGLOG(("signal: failure in suspend(%d), can't set tty %d\n", sig, ttysl_fd));
fprintf(stderr,"Can't set tty raw \n");
exit(1);
}
@@ -1479,6 +1530,7 @@ static RETSIGTYPE suspend(int sig)
static RETSIGTYPE cont(int sig)
{
if (tty_set(ttysl_fd) < 0) {
+ DEBUGLOG(("signal: failure in cont(%d), can't set tty raw %d\n", sig, ttysl_fd));
fprintf(stderr,"Can't set tty raw\n");
exit(1);
}
diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
index 46eccc6568..ac9b681d03 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -39,6 +39,11 @@
#ifdef HAVE_SYS_UIO_H
#include <sys/types.h>
#include <sys/uio.h>
+#if defined(HAVE_SENDFILE) && (defined(__FreeBSD__) || defined(__DragonFly__))
+/* Need to define __BSD_VISIBLE in order to expose prototype of sendfile */
+#define __BSD_VISIBLE 1
+#include <sys/socket.h>
+#endif
#endif
#if defined(HAVE_SENDFILE) && (defined(__linux__) || (defined(__sun) && defined(__SVR4)))
#include <sys/sendfile.h>
@@ -462,7 +467,7 @@ int
efile_fdatasync(Efile_error *errInfo, /* Where to return error codes. */
int fd) /* File descriptor for file to sync data. */
{
-#ifdef HAVE_FDATASYNC
+#if defined(HAVE_FDATASYNC) && !defined(__DARWIN__)
return check_error(fdatasync(fd), errInfo);
#else
return efile_fsync(errInfo, fd);
diff --git a/erts/emulator/drivers/win32/win_con.c b/erts/emulator/drivers/win32/win_con.c
index 0d63d46698..7fe708dc7b 100644
--- a/erts/emulator/drivers/win32/win_con.c
+++ b/erts/emulator/drivers/win32/win_con.c
@@ -279,7 +279,7 @@ ConInit(void)
}
/*
- ConNormalExit() is called from erl_exit() when the emulator
+ ConNormalExit() is called from erts_exit() when the emulator
is stopping. If the exit has not been initiated by this
console thread (WM_DESTROY or ID_BREAK), the function must
invoke the console thread to save the user preferences.
@@ -529,7 +529,7 @@ ConThreadInit(LPVOID param)
/*
PostQuitMessage() results in WM_QUIT which makes GetMessage()
return 0 (which stops the main loop). Before we return from
- the console thread, the ctrl_handler is called to do erl_exit.
+ the console thread, the ctrl_handler is called to do erts_exit.
*/
(*ctrl_handler)(CTRL_CLOSE_EVENT);
return msg.wParam;
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index cc68e1f74d..70354aa9af 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -406,7 +406,7 @@ BIF_RETTYPE hipe_bifs_enter_code_2(BIF_ALIST_2)
nrcallees = arityval(tuple_val(BIF_ARG_2)[0]);
else
nrcallees = 0;
- erl_exit(1, "%s: failed to allocate %lu bytes and %lu trampolines\r\n",
+ erts_exit(ERTS_ERROR_EXIT, "%s: failed to allocate %lu bytes and %lu trampolines\r\n",
__func__, (unsigned long)nrbytes, (unsigned long)nrcallees);
}
memcpy(address, bytes, nrbytes);
@@ -488,7 +488,7 @@ static void *const_term_alloc(void *tmpl)
alloc_size = size + (offsetof(struct const_term, mem)/sizeof(Eterm));
hipe_constants_size += alloc_size;
- p = (struct const_term*)erts_alloc(ERTS_ALC_T_HIPE, alloc_size * sizeof(Eterm));
+ p = (struct const_term*)erts_alloc(ERTS_ALC_T_LITERAL, alloc_size * sizeof(Eterm));
/* I have absolutely no idea if having a private 'off_heap'
works or not. _Some_ off_heap object is required for
@@ -497,6 +497,8 @@ static void *const_term_alloc(void *tmpl)
hp = &p->mem[0];
p->val = copy_struct(obj, size, &hp, &const_term_table_off_heap);
+ erts_set_literal_tag(&p->val, &p->mem[0], size);
+
return &p->bucket;
}
@@ -507,6 +509,9 @@ static void init_const_term_table(void)
f.cmp = (HCMP_FUN) const_term_cmp;
f.alloc = (HALLOC_FUN) const_term_alloc;
f.free = (HFREE_FUN) NULL;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_HIPE, &const_term_table, "const_term_table", 97, f);
}
@@ -574,15 +579,15 @@ static void print_mfa(Eterm mod, Eterm fun, unsigned int ari)
static Uint *hipe_find_emu_address(Eterm mod, Eterm name, unsigned int arity)
{
Module *modp;
- Uint *code_base;
+ BeamCodeHeader* code_hdr;
int i, n;
modp = erts_get_module(mod, erts_active_code_ix());
- if (modp == NULL || (code_base = modp->curr.code) == NULL)
+ if (modp == NULL || (code_hdr = modp->curr.code_hdr) == NULL)
return NULL;
- n = code_base[MI_NUM_FUNCTIONS];
+ n = code_hdr->num_functions;
for (i = 0; i < n; ++i) {
- Uint *code_ptr = (Uint*)code_base[MI_FUNCTIONS+i];
+ Uint *code_ptr = (Uint*)code_hdr->functions[i];
ASSERT(code_ptr[0] == BeamOpCode(op_i_func_info_IaaI));
if (code_ptr[3] == name && code_ptr[4] == arity)
return code_ptr+5;
@@ -715,6 +720,9 @@ static void init_nbif_table(void)
f.cmp = (HCMP_FUN) nbif_cmp;
f.alloc = (HALLOC_FUN) nbif_alloc;
f.free = NULL;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_NBIF_TABLE, &nbif_table, "nbif_table", 500, f);
@@ -808,6 +816,9 @@ static void init_primop_table(void)
f.cmp = (HCMP_FUN) primop_cmp;
f.alloc = (HALLOC_FUN) primop_alloc;
f.free = NULL;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_HIPE, &primop_table, "primop_table", 50, f);
@@ -1311,7 +1322,7 @@ static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote)
export_entry = erts_export_get_or_make_stub(m, f, arity);
StubAddress = hipe_make_native_stub(export_entry, arity);
if (!StubAddress)
- erl_exit(1, "hipe_make_stub: code allocation failed\r\n");
+ erts_exit(ERTS_ERROR_EXIT, "hipe_make_stub: code allocation failed\r\n");
return StubAddress;
}
@@ -1826,6 +1837,9 @@ static void init_modinfo_table(void)
f.cmp = (HCMP_FUN) modinfo_cmp;
f.alloc = (HALLOC_FUN) modinfo_alloc;
f.free = (HFREE_FUN) NULL;
+ f.meta_alloc = (HMALLOC_FUN) erts_alloc;
+ f.meta_free = (HMFREE_FUN) erts_free;
+ f.meta_print = (HMPRINT_FUN) erts_print;
hash_init(ERTS_ALC_T_HIPE, &modinfo_table, "modinfo_table", 11, f);
}
diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab
index e3328c7d2c..5ce254314a 100644
--- a/erts/emulator/hipe/hipe_bif0.tab
+++ b/erts/emulator/hipe/hipe_bif0.tab
@@ -142,4 +142,4 @@ atom bs_validate_unicode
atom bs_validate_unicode_retract
atom emulate_fpe
atom emasculate_binary
-
+atom is_divisible
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index 6aa0c9a32e..7240280345 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -193,6 +193,7 @@ standard_bif_interface_2(nbif_rethrow, hipe_rethrow)
standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub)
standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address)
nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error)
+standard_bif_interface_2(nbif_is_divisible, hipe_is_divisible)
/*
* Mbox primops with implicit P parameter.
diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c
index 2c747771ac..2e19bf88bf 100644
--- a/erts/emulator/hipe/hipe_gc.c
+++ b/erts/emulator/hipe/hipe_gc.c
@@ -46,10 +46,6 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
/* arch-specific nstack walk state */
struct nstack_walk_state walk_state;
- /* fullsweep-specific state */
- char *src, *oh;
- Uint src_size, oh_size;
-
if (!p->hipe.nstack) {
ASSERT(!p->hipe.nsp && !p->hipe.nstend);
return n_htop;
@@ -66,11 +62,6 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
sdesc = nstack_walk_init_sdesc(p, &walk_state);
- src = (char*)HEAP_START(p);
- src_size = (char*)HEAP_TOP(p) - src;
- oh = (char*)OLD_HEAP(p);
- oh_size = (char*)OLD_HTOP(p) - oh;
-
for (;;) {
if (nstack_walk_nsp_reached_end(nsp, nsp_end)) {
if (nsp == nsp_end) {
@@ -97,8 +88,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*nsp_i = val;
- } else if (in_area(ptr, src, src_size) ||
- in_area(ptr, oh, oh_size)) {
+ } else if (!erts_is_literal(gval, ptr)) {
MOVE_BOXED(ptr, val, n_htop, nsp_i);
}
} else if (is_list(gval)) {
@@ -106,8 +96,7 @@ Eterm *fullsweep_nstack(Process *p, Eterm *n_htop)
Eterm val = *ptr;
if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
- } else if (in_area(ptr, src, src_size) ||
- in_area(ptr, oh, oh_size)) {
+ } else if (!erts_is_literal(gval, ptr)) {
ASSERT(within(ptr, p));
MOVE_CONS(ptr, val, n_htop, nsp_i);
}
@@ -139,11 +128,13 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
unsigned int mask;
/* arch-specific nstack walk state */
struct nstack_walk_state walk_state;
+ char *oh;
+ Uint oh_size;
/* gensweep-specific state */
Eterm *old_htop, *n_htop;
- char *heap;
- Uint heap_size, mature_size;
+ char *mature;
+ Uint mature_size;
if (!p->hipe.nstack) {
ASSERT(!p->hipe.nsp && !p->hipe.nstend);
@@ -168,9 +159,10 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
old_htop = *ptr_old_htop;
n_htop = *ptr_n_htop;
- heap = (char*)HEAP_START(p);
- heap_size = (char*)HEAP_TOP(p) - heap;
- mature_size = (char*)HIGH_WATER(p) - heap;
+ mature = (char *) (p->abandoned_heap ? p->abandoned_heap : p->heap);
+ mature_size = (char*)HIGH_WATER(p) - mature;
+ oh = (char*)OLD_HEAP(p);
+ oh_size = (char*)OLD_HTOP(p) - oh;
for (;;) {
if (nstack_walk_nsp_reached_end(nsp, nsp_end)) {
@@ -209,9 +201,9 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*nsp_i = val;
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_BOXED(ptr, val, old_htop, nsp_i);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
ASSERT(within(ptr, p));
MOVE_BOXED(ptr, val, n_htop, nsp_i);
}
@@ -220,9 +212,9 @@ void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop)
Eterm val = *ptr;
if (IS_MOVED_CONS(val)) {
*nsp_i = ptr[1];
- } else if (in_area(ptr, heap, mature_size)) {
+ } else if (ErtsInArea(ptr, mature, mature_size)) {
MOVE_CONS(ptr, val, old_htop, nsp_i);
- } else if (in_area(ptr, heap, heap_size)) {
+ } else if (ErtsInYoungGen(gval, ptr, oh, oh_size)) {
ASSERT(within(ptr, p));
MOVE_CONS(ptr, val, n_htop, nsp_i);
}
diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c
index 968452a641..804c458b6c 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -108,7 +108,7 @@ static const char *code_str(unsigned code)
static void __noreturn
hipe_abort(const char *expr, const char *file, unsigned line)
{
- erl_exit(1, "ASSERTION FAILED, file %s, line %u: %s\r\n", file, line, expr);
+ erts_exit(ERTS_ERROR_EXIT, "ASSERTION FAILED, file %s, line %u: %s\r\n", file, line, expr);
}
#define HIPE_ASSERT3(expr, file, line) \
@@ -196,7 +196,7 @@ hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
ASSERT(!(p->flags & F_DISABLE_GC));
if ((p->stop - 2) < p->htop) {
DPRINTF("calling gc to increase BEAM stack size");
- p->fcalls -= erts_garbage_collect(p, 2, reg, arity);
+ erts_garbage_collect(p, 2, reg, arity);
ASSERT(!((p->stop - 2) < p->htop));
}
p->stop -= 2;
@@ -316,7 +316,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
break;
}
default:
- erl_exit(1, "hipe_mode_switch: cmd %#x\r\n", cmd);
+ erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: cmd %#x\r\n", cmd);
}
do_return_from_native:
DPRINTF("result == %#x (%s)", result, code_str(result));
@@ -560,7 +560,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
goto do_throw_to_native;
}
default:
- erl_exit(1, "hipe_mode_switch: result %#x\r\n", result);
+ erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %#x\r\n", result);
}
HIPE_CHECK_PCB(p);
p->def_arg_reg[3] = result;
diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h
index bc863a4f36..620cc6356b 100644
--- a/erts/emulator/hipe/hipe_mode_switch.h
+++ b/erts/emulator/hipe/hipe_mode_switch.h
@@ -95,7 +95,7 @@ ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsig
/* ensure that at least 2 words are available on the BEAM stack */
if ((p->stop - 2) < p->htop) {
- p->fcalls -= erts_garbage_collect(p, 2, reg, arity);
+ erts_garbage_collect(p, 2, reg, arity);
ASSERT(!((p->stop - 2) < p->htop));
}
p->stop -= 2;
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index 688378b2fe..0ec417999b 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -80,7 +80,7 @@ Eterm hipe_show_nstack_1(BIF_ALIST_1)
void hipe_gc(Process *p, Eterm need)
{
hipe_set_narity(p, 1);
- p->fcalls -= erts_garbage_collect(p, unsigned_val(need), NULL, 0);
+ erts_garbage_collect(p, unsigned_val(need), NULL, 0);
hipe_set_narity(p, 0);
}
@@ -157,13 +157,22 @@ BIF_RETTYPE hipe_set_timeout(BIF_ALIST_1)
*/
void hipe_select_msg(Process *p)
{
- ErlMessage *msgp;
+ ErtsMessage *msgp;
msgp = PEEK_MESSAGE(p);
UNLINK_MESSAGE(p, msgp); /* decrements global 'erts_proc_tot_mem' variable */
JOIN_MESSAGE(p);
CANCEL_TIMER(p); /* calls erts_cancel_proc_timer() */
- free_message(msgp);
+ erts_save_message_in_proc(p, msgp);
+ p->flags &= ~F_DELAY_GC;
+ if (ERTS_IS_GC_DESIRED(p)) {
+ /*
+ * We want to GC soon but we leave a few
+ * reductions giving the message some time
+ * to turn into garbage.
+ */
+ ERTS_VBUMP_LEAVE_REDS(p, 5);
+ }
}
void hipe_fclearerror_error(Process *p)
@@ -171,7 +180,7 @@ void hipe_fclearerror_error(Process *p)
#if !defined(NO_FPE_SIGNALS)
erts_fp_check_init_error(&p->fp_exception);
#else
- erl_exit(ERTS_ABORT_EXIT, "Emulated FPE not cleared by HiPE");
+ erts_exit(ERTS_ABORT_EXIT, "Emulated FPE not cleared by HiPE");
#endif
}
@@ -504,12 +513,25 @@ int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg)
return 1;
}
+BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2)
+{
+ /* Arguments are Eterm-sized unsigned integers */
+ Uint dividend = BIF_ARG_1;
+ Uint divisor = BIF_ARG_2;
+ if (dividend % divisor) {
+ BIF_ERROR(BIF_P, BADARG);
+ } else {
+ return NIL;
+ }
+}
+
/* This is like the loop_rec_fr BEAM instruction
*/
Eterm hipe_check_get_msg(Process *c_p)
{
- Eterm ret;
- ErlMessage *msgp;
+ ErtsMessage *msgp;
+
+ c_p->flags |= F_DELAY_GC;
next_message:
@@ -531,25 +553,29 @@ Eterm hipe_check_get_msg(Process *c_p)
/* XXX: BEAM doesn't need this */
c_p->hipe_smp.have_receive_locks = 1;
#endif
+ c_p->flags &= ~F_DELAY_GC;
return THE_NON_VALUE;
#ifdef ERTS_SMP
}
#endif
}
- ErtsMoveMsgAttachmentIntoProc(msgp, c_p, c_p->stop, HEAP_TOP(c_p),
- c_p->fcalls, (void) 0, (void) 0);
- ret = ERL_MESSAGE_TERM(msgp);
- if (is_non_value(ret)) {
+
+ if (is_non_value(ERL_MESSAGE_TERM(msgp))
+ && !erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) {
/*
* A corrupt distribution message that we weren't able to decode;
* remove it...
*/
ASSERT(!msgp->data.attached);
UNLINK_MESSAGE(c_p, msgp);
- free_message(msgp);
+ msgp->next = NULL;
+ erts_cleanup_messages(msgp);
goto next_message;
}
- return ret;
+
+ ASSERT(is_value(ERL_MESSAGE_TERM(msgp)));
+
+ return ERL_MESSAGE_TERM(msgp);
}
/*
diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h
index 0e1a75f7eb..55a0d3bb1b 100644
--- a/erts/emulator/hipe/hipe_native_bif.h
+++ b/erts/emulator/hipe/hipe_native_bif.h
@@ -68,6 +68,7 @@ AEXTERN(Eterm,nbif_bs_put_utf16le,(Process*,Eterm,byte*,unsigned int));
AEXTERN(Eterm,nbif_bs_get_utf16,(void));
AEXTERN(Eterm,nbif_bs_validate_unicode,(Process*,Eterm));
AEXTERN(Eterm,nbif_bs_validate_unicode_retract,(void));
+AEXTERN(void,nbif_is_divisible,(Process*,Uint,Uint));
AEXTERN(void,nbif_select_msg,(Process*));
AEXTERN(Eterm,nbif_cmp_2,(void));
@@ -93,6 +94,7 @@ BIF_RETTYPE hipe_bs_put_utf16le(BIF_ALIST_3);
BIF_RETTYPE hipe_bs_validate_unicode(BIF_ALIST_1);
struct erl_bin_match_buffer;
int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm);
+BIF_RETTYPE hipe_is_divisible(BIF_ALIST_2);
#ifdef NO_FPE_SIGNALS
AEXTERN(void,nbif_emulate_fpe,(Process*));
diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h
index adf7b1f382..0bec677574 100644
--- a/erts/emulator/hipe/hipe_primops.h
+++ b/erts/emulator/hipe/hipe_primops.h
@@ -68,6 +68,8 @@ PRIMOP_LIST(am_bs_get_utf16, &nbif_bs_get_utf16)
PRIMOP_LIST(am_bs_validate_unicode, &nbif_bs_validate_unicode)
PRIMOP_LIST(am_bs_validate_unicode_retract, &nbif_bs_validate_unicode_retract)
+PRIMOP_LIST(am_is_divisible, &nbif_is_divisible)
+
PRIMOP_LIST(am_cmp_2, &nbif_cmp_2)
PRIMOP_LIST(am_op_exact_eqeq_2, &nbif_eq_2)
diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c
index bb8a3f041f..0ecd13c4bc 100644
--- a/erts/emulator/hipe/hipe_x86_signal.c
+++ b/erts/emulator/hipe/hipe_x86_signal.c
@@ -38,9 +38,6 @@
*
* Our solution is to override the C library's signal handler setup
* procedure with our own which enforces the SA_ONSTACK flag.
- *
- * XXX: This code only supports Linux with glibc-2.1 or above,
- * and Solaris 8.
*/
#ifdef HAVE_CONFIG_H
#include "config.h"
@@ -55,27 +52,6 @@
#include "hipe_signal.h"
#if __GLIBC__ == 2 && (__GLIBC_MINOR__ >= 3)
-/* See comment below for glibc 2.2. */
-#ifndef __USE_GNU
-#define __USE_GNU /* to un-hide RTLD_NEXT */
-#endif
-#include <dlfcn.h>
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done() (__next_sigaction != 0)
-extern int __sigaction(int, const struct sigaction*, struct sigaction*);
-#define __SIGACTION __sigaction
-static void do_init(void)
-{
- __next_sigaction = dlsym(RTLD_NEXT, "__sigaction");
- if (__next_sigaction != 0)
- return;
- perror("dlsym");
- abort();
-}
-#define INIT() do { if (!init_done()) do_init(); } while (0)
-#endif /* glibc 2.3 */
-
-#if __GLIBC__ == 2 && (__GLIBC_MINOR__ == 2 /*|| __GLIBC_MINOR__ == 3*/)
/*
* __libc_sigaction() is the core routine.
* Without libpthread, sigaction() and __sigaction() are both aliases
@@ -100,65 +76,14 @@ static void do_init(void)
* old BSD or SysV interfaces.
* glibc's internal calls to __sigaction() appear to be mostly safe.
* hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler.
- *
- * Tested with glibc-2.1.92 on RedHat 7.0, glibc-2.2.2 on RedHat 7.1,
- * glibc-2.2.4 on RedHat 7.2, and glibc-2.2.5 on RedHat 7.3.
*/
-#if 0
-/* works with 2.2.5 and 2.2.4, but not 2.2.2 or 2.1.92 */
+#ifndef __USE_GNU
#define __USE_GNU /* to un-hide RTLD_NEXT */
-#include <dlfcn.h>
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done() (__next_sigaction != 0)
-#define __SIGACTION __sigaction
-static void do_init(void)
-{
- __next_sigaction = dlsym(RTLD_NEXT, "__sigaction");
- if (__next_sigaction != 0)
- return;
- perror("dlsym");
- abort();
-}
-#define INIT() do { if (!init_done()) do_init(); } while (0)
-#else
-/* semi-works with all 2.2 versions so far */
-extern int __sigaction(int, const struct sigaction*, struct sigaction*);
-#define __next_sigaction __sigaction /* pthreads-aware version */
-#undef __SIGACTION /* we can't override __sigaction() */
-#define INIT() do{}while(0)
#endif
-#endif /* glibc 2.2 */
-
-#if __GLIBC__ == 2 && __GLIBC_MINOR__ == 1
-/*
- * __sigaction() is the core routine.
- * Without libpthread, sigaction() is an alias for __sigaction().
- * libpthread redefines sigaction() as a non-trivial wrapper around
- * __sigaction().
- * glibc has internal calls to both sigaction() and __sigaction().
- *
- * Overriding __sigaction() would be ideal, but doing so breaks
- * libpthread (threads hang). Instead we override sigaction() and
- * use dlsym RTLD_NEXT to find glibc's version of sigaction().
- * glibc's internal calls to __sigaction() appear to be mostly safe.
- * hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler.
- *
- * Tested with glibc-2.1.3 on RedHat 6.2.
- */
-#include <dlfcn.h>
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done() (__next_sigaction != 0)
-#undef __SIGACTION
-static void do_init(void)
-{
- __next_sigaction = dlsym(RTLD_NEXT, "sigaction");
- if (__next_sigaction != 0)
- return;
- perror("dlsym");
- abort();
-}
-#define INIT() do { if (!init_done()) do_init(); } while (0)
-#endif /* glibc 2.1 */
+#define NEXT_SIGACTION "__sigaction"
+#define LIBC_SIGACTION __sigaction
+#define OVERRIDE_SIGACTION
+#endif /* glibc >= 2.3 */
/* Is there no standard identifier for Darwin/MacOSX ? */
#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
@@ -181,24 +106,13 @@ static void do_init(void)
* The other _sigaction, _sigaction_no_bind I don't understand the purpose
* of and don't modify.
*/
-#include <dlfcn.h>
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done() (__next_sigaction != 0)
-extern int _sigaction(int, const struct sigaction*, struct sigaction*);
-#define __SIGACTION _sigaction
-static void do_init(void)
-{
- __next_sigaction = dlsym(RTLD_NEXT, "sigaction");
- if (__next_sigaction != 0)
- return;
- perror("dlsym_darwin");
- abort();
-}
+#define NEXT_SIGACTION "sigaction"
+#define LIBC_SIGACTION _sigaction
+#undef OVERRIDE_SIGACTION
#define _NSIG NSIG
-#define INIT() do { if (!init_done()) do_init(); } while (0)
#endif /* __DARWIN__ */
-#if !defined(__GLIBC__) && !defined(__DARWIN__) && !defined(__NetBSD__)
+#if defined(__sun__)
/*
* Assume Solaris/x86 2.8.
* There is a number of sigaction() procedures in libc:
@@ -218,28 +132,76 @@ static void do_init(void)
* our init routine has had a chance to find _sigaction()'s address.
* This forces us to initialise at the first call.
*/
+#define NEXT_SIGACTION "_sigaction"
+#define LIBC_SIGACTION _sigaction
+#define OVERRIDE_SIGACTION
+#define _NSIG NSIG
+#endif /* __sun__ */
+
+#if defined(__FreeBSD__)
+/*
+ * This is a copy of Darwin code for FreeBSD.
+ * CAVEAT: detailed semantics are not verified yet.
+ */
+#define NEXT_SIGACTION "sigaction"
+#define LIBC_SIGACTION _sigaction
+#undef OVERRIDE_SIGACTION
+#define _NSIG NSIG
+#endif /* __FreeBSD__ */
+
+#if defined(__NetBSD__)
+/*
+ * Note: This is only stub code to allow the build to succeed.
+ * Whether this actually provides the needed overrides for safe
+ * signal delivery or not is unknown.
+ */
+#undef NEXT_SIGACTION
+#undef OVERRIDE_SIGACTION
+#endif /* __NetBSD__ */
+
+#if !(defined(__GLIBC__) || defined(__DARWIN__) || defined(__NetBSD__) || defined(__FreeBSD__) || defined(__sun__))
+/*
+ * Unknown libc -- assume musl. Note: musl deliberately does not provide a musl-specific
+ * feature test macro, so we cannot check for it.
+ *
+ * sigaction is a weak alias for __sigaction, which is a wrapper for __libc_sigaction.
+ * There are libc-internal calls to __libc_sigaction which install handlers, so we must
+ * override __libc_sigaction rather than __sigaction.
+ */
+#define NEXT_SIGACTION "__libc_sigaction"
+#define LIBC_SIGACTION __libc_sigaction
+#define OVERRIDE_SIGACTION
+#ifndef _NSIG
+#define _NSIG NSIG
+#endif
+#endif /* !(__GLIBC__ || __DARWIN__ || __NetBSD__ || __FreeBSD__ || __sun__) */
+
+#if defined(NEXT_SIGACTION)
+/*
+ * Initialize a function pointer to the libc core sigaction routine,
+ * to be used by our wrappers.
+ */
#include <dlfcn.h>
-static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*);
-#define init_done() (__next_sigaction != 0)
-#define __SIGACTION _sigaction
+static int (*next_sigaction)(int, const struct sigaction*, struct sigaction*);
static void do_init(void)
{
- __next_sigaction = dlsym(RTLD_NEXT, "_sigaction");
- if (__next_sigaction != 0)
+ next_sigaction = dlsym(RTLD_NEXT, NEXT_SIGACTION);
+ if (next_sigaction != 0)
return;
perror("dlsym");
abort();
}
-#define _NSIG NSIG
-#define INIT() do { if (!init_done()) do_init(); } while (0)
-#endif /* not glibc or darwin */
+#define INIT() do { if (!next_sigaction) do_init(); } while (0)
+#else /* !defined(NEXT_SIGACTION) */
+#define INIT() do { } while (0)
+#endif /* !defined(NEXT_SIGACTION) */
-#if !defined(__NetBSD__)
+#if defined(NEXT_SIGACTION)
/*
* This is our wrapper for sigaction(). sigaction() can be called before
* hipe_signal_init() has been executed, especially when threads support
* has been linked with the executable. Therefore, we must initialise
- * __next_sigaction() dynamically, the first time it's needed.
+ * next_sigaction() dynamically, the first time it's needed.
*/
static int my_sigaction(int signum, const struct sigaction *act, struct sigaction *oldact)
{
@@ -255,24 +217,26 @@ static int my_sigaction(int signum, const struct sigaction *act, struct sigactio
newact.sa_flags |= SA_ONSTACK;
act = &newact;
}
- return __next_sigaction(signum, act, oldact);
+ return next_sigaction(signum, act, oldact);
}
#endif
+
+#if defined(LIBC_SIGACTION)
/*
* This overrides the C library's core sigaction() procedure, catching
* all its internal calls.
*/
-#ifdef __SIGACTION
-int __SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldact)
+extern int LIBC_SIGACTION(int, const struct sigaction*, struct sigaction*);
+int LIBC_SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldact)
{
return my_sigaction(signum, act, oldact);
}
#endif
+#if defined(OVERRIDE_SIGACTION)
/*
* This catches the application's own sigaction() calls.
*/
-#if !defined(__DARWIN__) && !defined(__NetBSD__)
int sigaction(int signum, const struct sigaction *act, struct sigaction *oldact)
{
return my_sigaction(signum, act, oldact);
@@ -287,15 +251,11 @@ static void hipe_sigaltstack(void *ss_sp)
stack_t ss;
ss.ss_sp = ss_sp;
- ss.ss_flags = SS_ONSTACK;
+ ss.ss_flags = 0;
ss.ss_size = SIGSTKSZ;
if (sigaltstack(&ss, NULL) < 0) {
- /* might be a broken pre-2.4 Linux kernel, try harder */
- ss.ss_flags = 0;
- if (sigaltstack(&ss, NULL) < 0) {
- perror("sigaltstack");
- abort();
- }
+ perror("sigaltstack");
+ abort();
}
}
@@ -332,9 +292,7 @@ void hipe_signal_init(void)
struct sigaction sa;
int i;
-#ifndef __NetBSD__
INIT();
-#endif
hipe_sigaltstack_init();
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 105b129065..f87196d724 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -1337,11 +1337,7 @@ print_select_op(erts_dsprintf_buf_t *dsbufp,
{
Port *pp = erts_drvport2port(ix);
erts_dsprintf(dsbufp,
-#ifdef __OSE__
- "driver_select(%p, %d,%s%s%s%s | %d, %d) "
-#else
"driver_select(%p, %d,%s%s%s%s, %d) "
-#endif
"by ",
ix,
(int) GET_FD(fd),
@@ -1861,25 +1857,6 @@ stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode)
#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
-#ifdef __OSE__
-static SafeHashValue drv_ev_state_hash(void *des)
-{
- ErtsSysFdType fd = ((ErtsDrvEventState *) des)->fd;
- /* We use hash on signo ^ id in order for steal to happen when the
- same signo + fd is selected on by two different ports */
- SafeHashValue val = (SafeHashValue)(fd->signo ^ fd->id);
- return val ^ (val >> 8);
-}
-
-static int drv_ev_state_cmp(void *des1, void *des2)
-{
- ErtsSysFdType fd1 = ((ErtsDrvEventState *) des1)->fd;
- ErtsSysFdType fd2 = ((ErtsDrvEventState *) des2)->fd;
- if (fd1->signo == fd2->signo && fd1->id == fd2->id)
- return 0;
- return 1;
-}
-#else /* !__OSE__ && !ERTS_SYS_CONTINOUS_FD_NUMBERS i.e. probably windows */
static SafeHashValue drv_ev_state_hash(void *des)
{
SafeHashValue val = (SafeHashValue) ((ErtsDrvEventState *) des)->fd;
@@ -1891,7 +1868,6 @@ static int drv_ev_state_cmp(void *des1, void *des2)
return ( ((ErtsDrvEventState *) des1)->fd == ((ErtsDrvEventState *) des2)->fd
? 0 : 1);
}
-#endif
static void *drv_ev_state_alloc(void *des_tmpl)
{
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
index 754047829f..889d6f3868 100644
--- a/erts/emulator/sys/common/erl_mmap.c
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -51,23 +51,22 @@
#endif
/*
- * `mmap_state.sa.bot` and `mmap_state.sua.top` are read only after
+ * `mm->sa.bot` and `mm->sua.top` are read only after
* initialization, but the other pointers are not; i.e., only
* ERTS_MMAP_IN_SUPERCARRIER() is allowed without the mutex held.
*/
#define ERTS_MMAP_IN_SUPERCARRIER(PTR) \
- (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \
- < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sa.bot))
+ (((UWord) (PTR)) - ((UWord) mm->sa.bot) \
+ < ((UWord) mm->sua.top) - ((UWord) mm->sa.bot))
#define ERTS_MMAP_IN_SUPERALIGNED_AREA(PTR) \
- (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \
- (((UWord) (PTR)) - ((UWord) mmap_state.sa.bot) \
- < ((UWord) mmap_state.sa.top) - ((UWord) mmap_state.sa.bot)))
+ (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)), \
+ (((UWord) (PTR)) - ((UWord) mm->sa.bot) \
+ < ((UWord) mm->sa.top) - ((UWord) mm->sa.bot)))
#define ERTS_MMAP_IN_SUPERUNALIGNED_AREA(PTR) \
- (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mmap_state.mtx)), \
- (((UWord) (PTR)) - ((UWord) mmap_state.sua.bot) \
- < ((UWord) mmap_state.sua.top) - ((UWord) mmap_state.sua.bot)))
+ (ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&mm->mtx)), \
+ (((UWord) (PTR)) - ((UWord) mm->sua.bot) \
+ < ((UWord) mm->sua.top) - ((UWord) mm->sua.bot)))
-int erts_have_erts_mmap;
UWord erts_page_inv_mask;
#if defined(DEBUG) || defined(ERTS_MMAP_DEBUG)
@@ -197,10 +196,10 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
#define ERTS_MMAP_OP_LCK(RES, IN_SZ, OUT_SZ) \
do { \
- erts_smp_mtx_lock(&mmap_state.mtx); \
+ erts_smp_mtx_lock(&mm->mtx); \
ERTS_MMAP_OP_START((IN_SZ)); \
ERTS_MMAP_OP_END((RES), (OUT_SZ)); \
- erts_smp_mtx_unlock(&mmap_state.mtx); \
+ erts_smp_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MUNMAP_OP(PTR, SZ) \
@@ -219,9 +218,9 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
#define ERTS_MUNMAP_OP_LCK(PTR, SZ) \
do { \
- erts_smp_mtx_lock(&mmap_state.mtx); \
+ erts_smp_mtx_lock(&mm->mtx); \
ERTS_MUNMAP_OP((PTR), (SZ)); \
- erts_smp_mtx_unlock(&mmap_state.mtx); \
+ erts_smp_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MREMAP_OP_START(OLD_PTR, OLD_SZ, IN_SZ) \
@@ -247,10 +246,10 @@ static ErtsMMapOp mmap_ops[ERTS_MMAP_OP_RINGBUF_SZ];
#define ERTS_MREMAP_OP_LCK(RES, OLD_PTR, OLD_SZ, IN_SZ, OUT_SZ) \
do { \
- erts_smp_mtx_lock(&mmap_state.mtx); \
+ erts_smp_mtx_lock(&mm->mtx); \
ERTS_MREMAP_OP_START((OLD_PTR), (OLD_SZ), (IN_SZ)); \
ERTS_MREMAP_OP_END((RES), (OUT_SZ)); \
- erts_smp_mtx_unlock(&mmap_state.mtx); \
+ erts_smp_mtx_unlock(&mm->mtx); \
} while (0)
#define ERTS_MMAP_OP_ABORT() \
@@ -294,7 +293,7 @@ typedef struct {
Uint nseg;
}ErtsFreeSegMap;
-static struct {
+struct ErtsMemMapper_ {
int (*reserve_physical)(char *, UWord);
void (*unreserve_physical)(char *, UWord);
int supercarrier;
@@ -346,54 +345,62 @@ static struct {
UWord used;
} os;
} size;
-} mmap_state;
+};
+
+ErtsMemMapper erts_dflt_mmapper;
+
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ErtsMemMapper erts_literal_mmapper;
+char* erts_literals_start;
+UWord erts_literals_size;
+#endif
#define ERTS_MMAP_SIZE_SC_SA_INC(SZ) \
do { \
- mmap_state.size.supercarrier.used.total += (SZ); \
- mmap_state.size.supercarrier.used.sa += (SZ); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \
- <= mmap_state.size.supercarrier.total); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa \
- <= mmap_state.size.supercarrier.used.total); \
+ mm->size.supercarrier.used.total += (SZ); \
+ mm->size.supercarrier.used.sa += (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total \
+ <= mm->size.supercarrier.total); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sa \
+ <= mm->size.supercarrier.used.total); \
} while (0)
#define ERTS_MMAP_SIZE_SC_SA_DEC(SZ) \
do { \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \
- mmap_state.size.supercarrier.used.total -= (SZ); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sa >= (SZ)); \
- mmap_state.size.supercarrier.used.sa -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total >= (SZ)); \
+ mm->size.supercarrier.used.total -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sa >= (SZ)); \
+ mm->size.supercarrier.used.sa -= (SZ); \
} while (0)
#define ERTS_MMAP_SIZE_SC_SUA_INC(SZ) \
do { \
- mmap_state.size.supercarrier.used.total += (SZ); \
- mmap_state.size.supercarrier.used.sua += (SZ); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total \
- <= mmap_state.size.supercarrier.total); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua \
- <= mmap_state.size.supercarrier.used.total); \
+ mm->size.supercarrier.used.total += (SZ); \
+ mm->size.supercarrier.used.sua += (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total \
+ <= mm->size.supercarrier.total); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sua \
+ <= mm->size.supercarrier.used.total); \
} while (0)
#define ERTS_MMAP_SIZE_SC_SUA_DEC(SZ) \
do { \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.total >= (SZ)); \
- mmap_state.size.supercarrier.used.total -= (SZ); \
- ERTS_MMAP_ASSERT(mmap_state.size.supercarrier.used.sua >= (SZ)); \
- mmap_state.size.supercarrier.used.sua -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.total >= (SZ)); \
+ mm->size.supercarrier.used.total -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.supercarrier.used.sua >= (SZ)); \
+ mm->size.supercarrier.used.sua -= (SZ); \
} while (0)
#define ERTS_MMAP_SIZE_OS_INC(SZ) \
do { \
- ERTS_MMAP_ASSERT(mmap_state.size.os.used + (SZ) >= (SZ)); \
- mmap_state.size.os.used += (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.os.used + (SZ) >= (SZ)); \
+ mm->size.os.used += (SZ); \
} while (0)
#define ERTS_MMAP_SIZE_OS_DEC(SZ) \
do { \
- ERTS_MMAP_ASSERT(mmap_state.size.os.used >= (SZ)); \
- mmap_state.size.os.used -= (SZ); \
+ ERTS_MMAP_ASSERT(mm->size.os.used >= (SZ)); \
+ mm->size.os.used -= (SZ); \
} while (0)
static void
-add_free_desc_area(char *start, char *end)
+add_free_desc_area(ErtsMemMapper* mm, char *start, char *end)
{
ERTS_MMAP_ASSERT(end == (void *) 0 || end > start);
if (sizeof(ErtsFreeSegDesc) <= ((UWord) end) - ((UWord) start)) {
@@ -403,7 +410,7 @@ add_free_desc_area(char *start, char *end)
no = 1;
prev_desc = (ErtsFreeSegDesc *) start;
- prev_desc->start = mmap_state.desc.free_list;
+ prev_desc->start = mm->desc.free_list;
desc = (ErtsFreeSegDesc *) (start + sizeof(ErtsFreeSegDesc));
desc_end = start + 2*sizeof(ErtsFreeSegDesc);
@@ -414,59 +421,59 @@ add_free_desc_area(char *start, char *end)
desc_end += sizeof(ErtsFreeSegDesc);
no++;
}
- mmap_state.desc.free_list = (char *) prev_desc;
- mmap_state.no.free_seg_descs += no;
+ mm->desc.free_list = (char *) prev_desc;
+ mm->no.free_seg_descs += no;
}
}
static ErtsFreeSegDesc *
-add_unused_free_desc_area(void)
+add_unused_free_desc_area(ErtsMemMapper* mm)
{
char *ptr;
- if (!mmap_state.desc.unused_start)
+ if (!mm->desc.unused_start)
return NULL;
- ERTS_MMAP_ASSERT(mmap_state.desc.unused_end);
+ ERTS_MMAP_ASSERT(mm->desc.unused_end);
ERTS_MMAP_ASSERT(ERTS_PAGEALIGNED_SIZE
- <= mmap_state.desc.unused_end - mmap_state.desc.unused_start);
+ <= mm->desc.unused_end - mm->desc.unused_start);
- ptr = mmap_state.desc.unused_start + ERTS_PAGEALIGNED_SIZE;
- add_free_desc_area(mmap_state.desc.unused_start, ptr);
+ ptr = mm->desc.unused_start + ERTS_PAGEALIGNED_SIZE;
+ add_free_desc_area(mm, mm->desc.unused_start, ptr);
- if ((mmap_state.desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE)
- mmap_state.desc.unused_start = ptr;
+ if ((mm->desc.unused_end - ptr) >= ERTS_PAGEALIGNED_SIZE)
+ mm->desc.unused_start = ptr;
else
- mmap_state.desc.unused_end = mmap_state.desc.unused_start = NULL;
+ mm->desc.unused_end = mm->desc.unused_start = NULL;
- ERTS_MMAP_ASSERT(mmap_state.desc.free_list);
- return (ErtsFreeSegDesc *) mmap_state.desc.free_list;
+ ERTS_MMAP_ASSERT(mm->desc.free_list);
+ return (ErtsFreeSegDesc *) mm->desc.free_list;
}
static ERTS_INLINE ErtsFreeSegDesc *
-alloc_desc(void)
+alloc_desc(ErtsMemMapper* mm)
{
ErtsFreeSegDesc *res;
- res = (ErtsFreeSegDesc *) mmap_state.desc.free_list;
+ res = (ErtsFreeSegDesc *) mm->desc.free_list;
if (!res) {
- res = add_unused_free_desc_area();
+ res = add_unused_free_desc_area(mm);
if (!res)
return NULL;
}
- mmap_state.desc.free_list = res->start;
- ASSERT(mmap_state.no.free_segs.curr < mmap_state.no.free_seg_descs);
- mmap_state.no.free_segs.curr++;
- if (mmap_state.no.free_segs.max < mmap_state.no.free_segs.curr)
- mmap_state.no.free_segs.max = mmap_state.no.free_segs.curr;
+ mm->desc.free_list = res->start;
+ ASSERT(mm->no.free_segs.curr < mm->no.free_seg_descs);
+ mm->no.free_segs.curr++;
+ if (mm->no.free_segs.max < mm->no.free_segs.curr)
+ mm->no.free_segs.max = mm->no.free_segs.curr;
return res;
}
static ERTS_INLINE void
-free_desc(ErtsFreeSegDesc *desc)
+free_desc(ErtsMemMapper* mm, ErtsFreeSegDesc *desc)
{
- desc->start = mmap_state.desc.free_list;
- mmap_state.desc.free_list = (char *) desc;
- ERTS_MMAP_ASSERT(mmap_state.no.free_segs.curr > 0);
- mmap_state.no.free_segs.curr--;
+ desc->start = mm->desc.free_list;
+ mm->desc.free_list = (char *) desc;
+ ERTS_MMAP_ASSERT(mm->no.free_segs.curr > 0);
+ mm->no.free_segs.curr--;
}
static ERTS_INLINE ErtsFreeSegDesc* anode_to_desc(RBTNode* anode)
@@ -1233,7 +1240,7 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map)
# define ERTS_MMAP_FD (-1)
# else
# define ERTS_MMAP_FLAGS (MAP_PRIVATE)
-# define ERTS_MMAP_FD mmap_state.mmap_fd
+# define ERTS_MMAP_FD mm->mmap_fd
# endif
#endif
@@ -1334,7 +1341,7 @@ os_unreserve_physical(char *ptr, UWord size)
void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_UNRESERVE_PROT,
ERTS_MMAP_UNRESERVE_FLAGS, ERTS_MMAP_FD, 0);
if (res == (void *) MAP_FAILED)
- erl_exit(ERTS_ABORT_EXIT, "Failed to unreserve memory");
+ erts_exit(ERTS_ABORT_EXIT, "Failed to unreserve memory");
}
static void *
@@ -1378,11 +1385,12 @@ static void unreserve_noop(char *ptr, UWord size)
}
static UWord
-alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
+alloc_desc_insert_free_seg(ErtsMemMapper* mm,
+ ErtsFreeSegMap *map, char* start, char* end)
{
char *ptr;
ErtsFreeSegMap *da_map;
- ErtsFreeSegDesc *desc = alloc_desc();
+ ErtsFreeSegDesc *desc = alloc_desc(mm);
if (desc) {
insert_free_seg(map, desc, start, end);
return 0;
@@ -1395,13 +1403,13 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
*/
#if ERTS_HAVE_OS_MMAP
- if (!mmap_state.no_os_mmap) {
- ptr = os_mmap(mmap_state.desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0);
+ if (!mm->no_os_mmap) {
+ ptr = os_mmap(mm->desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0);
if (ptr) {
- mmap_state.desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE;
+ mm->desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE;
ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE);
- add_free_desc_area(ptr, ptr+ERTS_PAGEALIGNED_SIZE);
- desc = alloc_desc();
+ add_free_desc_area(mm, ptr, ptr+ERTS_PAGEALIGNED_SIZE);
+ desc = alloc_desc(mm);
ERTS_MMAP_ASSERT(desc);
insert_free_seg(map, desc, start, end);
return 0;
@@ -1412,20 +1420,20 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
/*
* ...then try to find a good place in the supercarrier...
*/
- da_map = &mmap_state.sua.map;
+ da_map = &mm->sua.map;
desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
if (desc) {
- if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
+ if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE);
else
desc = NULL;
}
else {
- da_map = &mmap_state.sa.map;
+ da_map = &mm->sa.map;
desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE);
if (desc) {
- if (mmap_state.reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
+ if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE))
ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE);
else
desc = NULL;
@@ -1433,15 +1441,15 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
}
if (desc) {
char *da_end = desc->start + ERTS_PAGEALIGNED_SIZE;
- add_free_desc_area(desc->start, da_end);
+ add_free_desc_area(mm, desc->start, da_end);
if (da_end != desc->end)
resize_free_seg(da_map, desc, da_end, desc->end);
else {
delete_free_seg(da_map, desc);
- free_desc(desc);
+ free_desc(mm, desc);
}
- desc = alloc_desc();
+ desc = alloc_desc(mm);
ERTS_MMAP_ASSERT(desc);
insert_free_seg(map, desc, start, end);
return 0;
@@ -1454,10 +1462,10 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
ptr = start + ERTS_PAGEALIGNED_SIZE;
ERTS_MMAP_ASSERT(ptr <= end);
- add_free_desc_area(start, ptr);
+ add_free_desc_area(mm, start, ptr);
if (ptr != end) {
- desc = alloc_desc();
+ desc = alloc_desc(mm);
ERTS_MMAP_ASSERT(desc);
insert_free_seg(map, desc, ptr, end);
}
@@ -1466,46 +1474,46 @@ alloc_desc_insert_free_seg(ErtsFreeSegMap *map, char* start, char* end)
}
void *
-erts_mmap(Uint32 flags, UWord *sizep)
+erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep)
{
char *seg;
UWord asize = ERTS_PAGEALIGNED_CEILING(*sizep);
/* Map in premapped supercarrier */
- if (mmap_state.supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) {
+ if (mm->supercarrier && !(ERTS_MMAPFLG_OS_ONLY & flags)) {
char *end;
ErtsFreeSegDesc *desc;
Uint32 superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
- erts_smp_mtx_lock(&mmap_state.mtx);
+ erts_smp_mtx_lock(&mm->mtx);
ERTS_MMAP_OP_START(*sizep);
if (!superaligned) {
- desc = lookup_free_seg(&mmap_state.sua.map, asize);
+ desc = lookup_free_seg(&mm->sua.map, asize);
if (desc) {
seg = desc->start;
end = seg+asize;
- if (!mmap_state.reserve_physical(seg, asize))
+ if (!mm->reserve_physical(seg, asize))
goto supercarrier_reserve_failure;
if (desc->end == end) {
- delete_free_seg(&mmap_state.sua.map, desc);
- free_desc(desc);
+ delete_free_seg(&mm->sua.map, desc);
+ free_desc(mm, desc);
}
else {
ERTS_MMAP_ASSERT(end < desc->end);
- resize_free_seg(&mmap_state.sua.map, desc, end, desc->end);
+ resize_free_seg(&mm->sua.map, desc, end, desc->end);
}
ERTS_MMAP_SIZE_SC_SUA_INC(asize);
goto supercarrier_success;
}
- if (asize <= mmap_state.sua.bot - mmap_state.sa.top) {
- if (!mmap_state.reserve_physical(mmap_state.sua.bot - asize,
+ if (asize <= mm->sua.bot - mm->sa.top) {
+ if (!mm->reserve_physical(mm->sua.bot - asize,
asize))
goto supercarrier_reserve_failure;
- mmap_state.sua.bot -= asize;
- seg = mmap_state.sua.bot;
+ mm->sua.bot -= asize;
+ seg = mm->sua.bot;
ERTS_MMAP_SIZE_SC_SUA_INC(asize);
goto supercarrier_success;
}
@@ -1513,84 +1521,84 @@ erts_mmap(Uint32 flags, UWord *sizep)
asize = ERTS_SUPERALIGNED_CEILING(asize);
- desc = lookup_free_seg(&mmap_state.sa.map, asize);
+ desc = lookup_free_seg(&mm->sa.map, asize);
if (desc) {
char *start = seg = desc->start;
seg = (char *) ERTS_SUPERALIGNED_CEILING(seg);
end = seg+asize;
- if (!mmap_state.reserve_physical(start, (UWord) (end - start)))
+ if (!mm->reserve_physical(start, (UWord) (end - start)))
goto supercarrier_reserve_failure;
ERTS_MMAP_SIZE_SC_SA_INC(asize);
if (desc->end == end) {
if (start != seg)
- resize_free_seg(&mmap_state.sa.map, desc, start, seg);
+ resize_free_seg(&mm->sa.map, desc, start, seg);
else {
- delete_free_seg(&mmap_state.sa.map, desc);
- free_desc(desc);
+ delete_free_seg(&mm->sa.map, desc);
+ free_desc(mm, desc);
}
}
else {
ERTS_MMAP_ASSERT(end < desc->end);
- resize_free_seg(&mmap_state.sa.map, desc, end, desc->end);
+ resize_free_seg(&mm->sa.map, desc, end, desc->end);
if (start != seg) {
UWord ad_sz;
- ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
start, seg);
start += ad_sz;
if (start != seg)
- mmap_state.unreserve_physical(start, (UWord) (seg - start));
+ mm->unreserve_physical(start, (UWord) (seg - start));
}
}
goto supercarrier_success;
}
if (superaligned) {
- char *start = mmap_state.sa.top;
+ char *start = mm->sa.top;
seg = (char *) ERTS_SUPERALIGNED_CEILING(start);
- if (asize + (seg - start) <= mmap_state.sua.bot - start) {
+ if (asize + (seg - start) <= mm->sua.bot - start) {
end = seg + asize;
- if (!mmap_state.reserve_physical(start, (UWord) (end - start)))
+ if (!mm->reserve_physical(start, (UWord) (end - start)))
goto supercarrier_reserve_failure;
- mmap_state.sa.top = end;
+ mm->sa.top = end;
ERTS_MMAP_SIZE_SC_SA_INC(asize);
if (start != seg) {
UWord ad_sz;
- ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
start, seg);
start += ad_sz;
if (start != seg)
- mmap_state.unreserve_physical(start, (UWord) (seg - start));
+ mm->unreserve_physical(start, (UWord) (seg - start));
}
goto supercarrier_success;
}
- desc = lookup_free_seg(&mmap_state.sua.map, asize + ERTS_SUPERALIGNED_SIZE);
+ desc = lookup_free_seg(&mm->sua.map, asize + ERTS_SUPERALIGNED_SIZE);
if (desc) {
char *org_start = desc->start;
char *org_end = desc->end;
seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start);
end = seg + asize;
- if (!mmap_state.reserve_physical(seg, (UWord) (org_end - seg)))
+ if (!mm->reserve_physical(seg, (UWord) (org_end - seg)))
goto supercarrier_reserve_failure;
ERTS_MMAP_SIZE_SC_SUA_INC(asize);
if (org_start != seg) {
ERTS_MMAP_ASSERT(org_start < seg);
- resize_free_seg(&mmap_state.sua.map, desc, org_start, seg);
+ resize_free_seg(&mm->sua.map, desc, org_start, seg);
desc = NULL;
}
if (end != org_end) {
UWord ad_sz = 0;
ERTS_MMAP_ASSERT(end < org_end);
if (desc)
- resize_free_seg(&mmap_state.sua.map, desc, end, org_end);
+ resize_free_seg(&mm->sua.map, desc, end, org_end);
else
- ad_sz = alloc_desc_insert_free_seg(&mmap_state.sua.map,
+ ad_sz = alloc_desc_insert_free_seg(mm, &mm->sua.map,
end, org_end);
end += ad_sz;
if (end != org_end)
- mmap_state.unreserve_physical(end,
+ mm->unreserve_physical(end,
(UWord) (org_end - end));
}
goto supercarrier_success;
@@ -1598,12 +1606,12 @@ erts_mmap(Uint32 flags, UWord *sizep)
}
ERTS_MMAP_OP_ABORT();
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
}
#if ERTS_HAVE_OS_MMAP
/* Map using OS primitives */
- if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mmap_state.no_os_mmap) {
+ if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mm->no_os_mmap) {
if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) {
seg = os_mmap(NULL, asize, 0);
if (!seg)
@@ -1661,25 +1669,25 @@ supercarrier_success:
#endif
ERTS_MMAP_OP_END(seg, asize);
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
*sizep = asize;
return (void *) seg;
supercarrier_reserve_failure:
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
*sizep = 0;
return NULL;
}
void
-erts_munmap(Uint32 flags, void *ptr, UWord size)
+erts_munmap(ErtsMemMapper* mm, Uint32 flags, void *ptr, UWord size)
{
ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(ptr));
ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(size));
if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) {
- ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap);
+ ERTS_MMAP_ASSERT(!mm->no_os_mmap);
#if ERTS_HAVE_OS_MMAP
ERTS_MUNMAP_OP_LCK(ptr, size);
ERTS_MMAP_SIZE_OS_DEC(size);
@@ -1692,45 +1700,45 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
ErtsFreeSegDesc *prev, *next, *desc;
UWord ad_sz = 0;
- ERTS_MMAP_ASSERT(mmap_state.supercarrier);
+ ERTS_MMAP_ASSERT(mm->supercarrier);
start = (char *) ptr;
end = start + size;
- erts_smp_mtx_lock(&mmap_state.mtx);
+ erts_smp_mtx_lock(&mm->mtx);
ERTS_MUNMAP_OP(ptr, size);
if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
- map = &mmap_state.sa.map;
+ map = &mm->sa.map;
adjacent_free_seg(map, start, end, &prev, &next);
ERTS_MMAP_SIZE_SC_SA_DEC(size);
- if (end == mmap_state.sa.top) {
+ if (end == mm->sa.top) {
ERTS_MMAP_ASSERT(!next);
if (prev) {
start = prev->start;
delete_free_seg(map, prev);
- free_desc(prev);
+ free_desc(mm, prev);
}
- mmap_state.sa.top = start;
+ mm->sa.top = start;
goto supercarrier_success;
}
}
else {
- map = &mmap_state.sua.map;
+ map = &mm->sua.map;
adjacent_free_seg(map, start, end, &prev, &next);
ERTS_MMAP_SIZE_SC_SUA_DEC(size);
- if (start == mmap_state.sua.bot) {
+ if (start == mm->sua.bot) {
ERTS_MMAP_ASSERT(!prev);
if (next) {
end = next->end;
delete_free_seg(map, next);
- free_desc(next);
+ free_desc(mm, next);
}
- mmap_state.sua.bot = end;
+ mm->sua.bot = end;
goto supercarrier_success;
}
}
@@ -1742,7 +1750,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
end = next->end;
if (prev) {
delete_free_seg(map, next);
- free_desc(next);
+ free_desc(mm, next);
goto save_prev;
}
desc = next;
@@ -1756,7 +1764,7 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
if (desc)
resize_free_seg(map, desc, start, end);
else
- ad_sz = alloc_desc_insert_free_seg(map, start, end);
+ ad_sz = alloc_desc_insert_free_seg(mm, map, start, end);
supercarrier_success: {
UWord unres_sz;
@@ -1764,30 +1772,32 @@ erts_munmap(Uint32 flags, void *ptr, UWord size)
ERTS_MMAP_ASSERT(size >= ad_sz);
unres_sz = size - ad_sz;
if (unres_sz)
- mmap_state.unreserve_physical(((char *) ptr) + ad_sz, unres_sz);
+ mm->unreserve_physical(((char *) ptr) + ad_sz, unres_sz);
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
}
}
}
static void *
-remap_move(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
+remap_move(ErtsMemMapper* mm,
+ Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
{
UWord size = *sizep;
- void *new_ptr = erts_mmap(flags, &size);
+ void *new_ptr = erts_mmap(mm, flags, &size);
if (!new_ptr)
return NULL;
*sizep = size;
if (old_size < size)
size = old_size;
sys_memcpy(new_ptr, ptr, (size_t) size);
- erts_munmap(flags, ptr, old_size);
+ erts_munmap(mm, flags, ptr, old_size);
return new_ptr;
}
void *
-erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
+erts_mremap(ErtsMemMapper* mm,
+ Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
{
void *new_ptr;
Uint32 superaligned;
@@ -1799,11 +1809,11 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
if (!ERTS_MMAP_IN_SUPERCARRIER(ptr)) {
- ERTS_MMAP_ASSERT(!mmap_state.no_os_mmap);
+ ERTS_MMAP_ASSERT(!mm->no_os_mmap);
- if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mmap_state.supercarrier) {
- new_ptr = remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr,
- old_size, sizep);
+ if (!(ERTS_MMAPFLG_OS_ONLY & flags) && mm->supercarrier) {
+ new_ptr = remap_move(mm, ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags,
+ ptr, old_size, sizep);
if (new_ptr)
return new_ptr;
}
@@ -1850,7 +1860,7 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
#endif
#if ERTS_HAVE_OS_MREMAP
if (superaligned)
- return remap_move(flags, new_ptr, old_size, sizep);
+ return remap_move(mm, flags, new_ptr, old_size, sizep);
else {
new_ptr = os_mremap(ptr, old_size, asize, 0);
if (!new_ptr)
@@ -1872,10 +1882,10 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
ErtsFreeSegDesc *prev, *next;
UWord ad_sz = 0;
- ERTS_MMAP_ASSERT(mmap_state.supercarrier);
+ ERTS_MMAP_ASSERT(mm->supercarrier);
if (ERTS_MMAPFLG_OS_ONLY & flags)
- return remap_move(flags, ptr, old_size, sizep);
+ return remap_move(mm, flags, ptr, old_size, sizep);
superaligned = (ERTS_MMAPFLG_SUPERALIGNED & flags);
@@ -1883,19 +1893,19 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
? ERTS_SUPERALIGNED_CEILING(*sizep)
: ERTS_PAGEALIGNED_CEILING(*sizep));
- erts_smp_mtx_lock(&mmap_state.mtx);
+ erts_smp_mtx_lock(&mm->mtx);
if (ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)
- ? (!superaligned && lookup_free_seg(&mmap_state.sua.map, asize))
- : (superaligned && lookup_free_seg(&mmap_state.sa.map, asize))) {
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ ? (!superaligned && lookup_free_seg(&mm->sua.map, asize))
+ : (superaligned && lookup_free_seg(&mm->sa.map, asize))) {
+ erts_smp_mtx_unlock(&mm->mtx);
/*
* Segment currently in wrong area (due to a previous memory
* shortage), move it to the right area.
* (remap_move() will succeed)
*/
- return remap_move(ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags, ptr,
- old_size, sizep);
+ return remap_move(mm, ERTS_MMAPFLG_SUPERCARRIER_ONLY|flags,
+ ptr, old_size, sizep);
}
ERTS_MREMAP_OP_START(ptr, old_size, *sizep);
@@ -1917,18 +1927,18 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
UWord unres_sz;
new_ptr = ptr;
if (!ERTS_MMAP_IN_SUPERALIGNED_AREA(ptr)) {
- map = &mmap_state.sua.map;
+ map = &mm->sua.map;
ERTS_MMAP_SIZE_SC_SUA_DEC(old_size - asize);
}
else {
- if (end == mmap_state.sa.top) {
- mmap_state.sa.top = new_end;
- mmap_state.unreserve_physical(((char *) ptr) + asize,
+ if (end == mm->sa.top) {
+ mm->sa.top = new_end;
+ mm->unreserve_physical(((char *) ptr) + asize,
old_size - asize);
goto supercarrier_resize_success;
}
ERTS_MMAP_SIZE_SC_SA_DEC(old_size - asize);
- map = &mmap_state.sa.map;
+ map = &mm->sa.map;
}
adjacent_free_seg(map, start, end, &prev, &next);
@@ -1936,11 +1946,11 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
if (next)
resize_free_seg(map, next, new_end, next->end);
else
- ad_sz = alloc_desc_insert_free_seg(map, new_end, end);
+ ad_sz = alloc_desc_insert_free_seg(mm, map, new_end, end);
ERTS_MMAP_ASSERT(old_size - asize >= ad_sz);
unres_sz = old_size - asize - ad_sz;
if (unres_sz)
- mmap_state.unreserve_physical(((char *) ptr) + asize + ad_sz,
+ mm->unreserve_physical(((char *) ptr) + asize + ad_sz,
unres_sz);
goto supercarrier_resize_success;
}
@@ -1950,17 +1960,17 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(old_size));
ERTS_MMAP_ASSERT(ERTS_IS_PAGEALIGNED(asize));
- adjacent_free_seg(&mmap_state.sua.map, start, end, &prev, &next);
+ adjacent_free_seg(&mm->sua.map, start, end, &prev, &next);
if (next && new_end <= next->end) {
- if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
asize - old_size))
goto supercarrier_reserve_failure;
if (new_end < next->end)
- resize_free_seg(&mmap_state.sua.map, next, new_end, next->end);
+ resize_free_seg(&mm->sua.map, next, new_end, next->end);
else {
- delete_free_seg(&mmap_state.sua.map, next);
- free_desc(next);
+ delete_free_seg(&mm->sua.map, next);
+ free_desc(mm, next);
}
new_ptr = ptr;
ERTS_MMAP_SIZE_SC_SUA_INC(asize - old_size);
@@ -1969,28 +1979,28 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
}
else { /* Superaligned area */
- if (end == mmap_state.sa.top) {
- if (new_end <= mmap_state.sua.bot) {
- if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ if (end == mm->sa.top) {
+ if (new_end <= mm->sua.bot) {
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
asize - old_size))
goto supercarrier_reserve_failure;
- mmap_state.sa.top = new_end;
+ mm->sa.top = new_end;
new_ptr = ptr;
ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size);
goto supercarrier_resize_success;
}
}
else {
- adjacent_free_seg(&mmap_state.sa.map, start, end, &prev, &next);
+ adjacent_free_seg(&mm->sa.map, start, end, &prev, &next);
if (next && new_end <= next->end) {
- if (!mmap_state.reserve_physical(((char *) ptr) + old_size,
+ if (!mm->reserve_physical(((char *) ptr) + old_size,
asize - old_size))
goto supercarrier_reserve_failure;
if (new_end < next->end)
- resize_free_seg(&mmap_state.sa.map, next, new_end, next->end);
+ resize_free_seg(&mm->sa.map, next, new_end, next->end);
else {
- delete_free_seg(&mmap_state.sa.map, next);
- free_desc(next);
+ delete_free_seg(&mm->sa.map, next);
+ free_desc(mm, next);
}
new_ptr = ptr;
ERTS_MMAP_SIZE_SC_SA_INC(asize - old_size);
@@ -2000,12 +2010,12 @@ erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep)
}
ERTS_MMAP_OP_ABORT();
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
/* Failed to resize... */
}
- return remap_move(flags, ptr, old_size, sizep);
+ return remap_move(mm, flags, ptr, old_size, sizep);
supercarrier_resize_success:
@@ -2022,25 +2032,24 @@ supercarrier_resize_success:
#endif
ERTS_MREMAP_OP_END(new_ptr, asize);
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
*sizep = asize;
return new_ptr;
supercarrier_reserve_failure:
ERTS_MREMAP_OP_END(NULL, old_size);
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ erts_smp_mtx_unlock(&mm->mtx);
*sizep = old_size;
return NULL;
}
-int erts_mmap_in_supercarrier(void *ptr)
+int erts_mmap_in_supercarrier(ErtsMemMapper* mm, void *ptr)
{
return ERTS_MMAP_IN_SUPERCARRIER(ptr);
}
-
static struct {
Eterm total;
Eterm total_sa;
@@ -2103,8 +2112,9 @@ static void hard_dbg_mseg_init(void);
#endif
void
-erts_mmap_init(ErtsMMapInit *init)
+erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init)
{
+ static int is_first_call = 1;
int virtual_map = 0;
char *start = NULL, *end = NULL;
UWord pagesize;
@@ -2126,25 +2136,25 @@ erts_mmap_init(ErtsMMapInit *init)
#endif
erts_page_inv_mask = pagesize - 1;
if (pagesize & erts_page_inv_mask)
- erl_exit(-1, "erts_mmap: Invalid pagesize: %bpu\n",
+ erts_exit(1, "erts_mmap: Invalid pagesize: %bpu\n",
pagesize);
ERTS_MMAP_OP_RINGBUF_INIT();
- erts_have_erts_mmap = 0;
-
- mmap_state.supercarrier = 0;
- mmap_state.reserve_physical = reserve_noop;
- mmap_state.unreserve_physical = unreserve_noop;
+ mm->supercarrier = 0;
+ mm->reserve_physical = reserve_noop;
+ mm->unreserve_physical = unreserve_noop;
#if HAVE_MMAP && !defined(MAP_ANON)
- mmap_state.mmap_fd = open("/dev/zero", O_RDWR);
- if (mmap_state.mmap_fd < 0)
- erl_exit(-1, "erts_mmap: Failed to open /dev/zero\n");
+ mm->mmap_fd = open("/dev/zero", O_RDWR);
+ if (mm->mmap_fd < 0)
+ erts_exit(1, "erts_mmap: Failed to open /dev/zero\n");
#endif
- erts_smp_mtx_init(&mmap_state.mtx, "erts_mmap");
- erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
+ erts_smp_mtx_init(&mm->mtx, "erts_mmap");
+ if (is_first_call) {
+ erts_mtx_init(&am.init_mutex, "mmap_init_atoms");
+ }
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
if (init->virtual_range.start) {
@@ -2155,13 +2165,13 @@ erts_mmap_init(ErtsMMapInit *init)
sz = end - ptr;
start = os_mmap_virtual(ptr, sz);
if (!start || start > ptr || start >= end)
- erl_exit(-1,
+ erts_exit(1,
"erts_mmap: Failed to create virtual range for super carrier\n");
sz = start - ptr;
if (sz)
os_munmap(end, sz);
- mmap_state.reserve_physical = os_reserve_physical;
- mmap_state.unreserve_physical = os_unreserve_physical;
+ mm->reserve_physical = os_reserve_physical;
+ mm->unreserve_physical = os_unreserve_physical;
virtual_map = 1;
}
else
@@ -2179,8 +2189,8 @@ erts_mmap_init(ErtsMMapInit *init)
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
if (!init->scrpm) {
start = os_mmap_virtual(NULL, sz);
- mmap_state.reserve_physical = os_reserve_physical;
- mmap_state.unreserve_physical = os_unreserve_physical;
+ mm->reserve_physical = os_reserve_physical;
+ mm->unreserve_physical = os_unreserve_physical;
virtual_map = 1;
}
else
@@ -2193,7 +2203,7 @@ erts_mmap_init(ErtsMMapInit *init)
start = os_mmap(NULL, sz, 1);
}
if (!start)
- erl_exit(-1,
+ erts_exit(1,
"erts_mmap: Failed to create super carrier of size %bpu MB\n",
init->scs/1024/1024);
end = start + sz;
@@ -2206,34 +2216,32 @@ erts_mmap_init(ErtsMMapInit *init)
}
#endif
}
- if (!mmap_state.no_os_mmap)
- erts_have_erts_mmap |= ERTS_HAVE_ERTS_OS_MMAP;
#endif
- mmap_state.no.free_seg_descs = 0;
- mmap_state.no.free_segs.curr = 0;
- mmap_state.no.free_segs.max = 0;
+ mm->no.free_seg_descs = 0;
+ mm->no.free_segs.curr = 0;
+ mm->no.free_segs.max = 0;
- mmap_state.size.supercarrier.total = 0;
- mmap_state.size.supercarrier.used.total = 0;
- mmap_state.size.supercarrier.used.sa = 0;
- mmap_state.size.supercarrier.used.sua = 0;
- mmap_state.size.os.used = 0;
+ mm->size.supercarrier.total = 0;
+ mm->size.supercarrier.used.total = 0;
+ mm->size.supercarrier.used.sa = 0;
+ mm->size.supercarrier.used.sua = 0;
+ mm->size.os.used = 0;
- mmap_state.desc.new_area_hint = NULL;
+ mm->desc.new_area_hint = NULL;
if (!start) {
- mmap_state.sa.bot = NULL;
- mmap_state.sua.top = NULL;
- mmap_state.sa.bot = NULL;
- mmap_state.sua.top = NULL;
- mmap_state.no_os_mmap = 0;
- mmap_state.supercarrier = 0;
+ mm->sa.bot = NULL;
+ mm->sua.top = NULL;
+ mm->sa.bot = NULL;
+ mm->sua.top = NULL;
+ mm->no_os_mmap = 0;
+ mm->supercarrier = 0;
}
else {
size_t desc_size;
- mmap_state.no_os_mmap = init->sco;
+ mm->no_os_mmap = init->sco;
desc_size = init->scrfsd;
if (desc_size < 100)
@@ -2242,68 +2250,75 @@ erts_mmap_init(ErtsMMapInit *init)
if ((desc_size
+ ERTS_SUPERALIGNED_SIZE
+ ERTS_PAGEALIGNED_SIZE) > end - start)
- erl_exit(-1, "erts_mmap: No space for segments in super carrier\n");
+ erts_exit(1, "erts_mmap: No space for segments in super carrier\n");
- mmap_state.sa.bot = start;
- mmap_state.sa.bot += desc_size;
- mmap_state.sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mmap_state.sa.bot);
- mmap_state.sa.top = mmap_state.sa.bot;
- mmap_state.sua.top = end;
- mmap_state.sua.bot = mmap_state.sua.top;
+ mm->sa.bot = start;
+ mm->sa.bot += desc_size;
+ mm->sa.bot = (char *) ERTS_SUPERALIGNED_CEILING(mm->sa.bot);
+ mm->sa.top = mm->sa.bot;
+ mm->sua.top = end;
+ mm->sua.bot = mm->sua.top;
- mmap_state.size.supercarrier.used.total += (UWord) (mmap_state.sa.bot - start);
+ mm->size.supercarrier.used.total += (UWord) (mm->sa.bot - start);
- mmap_state.desc.free_list = NULL;
- mmap_state.desc.reserved = 0;
+ mm->desc.free_list = NULL;
+ mm->desc.reserved = 0;
if (end == (void *) 0) {
/*
* Very unlikely, but we need a guarantee
- * that `mmap_state.sua.top` always will
+ * that `mm->sua.top` always will
* compare as larger than all segment pointers
* into the super carrier...
*/
- mmap_state.sua.top -= ERTS_PAGEALIGNED_SIZE;
- mmap_state.size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE;
+ mm->sua.top -= ERTS_PAGEALIGNED_SIZE;
+ mm->size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE;
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
- if (!virtual_map || os_reserve_physical(mmap_state.sua.top, ERTS_PAGEALIGNED_SIZE))
+ if (!virtual_map || os_reserve_physical(mm->sua.top, ERTS_PAGEALIGNED_SIZE))
#endif
- add_free_desc_area(mmap_state.sua.top, end);
- mmap_state.desc.reserved += (end - mmap_state.sua.top) / sizeof(ErtsFreeSegDesc);
+ add_free_desc_area(mm, mm->sua.top, end);
+ mm->desc.reserved += (end - mm->sua.top) / sizeof(ErtsFreeSegDesc);
}
- mmap_state.size.supercarrier.total = (UWord) (mmap_state.sua.top - start);
+ mm->size.supercarrier.total = (UWord) (mm->sua.top - start);
/*
* Area before (and after) super carrier
* will be used for free segment descritors.
*/
#ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION
- if (virtual_map && !os_reserve_physical(start, mmap_state.sa.bot - start))
- erl_exit(-1, "erts_mmap: Failed to reserve physical memory for descriptors\n");
+ if (virtual_map && !os_reserve_physical(start, mm->sa.bot - start))
+ erts_exit(1, "erts_mmap: Failed to reserve physical memory for descriptors\n");
#endif
- mmap_state.desc.unused_start = start;
- mmap_state.desc.unused_end = mmap_state.sa.bot;
- mmap_state.desc.reserved += ((mmap_state.desc.unused_end - start)
+ mm->desc.unused_start = start;
+ mm->desc.unused_end = mm->sa.bot;
+ mm->desc.reserved += ((mm->desc.unused_end - start)
/ sizeof(ErtsFreeSegDesc));
- init_free_seg_map(&mmap_state.sa.map, SA_SZ_ADDR_ORDER);
- init_free_seg_map(&mmap_state.sua.map, SZ_REVERSE_ADDR_ORDER);
+ init_free_seg_map(&mm->sa.map, SA_SZ_ADDR_ORDER);
+ init_free_seg_map(&mm->sua.map, SZ_REVERSE_ADDR_ORDER);
- mmap_state.supercarrier = 1;
- erts_have_erts_mmap |= ERTS_HAVE_ERTS_SUPERCARRIER_MMAP;
+ mm->supercarrier = 1;
- mmap_state.desc.new_area_hint = end;
+ mm->desc.new_area_hint = end;
}
#if !ERTS_HAVE_OS_MMAP
- mmap_state.no_os_mmap = 1;
+ mm->no_os_mmap = 1;
#endif
#ifdef HARD_DEBUG_MSEG
hard_dbg_mseg_init();
#endif
+
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ if (mm == &erts_literal_mmapper) {
+ erts_literals_start = erts_literal_mmapper.sa.bot;
+ erts_literals_size = erts_literal_mmapper.sua.top - erts_literals_start;
+ }
+#endif
+ is_first_call = 0;
}
@@ -2313,7 +2328,8 @@ add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2)
*lp = erts_bld_cons(hpp, szp, erts_bld_tuple(hpp, szp, 2, el1, el2), *lp);
}
-Eterm erts_mmap_info(int *print_to_p,
+Eterm erts_mmap_info(ErtsMemMapper* mm,
+ int *print_to_p,
void *print_to_arg,
Eterm** hpp, Uint* szp,
struct erts_mmap_info_struct* emis)
@@ -2328,29 +2344,29 @@ Eterm erts_mmap_info(int *print_to_p,
Eterm res = THE_NON_VALUE;
if (!hpp) {
- erts_smp_mtx_lock(&mmap_state.mtx);
- emis->sizes[0] = mmap_state.size.supercarrier.total;
- emis->sizes[1] = mmap_state.sa.top - mmap_state.sa.bot;
- emis->sizes[2] = mmap_state.sua.top - mmap_state.sua.bot;
- emis->sizes[3] = mmap_state.size.supercarrier.used.total;
- emis->sizes[4] = mmap_state.size.supercarrier.used.sa;
- emis->sizes[5] = mmap_state.size.supercarrier.used.sua;
+ erts_smp_mtx_lock(&mm->mtx);
+ emis->sizes[0] = mm->size.supercarrier.total;
+ emis->sizes[1] = mm->sa.top - mm->sa.bot;
+ emis->sizes[2] = mm->sua.top - mm->sua.bot;
+ emis->sizes[3] = mm->size.supercarrier.used.total;
+ emis->sizes[4] = mm->size.supercarrier.used.sa;
+ emis->sizes[5] = mm->size.supercarrier.used.sua;
- emis->segs[0] = mmap_state.no.free_segs.curr;
- emis->segs[1] = mmap_state.no.free_segs.max;
- emis->segs[2] = mmap_state.no.free_seg_descs;
- emis->segs[3] = mmap_state.desc.reserved;
- emis->segs[4] = mmap_state.sa.map.nseg;
- emis->segs[5] = mmap_state.sua.map.nseg;
+ emis->segs[0] = mm->no.free_segs.curr;
+ emis->segs[1] = mm->no.free_segs.max;
+ emis->segs[2] = mm->no.free_seg_descs;
+ emis->segs[3] = mm->desc.reserved;
+ emis->segs[4] = mm->sa.map.nseg;
+ emis->segs[5] = mm->sua.map.nseg;
- emis->os_used = mmap_state.size.os.used;
- erts_smp_mtx_unlock(&mmap_state.mtx);
+ emis->os_used = mm->size.os.used;
+ erts_smp_mtx_unlock(&mm->mtx);
}
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
const char* prefix = "supercarrier ";
erts_print(to, arg, "%stotal size: %bpu\n", prefix, emis->sizes[0]);
erts_print(to, arg, "%stotal sa size: %bpu\n", prefix, emis->sizes[1]);
@@ -2365,7 +2381,7 @@ Eterm erts_mmap_info(int *print_to_p,
erts_print(to, arg, "%ssa free segs: %bpu\n", prefix, emis->segs[4]);
erts_print(to, arg, "%ssua free segs: %bpu\n", prefix, emis->segs[5]);
}
- if (!mmap_state.no_os_mmap) {
+ if (!mm->no_os_mmap) {
erts_print(to, arg, "os mmap size used: %bpu\n", emis->os_used);
}
}
@@ -2377,7 +2393,7 @@ Eterm erts_mmap_info(int *print_to_p,
}
lix = 0;
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
group[0] = erts_bld_atom_uword_2tup_list(hpp, szp,
sizeof(size_tags)/sizeof(Eterm),
size_tags, emis->sizes);
@@ -2389,7 +2405,7 @@ Eterm erts_mmap_info(int *print_to_p,
lix++;
}
- if (!mmap_state.no_os_mmap) {
+ if (!mm->no_os_mmap) {
group[0] = erts_bld_atom_uword_2tup_list(hpp, szp,
1, &am.used, &emis->os_used);
list[lix] = erts_bld_2tup_list(hpp, szp, 1, group_tags, group);
@@ -2401,25 +2417,26 @@ Eterm erts_mmap_info(int *print_to_p,
return res;
}
-Eterm erts_mmap_info_options(char *prefix,
+Eterm erts_mmap_info_options(ErtsMemMapper* mm,
+ char *prefix,
int *print_to_p,
void *print_to_arg,
Uint **hpp,
Uint *szp)
{
- const UWord scs = mmap_state.sua.top - mmap_state.sa.bot;
- const Eterm sco = mmap_state.no_os_mmap ? am_true : am_false;
- const Eterm scrpm = (mmap_state.reserve_physical == reserve_noop) ? am_true : am_false;
+ const UWord scs = mm->sua.top - mm->sa.bot;
+ const Eterm sco = mm->no_os_mmap ? am_true : am_false;
+ const Eterm scrpm = (mm->reserve_physical == reserve_noop) ? am_true : am_false;
Eterm res = THE_NON_VALUE;
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
erts_print(to, arg, "%sscs: %bpu\n", prefix, scs);
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
erts_print(to, arg, "%ssco: %T\n", prefix, sco);
erts_print(to, arg, "%sscrpm: %T\n", prefix, scrpm);
- erts_print(to, arg, "%sscrfsd: %beu\n", prefix, mmap_state.desc.reserved);
+ erts_print(to, arg, "%sscrfsd: %beu\n", prefix, mm->desc.reserved);
}
}
@@ -2429,9 +2446,9 @@ Eterm erts_mmap_info_options(char *prefix,
}
res = NIL;
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
add_2tup(hpp, szp, &res, am.scrfsd,
- erts_bld_uint(hpp,szp, mmap_state.desc.reserved));
+ erts_bld_uint(hpp,szp, mm->desc.reserved));
add_2tup(hpp, szp, &res, am.scrpm, scrpm);
add_2tup(hpp, szp, &res, am.sco, sco);
}
@@ -2441,9 +2458,9 @@ Eterm erts_mmap_info_options(char *prefix,
}
-Eterm erts_mmap_debug_info(Process* p)
+Eterm erts_mmap_debug_info(ErtsMemMapper* mm, Process* p)
{
- if (mmap_state.supercarrier) {
+ if (mm->supercarrier) {
ERTS_DECL_AM(sabot);
ERTS_DECL_AM(satop);
ERTS_DECL_AM(suabot);
@@ -2453,18 +2470,17 @@ Eterm erts_mmap_debug_info(Process* p)
UWord values[4];
Eterm *hp, *hp_end;
Uint may_need;
- const Uint PTR_BIG_SZ = HALFWORD_HEAP ? 3 : 2;
-
- erts_smp_mtx_lock(&mmap_state.mtx);
- values[0] = (UWord)mmap_state.sa.bot;
- values[1] = (UWord)mmap_state.sa.top;
- values[2] = (UWord)mmap_state.sua.bot;
- values[3] = (UWord)mmap_state.sua.top;
- sa_list = build_free_seg_list(p, &mmap_state.sa.map);
- sua_list = build_free_seg_list(p, &mmap_state.sua.map);
- erts_smp_mtx_unlock(&mmap_state.mtx);
-
- may_need = 4*(2+3+PTR_BIG_SZ) + 2*(2+3);
+
+ erts_smp_mtx_lock(&mm->mtx);
+ values[0] = (UWord)mm->sa.bot;
+ values[1] = (UWord)mm->sa.top;
+ values[2] = (UWord)mm->sua.bot;
+ values[3] = (UWord)mm->sua.top;
+ sa_list = build_free_seg_list(p, &mm->sa.map);
+ sua_list = build_free_seg_list(p, &mm->sua.map);
+ erts_smp_mtx_unlock(&mm->mtx);
+
+ may_need = 4*(2+3+2) + 2*(2+3);
hp = HAlloc(p, may_need);
hp_end = hp + may_need;
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
index 66619c5161..67e131b53e 100644
--- a/erts/emulator/sys/common/erl_mmap.h
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -30,9 +30,6 @@
#define ERTS_MMAPFLG_SUPERCARRIER_ONLY (((Uint32) 1) << 1)
#define ERTS_MMAPFLG_SUPERALIGNED (((Uint32) 1) << 2)
-#define ERTS_HAVE_ERTS_OS_MMAP (1 << 0)
-#define ERTS_HAVE_ERTS_SUPERCARRIER_MMAP (1 << 1)
-extern int erts_have_erts_mmap;
extern UWord erts_page_inv_mask;
typedef struct {
@@ -53,23 +50,31 @@ typedef struct {
#define ERTS_MMAP_INIT_DEFAULT_INITER \
{{NULL, NULL}, {NULL, NULL}, 0, 1, (1 << 16), 1}
-void *erts_mmap(Uint32 flags, UWord *sizep);
-void erts_munmap(Uint32 flags, void *ptr, UWord size);
-void *erts_mremap(Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
-int erts_mmap_in_supercarrier(void *ptr);
-void erts_mmap_init(ErtsMMapInit*);
+#define ERTS_LITERAL_VIRTUAL_AREA_SIZE (UWORD_CONSTANT(1)*1024*1024*1024)
+
+#define ERTS_MMAP_INIT_LITERAL_INITER \
+ {{NULL, NULL}, {NULL, NULL}, ERTS_LITERAL_VIRTUAL_AREA_SIZE, 1, (1 << 16), 0}
+
+typedef struct ErtsMemMapper_ ErtsMemMapper;
+
+void *erts_mmap(ErtsMemMapper*, Uint32 flags, UWord *sizep);
+void erts_munmap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord size);
+void *erts_mremap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord old_size, UWord *sizep);
+int erts_mmap_in_supercarrier(ErtsMemMapper*, void *ptr);
+void erts_mmap_init(ErtsMemMapper*, ErtsMMapInit*);
struct erts_mmap_info_struct
{
UWord sizes[6];
UWord segs[6];
UWord os_used;
};
-Eterm erts_mmap_info(int *print_to_p, void *print_to_arg,
+Eterm erts_mmap_info(ErtsMemMapper*, int *print_to_p, void *print_to_arg,
Eterm** hpp, Uint* szp, struct erts_mmap_info_struct*);
-Eterm erts_mmap_info_options(char *prefix, int *print_to_p, void *print_to_arg,
+Eterm erts_mmap_info_options(ErtsMemMapper*,
+ char *prefix, int *print_to_p, void *print_to_arg,
Uint **hpp, Uint *szp);
struct process;
-Eterm erts_mmap_debug_info(struct process*);
+Eterm erts_mmap_debug_info(ErtsMemMapper*, struct process*);
#define ERTS_SUPERALIGNED_SIZE \
(1 << ERTS_MMAP_SUPERALIGNED_BITS)
@@ -121,6 +126,11 @@ Eterm erts_mmap_debug_info(struct process*);
# define ERTS_HAVE_OS_MMAP 1
#endif
+extern ErtsMemMapper erts_dflt_mmapper;
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+extern ErtsMemMapper erts_literal_mmapper;
+#endif
+
/*#define HARD_DEBUG_MSEG*/
#ifdef HARD_DEBUG_MSEG
# define HARD_DBG_INSERT_MSEG hard_dbg_insert_mseg
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index 0d51aad863..286130bece 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -99,17 +99,12 @@ static const int debruijn[32] = {
static int atoms_initialized;
-typedef struct mem_kind_t MemKind;
-
const ErtsMsegOpt_t erts_mseg_default_opt = {
1, /* Use cache */
1, /* Preserv data */
0, /* Absolute shrink threshold */
0, /* Relative shrink threshold */
0 /* Scheduler specific */
-#if HALFWORD_HEAP
- ,0 /* need low memory */
-#endif
};
@@ -142,7 +137,14 @@ struct cache_t_ {
typedef struct ErtsMsegAllctr_t_ ErtsMsegAllctr_t;
-struct mem_kind_t {
+struct ErtsMsegAllctr_t_ {
+ int ix;
+
+ int is_init_done;
+ int is_thread_safe;
+ erts_mtx_t mtx;
+
+ int is_cache_check_scheduled;
cache_t cache[MAX_CACHE_SIZE];
cache_t cache_unpowered_node;
@@ -168,29 +170,6 @@ struct mem_kind_t {
} max_ever;
} segments;
- ErtsMsegAllctr_t *ma;
- const char* name;
- MemKind* next;
-};/*MemKind*/
-
-struct ErtsMsegAllctr_t_ {
- int ix;
-
- int is_init_done;
- int is_thread_safe;
- erts_mtx_t mtx;
-
- int is_cache_check_scheduled;
-
- MemKind* mk_list;
-
-#if HALFWORD_HEAP
- MemKind low_mem;
- MemKind hi_mem;
-#else
- MemKind the_mem;
-#endif
-
Uint max_cache_size;
Uint abs_max_cache_bad_fit;
Uint rel_max_cache_bad_fit;
@@ -302,22 +281,17 @@ schedule_cache_check(ErtsMsegAllctr_t *ma) {
/* #define ERTS_PRINT_ERTS_MMAP */
static ERTS_INLINE void *
-mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep)
+mseg_create(ErtsMsegAllctr_t *ma, Uint flags, UWord *sizep)
{
#ifdef ERTS_PRINT_ERTS_MMAP
UWord req_size = *sizep;
#endif
void *seg;
Uint32 mmap_flags = 0;
-#if HALFWORD_HEAP
- mmap_flags |= ((mk == &ma->low_mem)
- ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
- : ERTS_MMAPFLG_OS_ONLY);
-#endif
if (MSEG_FLG_IS_2POW(flags))
mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
- seg = erts_mmap(mmap_flags, sizep);
+ seg = erts_mmap(&erts_dflt_mmapper, mmap_flags, sizep);
#ifdef ERTS_PRINT_ERTS_MMAP
erts_fprintf(stderr, "%p = erts_mmap(%s, {%bpu, %bpu});\n", seg,
@@ -331,18 +305,13 @@ mseg_create(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, UWord *sizep)
}
static ERTS_INLINE void
-mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord size) {
+mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, void *seg_p, UWord size) {
Uint32 mmap_flags = 0;
-#if HALFWORD_HEAP
- mmap_flags |= ((mk == &ma->low_mem)
- ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
- : ERTS_MMAPFLG_OS_ONLY);
-#endif
if (MSEG_FLG_IS_2POW(flags))
mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
- erts_munmap(mmap_flags, seg_p, size);
+ erts_munmap(&erts_dflt_mmapper, mmap_flags, seg_p, size);
#ifdef ERTS_PRINT_ERTS_MMAP
erts_fprintf(stderr, "erts_munmap(%s, %p, %bpu);\n",
(mmap_flags & ERTS_MMAPFLG_SUPERALIGNED) ? "sa" : "sua",
@@ -353,22 +322,17 @@ mseg_destroy(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *seg_p, UWord s
}
static ERTS_INLINE void *
-mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, MemKind* mk, void *old_seg, UWord old_size, UWord *sizep)
+mseg_recreate(ErtsMsegAllctr_t *ma, Uint flags, void *old_seg, UWord old_size, UWord *sizep)
{
#ifdef ERTS_PRINT_ERTS_MMAP
UWord req_size = *sizep;
#endif
void *new_seg;
Uint32 mmap_flags = 0;
-#if HALFWORD_HEAP
- mmap_flags |= ((mk == &ma->low_mem)
- ? ERTS_MMAPFLG_SUPERCARRIER_ONLY
- : ERTS_MMAPFLG_OS_ONLY);
-#endif
if (MSEG_FLG_IS_2POW(flags))
mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED;
- new_seg = erts_mremap(mmap_flags, old_seg, old_size, sizep);
+ new_seg = erts_mremap(&erts_dflt_mmapper, mmap_flags, old_seg, old_size, sizep);
#ifdef ERTS_PRINT_ERTS_MMAP
erts_fprintf(stderr, "%p = erts_mremap(%s, %p, %bpu, {%bpu, %bpu});\n",
@@ -392,11 +356,8 @@ do { \
|| erts_smp_thr_progress_is_blocking() \
|| ERTS_IS_CRASH_DUMPING); \
} while (0)
-#define ERTS_DBG_MK_CHK_THR_ACCESS(MK) \
- ERTS_DBG_MA_CHK_THR_ACCESS((MK)->ma)
#else
#define ERTS_DBG_MA_CHK_THR_ACCESS(MA)
-#define ERTS_DBG_MK_CHK_THR_ACCESS(MK)
#endif
/* Cache interface */
@@ -409,10 +370,10 @@ static ERTS_INLINE void mseg_cache_clear_node(cache_t *c) {
c->prev = c;
}
-static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, Uint flags) {
+static ERTS_INLINE int cache_bless_segment(ErtsMsegAllctr_t *ma, void *seg, UWord size, Uint flags) {
cache_t *c;
- ERTS_DBG_MK_CHK_THR_ACCESS(mk);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
ASSERT(!MSEG_FLG_IS_2POW(flags) || (MSEG_FLG_IS_2POW(flags) && MAP_IS_ALIGNED(seg) && IS_2POW(size)));
@@ -421,11 +382,11 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
* Large blocks has no such cache and it is up to mseg to cache them to speed things up.
*/
- if (!erts_circleq_is_empty(&(mk->cache_free))) {
+ if (!erts_circleq_is_empty(&(ma->cache_free))) {
/* We have free slots, use one to cache the segment */
- c = erts_circleq_head(&(mk->cache_free));
+ c = erts_circleq_head(&(ma->cache_free));
erts_circleq_remove(c);
c->seg = seg;
@@ -437,29 +398,28 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
ASSERT(ix < CACHE_AREAS);
ASSERT((1 << (ix + MSEG_ALIGN_BITS)) == size);
- erts_circleq_push_head(&(mk->cache_powered_node[ix]), c);
+ erts_circleq_push_head(&(ma->cache_powered_node[ix]), c);
} else
- erts_circleq_push_head(&(mk->cache_unpowered_node), c);
+ erts_circleq_push_head(&(ma->cache_unpowered_node), c);
- mk->cache_size++;
- ASSERT(mk->cache_size <= mk->ma->max_cache_size);
+ ma->cache_size++;
return 1;
- } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(mk->cache_unpowered_node))) {
+ } else if (!MSEG_FLG_IS_2POW(flags) && !erts_circleq_is_empty(&(ma->cache_unpowered_node))) {
/* No free slots.
* Evict oldest slot from unpowered cache so we can cache an unpowered (sbc) segment */
- c = erts_circleq_tail(&(mk->cache_unpowered_node));
+ c = erts_circleq_tail(&(ma->cache_unpowered_node));
erts_circleq_remove(c);
- mseg_destroy(mk->ma, ERTS_MSEG_FLG_NONE, mk, c->seg, c->size);
+ mseg_destroy(ma, ERTS_MSEG_FLG_NONE, c->seg, c->size);
mseg_cache_clear_node(c);
c->seg = seg;
c->size = size;
- erts_circleq_push_head(&(mk->cache_unpowered_node), c);
+ erts_circleq_push_head(&(ma->cache_unpowered_node), c);
return 1;
} else if (!MSEG_FLG_IS_2POW(flags)) {
@@ -473,20 +433,20 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
int i;
for( i = 0; i < CACHE_AREAS; i++) {
- if (erts_circleq_is_empty(&(mk->cache_powered_node[i])))
+ if (erts_circleq_is_empty(&(ma->cache_powered_node[i])))
continue;
- c = erts_circleq_tail(&(mk->cache_powered_node[i]));
+ c = erts_circleq_tail(&(ma->cache_powered_node[i]));
erts_circleq_remove(c);
- mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, c->seg, c->size);
+ mseg_destroy(ma, ERTS_MSEG_FLG_2POW, c->seg, c->size);
mseg_cache_clear_node(c);
c->seg = seg;
c->size = size;
- erts_circleq_push_head(&(mk->cache_unpowered_node), c);
+ erts_circleq_push_head(&(ma->cache_unpowered_node), c);
return 1;
}
@@ -495,11 +455,11 @@ static ERTS_INLINE int cache_bless_segment(MemKind *mk, void *seg, UWord size, U
return 0;
}
-static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flags) {
+static ERTS_INLINE void *cache_get_segment(ErtsMsegAllctr_t *ma, UWord *size_p, Uint flags) {
UWord size = *size_p;
- ERTS_DBG_MK_CHK_THR_ACCESS(mk);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
if (MSEG_FLG_IS_2POW(flags)) {
@@ -512,10 +472,10 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
for( i = ix; i < CACHE_AREAS; i++) {
- if (erts_circleq_is_empty(&(mk->cache_powered_node[i])))
+ if (erts_circleq_is_empty(&(ma->cache_powered_node[i])))
continue;
- c = erts_circleq_head(&(mk->cache_powered_node[i]));
+ c = erts_circleq_head(&(ma->cache_powered_node[i]));
erts_circleq_remove(c);
ASSERT(IS_2POW(c->size));
@@ -524,31 +484,31 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
csize = c->size;
seg = (char*) c->seg;
- mk->cache_size--;
- mk->cache_hits++;
+ ma->cache_size--;
+ ma->cache_hits++;
/* link to free cache list */
mseg_cache_clear_node(c);
- erts_circleq_push_head(&(mk->cache_free), c);
+ erts_circleq_push_head(&(ma->cache_free), c);
- ASSERT(!(mk->cache_size < 0));
+ ASSERT(!(ma->cache_size < 0));
if (csize != size)
- mseg_destroy(mk->ma, ERTS_MSEG_FLG_2POW, mk, seg + size, csize - size);
+ mseg_destroy(ma, ERTS_MSEG_FLG_2POW, seg + size, csize - size);
return seg;
}
}
- else if (!erts_circleq_is_empty(&(mk->cache_unpowered_node))) {
+ else if (!erts_circleq_is_empty(&(ma->cache_unpowered_node))) {
void *seg;
cache_t *c;
cache_t *best = NULL;
UWord bdiff = 0;
UWord csize;
- UWord bad_max_abs = mk->ma->abs_max_cache_bad_fit;
- UWord bad_max_rel = mk->ma->rel_max_cache_bad_fit;
+ UWord bad_max_abs = ma->abs_max_cache_bad_fit;
+ UWord bad_max_rel = ma->rel_max_cache_bad_fit;
- erts_circleq_foreach(c, &(mk->cache_unpowered_node)) {
+ erts_circleq_foreach(c, &(ma->cache_unpowered_node)) {
csize = c->size;
if (csize >= size) {
if (((csize - size)*100 < bad_max_rel*size) && (csize - size) < bad_max_abs ) {
@@ -557,11 +517,11 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
erts_circleq_remove(c);
- mk->cache_size--;
- mk->cache_hits++;
+ ma->cache_size--;
+ ma->cache_hits++;
mseg_cache_clear_node(c);
- erts_circleq_push_head(&(mk->cache_free), c);
+ erts_circleq_push_head(&(ma->cache_free), c);
*size_p = csize;
@@ -584,7 +544,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
ASSERT(best->seg);
ASSERT(best->size > 0);
- mk->cache_hits++;
+ ma->cache_hits++;
/* Use current cache placement for remaining segment space */
@@ -608,7 +568,7 @@ static ERTS_INLINE void *cache_get_segment(MemKind *mk, UWord *size_p, Uint flag
* using callbacks from aux-work in the scheduler.
*/
-static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) {
+static ERTS_INLINE Uint mseg_drop_one_cache_size(ErtsMsegAllctr_t *ma, Uint flags, cache_t *head) {
cache_t *c = NULL;
c = erts_circleq_tail(head);
@@ -617,19 +577,19 @@ static ERTS_INLINE Uint mseg_drop_one_memkind_cache_size(MemKind *mk, Uint flags
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg);
- mseg_destroy(mk->ma, flags, mk, c->seg, c->size);
+ mseg_destroy(ma, flags, c->seg, c->size);
mseg_cache_clear_node(c);
- erts_circleq_push_head(&(mk->cache_free), c);
+ erts_circleq_push_head(&(ma->cache_free), c);
- mk->segments.current.watermark--;
- mk->cache_size--;
+ ma->segments.current.watermark--;
+ ma->cache_size--;
- ASSERT( mk->cache_size >= 0 );
+ ASSERT(ma->cache_size >= 0);
- return mk->cache_size;
+ return ma->cache_size;
}
-static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, cache_t *head) {
+static ERTS_INLINE Uint mseg_drop_cache_size(ErtsMsegAllctr_t *ma, Uint flags, cache_t *head) {
cache_t *c = NULL;
while (!erts_circleq_is_empty(head)) {
@@ -640,58 +600,52 @@ static ERTS_INLINE Uint mseg_drop_memkind_cache_size(MemKind *mk, Uint flags, ca
if (erts_mtrace_enabled)
erts_mtrace_crr_free(SEGTYPE, SEGTYPE, c->seg);
- mseg_destroy(mk->ma, flags, mk, c->seg, c->size);
+ mseg_destroy(ma, flags, c->seg, c->size);
mseg_cache_clear_node(c);
- erts_circleq_push_head(&(mk->cache_free), c);
-
- mk->segments.current.watermark--;
- mk->cache_size--;
+ erts_circleq_push_head(&(ma->cache_free), c);
+ ma->segments.current.watermark--;
+ ma->cache_size--;
}
- ASSERT( mk->cache_size >= 0 );
+ ASSERT(ma->cache_size >= 0);
- return mk->cache_size;
+ return ma->cache_size;
}
-/* mseg_check_memkind_cache
- * - Check if we can empty some cached segments in this
- * MemKind.
+/* mseg_check_cache
+ * - Check if we can empty some cached segments in this allocator
*/
-static Uint mseg_check_memkind_cache(MemKind *mk) {
+static Uint mseg_check_cache(ErtsMsegAllctr_t *ma) {
int i;
- ERTS_DBG_MK_CHK_THR_ACCESS(mk);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
for (i = 0; i < CACHE_AREAS; i++) {
- if (!erts_circleq_is_empty(&(mk->cache_powered_node[i])))
- return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i]));
+ if (!erts_circleq_is_empty(&(ma->cache_powered_node[i])))
+ return mseg_drop_one_cache_size(ma, ERTS_MSEG_FLG_2POW, &(ma->cache_powered_node[i]));
}
- if (!erts_circleq_is_empty(&(mk->cache_unpowered_node)))
- return mseg_drop_one_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node));
+ if (!erts_circleq_is_empty(&(ma->cache_unpowered_node)))
+ return mseg_drop_one_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node));
return 0;
}
/* mseg_cache_check
* - Check if we have some cache we can purge
- * in any of the memkinds.
*/
static void mseg_cache_check(ErtsMsegAllctr_t *ma) {
- MemKind* mk;
Uint empty_cache = 1;
ERTS_MSEG_LOCK(ma);
- for (mk = ma->mk_list; mk; mk = mk->next) {
- if (mseg_check_memkind_cache(mk))
- empty_cache = 0;
- }
+ if (mseg_check_cache(ma))
+ empty_cache = 0;
/* If all MemKinds caches are empty,
* remove aux-work callback
@@ -709,7 +663,7 @@ static void mseg_cache_check(ErtsMsegAllctr_t *ma) {
/* erts_mseg_cache_check
* - This is a callback that is scheduled as aux-work from
* schedulers and is called at some interval if we have a cache
- * on this mseg-allocator and memkind.
+ * on this mseg-allocator.
* - Purpose: Empty cache slowly so we don't collect mapped areas
* and bloat memory.
*/
@@ -719,42 +673,32 @@ void erts_mseg_cache_check(void) {
}
-/* *_mseg_clear_*_cache
+/* mseg_clear_cache
* Remove cached segments from the allocator completely
*/
-static void mseg_clear_memkind_cache(MemKind *mk) {
+
+static void mseg_clear_cache(ErtsMsegAllctr_t *ma) {
int i;
+ ERTS_MSEG_LOCK(ma);
+ ERTS_DBG_MA_CHK_THR_ACCESS(ma);
/* drop pow2 caches */
for (i = 0; i < CACHE_AREAS; i++) {
- if (erts_circleq_is_empty(&(mk->cache_powered_node[i])))
+ if (erts_circleq_is_empty(&(ma->cache_powered_node[i])))
continue;
- mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_2POW, &(mk->cache_powered_node[i]));
- ASSERT(erts_circleq_is_empty(&(mk->cache_powered_node[i])));
+ mseg_drop_cache_size(ma, ERTS_MSEG_FLG_2POW, &(ma->cache_powered_node[i]));
+ ASSERT(erts_circleq_is_empty(&(ma->cache_powered_node[i])));
}
/* drop varied caches */
- if (!erts_circleq_is_empty(&(mk->cache_unpowered_node)))
- mseg_drop_memkind_cache_size(mk, ERTS_MSEG_FLG_NONE, &(mk->cache_unpowered_node));
-
- ASSERT(erts_circleq_is_empty(&(mk->cache_unpowered_node)));
- ASSERT(mk->cache_size == 0);
-}
+ if (!erts_circleq_is_empty(&(ma->cache_unpowered_node)))
+ mseg_drop_cache_size(ma, ERTS_MSEG_FLG_NONE, &(ma->cache_unpowered_node));
-static void mseg_clear_cache(ErtsMsegAllctr_t *ma) {
- MemKind* mk;
-
- ERTS_MSEG_LOCK(ma);
- ERTS_DBG_MA_CHK_THR_ACCESS(ma);
-
-
- for (mk = ma->mk_list; mk; mk = mk->next) {
- mseg_clear_memkind_cache(mk);
- }
+ ASSERT(erts_circleq_is_empty(&(ma->cache_unpowered_node)));
+ ASSERT(ma->cache_size == 0);
INC_CC(ma, clear_cache);
-
ERTS_MSEG_UNLOCK(ma);
}
@@ -763,25 +707,12 @@ void erts_mseg_clear_cache(void) {
mseg_clear_cache(ERTS_MSEG_ALLCTR_IX(0));
}
-
-
-static ERTS_INLINE MemKind* memkind(ErtsMsegAllctr_t *ma,
- const ErtsMsegOpt_t *opt)
-{
-#if HALFWORD_HEAP
- return opt->low_mem ? &ma->low_mem : &ma->hi_mem;
-#else
- return &ma->the_mem;
-#endif
-}
-
static void *
mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p,
Uint flags, const ErtsMsegOpt_t *opt)
{
UWord size;
void *seg;
- MemKind* mk = memkind(ma, opt);
INC_CC(ma, alloc);
@@ -795,10 +726,10 @@ mseg_alloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, UWord *size_p,
}
}
- if (opt->cache && mk->cache_size > 0 && (seg = cache_get_segment(mk, &size, flags)) != NULL)
+ if (opt->cache && ma->cache_size > 0 && (seg = cache_get_segment(ma, &size, flags)) != NULL)
goto done;
- seg = mseg_create(ma, flags, mk, &size);
+ seg = mseg_create(ma, flags, &size);
if (!seg)
*size_p = 0;
@@ -808,7 +739,7 @@ done:
if (erts_mtrace_enabled)
erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size);
- ERTS_MSEG_ALLOC_STAT(mk,size);
+ ERTS_MSEG_ALLOC_STAT(ma,size);
}
return seg;
@@ -819,11 +750,9 @@ static void
mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size,
Uint flags, const ErtsMsegOpt_t *opt)
{
- MemKind* mk = memkind(ma, opt);
-
- ERTS_MSEG_DEALLOC_STAT(mk,size);
+ ERTS_MSEG_DEALLOC_STAT(ma,size);
- if (opt->cache && cache_bless_segment(mk, seg, size, flags)) {
+ if (opt->cache && cache_bless_segment(ma, seg, size, flags)) {
schedule_cache_check(ma);
goto done;
}
@@ -831,7 +760,7 @@ mseg_dealloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg, UWord size,
if (erts_mtrace_enabled)
erts_mtrace_crr_free(atype, SEGTYPE, seg);
- mseg_destroy(ma, flags, mk, seg, size);
+ mseg_destroy(ma, flags, seg, size);
done:
@@ -842,7 +771,6 @@ static void *
mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
UWord old_size, UWord *new_size_p, Uint flags, const ErtsMsegOpt_t *opt)
{
- MemKind* mk;
void *new_seg;
UWord new_size;
@@ -861,7 +789,6 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
return NULL;
}
- mk = memkind(ma, opt);
new_seg = seg;
if (!MSEG_FLG_IS_2POW(flags))
@@ -876,7 +803,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
if (new_size > old_size) {
if (opt->preserv) {
- new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size);
+ new_seg = mseg_recreate(ma, flags, (void *) seg, old_size, &new_size);
if (!new_seg)
new_size = old_size;
}
@@ -896,7 +823,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
new_size = old_size;
}
else {
- new_seg = mseg_recreate(ma, flags, mk, (void *) seg, old_size, &new_size);
+ new_seg = mseg_recreate(ma, flags, (void *) seg, old_size, &new_size);
if (!new_seg)
new_size = old_size;
}
@@ -910,7 +837,7 @@ mseg_realloc(ErtsMsegAllctr_t *ma, ErtsAlcType_t atype, void *seg,
ASSERT(!MSEG_FLG_IS_2POW(flags) || IS_2POW(new_size));
*new_size_p = new_size;
- ERTS_MSEG_REALLOC_STAT(mk, old_size, new_size);
+ ERTS_MSEG_REALLOC_STAT(ma, old_size, new_size);
return new_seg;
}
@@ -1070,7 +997,8 @@ info_options(ErtsMsegAllctr_t *ma,
{
Eterm res;
- res = erts_mmap_info_options(prefix, print_to_p, print_to_arg, hpp, szp);
+ res = erts_mmap_info_options(&erts_dflt_mmapper,
+ prefix, print_to_p, print_to_arg, hpp, szp);
if (print_to_p) {
int to = *print_to_p;
@@ -1180,63 +1108,63 @@ info_calls(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp
}
static Eterm
-info_status(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg,
+info_status(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg,
int begin_new_max_period, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
- if (mk->segments.max_ever.no < mk->segments.max.no)
- mk->segments.max_ever.no = mk->segments.max.no;
- if (mk->segments.max_ever.sz < mk->segments.max.sz)
- mk->segments.max_ever.sz = mk->segments.max.sz;
+ if (ma->segments.max_ever.no < ma->segments.max.no)
+ ma->segments.max_ever.no = ma->segments.max.no;
+ if (ma->segments.max_ever.sz < ma->segments.max.sz)
+ ma->segments.max_ever.sz = ma->segments.max.sz;
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
- erts_print(to, arg, "cached_segments: %beu\n", mk->cache_size);
- erts_print(to, arg, "cache_hits: %beu\n", mk->cache_hits);
+ erts_print(to, arg, "cached_segments: %beu\n", ma->cache_size);
+ erts_print(to, arg, "cache_hits: %beu\n", ma->cache_hits);
erts_print(to, arg, "segments: %beu %beu %beu\n",
- mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no);
+ ma->segments.current.no, ma->segments.max.no, ma->segments.max_ever.no);
erts_print(to, arg, "segments_size: %beu %beu %beu\n",
- mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz);
+ ma->segments.current.sz, ma->segments.max.sz, ma->segments.max_ever.sz);
erts_print(to, arg, "segments_watermark: %beu\n",
- mk->segments.current.watermark);
+ ma->segments.current.watermark);
}
if (hpp || szp) {
res = NIL;
add_2tup(hpp, szp, &res,
am.segments_watermark,
- bld_unstable_uint(hpp, szp, mk->segments.current.watermark));
+ bld_unstable_uint(hpp, szp, ma->segments.current.watermark));
add_4tup(hpp, szp, &res,
am.segments_size,
- bld_unstable_uint(hpp, szp, mk->segments.current.sz),
- bld_unstable_uint(hpp, szp, mk->segments.max.sz),
- bld_unstable_uint(hpp, szp, mk->segments.max_ever.sz));
+ bld_unstable_uint(hpp, szp, ma->segments.current.sz),
+ bld_unstable_uint(hpp, szp, ma->segments.max.sz),
+ bld_unstable_uint(hpp, szp, ma->segments.max_ever.sz));
add_4tup(hpp, szp, &res,
am.segments,
- bld_unstable_uint(hpp, szp, mk->segments.current.no),
- bld_unstable_uint(hpp, szp, mk->segments.max.no),
- bld_unstable_uint(hpp, szp, mk->segments.max_ever.no));
+ bld_unstable_uint(hpp, szp, ma->segments.current.no),
+ bld_unstable_uint(hpp, szp, ma->segments.max.no),
+ bld_unstable_uint(hpp, szp, ma->segments.max_ever.no));
add_2tup(hpp, szp, &res,
am.cache_hits,
- bld_unstable_uint(hpp, szp, mk->cache_hits));
+ bld_unstable_uint(hpp, szp, ma->cache_hits));
add_2tup(hpp, szp, &res,
am.cached_segments,
- bld_unstable_uint(hpp, szp, mk->cache_size));
+ bld_unstable_uint(hpp, szp, ma->cache_size));
}
if (begin_new_max_period) {
- mk->segments.max.no = mk->segments.current.no;
- mk->segments.max.sz = mk->segments.current.sz;
+ ma->segments.max.no = ma->segments.current.no;
+ ma->segments.max.sz = ma->segments.current.sz;
}
return res;
}
-static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, void *print_to_arg,
+static Eterm info_memkind(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg,
int begin_max_per, Uint **hpp, Uint *szp)
{
Eterm res = THE_NON_VALUE;
@@ -1244,15 +1172,15 @@ static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, vo
Eterm values[3];
if (print_to_p) {
- erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", mk->name);
+ erts_print(*print_to_p, print_to_arg, "memory kind: %s\n", "all memory");
}
if (hpp || szp) {
atoms[0] = am.name;
atoms[1] = am.status;
atoms[2] = am.calls;
- values[0] = erts_bld_string(hpp, szp, mk->name);
+ values[0] = erts_bld_string(hpp, szp, "all memory");
}
- values[1] = info_status(ma, mk, print_to_p, print_to_arg, begin_max_per, hpp, szp);
+ values[1] = info_status(ma, print_to_p, print_to_arg, begin_max_per, hpp, szp);
values[2] = info_calls(ma, print_to_p, print_to_arg, hpp, szp);
if (hpp || szp)
@@ -1261,7 +1189,6 @@ static Eterm info_memkind(ErtsMsegAllctr_t *ma, MemKind* mk, int *print_to_p, vo
return res;
}
-
static Eterm
info_version(ErtsMsegAllctr_t *ma, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
{
@@ -1326,12 +1253,7 @@ erts_mseg_info(int ix,
ERTS_MSEG_LOCK(ma);
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
-#if HALFWORD_HEAP
- values[n++] = info_memkind(ma, &ma->low_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
- values[n++] = info_memkind(ma, &ma->hi_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
-#else
- values[n++] = info_memkind(ma, &ma->the_mem, print_to_p, print_to_arg, begin_max_per, hpp, szp);
-#endif
+ values[n++] = info_memkind(ma, print_to_p, print_to_arg, begin_max_per, hpp, szp);
if (hpp || szp)
res = bld_2tup_list(hpp, szp, n, atoms, values);
@@ -1408,13 +1330,10 @@ Uint
erts_mseg_no(const ErtsMsegOpt_t *opt)
{
ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_OPT(opt);
- MemKind* mk;
- Uint n = 0;
+ Uint n;
ERTS_MSEG_LOCK(ma);
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
- for (mk=ma->mk_list; mk; mk=mk->next) {
- n += mk->segments.current.no;
- }
+ n = ma->segments.current.no;
ERTS_MSEG_UNLOCK(ma);
return n;
}
@@ -1426,16 +1345,16 @@ erts_mseg_unit_size(void)
}
-static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name)
+static void mem_cache_init(ErtsMsegAllctr_t *ma)
{
int i;
/* Clear all cache headers */
- mseg_cache_clear_node(&(mk->cache_free));
- mseg_cache_clear_node(&(mk->cache_unpowered_node));
+ mseg_cache_clear_node(&(ma->cache_free));
+ mseg_cache_clear_node(&(ma->cache_unpowered_node));
for (i = 0; i < CACHE_AREAS; i++) {
- mseg_cache_clear_node(&(mk->cache_powered_node[i]));
+ mseg_cache_clear_node(&(ma->cache_powered_node[i]));
}
/* Populate cache free list */
@@ -1443,25 +1362,20 @@ static void mem_kind_init(ErtsMsegAllctr_t *ma, MemKind* mk, const char* name)
ASSERT(ma->max_cache_size <= MAX_CACHE_SIZE);
for (i = 0; i < ma->max_cache_size; i++) {
- mseg_cache_clear_node(&(mk->cache[i]));
- erts_circleq_push_head(&(mk->cache_free), &(mk->cache[i]));
+ mseg_cache_clear_node(&(ma->cache[i]));
+ erts_circleq_push_head(&(ma->cache_free), &(ma->cache[i]));
}
- mk->cache_size = 0;
- mk->cache_hits = 0;
-
- mk->segments.current.watermark = 0;
- mk->segments.current.no = 0;
- mk->segments.current.sz = 0;
- mk->segments.max.no = 0;
- mk->segments.max.sz = 0;
- mk->segments.max_ever.no = 0;
- mk->segments.max_ever.sz = 0;
-
- mk->ma = ma;
- mk->name = name;
- mk->next = ma->mk_list;
- ma->mk_list = mk;
+ ma->cache_size = 0;
+ ma->cache_hits = 0;
+
+ ma->segments.current.watermark = 0;
+ ma->segments.current.no = 0;
+ ma->segments.current.sz = 0;
+ ma->segments.max.no = 0;
+ ma->segments.max.sz = 0;
+ ma->segments.max_ever.no = 0;
+ ma->segments.max_ever.sz = 0;
}
void
@@ -1488,19 +1402,13 @@ erts_mseg_init(ErtsMsegInit_t *init)
erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms");
-#if HALFWORD_HEAP
- if (sizeof(void *) != 8)
- erl_exit(-1,"Halfword emulator cannot be run in 32bit mode");
-
- init->mmap.virtual_range.start = (char *) sbrk(0);
- init->mmap.virtual_range.end = (char *) 0x100000000UL;
- init->mmap.sco = 0;
+ erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap);
+#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION)
+ erts_mmap_init(&erts_literal_mmapper, &init->literal_mmap);
#endif
- erts_mmap_init(&init->mmap);
-
if (!IS_2POW(GET_PAGE_SIZE))
- erl_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE);
+ erts_exit(ERTS_ABORT_EXIT, "erts_mseg: Unexpected page_size %beu\n", GET_PAGE_SIZE);
ASSERT((MSEG_ALIGNED_SIZE % GET_PAGE_SIZE) == 0);
@@ -1529,14 +1437,7 @@ erts_mseg_init(ErtsMsegInit_t *init)
if (ma->max_cache_size > MAX_CACHE_SIZE)
ma->max_cache_size = MAX_CACHE_SIZE;
- ma->mk_list = NULL;
-
-#if HALFWORD_HEAP
- mem_kind_init(ma, &ma->low_mem, "low memory");
- mem_kind_init(ma, &ma->hi_mem, "high memory");
-#else
- mem_kind_init(ma, &ma->the_mem, "all memory");
-#endif
+ mem_cache_init(ma);
sys_memzero((void *) &ma->calls, sizeof(ErtsMsegCalls));
}
@@ -1545,13 +1446,8 @@ erts_mseg_init(ErtsMsegInit_t *init)
static ERTS_INLINE Uint tot_cache_size(ErtsMsegAllctr_t *ma)
{
- MemKind* mk;
- Uint sz = 0;
ERTS_DBG_MA_CHK_THR_ACCESS(ma);
- for (mk=ma->mk_list; mk; mk=mk->next) {
- sz += mk->cache_size;
- }
- return sz;
+ return ma->cache_size;
}
/*
diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h
index ba04e919fc..2acd8f8505 100644
--- a/erts/emulator/sys/common/erl_mseg.h
+++ b/erts/emulator/sys/common/erl_mseg.h
@@ -42,16 +42,6 @@
#if ERTS_HAVE_MSEG_SUPER_ALIGNED
# define MSEG_ALIGN_BITS ERTS_MMAP_SUPERALIGNED_BITS
-#else
-/* If we don't use super aligned multiblock carriers
- * we will mmap with page size alignment (and thus use corresponding
- * align bits).
- *
- * Current implementation needs this to be a constant and
- * only uses this for user dev testing so setting page size
- * to 4096 (12 bits) is fine.
- */
-# define MSEG_ALIGN_BITS (12)
#endif
#if HAVE_ERTS_MSEG
@@ -69,7 +59,8 @@ typedef struct {
Uint rmcbf;
Uint mcs;
Uint nos;
- ErtsMMapInit mmap;
+ ErtsMMapInit dflt_mmap;
+ ErtsMMapInit literal_mmap;
} ErtsMsegInit_t;
#define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \
@@ -78,7 +69,8 @@ typedef struct {
20, /* rmcbf: Relative max cache bad fit */ \
10, /* mcs: Max cache size */ \
1000, /* cci: Cache check interval */ \
- ERTS_MMAP_INIT_DEFAULT_INITER \
+ ERTS_MMAP_INIT_DEFAULT_INITER, \
+ ERTS_MMAP_INIT_LITERAL_INITER \
}
typedef struct {
@@ -87,9 +79,6 @@ typedef struct {
UWord abs_shrink_th;
UWord rel_shrink_th;
int sched_spec;
-#if HALFWORD_HEAP
- int low_mem;
-#endif
} ErtsMsegOpt_t;
extern const ErtsMsegOpt_t erts_mseg_default_opt;
diff --git a/erts/emulator/sys/common/erl_os_monotonic_time_extender.c b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c
index b79485241f..367b22d989 100644
--- a/erts/emulator/sys/common/erl_os_monotonic_time_extender.c
+++ b/erts/emulator/sys/common/erl_os_monotonic_time_extender.c
@@ -44,7 +44,7 @@ static void *os_monotonic_time_extender(void *vstatep)
erts_milli_sleep(sleep_time);
}
- erl_exit(ERTS_ABORT_EXIT, "os_monotonic_time_extender thread terminating");
+ erts_exit(ERTS_ABORT_EXIT, "os_monotonic_time_extender thread terminating");
return NULL;
}
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index 21fa214364..36ee94111c 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -74,6 +74,7 @@
#include "erl_thr_progress.h"
#include "erl_driver.h"
#include "erl_alloc.h"
+#include "erl_msacc.h"
#if !defined(ERTS_POLL_USE_EPOLL) \
&& !defined(ERTS_POLL_USE_DEVPOLL) \
@@ -2238,6 +2239,7 @@ static ERTS_INLINE int
check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
{
int res;
+ ERTS_MSACC_PUSH_STATE_M();
if (erts_smp_atomic_read_nob(&ps->no_of_user_fds) == 0
&& timeout_time == ERTS_POLL_NO_TIMEOUT) {
/* Nothing to poll and zero timeout; done... */
@@ -2259,6 +2261,7 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
#ifdef ERTS_SMP
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
timerfd_set(ps, &its);
res = epoll_wait(ps->kp_fd, ps->res_events, max_res, -1);
res = timerfd_clear(ps, res, max_res);
@@ -2268,10 +2271,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
}
#else /* !ERTS_POLL_USE_TIMERFD */
timeout = (int) get_timeout(ps, 1000, timeout_time);
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = epoll_wait(ps->kp_fd, ps->res_events, max_res, timeout);
#endif /* !ERTS_POLL_USE_TIMERFD */
#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */
@@ -2279,10 +2284,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
if (max_res > ps->res_events_len)
grow_res_events(ps, max_res);
timeout = get_timeout_timespec(ps, &ts, timeout_time);
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts);
#endif /* ----------------------------------------- */
}
@@ -2306,26 +2313,33 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
if (poll_res.dp_nfds > ps->res_events_len)
grow_res_events(ps, poll_res.dp_nfds);
poll_res.dp_fds = ps->res_events;
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
poll_res.dp_timeout = timeout;
res = ioctl(ps->kp_fd, DP_POLL, &poll_res);
#elif ERTS_POLL_USE_POLL && defined(HAVE_PPOLL) /* --- ppoll ---------------- */
struct timespec ts;
timeout = get_timeout_timespec(ps, &ts, timeout_time);
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = ppoll(ps->poll_fds, ps->no_poll_fds, &ts, NULL);
#elif ERTS_POLL_USE_POLL /* --- poll --------------------------------- */
timeout = (int) get_timeout(ps, 1000, timeout_time);
+
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = poll(ps->poll_fds, ps->no_poll_fds, timeout);
#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */
SysTimeval to;
@@ -2334,18 +2348,22 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds);
ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds);
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ }
res = ERTS_SELECT(ps->max_fd + 1,
&ps->res_input_fds,
&ps->res_output_fds,
NULL,
&to);
#ifdef ERTS_SMP
- if (timeout)
+ if (timeout) {
erts_thr_progress_finalize_wait(NULL);
+ ERTS_MSACC_POP_STATE_M();
+ }
if (res < 0
&& errno == EBADF
&& ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) {
@@ -2380,10 +2398,12 @@ check_fd_events(ErtsPollSet ps, ErtsMonotonicTime timeout_time, int max_res)
return res;
#endif /* ----------------------------------------- */
}
+ if (timeout) {
#ifdef ERTS_SMP
- if (timeout)
erts_thr_progress_finalize_wait(NULL);
#endif
+ ERTS_MSACC_POP_STATE_M();
+ }
return res;
}
}
diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h
index 19ce582154..bc2c681876 100644
--- a/erts/emulator/sys/common/erl_poll.h
+++ b/erts/emulator/sys/common/erl_poll.h
@@ -93,7 +93,7 @@
# if defined(ERTS_USE_POLL)
# undef ERTS_POLL_USE_POLL
# define ERTS_POLL_USE_POLL 1
-# elif !defined(__WIN32__) && !defined(__OSE__)
+# elif !defined(__WIN32__)
# undef ERTS_POLL_USE_SELECT
# define ERTS_POLL_USE_SELECT 1
# endif
@@ -104,31 +104,13 @@
typedef Uint32 ErtsPollEvents;
#undef ERTS_POLL_EV_E2N
-#if defined(__WIN32__) || defined(__OSE__) /* --- win32 or ose -------- */
+#if defined(__WIN32__) /* --- win32 --------------------------------------- */
#define ERTS_POLL_EV_IN 1
#define ERTS_POLL_EV_OUT 2
#define ERTS_POLL_EV_ERR 4
#define ERTS_POLL_EV_NVAL 8
-#ifdef __OSE__
-
-typedef struct ErtsPollOseMsgList_ {
- struct ErtsPollOseMsgList_ *next;
- union SIGNAL *data;
-} ErtsPollOseMsgList;
-
-struct erts_sys_fd_type {
- SIGSELECT signo;
- ErlDrvOseEventId id;
- ErtsPollOseMsgList *msgs;
- ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig);
- ethr_mutex mtx;
- void *extra;
-};
-
-#endif
-
#elif ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */
#include <sys/epoll.h>
@@ -140,7 +122,7 @@ struct erts_sys_fd_type {
#endif
#define ERTS_POLL_EV_E2N(EV) \
- ((__uint32_t) (EV))
+ ((uint32_t) (EV))
#define ERTS_POLL_EV_N2E(EV) \
((ErtsPollEvents) (EV))
diff --git a/erts/emulator/sys/ose/beam.lmconf b/erts/emulator/sys/ose/beam.lmconf
deleted file mode 100644
index 4ad46b01d9..0000000000
--- a/erts/emulator/sys/ose/beam.lmconf
+++ /dev/null
@@ -1,26 +0,0 @@
-OSE_LM_STACK_SIZES=256,512,1024,2048,4096,8192,16384,65536
-OSE_LM_SIGNAL_SIZES=31,63,127,255,1023,4095,16383,65535
-OSE_LM_POOL_SIZE=0x200000
-OSE_LM_MAIN_NAME=main
-OSE_LM_MAIN_STACK_SIZE=0xF000
-OSE_LM_MAIN_PRIORITY=20
-## Has to be of a type that allows MAM
-OSE_LM_PROGRAM_TYPE=APP_RAM
-OSE_LM_DATA_INIT=YES
-OSE_LM_BSS_INIT=YES
-OSE_LM_EXEC_MODEL=SHARED
-HEAP_MAX_SIZE=1000000000
-HEAP_SMALL_BUF_INIT_SIZE=20971520
-HEAP_LARGE_BUF_THRESHOLD=16000000
-HEAP_LOCK_TYPE=2
-
-ERTS_DEFAULT_PRIO=24
-ERTS_SCHEDULER_PRIO=24
-ERTS_ASYNC_PRIO=22
-ERTS_AUX_PRIO=24
-ERTS_SYS_MSG_DISPATCHER_PRIO=21
-
-# Setting the environment variable EFS_RESOLVE_TMO on the block to 0.
-# This will eliminiate delays when trying to open files on not mounted
-# volumes.
-EFS_RESOLVE_TMO=0
diff --git a/erts/emulator/sys/ose/driver_int.h b/erts/emulator/sys/ose/driver_int.h
deleted file mode 100644
index 4a5b7171d1..0000000000
--- a/erts/emulator/sys/ose/driver_int.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2009. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * System dependant driver declarations
- */
-
-#ifndef __DRIVER_INT_H__
-#define __DRIVER_INT_H__
-
-#ifdef HAVE_SYS_UIO_H
-#include <sys/types.h>
-#include <sys/uio.h>
-
-typedef struct iovec SysIOVec;
-
-#else
-
-typedef struct {
- char* iov_base;
- int iov_len;
-} SysIOVec;
-
-#endif
-
-#endif
diff --git a/erts/emulator/sys/ose/erl_main.c b/erts/emulator/sys/ose/erl_main.c
deleted file mode 100644
index 877e85f43a..0000000000
--- a/erts/emulator/sys/ose/erl_main.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2000-2009. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#include <stdlib.h>
-
-#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
-#include "ose.h"
-
-int
-main(int argc, char **argv) {
-
- (void)stdin;(void)stdout;(void)stderr;
-
- /* When starting using pm_create -c ARGV="-- -root ..", argv[0] is the first
- part of ARGV and not the name of the executable. So we shuffle some
- pointers here to make erl_start happy. */
- if (argv[0][0] == '-') {
- int i;
- char **tmp_argv = malloc(sizeof(char*)*(argc+1));
- for (i = 0; i < argc; i++)
- tmp_argv[i+1] = argv[i];
- tmp_argv[0] = "beam";
- erl_start(argc+1,tmp_argv);
- free(tmp_argv);
- } else {
- erl_start(argc,argv);
- }
-
- stop(current_process());
-
- return 0;
-}
diff --git a/erts/emulator/sys/ose/erl_ose_sys.h b/erts/emulator/sys/ose/erl_ose_sys.h
deleted file mode 100644
index d0cd3180bf..0000000000
--- a/erts/emulator/sys/ose/erl_ose_sys.h
+++ /dev/null
@@ -1,356 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1997-2011. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- *
- * This file handles differences between different Unix systems.
- * This should be the only place with conditional compilation
- * depending on the type of OS.
- */
-
-#ifndef _ERL_OSE_SYS_H
-#define _ERL_OSE_SYS_H
-
-#include "ose.h"
-#undef NIL
-#include "ramlog.h"
-#include "erts.sig"
-
-#include "fcntl.h"
-#include "math.h"
-#include "stdio.h"
-#include "stdlib.h"
-#include "string.h"
-#include "sys/param.h"
-#include "sys/time.h"
-#include "time.h"
-#include "dirent.h"
-#include "ethread.h"
-
-/* FIXME: configuration options */
-#define ERTS_SCHED_MIN_SPIN 1
-#define ERTS_SCHED_ONLY_POLL_SCHED_1 1
-#define ERTS_SCHED_FAIR 1
-#define NO_SYSCONF 1
-#define OPEN_MAX FOPEN_MAX
-
-#define MAP_ANON MAP_ANONYMOUS
-
-#ifndef HAVE_MMAP
-# define HAVE_MMAP 0
-#endif
-
-#if HAVE_MMAP
-# include "sys/mman.h"
-#endif
-
-/*
- * Min number of async threads
- */
-#define ERTS_MIN_NO_OF_ASYNC_THREADS 1
-
-/*
- * Our own type of "FD's"
- */
-#define ERTS_SYS_FD_TYPE struct erts_sys_fd_type*
-#define NO_FSTAT_ON_SYS_FD_TYPE 1 /* They are signals, not files */
-
-#include "sys/stat.h"
-
-/* FIXME mremap is not defined in OSE - POSIX issue */
-extern void *mremap (void *__addr, size_t __old_len, size_t __new_len,
- int __flags, ...);
-
-/* FIXME: mremap constants */
-#define MREMAP_MAYMOVE 1
-#define MREMAP_FIXED 2
-
-typedef void *GETENV_STATE;
-
-/*
-** For the erl_timer_sup module.
-*/
-#define HAVE_GETHRTIME
-
-typedef long long SysHrTime;
-extern SysHrTime sys_gethrtime(void);
-
-void sys_init_hrtime(void);
-
-typedef time_t erts_time_t;
-
-typedef struct timeval SysTimeval;
-
-#define sys_gettimeofday(Arg) ((void) gettimeofday((Arg), NULL))
-
-typedef struct {
- clock_t tms_utime;
- clock_t tms_stime;
- clock_t tms_cutime;
- clock_t tms_cstime;
-} SysTimes;
-
-extern int erts_ticks_per_sec;
-
-#define SYS_CLK_TCK (erts_ticks_per_sec)
-
-extern clock_t sys_times(SysTimes *buffer);
-
-/* No use in having other resolutions than 1 Ms. */
-#define SYS_CLOCK_RESOLUTION 1
-
-#define erts_isfinite finite
-
-#ifdef NO_FPE_SIGNALS
-
-#define erts_get_current_fp_exception() NULL
-#ifdef ERTS_SMP
-#define erts_thread_init_fp_exception() do{}while(0)
-#endif
-# define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0)
-# define __ERTS_FP_ERROR(fpexnp, f, Action) if (!finite(f)) { Action; } else {}
-# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action)
-# define __ERTS_SAVE_FP_EXCEPTION(fpexnp)
-# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp)
-
-#define erts_sys_block_fpe() 0
-#define erts_sys_unblock_fpe(x) do{}while(0)
-
-#else /* !NO_FPE_SIGNALS */
-
-extern volatile unsigned long *erts_get_current_fp_exception(void);
-#ifdef ERTS_SMP
-extern void erts_thread_init_fp_exception(void);
-#endif
-# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
-# define erts_fwait(fpexnp,f) \
- __asm__ __volatile__("fwait" : "=m"(*(fpexnp)) : "m"(f))
-# elif (defined(__powerpc__) || defined(__ppc__)) && defined(__GNUC__)
-# define erts_fwait(fpexnp,f) \
- __asm__ __volatile__("" : "=m"(*(fpexnp)) : "fm"(f))
-# elif defined(__sparc__) && defined(__linux__) && defined(__GNUC__)
-# define erts_fwait(fpexnp,f) \
- __asm__ __volatile__("" : "=m"(*(fpexnp)) : "em"(f))
-# else
-# define erts_fwait(fpexnp,f) \
- __asm__ __volatile__("" : "=m"(*(fpexnp)) : "g"(f))
-# endif
-# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
- extern void erts_restore_fpu(void);
-# else
-# define erts_restore_fpu() /*empty*/
-# endif
-# if (!defined(__GNUC__) || \
- (__GNUC__ < 2) || \
- (__GNUC__ == 2 && __GNUC_MINOR < 96)) && \
- !defined(__builtin_expect)
-# define __builtin_expect(x, expected_value) (x)
-# endif
-static __inline__ int erts_check_fpe(volatile unsigned long *fp_exception, double f)
-{
- erts_fwait(fp_exception, f);
- if (__builtin_expect(*fp_exception == 0, 1))
- return 0;
- *fp_exception = 0;
- erts_restore_fpu();
- return 1;
-}
-# undef erts_fwait
-# undef erts_restore_fpu
-extern void erts_fp_check_init_error(volatile unsigned long *fp_exception);
-static __inline__ void __ERTS_FP_CHECK_INIT(volatile unsigned long *fp_exception)
-{
- if (__builtin_expect(*fp_exception == 0, 1))
- return;
- erts_fp_check_init_error(fp_exception);
-}
-# define __ERTS_FP_ERROR(fpexnp, f, Action) do { if (erts_check_fpe((fpexnp),(f))) { Action; } } while (0)
-# define __ERTS_SAVE_FP_EXCEPTION(fpexnp) unsigned long old_erl_fp_exception = *(fpexnp)
-# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) \
- do { *(fpexnp) = old_erl_fp_exception; } while (0)
- /* This is for library calls where we don't trust the external
- code to always throw floating-point exceptions on errors. */
-static __inline__ int erts_check_fpe_thorough(volatile unsigned long *fp_exception, double f)
-{
- return erts_check_fpe(fp_exception, f) || !finite(f);
-}
-# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) \
- do { if (erts_check_fpe_thorough((fpexnp),(f))) { Action; } } while (0)
-
-int erts_sys_block_fpe(void);
-void erts_sys_unblock_fpe(int);
-
-#endif /* !NO_FPE_SIGNALS */
-
-#define ERTS_FP_CHECK_INIT(p) __ERTS_FP_CHECK_INIT(&(p)->fp_exception)
-#define ERTS_FP_ERROR(p, f, A) __ERTS_FP_ERROR(&(p)->fp_exception, f, A)
-#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A)
-
-/* FIXME: force HAVE_GETPAGESIZE and stub getpagesize */
-#ifndef HAVE_GETPAGESIZE
-#define HAVE_GETPAGESIZE 1
-#endif
-
-extern int getpagesize(void);
-
-#ifndef HZ
-#define HZ 60
-#endif
-
-/* OSE5 doesn't provide limits.h so a number of macros should be
- * added manually */
-
-#ifndef CHAR_BIT
-#define CHAR_BIT 8
-#endif
-
-/* Minimum and maximum values a `signed int' can hold. */
-#ifndef INT_MAX
-#define INT_MAX 2147483647
-#endif
-
-#ifndef INT_MIN
-#define INT_MIN (-INT_MAX - 1)
-#endif
-
-#ifndef UINT_MAX
-# define UINT_MAX 4294967295U
-#endif
-
-/*
-static void erts_ose_sys_send(union SIGNAL **signal,PROCESS dst,
- char* file,int line) {
- SIGSELECT **ziggy = (SIGSELECT**)signal;
- printf("%s:%d 0x%x Send signal 0x%x(0x%x) to 0x%x\r\n",
- file,line,current_process(),ziggy[0][0],*ziggy,dst);
- send(signal,dst);
-}
-#define send(signal,dst) erts_ose_sys_send(signal,dst,__FILE__,__LINE__)
-
-static void erts_ose_sys_send_w_sender(union SIGNAL **signal,
- PROCESS sender,PROCESS dst,
- char* file,int line) {
- SIGSELECT **ziggy = (SIGSELECT**)signal;
- printf("%s:%d 0x%x Send signal 0x%x(0x%x) to 0x%x as 0x%x\r\n",
- file,line,current_process(),ziggy[0][0],*ziggy,dst,sender);
- send_w_sender(signal,sender,dst);
-}
-#define send_w_sender(signal,sender,dst) \
- erts_ose_sys_send_w_sender(signal,sender,dst,__FILE__,__LINE__)
-
-
-static union SIGNAL *erts_ose_sys_receive(SIGSELECT *sigsel,
- char *file,
- int line) {
- SIGSELECT *sig;
- int i;
-
- printf("%s:%d 0x%x receive({%d,",file,line,current_process(),sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("})\n");
- sig = (SIGSELECT*)receive(sigsel);
- printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(),
- *sig,sender((union SIGNAL**)(&sig)));
- return (union SIGNAL*)sig;
-}
-#define receive(SIGSEL) erts_ose_sys_receive(SIGSEL,__FILE__,__LINE__)
-
-static union SIGNAL *erts_ose_sys_receive_w_tmo(OSTIME tmo,SIGSELECT *sigsel,
- char *file,int line) {
- SIGSELECT *sig;
- int i;
- if (tmo == 0) {
- sig = (SIGSELECT*)receive_w_tmo(tmo,sigsel);
- if (sig != NULL) {
- printf("%s:%d 0x%x receive_w_tmo(0,{%d,",file,line,current_process(),
- sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("})\n");
- printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(),
- *sig,sender((union SIGNAL**)(&sig)));
- }
- } else {
- printf("%s:%d 0x%x receive_w_tmo(%u,{%d,",file,line,current_process(),tmo,
- sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("})\n");
- sig = (SIGSELECT*)receive_w_tmo(tmo,sigsel);
- printf("%s:%d 0x%x got ",file,line,current_process());
- if (sig == NULL)
- printf("TIMEOUT\n");
- else
- printf("0x%x from 0x%x\n",*sig,sender((union SIGNAL**)(&sig)));
- }
-
- return (union SIGNAL*)sig;
-}
-
-#define receive_w_tmo(tmo,sigsel) erts_ose_sys_receive_w_tmo(tmo,sigsel, \
- __FILE__,__LINE__)
-
-static union SIGNAL *erts_ose_sys_receive_fsem(OSTIME tmo,SIGSELECT *sigsel,
- OSFSEMVAL fsem,
- char *file,int line) {
- SIGSELECT *sig;
- int i;
- if (tmo == 0) {
- sig = (SIGSELECT*)receive_fsem(tmo,sigsel,fsem);
- if (sig != NULL && sig != OS_RCV_FSEM) {
- printf("%s:%d 0x%x receive_fsem(0,{%d,",file,line,current_process(),
- sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("},%d)\n",fsem);
- printf("%s:%d 0x%x got 0x%x from 0x%x\n",file,line,current_process(),
- *sig,sender((union SIGNAL**)(&sig)));
- }
- } else {
- printf("%s:%d 0x%x receive_fsem(%u,{%d,",file,line,current_process(),tmo,
- sigsel[0]);
- for (i = 1; i < sigsel[0]; i++)
- printf("0x%x, ",sigsel[i]);
- if (sigsel[0] != 0)
- printf("0x%x",sigsel[i]);
- printf("},%d)\n",fsem);
- sig = (SIGSELECT*)receive_fsem(tmo,sigsel,fsem);
- printf("%s:%d 0x%x got ",file,line,current_process());
- if (sig == NULL)
- printf("TIMEOUT\n");
- else if (sig == OS_RCV_FSEM)
- printf("FSEM\n");
- else
- printf("0x%x from 0x%x\n",*sig,sender((union SIGNAL**)(&sig)));
- }
-
- return (union SIGNAL*)sig;
-}
-
-#define receive_fsem(tmo,sigsel,fsem) \
- erts_ose_sys_receive_fsem(tmo,sigsel,fsem,__FILE__,__LINE__)
-*/
-#endif /* _ERL_OSE_SYS_H */
diff --git a/erts/emulator/sys/ose/erl_ose_sys_ddll.c b/erts/emulator/sys/ose/erl_ose_sys_ddll.c
deleted file mode 100644
index 5051f7fcc1..0000000000
--- a/erts/emulator/sys/ose/erl_ose_sys_ddll.c
+++ /dev/null
@@ -1,127 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2006-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Interface functions to the dynamic linker using dl* functions.
- * (No support in OSE, we use static linkage instead)
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "erl_vm.h"
-#include "global.h"
-
-
-void erl_sys_ddll_init(void) {
-}
-
-/*
- * Open a shared object
- */
-int erts_sys_ddll_open(const char *full_name, void **handle, ErtsSysDdllError* err)
-{
- return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY;
-}
-
-int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err)
-{
- return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY;
-}
-
-/*
- * Find a symbol in the shared object
- */
-int erts_sys_ddll_sym2(void *handle, const char *func_name, void **function,
- ErtsSysDdllError* err)
-{
- return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY;
-}
-
-/* XXX:PaN These two will be changed with new driver interface! */
-
-/*
- * Load the driver init function, might appear under different names depending on object arch...
- */
-
-int erts_sys_ddll_load_driver_init(void *handle, void **function)
-{
- void *fn;
- int res;
- if ((res = erts_sys_ddll_sym2(handle, "driver_init", &fn, NULL)) != ERL_DE_NO_ERROR) {
- res = erts_sys_ddll_sym2(handle, "_driver_init", &fn, NULL);
- }
- if (res == ERL_DE_NO_ERROR) {
- *function = fn;
- }
- return res;
-}
-
-int erts_sys_ddll_load_nif_init(void *handle, void **function, ErtsSysDdllError* err)
-{
- void *fn;
- int res;
- if ((res = erts_sys_ddll_sym2(handle, "nif_init", &fn, err)) != ERL_DE_NO_ERROR) {
- res = erts_sys_ddll_sym2(handle, "_nif_init", &fn, err);
- }
- if (res == ERL_DE_NO_ERROR) {
- *function = fn;
- }
- return res;
-}
-
-/*
- * Call the driver_init function, whatever it's really called, simple on unix...
-*/
-void *erts_sys_ddll_call_init(void *function) {
- void *(*initfn)(void) = function;
- return (*initfn)();
-}
-void *erts_sys_ddll_call_nif_init(void *function) {
- return erts_sys_ddll_call_init(function);
-}
-
-
-
-/*
- * Close a chared object
- */
-int erts_sys_ddll_close2(void *handle, ErtsSysDdllError* err)
-{
- return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY;
-}
-
-
-/*
- * Return string that describes the (current) error
- */
-char *erts_sys_ddll_error(int code)
-{
- return "Unspecified error";
-}
-
-void erts_sys_ddll_free_error(ErtsSysDdllError* err)
-{
- if (err->str != NULL) {
- erts_free(ERTS_ALC_T_DDLL_TMP_BUF, err->str);
- }
-}
diff --git a/erts/emulator/sys/ose/erl_poll.c b/erts/emulator/sys/ose/erl_poll.c
deleted file mode 100644
index 5cee582a00..0000000000
--- a/erts/emulator/sys/ose/erl_poll.c
+++ /dev/null
@@ -1,818 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2006-2012. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Description: Poll interface suitable for ERTS on OSE with or without
- * SMP support.
- *
- * The interface is currently implemented using:
- * - receive + receive_fsem
- *
- * Author: Lukas Larsson
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "erl_thr_progress.h"
-#include "erl_driver.h"
-#include "erl_alloc.h"
-#include "erl_poll.h"
-
-#define NOFILE 4096
-
-/*
- * Some debug macros
- */
-
-/* #define HARDDEBUG
-#define HARDTRACE*/
-#ifdef HARDDEBUG
-#ifdef HARDTRACE
-#define HARDTRACEF(X, ...) { fprintf(stderr, X, __VA_ARGS__); fprintf(stderr,"\r\n"); }
-#else
-#define HARDTRACEF(...)
-#endif
-
-#else
-#define HARDTRACEF(X,...)
-#define HARDDEBUGF(...)
-#endif
-
-#if 0
-#define ERTS_POLL_DEBUG_PRINT
-#endif
-
-#if defined(DEBUG) && 0
-#define HARD_DEBUG
-#endif
-
-# define SEL_ALLOC erts_alloc
-# define SEL_REALLOC realloc_wrap
-# define SEL_FREE erts_free
-
-#ifdef ERTS_SMP
-
-#define ERTS_POLLSET_LOCK(PS) \
- erts_smp_mtx_lock(&(PS)->mtx)
-#define ERTS_POLLSET_UNLOCK(PS) \
- erts_smp_mtx_unlock(&(PS)->mtx)
-
-#else
-
-#define ERTS_POLLSET_LOCK(PS)
-#define ERTS_POLLSET_UNLOCK(PS)
-
-#endif
-
-/*
- * --- Data types ------------------------------------------------------------
- */
-
-union SIGNAL {
- SIGSELECT sig_no;
-};
-
-typedef struct erts_sigsel_item_ ErtsSigSelItem;
-
-struct erts_sigsel_item_ {
- ErtsSigSelItem *next;
- ErtsSysFdType fd;
- ErtsPollEvents events;
-};
-
-typedef struct erts_sigsel_info_ ErtsSigSelInfo;
-
-struct erts_sigsel_info_ {
- ErtsSigSelInfo *next;
- SIGSELECT signo;
- ErlDrvOseEventId (*decode)(union SIGNAL* sig);
- ErtsSigSelItem *fds;
-};
-
-struct ErtsPollSet_ {
- SIGSELECT *sigs;
- ErtsSigSelInfo *info;
- Uint sig_count;
- Uint item_count;
- PROCESS interrupt;
- erts_atomic32_t wakeup_state;
- erts_atomic64_t timeout_time;
-#ifdef ERTS_SMP
- erts_smp_mtx_t mtx;
-#endif
-};
-
-static int max_fds = -1;
-
-static ERTS_INLINE void
-init_timeout_time(ErtsPollSet ps)
-{
- erts_atomic64_init_nob(&ps->timeout_time,
- (erts_aint64_t) ERTS_MONOTONIC_TIME_MAX);
-}
-
-static ERTS_INLINE void
-set_timeout_time(ErtsPollSet ps, ErtsMonotonicTime time)
-{
- erts_atomic64_set_relb(&ps->timeout_time,
- (erts_aint64_t) time);
-}
-
-static ERTS_INLINE ErtsMonotonicTime
-get_timeout_time(ErtsPollSet ps)
-{
- return (ErtsMonotonicTime) erts_atomic64_read_acqb(&ps->timeout_time);
-}
-
-#define ERTS_POLL_NOT_WOKEN ((erts_aint32_t) (1 << 0))
-#define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) (1 << 1))
-#define ERTS_POLL_WOKEN_TIMEDOUT ((erts_aint32_t) (1 << 2))
-#define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) (1 << 3))
-#define ERTS_POLL_SLEEPING ((erts_aint32_t) (1 << 4))
-
-/* signal list prototypes */
-static ErtsSigSelInfo *get_sigsel_info(ErtsPollSet ps, SIGSELECT signo);
-static ErtsSigSelItem *get_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd);
-static ErtsSigSelInfo *add_sigsel_info(ErtsPollSet ps, ErtsSysFdType fd,
- ErlDrvOseEventId (*decode)(union SIGNAL* sig));
-static ErtsSigSelItem *add_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd,
- ErlDrvOseEventId (*decode)(union SIGNAL* sig));
-static int del_sigsel_info(ErtsPollSet ps, ErtsSigSelInfo *info);
-static int del_sigsel_item(ErtsPollSet ps, ErtsSigSelItem *item);
-static int update_sigsel(ErtsPollSet ps);
-
-static ErtsSigSelInfo *
-get_sigsel_info(ErtsPollSet ps, SIGSELECT signo) {
- ErtsSigSelInfo *curr = ps->info;
- while (curr != NULL) {
- if (curr->signo == signo)
- return curr;
- curr = curr->next;
- }
- return NULL;
-}
-
-static ErtsSigSelItem *
-get_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd) {
- ErtsSigSelInfo *info = get_sigsel_info(ps,fd->signo);
- ErtsSigSelItem *curr;
-
- if (info == NULL)
- return NULL;
-
- curr = info->fds;
-
- while (curr != NULL) {
- if (curr->fd->id == fd->id) {
- ASSERT(curr->fd->signo == fd->signo);
- return curr;
- }
- curr = curr->next;
- }
- return NULL;
-}
-
-static ErtsSigSelInfo *
-add_sigsel_info(ErtsPollSet ps, ErtsSysFdType fd,
- ErlDrvOseEventId (*decode)(union SIGNAL* sig)) {
- ErtsSigSelInfo *info = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(ErtsSigSelInfo));
- info->next = ps->info;
- info->fds = NULL;
- info->signo = fd->signo;
- info->decode = decode;
- ps->info = info;
- ps->sig_count++;
- return info;
-}
-
-static ErtsSigSelItem *
-add_sigsel_item(ErtsPollSet ps, ErtsSysFdType fd,
- ErlDrvOseEventId (*decode)(union SIGNAL* sig)) {
- ErtsSigSelInfo *info = get_sigsel_info(ps,fd->signo);
- ErtsSigSelItem *item = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(ErtsSigSelItem));
- if (info == NULL)
- info = add_sigsel_info(ps, fd, decode);
- if (info->decode != decode) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(dsbufp, "erts_poll_control() inconsistency: multiple resolve_signal functions for same signal (%d)\n",
- fd->signo);
- erts_send_error_to_logger_nogl(dsbufp);
- }
- ASSERT(info->decode == decode);
- item->next = info->fds;
- item->fd = fd;
- item->events = 0;
- info->fds = item;
- ps->item_count++;
- return item;
-}
-
-static int del_sigsel_info(ErtsPollSet ps, ErtsSigSelInfo *info) {
- ErtsSigSelInfo *curr, *prev;
-
- if (ps->info == info) {
- ps->info = ps->info->next;
- } else {
- curr = ps->info->next;
- prev = ps->info;
-
- while (curr != info) {
- if (curr == NULL)
- return 1;
- prev = curr;
- curr = curr->next;
- }
- prev->next = curr->next;
- }
-
- ps->sig_count--;
- SEL_FREE(ERTS_ALC_T_POLLSET, info);
- return 0;
-}
-
-static int del_sigsel_item(ErtsPollSet ps, ErtsSigSelItem *item) {
- ErtsSigSelInfo *info = get_sigsel_info(ps,item->fd->signo);
- ErtsSigSelItem *curr, *prev;
-
- ps->item_count--;
- ASSERT(ps->item_count >= 0);
-
- if (info->fds == item) {
- info->fds = info->fds->next;
- SEL_FREE(ERTS_ALC_T_POLLSET,item);
- if (info->fds == NULL)
- return del_sigsel_info(ps,info);
- return 0;
- }
-
- curr = info->fds->next;
- prev = info->fds;
-
- while (curr != item) {
- if (curr == NULL) {
- /* We did not find an item to delete so we have to
- * increment item count again.
- */
- ps->item_count++;
- return 1;
- }
- prev = curr;
- curr = curr->next;
- }
- prev->next = curr->next;
- SEL_FREE(ERTS_ALC_T_POLLSET,item);
- return 0;
-}
-
-#ifdef ERTS_SMP
-
-static void update_redir_tables(ErtsPollSet ps) {
- struct OS_redir_entry *redir_table;
- PROCESS sched_1 = ERTS_SCHEDULER_IX(0)->tid.id;
- int i;
- redir_table = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(struct OS_redir_entry)*(ps->sig_count+1));
-
- redir_table[0].sig = ps->sig_count+1;
- redir_table[0].pid = 0;
-
- for (i = 1; i < ps->sig_count+1; i++) {
- redir_table[i].sig = ps->sigs[i];
- redir_table[i].pid = sched_1;
- }
-
- for (i = 1; i < erts_no_schedulers; i++) {
- ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(i);
- set_redirection(esdp->tid.id,redir_table);
- }
-
- SEL_FREE(ERTS_ALC_T_POLLSET,redir_table);
-}
-
-#endif
-
-static int update_sigsel(ErtsPollSet ps) {
- ErtsSigSelInfo *info = ps->info;
-
- int i;
-
- if (ps->sigs != NULL)
- SEL_FREE(ERTS_ALC_T_POLLSET,ps->sigs);
-
- if (ps->sig_count == 0) {
- /* If there are no signals we place a non-valid signal to make sure that
- * we do not trigger on a any unrelated signals which are sent to the
- * process.
- */
- ps->sigs = SEL_ALLOC(ERTS_ALC_T_POLLSET,sizeof(SIGSELECT)*(2));
- ps->sigs[0] = 1;
- ps->sigs[1] = ERTS_SIGNAL_INVALID;
- return 0;
- }
-
- ps->sigs = SEL_ALLOC(ERTS_ALC_T_POLLSET,sizeof(SIGSELECT)*(ps->sig_count+1));
- ps->sigs[0] = ps->sig_count;
-
- for (i = 1; info != NULL; i++, info = info->next)
- ps->sigs[i] = info->signo;
-
-#ifdef ERTS_SMP
- update_redir_tables(ps);
-#endif
-
- return 0;
-}
-
-static ERTS_INLINE void
-wake_poller(ErtsPollSet ps)
-{
- erts_aint32_t wakeup_state;
-
- ERTS_THR_MEMORY_BARRIER;
- wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
- while (wakeup_state != ERTS_POLL_WOKEN_IO_READY
- && wakeup_state != ERTS_POLL_WOKEN_INTR) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_INTR,
- wakeup_state);
- if (act == wakeup_state) {
- wakeup_state = act;
- break;
- }
- wakeup_state = act;
- }
- if (wakeup_state == ERTS_POLL_SLEEPING) {
- /*
- * Since we don't know the internals of signal_fsem() we issue
- * a memory barrier as a safety precaution ensuring that
- * the store we just made to wakeup_state wont be reordered
- * with loads in signal_fsem().
- */
- ERTS_THR_MEMORY_BARRIER;
- signal_fsem(ps->interrupt);
- }
-}
-
-static ERTS_INLINE void
-reset_interrupt(ErtsPollSet ps)
-{
- /* We need to keep io-ready if set */
- erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
- while (wakeup_state != ERTS_POLL_NOT_WOKEN &&
- wakeup_state != ERTS_POLL_SLEEPING) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_NOT_WOKEN,
- wakeup_state);
- if (wakeup_state == act)
- break;
- wakeup_state = act;
- }
- ERTS_THR_MEMORY_BARRIER;
-}
-
-static ERTS_INLINE void
-set_interrupt(ErtsPollSet ps)
-{
- wake_poller(ps);
-}
-
-void erts_poll_interrupt(ErtsPollSet ps,int set) {
- HARDTRACEF("erts_poll_interrupt called!\n");
-
- if (!set)
- reset_interrupt(ps);
- else
- set_interrupt(ps);
-
-}
-
-void erts_poll_interrupt_timed(ErtsPollSet ps,
- int set,
- ErtsTimeoutTime timeout_time) {
- HARDTRACEF("erts_poll_interrupt_timed called!\n");
-
- if (!set)
- reset_interrupt(ps);
- else if (get_timeout_time(ps) > timeout_time)
- set_interrupt(ps);
-}
-
-ErtsPollEvents erts_poll_control(ErtsPollSet ps, ErtsSysFdType fd,
- ErtsPollEvents pe, int on, int* do_wake) {
- ErtsSigSelItem *curr;
- ErtsPollEvents new_events;
- int old_sig_count;
-
- HARDTRACEF(
- "%ux: In erts_poll_control, fd = %d, pe = %d, on = %d, *do_wake = %d, curr = 0x%xu",
- ps, fd, pe, on, do_wake, curr);
-
- ERTS_POLLSET_LOCK(ps);
-
- if (on && (pe & ERTS_POLL_EV_IN) && (pe & ERTS_POLL_EV_OUT)) {
- /* Check to make sure both in and out are not used at the same time */
- new_events = ERTS_POLL_EV_NVAL;
- goto done;
- }
-
- curr = get_sigsel_item(ps, fd);
- old_sig_count = ps->sig_count;
-
- if (curr == NULL && on) {
- curr = add_sigsel_item(ps, fd, fd->resolve_signal);
- } else if (curr == NULL && !on) {
- new_events = ERTS_POLL_EV_NVAL;
- goto done;
- }
-
- new_events = curr->events;
-
- if (pe == 0) {
- *do_wake = 0;
- goto done;
- }
-
- if (on) {
- new_events |= pe;
- curr->events = new_events;
- } else {
- new_events &= ~pe;
- curr->events = new_events;
- if (new_events == 0 && del_sigsel_item(ps, curr)) {
- new_events = ERTS_POLL_EV_NVAL;
- goto done;
- }
- }
-
- if (ps->sig_count != old_sig_count) {
- if (update_sigsel(ps))
- new_events = ERTS_POLL_EV_NVAL;
- }
-done:
- ERTS_POLLSET_UNLOCK(ps);
- HARDTRACEF("%ux: Out erts_poll_control", ps);
- return new_events;
-}
-
-int erts_poll_wait(ErtsPollSet ps,
- ErtsPollResFd pr[],
- int *len,
- ErtsMonotonicTime timeout_time)
-{
- int res = ETIMEDOUT, no_fds, currid = 0;
- OSTIME timeout;
- union SIGNAL *sig;
- ErtsMonotonicTime current_time, diff_time, timeout;
- // HARDTRACEF("%ux: In erts_poll_wait",ps);
- if (ps->interrupt == (PROCESS)0)
- ps->interrupt = current_process();
-
- ASSERT(current_process() == ps->interrupt);
- ASSERT(get_fsem(current_process()) == 0);
- ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) &
- (ERTS_POLL_NOT_WOKEN | ERTS_POLL_WOKEN_INTR));
- /* Max no of spots avable in pr */
- no_fds = *len;
-
- *len = 0;
-
- /* erts_printf("Entering erts_poll_wait(), timeout_time=%bps\n",
- timeout_time); */
-
- if (timeout_time == ERTS_POLL_NO_TIMEOUT) {
- no_timeout:
- timeout = (OSTIME) 0;
- save_timeout_time = ERTS_MONOTONIC_TIME_MIN;
- }
- else {
- ErtsMonotonicTime current_time, diff_time;
- current_time = erts_get_monotonic_time(NULL);
- diff_time = timeout_time - current_time;
- if (diff_time <= 0)
- goto no_timeout;
- diff_time = (ERTS_MONOTONIC_TO_MSEC(diff_time - 1) + 1);
- if (diff_time > INT_MAX)
- diff_time = INT_MAX;
- timeout = (OSTIME) diff_time;
- save_timeout_time = current_time;
- save_timeout_time += ERTS_MSEC_TO_MONOTONIC(diff_time);
- }
-
- set_timeout_time(ps, save_timeout_time);
-
- while (currid < no_fds) {
- if (timeout > 0) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_SLEEPING,
- ERTS_POLL_NOT_WOKEN);
- if (act == ERTS_POLL_NOT_WOKEN) {
-#ifdef ERTS_SMP
- erts_thr_progress_prepare_wait(NULL);
-#endif
- sig = receive_fsem(timeout, ps->sigs, 1);
-#ifdef ERTS_SMP
- erts_thr_progress_finalize_wait(NULL);
-#endif
- } else {
- ASSERT(act == ERTS_POLL_WOKEN_INTR);
- sig = OS_RCV_FSEM;
- }
- } else
- sig = receive_w_tmo(0, ps->sigs);
-
- if (sig == NULL) {
- if (timeout > 0) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_TIMEDOUT,
- ERTS_POLL_SLEEPING);
- if (act == ERTS_POLL_WOKEN_INTR)
- /* Restore fsem as it was signaled but we got a timeout */
- wait_fsem(1);
- } else
- erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_TIMEDOUT,
- ERTS_POLL_NOT_WOKEN);
- break;
- } else if (sig == OS_RCV_FSEM) {
- ASSERT(erts_atomic32_read_nob(&ps->wakeup_state) == ERTS_POLL_WOKEN_INTR);
- break;
- }
- {
- ErtsSigSelInfo *info = get_sigsel_info(ps, sig->sig_no);
- struct erts_sys_fd_type fd = { sig->sig_no, info->decode(sig) };
- ErtsSigSelItem *item = get_sigsel_item(ps, &fd);
-
- ASSERT(sig);
- if (currid == 0 && timeout > 0) {
- erts_aint32_t act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_IO_READY,
- ERTS_POLL_SLEEPING);
- if (act == ERTS_POLL_WOKEN_INTR) {
- /* Restore fsem as it was signaled but we got a msg */
- wait_fsem(1);
- act = erts_atomic32_cmpxchg_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_IO_READY,
- ERTS_POLL_WOKEN_INTR);
- }
- } else if (currid == 0) {
- erts_atomic32_set_nob(&ps->wakeup_state,
- ERTS_POLL_WOKEN_IO_READY);
- }
-
- if (item == NULL) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- erts_dsprintf(
- dsbufp,
- "erts_poll_wait() failed: found unkown signal id %d (signo %u) "
- "(curr_proc 0x%x)\n",
- fd.id, fd.signo, current_process());
- erts_send_error_to_logger_nogl(dsbufp);
- timeout = 0;
- /* Under normal circumstances the signal is deallocated by the
- * driver that issued the select operation. But in this case
- * there's no driver waiting for such signal so we have to
- * deallocate it here */
- if (sig)
- free_buf(&sig);
- } else {
- int i;
- struct erts_sys_fd_type *fd = NULL;
- ErtsPollOseMsgList *tl,*new;
-
- /* Check if this fd has already been triggered by a previous signal */
- for (i = 0; i < currid;i++) {
- if (pr[i].fd == item->fd) {
- fd = pr[i].fd;
- pr[i].events |= item->events;
- break;
- }
- }
-
- /* First time this fd is triggered */
- if (fd == NULL) {
- pr[currid].fd = item->fd;
- pr[currid].events = item->events;
- fd = item->fd;
- timeout = 0;
- currid++;
- }
-
- /* Insert new signal in approriate list */
- new = erts_alloc(ERTS_ALC_T_FD_SIG_LIST,sizeof(ErtsPollOseMsgList));
- new->next = NULL;
- new->data = sig;
-
- ethr_mutex_lock(&fd->mtx);
- tl = fd->msgs;
-
- if (tl == NULL) {
- fd->msgs = new;
- } else {
- while (tl->next != NULL)
- tl = tl->next;
- tl->next = new;
- }
- ethr_mutex_unlock(&fd->mtx);
- }
-
- }
- }
-
- {
- erts_aint32_t wakeup_state = erts_atomic32_read_nob(&ps->wakeup_state);
-
- switch (wakeup_state) {
- case ERTS_POLL_WOKEN_IO_READY:
- res = 0;
- break;
- case ERTS_POLL_WOKEN_INTR:
- res = EINTR;
- break;
- case ERTS_POLL_WOKEN_TIMEDOUT:
- res = ETIMEDOUT;
- break;
- case ERTS_POLL_NOT_WOKEN:
- /* This happens when we get an invalid signal only */
- res = EINVAL;
- break;
- default:
- res = 0;
- erl_exit(ERTS_ABORT_EXIT,
- "%s:%d: Internal error: Invalid wakeup_state=%d\n",
- __FILE__, __LINE__, (int) wakeup_state);
- }
- }
-
- erts_atomic32_set_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
- set_timeout_time(ps, ERTS_MONOTONIC_TIME_MAX);
-
- *len = currid;
-
- // HARDTRACEF("%ux: Out erts_poll_wait",ps);
- return res;
-}
-
-int erts_poll_max_fds(void)
-{
-
- HARDTRACEF("In/Out erts_poll_max_fds -> %d",max_fds);
- return max_fds;
-}
-
-void erts_poll_info(ErtsPollSet ps,
- ErtsPollInfo *pip)
-{
- Uint size = 0;
- Uint num_events = 0;
-
- size += sizeof(struct ErtsPollSet_);
- size += sizeof(ErtsSigSelInfo)*ps->sig_count;
- size += sizeof(ErtsSigSelItem)*ps->item_count;
- size += sizeof(SIGSELECT)*(ps->sig_count+1);
-
- pip->primary = "receive_fsem";
-
- pip->fallback = NULL;
-
- pip->kernel_poll = NULL;
-
- pip->memory_size = size;
-
- pip->poll_set_size = num_events;
-
- pip->fallback_poll_set_size = 0;
-
- pip->lazy_updates = 0;
-
- pip->pending_updates = 0;
-
- pip->batch_updates = 0;
-
- pip->concurrent_updates = 0;
-
-
- pip->max_fds = erts_poll_max_fds();
- HARDTRACEF("%ux: Out erts_poll_info",ps);
-
-}
-
-ErtsPollSet erts_poll_create_pollset(void)
-{
- ErtsPollSet ps = SEL_ALLOC(ERTS_ALC_T_POLLSET,
- sizeof(struct ErtsPollSet_));
-
- ps->sigs = NULL;
- ps->sig_count = 0;
- ps->item_count = 0;
- ps->info = NULL;
- ps->interrupt = (PROCESS)0;
- erts_atomic32_init_nob(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN);
- init_timeout_time(ps);
-#ifdef ERTS_SMP
- erts_smp_mtx_init(&ps->mtx, "pollset");
-#endif
- update_sigsel(ps);
- HARDTRACEF("%ux: Out erts_poll_create_pollset",ps);
- return ps;
-}
-
-void erts_poll_destroy_pollset(ErtsPollSet ps)
-{
- ErtsSigSelInfo *info;
- for (info = ps->info; ps->info != NULL; info = ps->info, ps->info = ps->info->next) {
- ErtsSigSelItem *item;
- for (item = info->fds; info->fds != NULL; item = info->fds, info->fds = info->fds->next)
- SEL_FREE(ERTS_ALC_T_POLLSET, item);
- SEL_FREE(ERTS_ALC_T_POLLSET, info);
- }
-
- SEL_FREE(ERTS_ALC_T_POLLSET,ps->sigs);
-
-#ifdef ERTS_SMP
- erts_smp_mtx_destroy(&ps->mtx);
-#endif
-
- SEL_FREE(ERTS_ALC_T_POLLSET,ps);
-}
-
-void erts_poll_init(void)
-{
- HARDTRACEF("In %s", __FUNCTION__);
- max_fds = 256;
-
- HARDTRACEF("Out %s", __FUNCTION__);
-}
-
-
-/* OSE driver functions */
-
-union SIGNAL *erl_drv_ose_get_signal(ErlDrvEvent drv_ev) {
- struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev;
- ethr_mutex_lock(&ev->mtx);
- if (ev->msgs == NULL) {
- ethr_mutex_unlock(&ev->mtx);
- return NULL;
- } else {
- ErtsPollOseMsgList *msg = ev->msgs;
- union SIGNAL *sig = (union SIGNAL*)msg->data;
- ASSERT(msg->data);
- ev->msgs = msg->next;
- ethr_mutex_unlock(&ev->mtx);
- erts_free(ERTS_ALC_T_FD_SIG_LIST,msg);
- restore(sig);
- return sig;
- }
-}
-
-ErlDrvEvent
-erl_drv_ose_event_alloc(SIGSELECT signo, ErlDrvOseEventId id,
- ErlDrvOseEventId (*resolve_signal)(union SIGNAL *sig), void *extra) {
- struct erts_sys_fd_type *ev = erts_alloc(ERTS_ALC_T_DRV_EV,
- sizeof(struct erts_sys_fd_type));
- ev->signo = signo;
- ev->extra = extra;
- ev->id = id;
- ev->msgs = NULL;
- ev->resolve_signal = resolve_signal;
- ethr_mutex_init(&ev->mtx);
- return (ErlDrvEvent)ev;
-}
-
-void erl_drv_ose_event_free(ErlDrvEvent drv_ev) {
- struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev;
- ASSERT(ev->msgs == NULL);
- ethr_mutex_destroy(&ev->mtx);
- erts_free(ERTS_ALC_T_DRV_EV,ev);
-}
-
-void erl_drv_ose_event_fetch(ErlDrvEvent drv_ev, SIGSELECT *signo,
- ErlDrvOseEventId *id, void **extra) {
- struct erts_sys_fd_type *ev = (struct erts_sys_fd_type *)drv_ev;
- if (signo)
- *signo = ev->signo;
- if (extra)
- *extra = ev->extra;
- if (id)
- *id = ev->id;
-}
diff --git a/erts/emulator/sys/ose/erts.sig b/erts/emulator/sys/ose/erts.sig
deleted file mode 100644
index 78b883ee6c..0000000000
--- a/erts/emulator/sys/ose/erts.sig
+++ /dev/null
@@ -1,17 +0,0 @@
-#ifndef ERTS_OSE_SIGNALS
-#define ERTS_OSE_SIGNALS
-
-#ifndef ERTS_OSE_SIGNAL_BASE
-#define ERTS_OSE_SIGNAL_BASE 0x01900280
-#endif
-
-#define ERTS_SIGNAL_INVALID ERTS_OSE_SIGNAL_BASE
-#define ERTS_SIGNAL_FD_DRV_CONFIG ERTS_OSE_SIGNAL_BASE+1
-#define ERTS_SIGNAL_FD_DRV_ASYNC ERTS_OSE_SIGNAL_BASE+2
-#define ERTS_SIGNAL_OSE_DRV_ATTACH ERTS_OSE_SIGNAL_BASE+3
-#define ERTS_SIGNAL_OSE_DRV_HUNT ERTS_OSE_SIGNAL_BASE+4
-
-#define ERTS_SIGNAL_RUN_ERL_SETUP ERTS_OSE_SIGNAL_BASE+100
-#define ERTS_SIGNAL_RUN_ERL_DAEMON ERTS_OSE_SIGNAL_BASE+101
-
-#endif
diff --git a/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf b/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf
deleted file mode 100644
index a19d23facf..0000000000
--- a/erts/emulator/sys/ose/gcc_4.4.3_lm_ppc.lcf
+++ /dev/null
@@ -1,182 +0,0 @@
-/*******************************************************************************
- * Copyright (C) 2013-2014 by Enea Software AB,
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- *
- * 3. Neither the name of the copyright holder nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- ******************************************************************************/
-
-OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc")
-OUTPUT_ARCH("powerpc")
-ENTRY("crt0_lm")
-MEMORY
-{
- rom : ORIGIN = 0x01000000, LENGTH = 0x01000000
- ram : ORIGIN = 0x02000000, LENGTH = 0x01000000
-}
-PHDRS
-{
- ph_conf PT_LOAD ;
- ph_rom PT_LOAD ;
- ph_ram PT_LOAD ;
-}
-SECTIONS
-{
- .text :
- {
- *(.text_first)
- *(.text)
- *(.text.*)
- *(.stub)
- *(oscode)
- *(.init*)
- *(.fini*)
- *(.gnu.warning)
- *(.gnu.linkonce.t.*)
- *(.glue_7t)
- *(.glue_7)
- } > rom :ph_rom = 0
- .ose_sfk_biosentry :
- {
- *(.ose_sfk_biosentry)
- } > rom :ph_rom
- .ctors :
- {
- __CTOR_LIST__ = .;
- *(.ctors)
- *(SORT(.ctors.*))
- __CTOR_END__ = .;
- } > rom :ph_rom
- .dtors :
- {
- __DTOR_LIST__ = .;
- *(.dtors)
- *(SORT(.dtors.*))
- __DTOR_END__ = .;
- } > rom :ph_rom
- OSESYMS :
- {
- *(.osesyms)
- } > rom :ph_rom
- .rodata :
- {
- *(.rodata)
- *(.rodata.*)
- *(.gnu.linkonce.r.*)
- } > rom :ph_rom
- .eh_frame_hdr :
- {
- *(.eh_frame_hdr)
- } > rom :ph_rom
- .eh_frame :
- {
- __EH_FRAME_BEGIN__ = .;
- *(.eh_frame)
- LONG(0)
- __EH_FRAME_END__ = .;
- } > rom :ph_rom
- .gcc_except_table :
- {
- *(.gcc_except_table .gcc_except_table.*)
- } > rom :ph_rom
- .sdata2 :
- {
- PROVIDE (_SDA2_BASE_ = .);
- *(.sdata2)
- *(.sdata2.*)
- *(.gnu.linkonce.s2.*)
- } > rom :ph_rom
- .sbss2 :
- {
- *(.sbss2)
- *(.sbss2.*)
- *(.gnu.linkonce.sb2.*)
- } > rom :ph_rom
- LMCONF :
- {
- obj/?*?/ose_confd.o(.rodata)
- *(LMCONF)
- } > rom :ph_conf
- .data :
- {
- LONG(0xDEADBABE)
- *(.data)
- *(.data.*)
- *(.gnu.linkonce.d.*)
- SORT(CONSTRUCTORS)
- . = ALIGN(0x10);
- } > ram :ph_ram = 0
- .sdata2 :
- {
- _SDA2_BASE_ = .;
- *(.sdata2 .sdata2.* .gnu.linkonce.s2.*)
- }> ram :ph_ram
- .sdata :
- {
- PROVIDE (_SDA_BASE_ = .);
- *(.sdata)
- *(.sdata.*)
- *(.gnu.linkonce.s.*)
- } > ram :ph_ram
- .sbss :
- {
- *(.sbss)
- *(.sbss.*)
- *(.scommon)
- *(.gnu.linkonce.sb.*)
- } > ram :ph_ram
- .bss (NOLOAD) :
- {
- *(.bss)
- *(.bss.*)
- *(COMMON)
- *(.gnu.linkonce.b.*)
- *(.osvars)
- } > ram :ph_ram
- .ignore (NOLOAD) :
- {
- *(.rel.dyn)
- } > ram :ph_ram
- .debug 0 : { *(.debug) }
- .line 0 : { *(.line) }
- .debug_srcinfo 0 : { *(.debug_srcinfo) }
- .debug_sfnames 0 : { *(.debug_sfnames) }
- .debug_aranges 0 : { *(.debug_aranges) }
- .debug_pubnames 0 : { *(.debug_pubnames) }
- .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) }
- .debug_abbrev 0 : { *(.debug_abbrev) }
- .debug_line 0 : { *(.debug_line) }
- .debug_frame 0 : { *(.debug_frame) }
- .debug_str 0 : { *(.debug_str) }
- .debug_loc 0 : { *(.debug_loc) }
- .debug_macinfo 0 : { *(.debug_macinfo) }
- .debug_weaknames 0 : { *(.debug_weaknames) }
- .debug_funcnames 0 : { *(.debug_funcnames) }
- .debug_typenames 0 : { *(.debug_typenames) }
- .debug_varnames 0 : { *(.debug_varnames) }
-}
-__OSESYMS_START = ADDR(OSESYMS);
-__OSESYMS_END = ADDR(OSESYMS) + SIZEOF(OSESYMS);
diff --git a/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf b/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf
deleted file mode 100644
index 3440c2961b..0000000000
--- a/erts/emulator/sys/ose/gcc_4.6.3_lm_ppc.lcf
+++ /dev/null
@@ -1,242 +0,0 @@
-/*******************************************************************************
- * Copyright (C) 2013-2014 by Enea Software AB,
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- *
- * 3. Neither the name of the copyright holder nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
- * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- ******************************************************************************/
-
-OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc")
-OUTPUT_ARCH("powerpc")
-
-ENTRY("crt0_lm")
-
-/* Note:
- * You may have to increase the length of the "rom" memory region and the
- * origin and length of the "ram" memory region below depending on the size
- * of the code and data in your load module.
- */
-
-MEMORY
-{
- conf : ORIGIN = 0x00100000, LENGTH = 0x00030000
- rom : ORIGIN = 0x01000000, LENGTH = 0x01000000
- ram : ORIGIN = 0x03000000, LENGTH = 0x01000000
-}
-
-PHDRS
-{
- ph_conf PT_LOAD ;
- ph_rom PT_LOAD ;
- ph_ram PT_LOAD ;
-}
-
-SECTIONS
-{
-/*---------------------------------------------------------------------------
- * Load module configuration area
- *-------------------------------------------------------------------------*/
-
- /* Load module configuration section. */
- LMCONF :
- {
- obj/?*?/ose_confd.o(.rodata)
- *(LMCONF)
- } > conf :ph_conf
-
-/*---------------------------------------------------------------------------
- * Read-only area
- *-------------------------------------------------------------------------*/
-
- /* Code section. */
- .text :
- {
- *(.text)
- *(.text.*)
- *(.stub)
- *(oscode)
- *(.init*)
- *(.fini*)
- *(.gnu.warning)
- *(.gnu.linkonce.t.*)
- } > rom :ph_rom = 0
-
- /* OSE symbols section. */
- OSESYMS :
- {
- *(.osesyms)
- } > rom :ph_rom
-
- /* Read-only data section. */
- .rodata :
- {
- *(.rodata)
- *(.rodata.*)
- *(.gnu.linkonce.r.*)
- } > rom :ph_rom
-
- /* C++ exception handling section. */
- .eh_frame :
- {
- __EH_FRAME_BEGIN__ = .;
- *(.eh_frame)
- LONG(0)
- __EH_FRAME_END__ = .;
- } > rom :ph_rom
-
- /* C++ exception handling section. */
- .gcc_except_table :
- {
- *(.gcc_except_table .gcc_except_table.*)
- } > rom :ph_rom
-
- /* PowerPC EABI initialized read-only data section. */
- .sdata2 :
- {
- PROVIDE (_SDA2_BASE_ = .);
- *(.sdata2)
- *(.sdata2.*)
- *(.gnu.linkonce.s2.*)
- } > rom :ph_rom
-
- /* PowerPC EABI uninitialized read-only data section. */
- .sbss2 :
- {
- *(.sbss2)
- *(.sbss2.*)
- *(.gnu.linkonce.sb2.*)
- } > rom :ph_rom
-
-/*---------------------------------------------------------------------------
- * Read-write area
- *-------------------------------------------------------------------------*/
-
- /*-------------------------------------------------------------------
- * Initialized data (copied by PM)
- *-----------------------------------------------------------------*/
-
- /* Data section. */
- .data :
- {
- *(.data)
- *(.data.*)
- *(.gnu.linkonce.d.*)
- SORT(CONSTRUCTORS)
- } > ram :ph_ram
-
- /* C++ constructor section. */
- .ctors :
- {
- __CTOR_LIST__ = .;
- *(.ctors)
- *(SORT(.ctors.*))
- __CTOR_END__ = .;
- } > ram :ph_ram
-
- /* C++ destructor section. */
- .dtors :
- {
- __DTOR_LIST__ = .;
- *(.dtors)
- *(SORT(.dtors.*))
- __DTOR_END__ = .;
- } > ram :ph_ram
-
-
- /* Small data section. */
- .sdata ALIGN(0x10) :
- {
- PROVIDE (_SDA_BASE_ = .);
- *(.sdata)
- *(.sdata.*)
- *(.gnu.linkonce.s.*)
- } > ram :ph_ram
-
- /*-------------------------------------------------------------------
- * Uninitialized data (cleared by PM)
- *-----------------------------------------------------------------*/
-
- /* Small bss section. */
- .sbss :
- {
- *(.sbss)
- *(.sbss.*)
- *(.scommon)
- *(.gnu.linkonce.sb.*)
- } > ram :ph_ram
-
- /* Bss section. */
- .bss :
- {
- *(.bss)
- *(.bss.*)
- *(COMMON)
- *(.gnu.linkonce.b.*)
- } > ram :ph_ram
-
-/*---------------------------------------------------------------------------
- * Debug information
- *-------------------------------------------------------------------------*/
-
- /*
- * Stabs debug sections.
- */
-
- .stab 0 : { *(.stab) }
- .stabstr 0 : { *(.stabstr) }
- .stab.excl 0 : { *(.stab.excl) }
- .stab.exclstr 0 : { *(.stab.exclstr) }
- .stab.index 0 : { *(.stab.index) }
- .stab.indexstr 0 : { *(.stab.indexstr) }
- .comment 0 : { *(.comment) }
-
- /*
- * DWARF debug sections.
- */
-
- /* DWARF 1 */
- .debug 0 : { *(.debug) }
- .line 0 : { *(.line) }
- /* GNU DWARF 1 extensions */
- .debug_srcinfo 0 : { *(.debug_srcinfo) }
- .debug_sfnames 0 : { *(.debug_sfnames) }
- /* DWARF 1.1 and DWARF 2 */
- .debug_aranges 0 : { *(.debug_aranges) }
- .debug_pubnames 0 : { *(.debug_pubnames) }
- /* DWARF 2 */
- .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) }
- .debug_abbrev 0 : { *(.debug_abbrev) }
- .debug_line 0 : { *(.debug_line) }
- .debug_frame 0 : { *(.debug_frame) }
- .debug_str 0 : { *(.debug_str) }
- .debug_loc 0 : { *(.debug_loc) }
- .debug_macinfo 0 : { *(.debug_macinfo) }
- /* SGI/MIPS DWARF 2 extensions */
- .debug_weaknames 0 : { *(.debug_weaknames) }
- .debug_funcnames 0 : { *(.debug_funcnames) }
- .debug_typenames 0 : { *(.debug_typenames) }
- .debug_varnames 0 : { *(.debug_varnames) }
-}
diff --git a/erts/emulator/sys/ose/sys.c b/erts/emulator/sys/ose/sys.c
deleted file mode 100644
index bcd0ffa0b6..0000000000
--- a/erts/emulator/sys/ose/sys.c
+++ /dev/null
@@ -1,1847 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-#include "sys/time.h"
-#include "time.h"
-#include "sys/uio.h"
-#include "termios.h"
-#include "ctype.h"
-#include "termios.h"
-
-#ifdef HAVE_FCNTL_H
-#include "fcntl.h"
-#endif
-
-#ifdef HAVE_SYS_IOCTL_H
-#include "sys/ioctl.h"
-#endif
-
-#define ERTS_WANT_BREAK_HANDLING
-#define WANT_NONBLOCKING
-#include "sys.h"
-#include "erl_thr_progress.h"
-
-#ifdef USE_THREADS
-#include "erl_threads.h"
-#endif
-
-#include "erl_mseg.h"
-
-#include "unistd.h"
-#include "efs.h"
-#include "erl_printf.h"
-#include "aio.h"
-#include "pm.h"
-#include "fcntl.h"
-
-/* Set the define to 1 to get some logging */
-#if 0
-#include "ramlog.h"
-#define LOG(output) ramlog_printf output
-#else
-#define LOG(output)
-#endif
-
-extern char **environ;
-static erts_smp_rwmtx_t environ_rwmtx;
-static PROCESS sig_proxy_pid = 0;
-
-#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
- * vector sock_sendv().
- */
-/*
- * Don't need global.h, but bif_table.h (included by bif.h),
- * won't compile otherwise
- */
-#include "global.h"
-#include "bif.h"
-
-#include "erl_sys_driver.h"
-#include "erl_check_io.h"
-#include "erl_cpu_topology.h"
-
-/* The priority for reader/writer processes */
-#define FD_PROC_PRI get_pri(current_process())
-
-typedef struct ErtsSysReportExit_ ErtsSysReportExit;
-struct ErtsSysReportExit_ {
- ErtsSysReportExit *next;
- Eterm port;
- int pid;
- int ifd;
- int ofd;
- ErlDrvEvent attach_event;
- ErlDrvEvent input_event;
- ErlDrvEvent output_event;
-};
-
-/* This data is shared by these drivers - initialized by spawn_init() */
-static struct driver_data {
- ErlDrvPort port_num;
- int ofd;
- int ifd;
- int packet_bytes;
- ErtsSysReportExit *report_exit;
- int pid;
- int alive;
- int status;
- ErlDrvEvent input_event;
- ErlDrvEvent output_event;
- struct aiocb aiocb;
- FmHandle handle;
- char *install_handle;
-} *driver_data; /* indexed by fd */
-
-struct async {
- SIGSELECT signo;
- ErlDrvTermData port;
- ErlDrvTermData proc;
- PROCESS spid;
- PROCESS target;
- Uint32 ref;
-};
-
-static ErtsSysReportExit *report_exit_list;
-static ERTS_INLINE void report_exit_status(ErtsSysReportExit *rep, int status);
-
-extern int driver_interrupt(int, int);
-extern void do_break(void);
-
-extern void erl_sys_args(int*, char**);
-
-/* The following two defs should probably be moved somewhere else */
-
-extern void erts_sys_init_float(void);
-
-extern void erl_crash_dump(char* file, int line, char* fmt, ...);
-
-#define DIR_SEPARATOR_CHAR '/'
-
-#if defined(DEBUG)
-#define ERL_BUILD_TYPE_MARKER ".debug"
-#else /* opt */
-#define ERL_BUILD_TYPE_MARKER
-#endif
-
-#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER
-
-#ifdef DEBUG
-static int debug_log = 0;
-#endif
-
-#ifdef ERTS_SMP
-static erts_smp_atomic32_t have_prepared_crash_dump;
-#define ERTS_PREPARED_CRASH_DUMP \
- ((int) erts_smp_atomic32_xchg_nob(&have_prepared_crash_dump, 1))
-#else
-static volatile int have_prepared_crash_dump;
-#define ERTS_PREPARED_CRASH_DUMP \
- (have_prepared_crash_dump++)
-#endif
-
-static erts_smp_atomic_t sys_misc_mem_sz;
-
-#if defined(ERTS_SMP)
-erts_mtx_t chld_stat_mtx;
-#endif
-
-#if defined(ERTS_SMP) /* ------------------------------------------------- */
-#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx)
-#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx)
-
-#else /* ------------------------------------------------------------------- */
-#define CHLD_STAT_LOCK
-#define CHLD_STAT_UNLOCK
-static volatile int children_died;
-#endif
-
-#define SET_AIO(REQ,FD,SIZE,BUFF) \
- memset(&(REQ),0,sizeof(REQ)); \
- (REQ).aio_fildes = FD; \
- (REQ).aio_offset = FM_POSITION_CURRENT; \
- (REQ).aio_nbytes = SIZE; \
- (REQ).aio_buf = BUFF; \
- (REQ).aio_sigevent.sigev_notify = SIGEV_NONE
-
-/* the first sizeof(struct aiocb *) bytes of the write buffer
- * will contain the pointer to the aiocb struct, this needs
- * to be freed between asynchronous writes.
- * A write of 0 bytes is ignored. */
-#define WRITE_AIO(FD,SIZE,BUFF) do { \
- if (SIZE > 0) { \
- struct aiocb *write_req = driver_alloc(sizeof(struct aiocb)); \
- char *write_buff = driver_alloc((sizeof(char)*SIZE)+1+ \
- (sizeof(struct aiocb *))); \
- *(struct aiocb **)write_buff = (struct aiocb *)write_req; \
- write_buff += sizeof(struct aiocb *); \
- memcpy(write_buff,BUFF,SIZE+1); \
- SET_AIO(*write_req,FD,SIZE,write_buff); \
- if (aio_write(write_req)) \
- ramlog_printf("%s:%d: write failed with %d\n", \
- __FILE__,__LINE__,errno); \
- } \
-} while(0)
-
-/* free the write_buffer and write_req
- * created in the WRITE_AIO() request macro */
-#define FREE_AIO(ptr) do { \
- struct aiocb *aiocb_ptr; \
- char *buffer_ptr; \
- aiocb_ptr = *(struct aiocb **)((ptr)-sizeof(struct aiocb *)); \
- buffer_ptr = (((char*)ptr)-sizeof(struct aiocb *)); \
- driver_free(aiocb_ptr); \
- driver_free(buffer_ptr); \
-} while(0)
-
-#define DISPATCH_AIO(sig) do { \
- if (aio_dispatch(sig)) \
- ramlog_printf("%s:%d: dispatch failed with %d\n", \
- __FILE__,__LINE__,errno); \
- } while(0)
-
-#define AIO_PIPE_SIZE 1024
-
-/* debug print macros */
-#define DEBUG_RES 0
-
-#ifdef DEBUG_RES
-#define DEBUG_CHECK_RES(actual, expected) \
- do { \
- if (actual != expected ) { \
- ramlog_printf("Result check failed" \
- " got: 0x%08x expected:0x%08x\nat: %s:%d\n", \
- actual, expected, __FILE__, __LINE__); \
- abort(); /* This might perhaps be too harsh? */ \
- } \
- } while(0)
-#else
-#define DEBUG_CHECK_RES
-#endif
-
-static struct fd_data {
- char pbuf[4]; /* hold partial packet bytes */
- int psz; /* size of pbuf */
- char *buf;
- char *cpos;
- int sz;
- int remain; /* for input on fd */
-} *fd_data; /* indexed by fd */
-
-/********************* General functions ****************************/
-
-/* This is used by both the drivers and general I/O, must be set early */
-static int max_files = -1;
-
-/*
- * a few variables used by the break handler
- */
-#ifdef ERTS_SMP
-erts_smp_atomic32_t erts_break_requested;
-#define ERTS_SET_BREAK_REQUESTED \
- erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 1)
-#define ERTS_UNSET_BREAK_REQUESTED \
- erts_smp_atomic32_set_nob(&erts_break_requested, (erts_aint32_t) 0)
-#else
-volatile int erts_break_requested = 0;
-#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1)
-#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0)
-#endif
-/* set early so the break handler has access to initial mode */
-static struct termios initial_tty_mode;
-static int replace_intr = 0;
-/* assume yes initially, ttsl_init will clear it */
-int using_oldshell = 1;
-static PROCESS get_signal_proxy_pid(void);
-
-static void
-init_check_io(void)
-{
- erts_init_check_io();
- max_files = erts_check_io_max_files();
-}
-
-#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
-#define ERTS_CHK_IO_AS_INTR() erts_check_io_async_sig_interrupt()
-#else
-#define ERTS_CHK_IO_AS_INTR() erts_check_io_interrupt(1)
-#endif
-#define ERTS_CHK_IO_INTR erts_check_io_interrupt
-#define ERTS_CHK_IO_INTR_TMD erts_check_io_interrupt_timed
-#define ERTS_CHK_IO erts_check_io
-#define ERTS_CHK_IO_SZ erts_check_io_size
-
-
-void
-erts_sys_schedule_interrupt(int set)
-{
- ERTS_CHK_IO_INTR(set);
-}
-
-#ifdef ERTS_SMP
-void
-erts_sys_schedule_interrupt_timed(int set, ErtsMonotonicTime timeout_time)
-{
- ERTS_CHK_IO_INTR_TMD(set, timeout_time);
-}
-#endif
-
-Uint
-erts_sys_misc_mem_sz(void)
-{
- Uint res = ERTS_CHK_IO_SZ();
- res += erts_smp_atomic_read_mb(&sys_misc_mem_sz);
- return res;
-}
-
-/*
- * reset the terminal to the original settings on exit
- */
-void sys_tty_reset(int exit_code)
-{
- if (using_oldshell && !replace_intr) {
- SET_BLOCKING(0);
- }
- else if (isatty(0)) {
- tcsetattr(0,TCSANOW,&initial_tty_mode);
- }
-}
-
-#ifdef USE_THREADS
-
-typedef struct {
- int sched_bind_data;
-} erts_thr_create_data_t;
-
-/*
- * thr_create_prepare() is called in parent thread before thread creation.
- * Returned value is passed as argument to thr_create_cleanup().
- */
-static void *
-thr_create_prepare(void)
-{
- erts_thr_create_data_t *tcdp;
-
- tcdp = erts_alloc(ERTS_ALC_T_TMP, sizeof(erts_thr_create_data_t));
-
- tcdp->sched_bind_data = erts_sched_bind_atthrcreate_prepare();
-
- return (void *) tcdp;
-}
-
-
-/* thr_create_cleanup() is called in parent thread after thread creation. */
-static void
-thr_create_cleanup(void *vtcdp)
-{
- erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp;
-
- erts_sched_bind_atthrcreate_parent(tcdp->sched_bind_data);
-
- erts_free(ERTS_ALC_T_TMP, tcdp);
-}
-
-static void
-thr_create_prepare_child(void *vtcdp)
-{
- erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp;
-
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_thread_setup();
-#endif
-
- erts_sched_bind_atthrcreate_child(tcdp->sched_bind_data);
-}
-
-#endif /* #ifdef USE_THREADS */
-
-/* The two functions below are stolen from win_con.c
- They have to use malloc/free/realloc directly becasue
- we want to do able to do erts_printf very early on.
- */
-#define VPRINTF_BUF_INC_SIZE 128
-static erts_dsprintf_buf_t *
-grow_vprintf_buf(erts_dsprintf_buf_t *dsbufp, size_t need)
-{
- char *buf;
- size_t size;
-
- ASSERT(dsbufp);
-
- if (!dsbufp->str) {
- size = (((need + VPRINTF_BUF_INC_SIZE - 1)
- / VPRINTF_BUF_INC_SIZE)
- * VPRINTF_BUF_INC_SIZE);
- buf = (char *) malloc(size * sizeof(char));
- }
- else {
- size_t free_size = dsbufp->size - dsbufp->str_len;
-
- if (need <= free_size)
- return dsbufp;
-
- size = need - free_size + VPRINTF_BUF_INC_SIZE;
- size = (((size + VPRINTF_BUF_INC_SIZE - 1)
- / VPRINTF_BUF_INC_SIZE)
- * VPRINTF_BUF_INC_SIZE);
- size += dsbufp->size;
- buf = (char *) realloc((void *) dsbufp->str,
- size * sizeof(char));
- }
- if (!buf)
- return NULL;
- if (buf != dsbufp->str)
- dsbufp->str = buf;
- dsbufp->size = size;
- return dsbufp;
-}
-
-static int erts_sys_ramlog_printf(char *format, va_list arg_list)
-{
- int res,i;
- erts_dsprintf_buf_t dsbuf = ERTS_DSPRINTF_BUF_INITER(grow_vprintf_buf);
- res = erts_vdsprintf(&dsbuf, format, arg_list);
- if (res >= 0) {
- for (i = 0; i < dsbuf.str_len; i+= 50)
- /* We print 50 characters at a time because otherwise
- the ramlog looks broken */
- ramlog_printf("%.*s",dsbuf.str_len-50 < 0?dsbuf.str_len:50,dsbuf.str+i);
- }
- if (dsbuf.str)
- free((void *) dsbuf.str);
- return res;
-}
-
-void
-erts_sys_pre_init(void)
-{
- erts_printf_add_cr_to_stdout = 1;
- erts_printf_add_cr_to_stderr = 1;
-#ifdef USE_THREADS
- {
- erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER;
-
- eid.thread_create_child_func = thr_create_prepare_child;
- /* Before creation in parent */
- eid.thread_create_prepare_func = thr_create_prepare;
- /* After creation in parent */
- eid.thread_create_parent_func = thr_create_cleanup,
-
- erts_thr_init(&eid);
-
- report_exit_list = NULL;
-
-#ifdef ERTS_ENABLE_LOCK_COUNT
- erts_lcnt_init();
-#endif
-
-#if defined(ERTS_SMP)
- erts_mtx_init(&chld_stat_mtx, "child_status");
-#endif
- }
-#ifdef ERTS_SMP
- erts_smp_atomic32_init_nob(&erts_break_requested, 0);
- erts_smp_atomic32_init_nob(&have_prepared_crash_dump, 0);
-#else
- erts_break_requested = 0;
- have_prepared_crash_dump = 0;
-#endif
-#if !defined(ERTS_SMP)
- children_died = 0;
-#endif
-#endif /* USE_THREADS */
-
- erts_printf_stdout_func = erts_sys_ramlog_printf;
-
- erts_smp_atomic_init_nob(&sys_misc_mem_sz, 0);
-}
-
-void
-erl_sys_init(void)
-{
-
-#ifdef USE_SETLINEBUF
- setlinebuf(stdout);
-#else
- setvbuf(stdout, (char *)NULL, _IOLBF, BUFSIZ);
-#endif
-
- erts_sys_init_float();
-
- /* we save this so the break handler can set and reset it properly */
- /* also so that we can reset on exit (break handler or not) */
- if (isatty(0)) {
- tcgetattr(0,&initial_tty_mode);
- }
- tzset(); /* Required at least for NetBSD with localtime_r() */
-}
-
-static ERTS_INLINE int
-prepare_crash_dump(int secs)
-{
-#define NUFBUF (3)
- int i, max;
- char env[21]; /* enough to hold any 64-bit integer */
- size_t envsz;
- /*DeclareTmpHeapNoproc(heap,NUFBUF);*/
- /*Eterm *hp = heap;*/
- /*Eterm list = NIL;*/
- int has_heart = 0;
-
- UseTmpHeapNoproc(NUFBUF);
-
- if (ERTS_PREPARED_CRASH_DUMP)
- return 0; /* We have already been called */
-
-
- /* Positive secs means an alarm must be set
- * 0 or negative means no alarm
- *
- * Set alarm before we try to write to a port
- * we don't want to hang on a port write with
- * no alarm.
- *
- */
-
-#if 0 /*ose TBD!!!*/
- if (secs >= 0) {
- alarm((unsigned int)secs);
- }
-#endif
-
- /* Make sure we unregister at epmd (unknown fd) and get at least
- one free filedescriptor (for erl_crash.dump) */
-
- max = max_files;
- if (max < 1024)
- max = 1024;
- for (i = 3; i < max; i++) {
- close(i);
- }
-
- envsz = sizeof(env);
- i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz);
- if (i >= 0) {
- int nice_val;
- nice_val = i != 0 ? 0 : atoi(env);
- if (nice_val > 39) {
- nice_val = 39;
- }
- set_pri(nice_val);
- }
-
- UnUseTmpHeapNoproc(NUFBUF);
-#undef NUFBUF
- return has_heart;
-}
-
-int erts_sys_prepare_crash_dump(int secs)
-{
- return prepare_crash_dump(secs);
-}
-
-static ERTS_INLINE void
-break_requested(void)
-{
- /*
- * just set a flag - checked for and handled by
- * scheduler threads erts_check_io() (not signal handler).
- */
-#ifdef DEBUG
- fprintf(stderr,"break!\n");
-#endif
- if (ERTS_BREAK_REQUESTED)
- erl_exit(ERTS_INTR_EXIT, "");
-
- ERTS_SET_BREAK_REQUESTED;
- ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
-}
-
-/* Disable break */
-void erts_set_ignore_break(void) {
-
-}
-
-/* Don't use ctrl-c for break handler but let it be
- used by the shell instead (see user_drv.erl) */
-void erts_replace_intr(void) {
- struct termios mode;
-
- if (isatty(0)) {
- tcgetattr(0, &mode);
-
- /* here's an example of how to replace ctrl-c with ctrl-u */
- /* mode.c_cc[VKILL] = 0;
- mode.c_cc[VINTR] = CKILL; */
-
- mode.c_cc[VINTR] = 0; /* disable ctrl-c */
- tcsetattr(0, TCSANOW, &mode);
- replace_intr = 1;
- }
-}
-
-void init_break_handler(void)
-{
-
-}
-
-int sys_max_files(void)
-{
- return(max_files);
-}
-
-
-/************************** OS info *******************************/
-
-/* Used by erlang:info/1. */
-/* (This code was formerly in drv.XXX/XXX_os_drv.c) */
-
-char os_type[] = "ose";
-
-void
-os_flavor(char* namebuf, /* Where to return the name. */
- unsigned size) /* Size of name buffer. */
-{
-#if 0
- struct utsname uts; /* Information about the system. */
- char* s;
-
- (void) uname(&uts);
- for (s = uts.sysname; *s; s++) {
- if (isupper((int) *s)) {
- *s = tolower((int) *s);
- }
- }
- strcpy(namebuf, uts.sysname);
-#else
- strncpy(namebuf, "release", size);
-#endif
-}
-
-void
-os_version(pMajor, pMinor, pBuild)
-int* pMajor; /* Pointer to major version. */
-int* pMinor; /* Pointer to minor version. */
-int* pBuild; /* Pointer to build number. */
-{
- *pMajor = 5;
- *pMinor = 7;
- *pBuild = 0;
-}
-
-void init_getenv_state(GETENV_STATE *state)
-{
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- *state = NULL;
-}
-
-char **environ; /*ose - needs replacement*/
-
-char *getenv_string(GETENV_STATE *state0)
-{
- char **state = (char **) *state0;
- char *cp;
-
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx));
-
- if (state == NULL)
- state = environ;
-
- cp = *state++;
- *state0 = (GETENV_STATE) state;
-
- return cp;
-}
-
-void fini_getenv_state(GETENV_STATE *state)
-{
- *state = NULL;
- erts_smp_rwmtx_runlock(&environ_rwmtx);
-}
-
-
-/************************** Port I/O *******************************/
-
-/* I. Common stuff */
-
-union SIGNAL {
- SIGSELECT sig_no;
- struct FmReadPtr fm_read_reply;
- struct FmWritePtr fm_write_reply;
- struct async async;
-};
-
-/* II. The spawn/fd drivers */
-
-/*
- * Decreasing the size of it below 16384 is not allowed.
- */
-#define ERTS_SYS_READ_BUF_SZ (64*1024)
-
-/* Driver interfaces */
-static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*);
-static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*);
-static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT,
- char **, ErlDrvSizeT);
-static int spawn_init(void);
-static void fd_stop(ErlDrvData);
-static void erl_stop(ErlDrvData);
-static void ready_input(ErlDrvData, ErlDrvEvent);
-static void ready_output(ErlDrvData, ErlDrvEvent);
-static void output(ErlDrvData, char*, ErlDrvSizeT);
-static void stop_select(ErlDrvEvent, void*);
-
-static PROCESS
-get_signal_proxy_pid(void) {
- union SIGNAL *sig;
- SIGSELECT any_sig[] = {1,ERTS_SIGNAL_OSE_DRV_ATTACH};
-
- if (!sig_proxy_pid) {
- sig = alloc(sizeof(union SIGNAL), ERTS_SIGNAL_OSE_DRV_ATTACH);
- hunt("ose_signal_driver_proxy", 0, NULL, &sig);
- sig = receive(any_sig);
- sig_proxy_pid = sender(&sig);
- free_buf(&sig);
- }
- ASSERT(sig_proxy_pid);
- return sig_proxy_pid;
-}
-
-static ErlDrvOseEventId
-resolve_signal(union SIGNAL* sig) {
- switch(sig->sig_no) {
-
- case FM_READ_PTR_REPLY:
- return (ErlDrvOseEventId)sig->fm_read_reply.handle;
-
- case FM_WRITE_PTR_REPLY:
- return (ErlDrvOseEventId)sig->fm_write_reply.handle;
-
- case ERTS_SIGNAL_OSE_DRV_ATTACH:
- return (ErlDrvOseEventId)sig->async.target;
-
- default:
- break;
- }
- return (ErlDrvOseEventId)-1;
-}
-
-struct erl_drv_entry spawn_driver_entry = {
- spawn_init,
- spawn_start,
- NULL, /* erl_stop, */
- output,
- ready_input,
- ready_output,
- "spawn",
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- ERL_DRV_FLAG_USE_PORT_LOCKING,
- NULL, NULL,
- stop_select
-};
-struct erl_drv_entry fd_driver_entry = {
- NULL,
- fd_start,
- fd_stop,
- output,
- ready_input,
- ready_output,
- "fd",
- NULL,
- NULL,
- fd_control,
- NULL,
- NULL,
- NULL, /* ready_async */
- NULL, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL, /* handle2 */
- NULL, /* process_exit */
- stop_select
-};
-
-static void
-set_spawn_fd(int local_fd, int remote_fd, PROCESS remote_pid) {
- PROCESS vm_pid;
- FmHandle handle;
- char env_val[55];
- char env_name[10];
- EfsStatus efs_res;
-
- /* get pid of pipevm and handle of chosen fd */
- efs_res = efs_examine_fd(local_fd, FLIB_FD_VMPID, &vm_pid, 0);
- DEBUG_CHECK_RES(efs_res, EFS_SUCCESS);
-
- /* setup the file descriptor to buffer per line */
- efs_res = efs_config_fd(local_fd, FLIB_FD_BUFMODE, FM_BUFF_LINE,
- FLIB_FD_BUFSIZE, 80, 0);
- DEBUG_CHECK_RES(efs_res, EFS_SUCCESS);
-
- /* duplicate handle and set spawn pid owner */
- efs_res = efs_dup_to(local_fd, remote_pid, &handle);
- DEBUG_CHECK_RES(efs_res, EFS_SUCCESS);
-
- sprintf(env_name, "FD%d", remote_fd);
-
- /* Syntax of the environment variable:
- * "FD#" "<pid of pipevm>,<handle>,<buffer mode>,<buff size>,<omode>" */
- sprintf(env_val, "0x%lx,0x%lx,%lu,%lu,0x%x",
- vm_pid, handle,
- FM_BUFF_LINE, 80,
- O_APPEND);
-
- set_env(remote_pid, env_name, env_val);
-}
-
-static ErlDrvData
-set_driver_data(ErlDrvPort port_num,
- int ifd,
- int ofd,
- int packet_bytes,
- int read_write,
- int exit_status,
- PROCESS pid)
-{
- Port *prt;
- ErtsSysReportExit *report_exit;
-
- prt = erts_drvport2port(port_num);
- if (prt != ERTS_INVALID_ERL_DRV_PORT) {
- prt->os_pid = pid;
- }
-
- /* READ */
- if (read_write & DO_READ) {
- EfsStatus res = efs_examine_fd(ifd, FLIB_FD_HANDLE,
- &driver_data[ifd].handle, 0);
- if (res != EFS_SUCCESS)
- ramlog_printf("%s:%d: efs_examine_fd(%d) failed with %d\n",
- __FILE__,__LINE__,ifd,errno);
- driver_data[ifd].ifd = ifd;
- driver_data[ifd].packet_bytes = packet_bytes;
- driver_data[ifd].port_num = port_num;
- driver_data[ifd].pid = pid;
-
- /* async read struct */
- memset(&driver_data[ifd].aiocb, 0, sizeof(struct aiocb));
- driver_data[ifd].aiocb.aio_buf = driver_alloc(AIO_PIPE_SIZE);
- driver_data[ifd].aiocb.aio_fildes = ifd;
- driver_data[ifd].aiocb.aio_nbytes = (packet_bytes?packet_bytes:AIO_PIPE_SIZE);
- driver_data[ifd].alive = 1;
- driver_data[ifd].status = 0;
- driver_data[ifd].input_event =
- erl_drv_ose_event_alloc(FM_READ_PTR_REPLY,
- driver_data[ifd].handle, resolve_signal,
- &driver_data[ifd].ifd);
-
- /* READ & WRITE */
- if (read_write & DO_WRITE) {
- driver_data[ifd].ofd = ofd;
- efs_examine_fd(ofd, FLIB_FD_HANDLE, &driver_data[ofd].handle, 0);
-
- driver_data[ifd].output_event =
- erl_drv_ose_event_alloc(FM_WRITE_PTR_REPLY,
- driver_data[ofd].handle, resolve_signal,
- &driver_data[ofd].ofd);
- driver_data[ofd].pid = pid;
- if (ifd != ofd) {
- driver_data[ofd] = driver_data[ifd];
- driver_data[ofd].aiocb.aio_buf = NULL;
- }
- }
- else { /* READ ONLY */
- driver_data[ifd].ofd = -1;
- }
-
- /* enable input event */
- (void) driver_select(port_num, driver_data[ifd].input_event,
- (ERL_DRV_READ | ERL_DRV_USE), 1);
-
- if (aio_read(&driver_data[ifd].aiocb))
- ramlog_printf("%s:%d: aio_read(%d) failed with %d\n",
- __FILE__,__LINE__,ifd,errno);
- }
- else { /* WRITE ONLY */
- efs_examine_fd(ofd, FLIB_FD_HANDLE, &driver_data[ofd].handle, 0);
- driver_data[ofd].packet_bytes = packet_bytes;
- driver_data[ofd].port_num = port_num;
- driver_data[ofd].ofd = ofd;
- driver_data[ofd].pid = pid;
- driver_data[ofd].alive = 1;
- driver_data[ofd].status = 0;
- driver_data[ofd].output_event =
- erl_drv_ose_event_alloc(FM_WRITE_PTR_REPLY, driver_data[ofd].handle,
- resolve_signal, &driver_data[ofd].ofd);
- driver_data[ofd].input_event = driver_data[ofd].output_event;
- }
-
- /* this is used for spawned load modules, and is needed
- * to properly uninstall them */
- if (exit_status) {
- struct PmProgramInfo *info;
- int install_handle_size;
- union SIGNAL *sig;
- PmStatus pm_status;
- report_exit = erts_alloc(ERTS_ALC_T_PRT_REP_EXIT,
- sizeof(ErtsSysReportExit));
- report_exit->next = report_exit_list;
- report_exit->port = erts_drvport2id(port_num);
- report_exit->pid = pid;
- report_exit->ifd = (read_write & DO_READ) ? ifd : -1;
- report_exit->ofd = (read_write & DO_WRITE) ? ofd : -1;
- report_exit_list = report_exit;
- report_exit->attach_event =
- erl_drv_ose_event_alloc(ERTS_SIGNAL_OSE_DRV_ATTACH, pid,
- resolve_signal, &driver_data[ifd].ifd);
-
- /* setup ifd and ofd report exit */
- driver_data[ifd].report_exit = report_exit;
- driver_data[ofd].report_exit = report_exit;
-
- pm_status = ose_pm_program_info(pid, &info);
- DEBUG_CHECK_RES(pm_status, PM_SUCCESS);
-
- install_handle_size = strlen(info->install_handle)+1;
- driver_data[ifd].install_handle = driver_alloc(install_handle_size);
- strcpy(driver_data[ifd].install_handle,
- info->install_handle);
-
- free_buf((union SIGNAL **)&info);
-
- sig = alloc(sizeof(struct async), ERTS_SIGNAL_OSE_DRV_ATTACH);
- sig->async.target = pid;
- send(&sig, get_signal_proxy_pid());
-
- /* this event will trigger when we receive an attach signal
- * from the recently dead load module */
- (void)driver_select(port_num,report_exit->attach_event, DO_READ, 1);
- }
- else {
- report_exit = NULL;
- }
-
- /* the return value is the pointer to the driver_data struct we created
- * in this function, it will be used in the drivers input
- * and output functions */
- return (ErlDrvData)((!(read_write & DO_READ) && read_write & DO_WRITE)
- ? &driver_data[ofd]
- : &driver_data[ifd]);
-}
-
-static int spawn_init()
-{
- int i;
-
- driver_data = (struct driver_data *)
- erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
- max_files * sizeof(struct driver_data));
-
- for (i = 0; i < max_files; i++)
- driver_data[i].pid = -1;
-
- return 1;
-}
-
-static void
-init_fd_data(int fd, ErlDrvPort port_num)
-{
- fd_data[fd].buf = NULL;
- fd_data[fd].cpos = NULL;
- fd_data[fd].remain = 0;
- fd_data[fd].sz = 0;
- fd_data[fd].psz = 0;
-}
-
-/* FIXME write a decent text on pipes on ose */
-static ErlDrvData
-spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts)
-{
- int ifd[2];
- int ofd[2];
- static uint32_t ticker = 1;
- PmStatus pm_status;
- OSDOMAIN domain = PM_NEW_DOMAIN;
- PROCESS progpid, mainbid, mainpid;
- char *handle = NULL;
- struct PmProgramInfo *info;
- char *args = NULL;
- char *tmp_handle;
- ErlDrvData res = (ErlDrvData)-1;
- int handle_size;
- char *ptr;
-
-
- args = driver_alloc(strlen(name)+1);
- strcpy(args, name);
- /* We need to handle name in three parts
- * - install handle (must be unique)
- * - install binary (needed for ose_pm_install_load_module())
- * - full path (as argument to the spawned applications env.var
- */
-
- /* full path including arguments */
- args = driver_alloc(strlen(name)+1);
- strcpy(args, name);
-
- /* handle path */
- tmp_handle = strrchr(name, '/');
- if (tmp_handle == NULL) {
- tmp_handle = name;
- }
- else {
- tmp_handle++;
- }
-
- /* handle args */
- ptr = strchr(tmp_handle, ' ');
- if (ptr != NULL) {
- *ptr = '\0';
- handle_size = ptr - tmp_handle;
- }
- else {
- handle_size = strlen(name)+1;
- }
-
- /* make room for ticker */
- handle_size += (ticker<10)?3:((ticker<100)?4:5);
- handle = driver_alloc(handle_size);
-
- do {
- snprintf(handle, handle_size, "%s_%d", tmp_handle, ticker);
- pm_status = ose_pm_install_load_module(0, "ELF", name, handle,
- 0, 0, NULL);
- ticker++;
- } while (pm_status == PM_EINSTALL_HANDLE_ALREADY_INSTALLED);
-
- if (pm_status != PM_SUCCESS) {
- errno = ENOSYS; /* FIXME add comment */
- return ERL_DRV_ERROR_ERRNO;
- }
-
- /* Create Program */
- pm_status = ose_pm_create_program(&domain, handle, 0, 0,
- NULL, &progpid, &mainbid);
- DEBUG_CHECK_RES(pm_status, PM_SUCCESS);
-
- /* Get the mainpid from the newly created program */
- pm_status = ose_pm_program_info(progpid, &info);
- DEBUG_CHECK_RES(pm_status, PM_SUCCESS);
-
- mainpid = info->main_process;
- free_buf ((union SIGNAL **)&info);
-
- /* pipevm needs to be started
- * pipe will return 0 if success, -1 if not,
- * errno will be set */
- if (pipe(ifd) != 0 || pipe(ofd) != 0) {
- DEBUG_CHECK_RES(0, -1);
- ASSERT(0);
- }
-
- /* setup driver data */
- res = set_driver_data(port_num, ofd[0], ifd[1], opts->packet_bytes,
- opts->read_write, 1 /* opts->exit_status */, progpid);
-
- /* init the fd_data array for read/write */
- init_fd_data(ofd[0], port_num);
- init_fd_data(ifd[1], port_num);
-
- /* setup additional configurations
- * for the spawned applications environment */
- if (args != NULL) {
- set_env(progpid, "ARGV", args);
- }
- set_env(mainbid, "EFS_RESOLVE_TMO", 0);
- set_spawn_fd(ifd[0], 0, mainpid);
- set_spawn_fd(ofd[1], 1, mainpid);
- set_spawn_fd(ofd[1], 2, mainpid);
-
- /* start the spawned program */
- pm_status = ose_pm_start_program(mainbid);
- DEBUG_CHECK_RES(pm_status, PM_SUCCESS);
-
- /* close unused fd's */
- close(ifd[0]);
- close(ofd[1]);
-
- if (handle) {
- driver_free(handle);
- }
-
- return (ErlDrvData)res;
-}
-
-#define FD_DEF_HEIGHT 24
-#define FD_DEF_WIDTH 80
-/* Control op */
-#define FD_CTRL_OP_GET_WINSIZE 100
-
-static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height)
-{
-#ifdef TIOCGWINSZ
- struct winsize ws;
- if (ioctl(fd,TIOCGWINSZ,&ws) == 0) {
- *width = (Uint32) ws.ws_col;
- *height = (Uint32) ws.ws_row;
- return 0;
- }
-#endif
- return -1;
-}
-
-static ErlDrvSSizeT fd_control(ErlDrvData drv_data,
- unsigned int command,
- char *buf, ErlDrvSizeT len,
- char **rbuf, ErlDrvSizeT rlen)
-{
- struct driver_data *data = (struct driver_data *)drv_data;
- char resbuff[2*sizeof(Uint32)];
- switch (command) {
- case FD_CTRL_OP_GET_WINSIZE:
- {
- Uint32 w,h;
- if (fd_get_window_size(data->ifd,&w,&h))
- return 0;
- memcpy(resbuff,&w,sizeof(Uint32));
- memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32));
- }
- break;
- default:
- return 0;
- }
- if (rlen < 2*sizeof(Uint32)) {
- *rbuf = driver_alloc(2*sizeof(Uint32));
- }
- memcpy(*rbuf,resbuff,2*sizeof(Uint32));
- return 2*sizeof(Uint32);
-}
-
-static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
- SysDriverOpts* opts)
-{
- ErlDrvData res;
-
- CHLD_STAT_LOCK;
- if (opts->read_write & DO_READ) {
- init_fd_data(opts->ifd, port_num);
- }
- if (opts->read_write & DO_WRITE) {
- init_fd_data(opts->ofd, port_num);
- }
- res = set_driver_data(port_num, opts->ifd, opts->ofd,
- opts->packet_bytes,
- opts->read_write, 0, -1);
- CHLD_STAT_UNLOCK;
- return res;
-}
-
-static void clear_fd_data(int fd)
-{
- if (fd_data[fd].sz > 0) {
- erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf);
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fd_data[fd].sz);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fd_data[fd].sz);
- }
- fd_data[fd].buf = NULL;
- fd_data[fd].sz = 0;
- fd_data[fd].remain = 0;
- fd_data[fd].cpos = NULL;
- fd_data[fd].psz = 0;
-}
-
-static void nbio_stop_fd(ErlDrvPort prt, ErlDrvEvent ev)
-{
- int *fd;
- driver_select(prt,ev,DO_READ|DO_WRITE,0);
- erl_drv_ose_event_fetch(ev, NULL, NULL, (void **)&fd);
- clear_fd_data(*fd);
- SET_BLOCKING(*fd);
-}
-
-static void fd_stop(ErlDrvData drv_data) /* Does not close the fds */
-{
- struct driver_data *data = (struct driver_data *)drv_data;
-
- if (data->ofd != -1) {
- if (data->ifd != data->ofd) { /* read and write */
- nbio_stop_fd(data->port_num, data->input_event);
- nbio_stop_fd(data->port_num, data->output_event);
- }
- else { /* write only */
- nbio_stop_fd(data->port_num, data->output_event);
- }
- }
- else { /* read only */
- nbio_stop_fd(data->port_num, data->input_event);
- }
-}
-
-
-static void erl_stop(ErlDrvData drv_data)
-{
- struct driver_data *data = (struct driver_data *)drv_data;
-
- CHLD_STAT_LOCK;
- data->pid = -1;
- CHLD_STAT_UNLOCK;
-
- if (data->ofd != -1) {
- if (data->ifd != data->ofd) { /* read and write */
- nbio_stop_fd(data->port_num, data->input_event);
- nbio_stop_fd(data->port_num, data->output_event);
- }
- else { /* write only */
- nbio_stop_fd(data->port_num, data->output_event);
- }
- }
- else { /* read only */
- nbio_stop_fd(data->port_num, data->input_event);
- }
- close(data->ifd);
- close(data->ofd);
-}
-
-/* The parameter e is a pointer to the driver_data structure
- * related to the fd to be used as output */
-static void output(ErlDrvData drv_data, char* buf, ErlDrvSizeT len)
-{
- ErlDrvSizeT sz;
- char lb[4];
- char* lbp;
- struct driver_data *data = (struct driver_data *)drv_data;
-
- if (((data->packet_bytes == 2) &&
- (len > 0xffff)) || (data->packet_bytes == 1 && len > 0xff)) {
- driver_failure_posix(data->port_num, EINVAL);
- return; /* -1; */
- }
- put_int32(len, lb);
- lbp = lb + (4-(data->packet_bytes));
-
- if ((sz = driver_sizeq(data->port_num)) > 0) {
- if (data->packet_bytes != 0) {
- driver_enq(data->port_num, lbp, data->packet_bytes);
- }
- driver_enq(data->port_num, buf, len);
-
- if (sz + len + data->packet_bytes >= (1 << 13))
- set_busy_port(data->port_num, 1);
- }
- else {
- char *pbbuf;
- if (data->packet_bytes != 0) {
- pbbuf = malloc(len + data->packet_bytes);
- int i;
- for (i = 0; i < data->packet_bytes; i++) {
- *pbbuf++ = *lbp++;
- }
- strncpy(pbbuf, buf, len);
- pbbuf -= data->packet_bytes;
- }
- driver_select(data->port_num, data->output_event,
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
- WRITE_AIO(data->ofd,
- (data->packet_bytes ? len+data->packet_bytes : len),
- (data->packet_bytes ? pbbuf : buf));
- if (data->packet_bytes != 0) free(pbbuf);
- }
- return; /* 0; */
-}
-
-/* This function is being run when we in recieve
- * either a read of 0 bytes, or the attach signal from a dying
- * spawned load module */
-static int port_inp_failure(ErlDrvPort port_num, ErlDrvEvent ready_fd, int res)
- /* Result: 0 (eof) or -1 (error) */
-{
- int *fd;
- SIGSELECT sig_no;
- ASSERT(res <= 0);
-
- erl_drv_ose_event_fetch(ready_fd,&sig_no, NULL, (void **)&fd);
- /* As we need to handle two signals, we do this in two steps */
- if (driver_data[*fd].alive) {
- report_exit_status(driver_data[*fd].report_exit, 0); /* status? */
- }
- else {
- driver_select(port_num,ready_fd,DO_READ|DO_WRITE,0);
- clear_fd_data(*fd);
- driver_report_exit(driver_data[*fd].port_num, driver_data[*fd].status);
- /* As we do not really know if the spawn has crashed or exited nicely
- * we do not check the result status of the following call.. FIXME
- * can we handle this in a better way? */
- ose_pm_uninstall_load_module(driver_data[*fd].install_handle);
- driver_free(driver_data[*fd].install_handle);
- driver_free((void *)driver_data[*fd].aiocb.aio_buf);
-
- close(*fd);
- }
-
- return 0;
-}
-
-/* The parameter e is a pointer to the driver_data structure
- * related to the fd to be used as output.
- * ready_fd is the event that triggered this call to ready_input */
-static void ready_input(ErlDrvData drv_data, ErlDrvEvent ready_fd)
-{
- int res;
- Uint h;
- char *buf;
- union SIGNAL *sig;
- struct driver_data *data = (struct driver_data *)drv_data;
-
- sig = erl_drv_ose_get_signal(ready_fd);
- ASSERT(sig);
-
-
- while (sig) {
- /* If we've recieved an attach signal, we need to handle
- * it in port_inp_failure */
- if (sig->sig_no == ERTS_SIGNAL_OSE_DRV_ATTACH) {
- port_inp_failure(data->port_num, ready_fd, 0);
- }
- else {
- res = sig->fm_read_reply.actual;
- if (res == 0) {
- port_inp_failure(data->port_num, ready_fd, res);
- break;
- }
-
- if (data->packet_bytes == 0) {
- if (res < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
- port_inp_failure(data->port_num, ready_fd, res);
- }
- }
- else if (res == 0) {
- /* read of 0 bytes, eof, otherside of pipe is assumed dead */
- port_inp_failure(data->port_num, ready_fd, res);
- break;
- }
- else {
- buf = driver_alloc(res);
- memcpy(buf, (void *)data->aiocb.aio_buf, res);
- driver_select(data->port_num, data->output_event,
- ERL_DRV_WRITE|ERL_DRV_USE, 1);
- driver_output(data->port_num, (char*) buf, res);
- driver_free(buf);
- }
- /* clear the previous read */
- memset(data->aiocb.aio_buf, 0, res);
-
- /* issue a new read */
- DISPATCH_AIO(sig);
- aio_read(&data->aiocb);
- }
- else if (data->packet_bytes && fd_data[data->ifd].remain > 0) {
- /* we've read a partial package, or a header */
-
- if (res == fd_data[data->ifd].remain) { /* we are done! */
- char *buf = data->aiocb.aio_buf;
- int i;
-
- /* do we have anything buffered? */
- if (fd_data[data->ifd].buf != NULL) {
- memcpy(fd_data[data->ifd].buf + fd_data[data->ifd].sz,
- buf, res);
- buf = fd_data[data->ifd].buf;
- }
-
- fd_data[data->ifd].sz += res;
- driver_output(data->port_num, buf, (fd_data[data->ifd].sz>0?fd_data[data->ifd].sz:res));
- clear_fd_data(data->ifd);
-
- /* clear the previous read */
- memset(data->aiocb.aio_buf, 0, res);
-
- /* issue a new read */
- DISPATCH_AIO(sig);
- data->aiocb.aio_nbytes = data->packet_bytes;
-
- if (data->aiocb.aio_buf == NULL) {
- port_inp_failure(data->port_num, ready_fd, -1);
- }
- aio_read(&data->aiocb);
- }
- else if(res < fd_data[data->ifd].remain) { /* received part of a package */
- if (fd_data[data->ifd].sz == 0) {
-
- fd_data[data->ifd].sz += res;
- memcpy(fd_data[data->ifd].buf, data->aiocb.aio_buf, res);
- fd_data[data->ifd].remain -= res;
- }
- else {
- memcpy(fd_data[data->ifd].buf + fd_data[data->ifd].sz,
- data->aiocb.aio_buf, res);
- fd_data[data->ifd].sz += res;
- fd_data[data->ifd].remain -= res;
- }
- /* clear the previous read */
- memset(data->aiocb.aio_buf, 0, res);
-
- /* issue a new read */
- DISPATCH_AIO(sig);
- data->aiocb.aio_nbytes = fd_data[data->ifd].remain;
-
- if (data->aiocb.aio_buf == NULL) {
- port_inp_failure(data->port_num, ready_fd, -1);
- }
- aio_read(&data->aiocb);
- }
- }
- else if (data->packet_bytes && fd_data[data->ifd].remain == 0) { /* we've recieved a header */
-
- /* analyze the header FIXME */
- switch (data->packet_bytes) {
- case 1: h = get_int8(data->aiocb.aio_buf); break;
- case 2: h = get_int16(data->aiocb.aio_buf); break;
- case 4: h = get_int32(data->aiocb.aio_buf); break;
- }
-
- fd_data[data->ifd].buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h + data->packet_bytes);
- fd_data[data->ifd].remain = ((h + data->packet_bytes) - res);
-
- /* clear the previous read */
- memset(data->aiocb.aio_buf, 0, data->packet_bytes);
-
- /* issue a new read */
- DISPATCH_AIO(sig);
- data->aiocb.aio_nbytes = h;
-
- if (data->aiocb.aio_buf == NULL) {
- port_inp_failure(data->port_num, ready_fd, -1);
- }
- aio_read(&data->aiocb);
- }
- }
- sig = erl_drv_ose_get_signal(ready_fd);
- }
-}
-
-
-/* The parameter e is a pointer to the driver_data structure
- * related to the fd to be used as output.
- * ready_fd is the event that triggered this call to ready_input */
-static void ready_output(ErlDrvData drv_data, ErlDrvEvent ready_fd)
-{
- SysIOVec *iov;
- int vlen;
- int res;
- union SIGNAL *sig;
- struct driver_data *data = (struct driver_data *)drv_data;
-
- sig = erl_drv_ose_get_signal(ready_fd);
- ASSERT(sig);
-
- while (sig != NULL) {
- if (sig->fm_write_reply.actual <= 0) {
- int status;
-
- status = efs_status_to_errno(sig->fm_write_reply.status);
- driver_select(data->port_num, ready_fd, ERL_DRV_WRITE, 0);
- DISPATCH_AIO(sig);
- FREE_AIO(sig->fm_write_reply.buffer);
-
- driver_failure_posix(data->port_num, status);
- }
- else { /* written bytes > 0 */
- iov = driver_peekq(data->port_num, &vlen);
- if (vlen > 0) {
- DISPATCH_AIO(sig);
- FREE_AIO(sig->fm_write_reply.buffer);
- res = driver_deq(data->port_num, iov[0].iov_len);
- if (res > 0) {
- iov = driver_peekq(data->port_num, &vlen);
- WRITE_AIO(data->ofd, iov[0].iov_len, iov[0].iov_base);
- }
- }
- else if (vlen == 0) {
- DISPATCH_AIO(sig);
- FREE_AIO(sig->fm_write_reply.buffer);
- }
-
- }
- sig = erl_drv_ose_get_signal(ready_fd);
- }
-}
-
-static void stop_select(ErlDrvEvent ready_fd, void* _)
-{
- int *fd;
- erl_drv_ose_event_fetch(ready_fd, NULL, NULL, (void **)&fd);
- erl_drv_ose_event_free(ready_fd);
- close(*fd);
-}
-
-
-void erts_do_break_handling(void)
-{
- struct termios temp_mode;
- int saved = 0;
-
- /*
- * Most functions that do_break() calls are intentionally not thread safe;
- * therefore, make sure that all threads but this one are blocked before
- * proceeding!
- */
- erts_smp_thr_progress_block();
-
- /* during break we revert to initial settings */
- /* this is done differently for oldshell */
- if (using_oldshell && !replace_intr) {
- SET_BLOCKING(1);
- }
- else if (isatty(0)) {
- tcgetattr(0,&temp_mode);
- tcsetattr(0,TCSANOW,&initial_tty_mode);
- saved = 1;
- }
-
- /* call the break handling function, reset the flag */
- do_break();
-
- fflush(stdout);
-
- /* after break we go back to saved settings */
- if (using_oldshell && !replace_intr) {
- SET_NONBLOCKING(1);
- }
- else if (saved) {
- tcsetattr(0,TCSANOW,&temp_mode);
- }
-
- erts_smp_thr_progress_unblock();
-}
-
-static pid_t
-getpid(void)
-{
- return get_bid(current_process());
-}
-
-int getpagesize(void)
-{
- return 1024;
-}
-
-
-/* Fills in the systems representation of the jam/beam process identifier.
-** The Pid is put in STRING representation in the supplied buffer,
-** no interpretatione of this should be done by the rest of the
-** emulator. The buffer should be at least 21 bytes long.
-*/
-void sys_get_pid(char *buffer, size_t buffer_size){
- pid_t p = getpid();
- /* Assume the pid is scalar and can rest in an unsigned long... */
- erts_snprintf(buffer, buffer_size, "%lu",(unsigned long) p);
-}
-
-int
-erts_sys_putenv_raw(char *key, char *value) {
- return erts_sys_putenv(key, value);
-}
-int
-erts_sys_putenv(char *key, char *value)
-{
- int res;
-
- erts_smp_rwmtx_rwlock(&environ_rwmtx);
- res = set_env(get_bid(current_process()), key,
- value);
- erts_smp_rwmtx_rwunlock(&environ_rwmtx);
- return res;
-}
-
-
-int
-erts_sys_unsetenv(char *key)
-{
- int res;
-
- erts_smp_rwmtx_rwlock(&environ_rwmtx);
- res = set_env(get_bid(current_process()),key,NULL);
- erts_smp_rwmtx_rwunlock(&environ_rwmtx);
-
- return res;
-}
-
-int
-erts_sys_getenv__(char *key, char *value, size_t *size)
-{
- int res;
- char *orig_value = get_env(get_bid(current_process()), key);
- if (!orig_value)
- res = -1;
- else {
- size_t len = sys_strlen(orig_value);
- if (len >= *size) {
- *size = len + 1;
- res = 1;
- }
- else {
- *size = len;
- sys_memcpy((void *) value, (void *) orig_value, len+1);
- res = 0;
- }
- free_buf((union SIGNAL **)&orig_value);
- }
- return res;
-}
-
-int
-erts_sys_getenv_raw(char *key, char *value, size_t *size) {
- return erts_sys_getenv(key, value, size);
-}
-
-/*
- * erts_sys_getenv
- * returns:
- * -1, if environment key is not set with a value
- * 0, if environment key is set and value fits into buffer res
- * 1, if environment key is set but does not fit into buffer res
- * res is set with the needed buffer res value
- */
-
-int
-erts_sys_getenv(char *key, char *value, size_t *size)
-{
- int res;
- erts_smp_rwmtx_rlock(&environ_rwmtx);
- res = erts_sys_getenv__(key, value, size);
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- return res;
-}
-
-void
-sys_init_io(void)
-{
- fd_data = (struct fd_data *)
- erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
- max_files * sizeof(struct fd_data));
-}
-
-extern const char pre_loaded_code[];
-extern Preload pre_loaded[];
-
-void erts_sys_alloc_init(void)
-{
-}
-
-void *erts_sys_alloc(ErtsAlcType_t t, void *x, Uint sz)
-{
- void *res = malloc((size_t) sz);
-#if HAVE_ERTS_MSEG
- if (!res) {
- erts_mseg_clear_cache();
- return malloc((size_t) sz);
- }
-#endif
- return res;
-}
-
-void *erts_sys_realloc(ErtsAlcType_t t, void *x, void *p, Uint sz)
-{
- void *res = realloc(p, (size_t) sz);
-#if HAVE_ERTS_MSEG
- if (!res) {
- erts_mseg_clear_cache();
- return realloc(p, (size_t) sz);
- }
-#endif
- return res;
-}
-
-void erts_sys_free(ErtsAlcType_t t, void *x, void *p)
-{
- free(p);
-}
-
-/* Return a pointer to a vector of names of preloaded modules */
-
-Preload*
-sys_preloaded(void)
-{
- return pre_loaded;
-}
-
-/* Return a pointer to preloaded code for module "module" */
-unsigned char*
-sys_preload_begin(Preload* p)
-{
- return p->code;
-}
-
-/* Clean up if allocated */
-void sys_preload_end(Preload* p)
-{
- /* Nothing */
-}
-
-/* Read a key from console (?) */
-
-int sys_get_key(fd)
-int fd;
-{
- int c;
- unsigned char rbuf[64];
-
- fflush(stdout); /* Flush query ??? */
-
- if ((c = read(fd,rbuf,64)) <= 0) {
- return c;
- }
-
- return rbuf[0];
-}
-
-
-#ifdef DEBUG
-
-extern int erts_initialized;
-void
-erl_assert_error(const char* expr, const char* func,
- const char* file, int line)
-{
- fflush(stdout);
- fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n",
- file, line, func, expr);
- fflush(stderr);
- ramlog_printf("%s:%d:%s() Assertion failed: %s\n",
- file, line, func, expr);
-
- abort();
-}
-
-void
-erl_debug(char* fmt, ...)
-{
- char sbuf[1024]; /* Temporary buffer. */
- va_list va;
-
- if (debug_log) {
- va_start(va, fmt);
- vsprintf(sbuf, fmt, va);
- va_end(va);
- fprintf(stderr, "%s", sbuf);
- }
-}
-
-#endif /* DEBUG */
-
-static ERTS_INLINE void
-report_exit_status(ErtsSysReportExit *rep, int status)
-{
- if (rep->ifd >= 0) {
- driver_data[rep->ifd].alive = 0;
- driver_data[rep->ifd].status = status;
- }
- if (rep->ofd >= 0) {
- driver_data[rep->ofd].alive = 0;
- driver_data[rep->ofd].status = status;
- }
-
- erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep);
-}
-
-#define ERTS_REPORT_EXIT_STATUS report_exit_status
-
-/*
- * Called from schedule() when it runs out of runnable processes,
- * or when Erlang code has performed INPUT_REDUCTIONS reduction
- * steps. runnable == 0 iff there are no runnable Erlang processes.
- */
-void
-erl_sys_schedule(int runnable)
-{
- ASSERT(get_fsem(current_process()) == 0);
-#ifdef ERTS_SMP
- ASSERT(erts_get_scheduler_data()->no == 1);
- ERTS_CHK_IO(!runnable);
-#else
- ERTS_CHK_IO( 1 );
-#endif
- ASSERT(get_fsem(current_process()) == 0);
- ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
-}
-
-
-#ifdef ERTS_SMP
-
-void
-erts_sys_main_thread(void)
-{
- erts_thread_disable_fpe();
-
- /* Become signal receiver thread... */
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_set_thread_name("signal_receiver");
-#endif
-
- while (1) {
- static const SIGSELECT sigsel[] = {0};
- union SIGNAL *msg = receive(sigsel);
-
- fprintf(stderr,"Main thread got message %d from 0x%x!!\r\n",
- msg->sig_no, sender(&msg));
- free_buf(&msg);
- }
-}
-
-#endif /* ERTS_SMP */
-
-void
-erl_sys_args(int* argc, char** argv)
-{
- int i, j;
-
- erts_smp_rwmtx_init(&environ_rwmtx, "environ");
-
- init_check_io();
-
- /* Handled arguments have been marked with NULL. Slide arguments
- not handled towards the beginning of argv. */
- for (i = 0, j = 0; i < *argc; i++) {
- if (argv[i])
- argv[j++] = argv[i];
- }
- *argc = j;
-
-}
diff --git a/erts/emulator/sys/ose/sys_float.c b/erts/emulator/sys/ose/sys_float.c
deleted file mode 100644
index 3d9abc6bd1..0000000000
--- a/erts/emulator/sys/ose/sys_float.c
+++ /dev/null
@@ -1,845 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2001-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "global.h"
-#include "erl_process.h"
-
-
-#ifdef NO_FPE_SIGNALS
-
-void
-erts_sys_init_float(void)
-{
-# ifdef SIGFPE
- sys_sigset(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */
-# endif
-}
-
-#else /* !NO_FPE_SIGNALS */
-
-#ifdef ERTS_SMP
-static erts_tsd_key_t fpe_key;
-
-/* once-only initialisation early in the main thread (via erts_sys_init_float()) */
-static void erts_init_fp_exception(void)
-{
- /* XXX: the wrappers prevent using a pthread destructor to
- deallocate the key's value; so when/where do we do that? */
- erts_tsd_key_create(&fpe_key);
-}
-
-void erts_thread_init_fp_exception(void)
-{
- unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe));
- *fpe = 0L;
- erts_tsd_set(fpe_key, fpe);
-}
-
-static ERTS_INLINE volatile unsigned long *erts_thread_get_fp_exception(void)
-{
- return (volatile unsigned long*)erts_tsd_get(fpe_key);
-}
-#else /* !SMP */
-#define erts_init_fp_exception() /*empty*/
-static volatile unsigned long fp_exception;
-#define erts_thread_get_fp_exception() (&fp_exception)
-#endif /* SMP */
-
-volatile unsigned long *erts_get_current_fp_exception(void)
-{
- Process *c_p;
-
- c_p = erts_get_current_process();
- if (c_p)
- return &c_p->fp_exception;
- return erts_thread_get_fp_exception();
-}
-
-static void set_current_fp_exception(unsigned long pc)
-{
- volatile unsigned long *fpexnp = erts_get_current_fp_exception();
- ASSERT(fpexnp != NULL);
- *fpexnp = pc;
-}
-
-void erts_fp_check_init_error(volatile unsigned long *fpexnp)
-{
- char buf[64];
- snprintf(buf, sizeof buf, "ERTS_FP_CHECK_INIT at %p: detected unhandled FPE at %p\r\n",
- __builtin_return_address(0), (void*)*fpexnp);
- if (write(2, buf, strlen(buf)) <= 0)
- erl_exit(ERTS_ABORT_EXIT, "%s", buf);
- *fpexnp = 0;
-#if defined(__i386__) || defined(__x86_64__)
- erts_restore_fpu();
-#endif
-}
-
-/* Is there no standard identifier for Darwin/MacOSX ? */
-#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
-#define __DARWIN__ 1
-#endif
-
-#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__)
-
-static void unmask_x87(void)
-{
- unsigned short cw;
-
- __asm__ __volatile__("fstcw %0" : "=m"(cw));
- cw &= ~(0x01|0x04|0x08); /* unmask IM, ZM, OM */
- __asm__ __volatile__("fldcw %0" : : "m"(cw));
-}
-
-/* mask x87 FPE, return true if the previous state was unmasked */
-static int mask_x87(void)
-{
- unsigned short cw;
- int unmasked;
-
- __asm__ __volatile__("fstcw %0" : "=m"(cw));
- unmasked = (cw & (0x01|0x04|0x08)) == 0;
- /* or just set cw = 0x37f */
- cw |= (0x01|0x04|0x08); /* mask IM, ZM, OM */
- __asm__ __volatile__("fldcw %0" : : "m"(cw));
- return unmasked;
-}
-
-static void unmask_sse2(void)
-{
- unsigned int mxcsr;
-
- __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr));
- mxcsr &= ~(0x003F|0x0680); /* clear exn flags, unmask OM, ZM, IM (not PM, UM, DM) */
- __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr));
-}
-
-/* mask SSE2 FPE, return true if the previous state was unmasked */
-static int mask_sse2(void)
-{
- unsigned int mxcsr;
- int unmasked;
-
- __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr));
- unmasked = (mxcsr & 0x0680) == 0;
- /* or just set mxcsr = 0x1f80 */
- mxcsr &= ~0x003F; /* clear exn flags */
- mxcsr |= 0x0680; /* mask OM, ZM, IM (not PM, UM, DM) */
- __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr));
- return unmasked;
-}
-
-#if defined(__x86_64__)
-
-static inline int cpu_has_sse2(void) { return 1; }
-
-#else /* !__x86_64__ */
-
-/*
- * Check if an x86-32 processor has SSE2.
- */
-static unsigned int xor_eflags(unsigned int mask)
-{
- unsigned int eax, edx;
-
- eax = mask; /* eax = mask */
- __asm__("pushfl\n\t"
- "popl %0\n\t" /* edx = original EFLAGS */
- "xorl %0, %1\n\t" /* eax = mask ^ EFLAGS */
- "pushl %1\n\t"
- "popfl\n\t" /* new EFLAGS = mask ^ original EFLAGS */
- "pushfl\n\t"
- "popl %1\n\t" /* eax = new EFLAGS */
- "xorl %0, %1\n\t" /* eax = new EFLAGS ^ old EFLAGS */
- "pushl %0\n\t"
- "popfl" /* restore original EFLAGS */
- : "=d"(edx), "=a"(eax)
- : "1"(eax));
- return eax;
-}
-
-static __inline__ unsigned int cpuid_eax(unsigned int op)
-{
- unsigned int eax, save_ebx;
-
- /* In PIC mode i386 reserves EBX. So we must save
- and restore it ourselves to not upset gcc. */
- __asm__(
- "movl %%ebx, %1\n\t"
- "cpuid\n\t"
- "movl %1, %%ebx"
- : "=a"(eax), "=m"(save_ebx)
- : "0"(op)
- : "cx", "dx");
- return eax;
-}
-
-static __inline__ unsigned int cpuid_edx(unsigned int op)
-{
- unsigned int eax, edx, save_ebx;
-
- /* In PIC mode i386 reserves EBX. So we must save
- and restore it ourselves to not upset gcc. */
- __asm__(
- "movl %%ebx, %2\n\t"
- "cpuid\n\t"
- "movl %2, %%ebx"
- : "=a"(eax), "=d"(edx), "=m"(save_ebx)
- : "0"(op)
- : "cx");
- return edx;
-}
-
-/* The AC bit, bit #18, is a new bit introduced in the EFLAGS
- * register on the Intel486 processor to generate alignment
- * faults. This bit cannot be set on the Intel386 processor.
- */
-static __inline__ int is_386(void)
-{
- return ((xor_eflags(1<<18) >> 18) & 1) == 0;
-}
-
-/* Newer x86 processors have a CPUID instruction, as indicated by
- * the ID bit (#21) in EFLAGS being modifiable.
- */
-static __inline__ int has_CPUID(void)
-{
- return (xor_eflags(1<<21) >> 21) & 1;
-}
-
-static int cpu_has_sse2(void)
-{
- unsigned int maxlev, features;
- static int has_sse2 = -1;
-
- if (has_sse2 >= 0)
- return has_sse2;
- has_sse2 = 0;
-
- if (is_386())
- return 0;
- if (!has_CPUID())
- return 0;
- maxlev = cpuid_eax(0);
- /* Intel A-step Pentium had a preliminary version of CPUID.
- It also didn't have SSE2. */
- if ((maxlev & 0xFFFFFF00) == 0x0500)
- return 0;
- /* If max level is zero then CPUID cannot report any features. */
- if (maxlev == 0)
- return 0;
- features = cpuid_edx(1);
- has_sse2 = (features & (1 << 26)) != 0;
-
- return has_sse2;
-}
-#endif /* !__x86_64__ */
-
-static void unmask_fpe(void)
-{
- __asm__ __volatile__("fnclex");
- unmask_x87();
- if (cpu_has_sse2())
- unmask_sse2();
-}
-
-static void unmask_fpe_conditional(int unmasked)
-{
- if (unmasked)
- unmask_fpe();
-}
-
-/* mask x86 FPE, return true if the previous state was unmasked */
-static int mask_fpe(void)
-{
- int unmasked;
-
- unmasked = mask_x87();
- if (cpu_has_sse2())
- unmasked |= mask_sse2();
- return unmasked;
-}
-
-void erts_restore_fpu(void)
-{
- __asm__ __volatile__("fninit");
- unmask_x87();
- if (cpu_has_sse2())
- unmask_sse2();
-}
-
-#elif defined(__sparc__) && defined(__linux__)
-
-#if defined(__arch64__)
-#define LDX "ldx"
-#define STX "stx"
-#else
-#define LDX "ld"
-#define STX "st"
-#endif
-
-static void unmask_fpe(void)
-{
- unsigned long fsr;
-
- __asm__(STX " %%fsr, %0" : "=m"(fsr));
- fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */
- fsr |= (0x1AUL << 23); /* enable NV, OF, DZ exceptions */
- __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr));
-}
-
-static void unmask_fpe_conditional(int unmasked)
-{
- if (unmasked)
- unmask_fpe();
-}
-
-/* mask SPARC FPE, return true if the previous state was unmasked */
-static int mask_fpe(void)
-{
- unsigned long fsr;
- int unmasked;
-
- __asm__(STX " %%fsr, %0" : "=m"(fsr));
- unmasked = ((fsr >> 23) & 0x1A) == 0x1A;
- fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */
- __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr));
- return unmasked;
-}
-
-#elif (defined(__powerpc__) && defined(__linux__)) || (defined(__ppc__) && defined(__DARWIN__))
-
-#if defined(__linux__)
-#include <sys/prctl.h>
-
-static void set_fpexc_precise(void)
-{
- if (prctl(PR_SET_FPEXC, PR_FP_EXC_PRECISE) < 0) {
- perror("PR_SET_FPEXC");
- exit(1);
- }
-}
-
-#elif defined(__DARWIN__)
-
-#include <mach/mach.h>
-#include <pthread.h>
-
-/*
- * FE0 FE1 MSR bits
- * 0 0 floating-point exceptions disabled
- * 0 1 floating-point imprecise nonrecoverable
- * 1 0 floating-point imprecise recoverable
- * 1 1 floating-point precise mode
- *
- * Apparently:
- * - Darwin 5.5 (MacOS X <= 10.1) starts with FE0 == FE1 == 0,
- * and resets FE0 and FE1 to 0 after each SIGFPE.
- * - Darwin 6.0 (MacOS X 10.2) starts with FE0 == FE1 == 1,
- * and does not reset FE0 or FE1 after a SIGFPE.
- */
-#define FE0_MASK (1<<11)
-#define FE1_MASK (1<<8)
-
-/* a thread cannot get or set its own MSR bits */
-static void *fpu_fpe_enable(void *arg)
-{
- thread_t t = *(thread_t*)arg;
- struct ppc_thread_state state;
- unsigned int state_size = PPC_THREAD_STATE_COUNT;
-
- if (thread_get_state(t, PPC_THREAD_STATE, (natural_t*)&state, &state_size) != KERN_SUCCESS) {
- perror("thread_get_state");
- exit(1);
- }
- if ((state.srr1 & (FE1_MASK|FE0_MASK)) != (FE1_MASK|FE0_MASK)) {
-#if 1
- /* This would also have to be performed in the SIGFPE handler
- to work around the MSR reset older Darwin releases do. */
- state.srr1 |= (FE1_MASK|FE0_MASK);
- thread_set_state(t, PPC_THREAD_STATE, (natural_t*)&state, state_size);
-#else
- fprintf(stderr, "srr1 == 0x%08x, your Darwin is too old\n", state.srr1);
- exit(1);
-#endif
- }
- return NULL; /* Ok, we appear to be on Darwin 6.0 or later */
-}
-
-static void set_fpexc_precise(void)
-{
- thread_t self = mach_thread_self();
- pthread_t enabler;
-
- if (pthread_create(&enabler, NULL, fpu_fpe_enable, &self)) {
- perror("pthread_create");
- } else if (pthread_join(enabler, NULL)) {
- perror("pthread_join");
- }
-}
-
-#endif
-
-static void set_fpscr(unsigned int fpscr)
-{
- union {
- double d;
- unsigned int fpscr[2];
- } u;
-
- u.fpscr[0] = 0xFFF80000;
- u.fpscr[1] = fpscr;
- __asm__ __volatile__("mtfsf 255,%0" : : "f"(u.d));
-}
-
-static unsigned int get_fpscr(void)
-{
- union {
- double d;
- unsigned int fpscr[2];
- } u;
-
- __asm__("mffs %0" : "=f"(u.d));
- return u.fpscr[1];
-}
-
-static void unmask_fpe(void)
-{
- set_fpexc_precise();
- set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */
-}
-
-static void unmask_fpe_conditional(int unmasked)
-{
- if (unmasked)
- unmask_fpe();
-}
-
-/* mask PowerPC FPE, return true if the previous state was unmasked */
-static int mask_fpe(void)
-{
- int unmasked;
-
- unmasked = (get_fpscr() & (0x80|0x40|0x10)) == (0x80|0x40|0x10);
- set_fpscr(0x00);
- return unmasked;
-}
-
-#else
-
-static void unmask_fpe(void)
-{
- fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ);
-}
-
-static void unmask_fpe_conditional(int unmasked)
-{
- if (unmasked)
- unmask_fpe();
-}
-
-/* mask IEEE FPE, return true if previous state was unmasked */
-static int mask_fpe(void)
-{
- const fp_except unmasked_mask = FP_X_INV | FP_X_OFL | FP_X_DZ;
- fp_except old_mask;
-
- old_mask = fpsetmask(0);
- return (old_mask & unmasked_mask) == unmasked_mask;
-}
-
-#endif
-
-#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || ((defined(__NetBSD__) || defined(__OpenBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__))
-
-#if defined(__linux__) && defined(__i386__)
-#if !defined(X86_FXSR_MAGIC)
-#define X86_FXSR_MAGIC 0x0000
-#endif
-#elif defined(__FreeBSD__) && defined(__x86_64__)
-#include <sys/types.h>
-#include <machine/fpu.h>
-#elif defined(__FreeBSD__) && defined(__i386__)
-#include <sys/types.h>
-#include <machine/npx.h>
-#elif defined(__DARWIN__)
-#include <machine/signal.h>
-#elif defined(__OpenBSD__) && defined(__x86_64__)
-#include <sys/types.h>
-#include <machine/fpu.h>
-#endif
-#if !(defined(__OpenBSD__) && defined(__x86_64__))
-#include <ucontext.h>
-#endif
-#include <string.h>
-
-#if defined(__linux__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->gregs[REG_RIP])
-#elif defined(__linux__) && defined(__i386__)
-#define mc_pc(mc) ((mc)->gregs[REG_EIP])
-#elif defined(__DARWIN__) && defined(__i386__)
-#ifdef DARWIN_MODERN_MCONTEXT
-#define mc_pc(mc) ((mc)->__ss.__eip)
-#else
-#define mc_pc(mc) ((mc)->ss.eip)
-#endif
-#elif defined(__DARWIN__) && defined(__x86_64__)
-#ifdef DARWIN_MODERN_MCONTEXT
-#define mc_pc(mc) ((mc)->__ss.__rip)
-#else
-#define mc_pc(mc) ((mc)->ss.rip)
-#endif
-#elif defined(__FreeBSD__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->mc_rip)
-#elif defined(__FreeBSD__) && defined(__i386__)
-#define mc_pc(mc) ((mc)->mc_eip)
-#elif defined(__NetBSD__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->__gregs[_REG_RIP])
-#elif defined(__NetBSD__) && defined(__i386__)
-#define mc_pc(mc) ((mc)->__gregs[_REG_EIP])
-#elif defined(__OpenBSD__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->sc_rip)
-#elif defined(__sun__) && defined(__x86_64__)
-#define mc_pc(mc) ((mc)->gregs[REG_RIP])
-#endif
-
-static void fpe_sig_action(int sig, siginfo_t *si, void *puc)
-{
- ucontext_t *uc = puc;
- unsigned long pc;
-
-#if defined(__linux__)
-#if defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- fpregset_t fpstate = mc->fpregs;
- pc = mc_pc(mc);
- /* A failed SSE2 instruction will restart. To avoid
- looping we mask SSE2 exceptions now and unmask them
- again later in erts_check_fpe()/erts_restore_fpu().
- On RISCs we update PC to skip the failed instruction,
- but the ever increasing complexity of the x86 instruction
- set encoding makes that a poor solution here. */
- fpstate->mxcsr = 0x1F80;
- fpstate->swd &= ~0xFF;
-#elif defined(__i386__)
- mcontext_t *mc = &uc->uc_mcontext;
- fpregset_t fpstate = mc->fpregs;
- pc = mc_pc(mc);
- if ((fpstate->status >> 16) == X86_FXSR_MAGIC)
- ((struct _fpstate*)fpstate)->mxcsr = 0x1F80;
- fpstate->sw &= ~0xFF;
-#elif defined(__sparc__) && defined(__arch64__)
- /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */
- struct sigcontext *sc = (struct sigcontext*)puc;
- pc = sc->sigc_regs.tpc;
- sc->sigc_regs.tpc = sc->sigc_regs.tnpc;
- sc->sigc_regs.tnpc += 4;
-#elif defined(__sparc__)
- /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */
- struct sigcontext *sc = (struct sigcontext*)puc;
- pc = sc->si_regs.pc;
- sc->si_regs.pc = sc->si_regs.npc;
- sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4;
-#elif defined(__powerpc__)
-#if defined(__powerpc64__)
- mcontext_t *mc = &uc->uc_mcontext;
- unsigned long *regs = &mc->gp_regs[0];
-#else
- mcontext_t *mc = uc->uc_mcontext.uc_regs;
- unsigned long *regs = &mc->gregs[0];
-#endif
- pc = regs[PT_NIP];
- regs[PT_NIP] += 4;
- regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */
-#endif
-#elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__))
-#ifdef DARWIN_MODERN_MCONTEXT
- mcontext_t mc = uc->uc_mcontext;
- pc = mc_pc(mc);
- mc->__fs.__fpu_mxcsr = 0x1F80;
- *(unsigned short *)&mc->__fs.__fpu_fsw &= ~0xFF;
-#else
- mcontext_t mc = uc->uc_mcontext;
- pc = mc_pc(mc);
- mc->fs.fpu_mxcsr = 0x1F80;
- *(unsigned short *)&mc->fs.fpu_fsw &= ~0xFF;
-#endif /* DARWIN_MODERN_MCONTEXT */
-#elif defined(__DARWIN__) && defined(__ppc__)
- mcontext_t mc = uc->uc_mcontext;
- pc = mc->ss.srr0;
- mc->ss.srr0 += 4;
- mc->fs.fpscr = 0x80|0x40|0x10;
-#elif defined(__FreeBSD__) && defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- struct savefpu *savefpu = (struct savefpu*)&mc->mc_fpstate;
- struct envxmm *envxmm = &savefpu->sv_env;
- pc = mc_pc(mc);
- envxmm->en_mxcsr = 0x1F80;
- envxmm->en_sw &= ~0xFF;
-#elif defined(__FreeBSD__) && defined(__i386__)
- mcontext_t *mc = &uc->uc_mcontext;
- union savefpu *savefpu = (union savefpu*)&mc->mc_fpstate;
- pc = mc_pc(mc);
- if (mc->mc_fpformat == _MC_FPFMT_XMM) {
- struct envxmm *envxmm = &savefpu->sv_xmm.sv_env;
- envxmm->en_mxcsr = 0x1F80;
- envxmm->en_sw &= ~0xFF;
- } else {
- struct env87 *env87 = &savefpu->sv_87.sv_env;
- env87->en_sw &= ~0xFF;
- }
-#elif defined(__NetBSD__) && defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- struct fxsave64 *fxsave = (struct fxsave64 *)&mc->__fpregs;
- pc = mc_pc(mc);
- fxsave->fx_mxcsr = 0x1F80;
- fxsave->fx_fsw &= ~0xFF;
-#elif defined(__NetBSD__) && defined(__i386__)
- mcontext_t *mc = &uc->uc_mcontext;
- pc = mc_pc(mc);
- if (uc->uc_flags & _UC_FXSAVE) {
- struct envxmm *envxmm = (struct envxmm *)&mc->__fpregs;
- envxmm->en_mxcsr = 0x1F80;
- envxmm->en_sw &= ~0xFF;
- } else {
- struct env87 *env87 = (struct env87 *)&mc->__fpregs;
- env87->en_sw &= ~0xFF;
- }
-#elif defined(__OpenBSD__) && defined(__x86_64__)
- struct fxsave64 *fxsave = uc->sc_fpstate;
- pc = mc_pc(uc);
- fxsave->fx_mxcsr = 0x1F80;
- fxsave->fx_fsw &= ~0xFF;
-#elif defined(__sun__) && defined(__x86_64__)
- mcontext_t *mc = &uc->uc_mcontext;
- struct fpchip_state *fpstate = &mc->fpregs.fp_reg_set.fpchip_state;
- pc = mc_pc(mc);
- fpstate->mxcsr = 0x1F80;
- fpstate->sw &= ~0xFF;
-#endif
-#if 0
- {
- char buf[64];
- snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc);
- write(2, buf, strlen(buf));
- }
-#endif
- set_current_fp_exception(pc);
-}
-
-static void erts_thread_catch_fp_exceptions(void)
-{
- struct sigaction act;
- memset(&act, 0, sizeof act);
- act.sa_sigaction = fpe_sig_action;
- act.sa_flags = SA_SIGINFO;
- sigaction(SIGFPE, &act, NULL);
- unmask_fpe();
-}
-
-#else /* !((__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */
-
-static void fpe_sig_handler(int sig)
-{
- set_current_fp_exception(1); /* XXX: convert to sigaction so we can get the trap PC */
-}
-
-static void erts_thread_catch_fp_exceptions(void)
-{
- sys_sigset(SIGFPE, fpe_sig_handler);
- unmask_fpe();
-}
-
-#endif /* (__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */
-
-/* once-only initialisation early in the main thread */
-void erts_sys_init_float(void)
-{
- erts_init_fp_exception();
- erts_thread_catch_fp_exceptions();
- erts_printf_block_fpe = erts_sys_block_fpe;
- erts_printf_unblock_fpe = erts_sys_unblock_fpe;
-}
-
-#endif /* NO_FPE_SIGNALS */
-
-void erts_thread_init_float(void)
-{
-#ifdef ERTS_SMP
- /* This allows Erlang schedulers to leave Erlang-process context
- and still have working FP exceptions. XXX: is this needed? */
- erts_thread_init_fp_exception();
-#endif
-
-#ifndef NO_FPE_SIGNALS
- /* NOTE:
- * erts_thread_disable_fpe() is called in all threads at
- * creation. We at least need to call unmask_fpe()
- */
-#if defined(__DARWIN__) || defined(__FreeBSD__)
- /* Darwin (7.9.0) does not appear to propagate FP exception settings
- to a new thread from its parent. So if we want FP exceptions, we
- must manually re-enable them in each new thread.
- FreeBSD 6.1 appears to suffer from a similar issue. */
- erts_thread_catch_fp_exceptions();
-#else
- unmask_fpe();
-#endif
-
-#endif
-}
-
-void erts_thread_disable_fpe(void)
-{
-#if !defined(NO_FPE_SIGNALS)
- (void)mask_fpe();
-#endif
-}
-
-#if !defined(NO_FPE_SIGNALS)
-int erts_sys_block_fpe(void)
-{
- return mask_fpe();
-}
-
-void erts_sys_unblock_fpe(int unmasked)
-{
- unmask_fpe_conditional(unmasked);
-}
-#endif
-
-/* The following check is incorporated from the Vee machine */
-
-#define ISDIGIT(d) ((d) >= '0' && (d) <= '9')
-
-/*
- ** Convert a double to ascii format 0.dddde[+|-]ddd
- ** return number of characters converted or -1 if error.
- **
- ** These two functions should maybe use localeconv() to pick up
- ** the current radix character, but since it is uncertain how
- ** expensive such a system call is, and since no-one has heard
- ** of other radix characters than '.' and ',' an ad-hoc
- ** low execution time solution is used instead.
- */
-
-int
-sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t decimals)
-{
- char *s = buffer;
-
- if (erts_snprintf(buffer, buffer_size, "%.*e", decimals, fp) >= buffer_size)
- return -1;
- /* Search upto decimal point */
- if (*s == '+' || *s == '-') s++;
- while (ISDIGIT(*s)) s++;
- if (*s == ',') *s++ = '.'; /* Replace ',' with '.' */
- /* Scan to end of string */
- while (*s) s++;
- return s-buffer; /* i.e strlen(buffer) */
-}
-
-/* Float conversion */
-
-int
-sys_chars_to_double(char* buf, double* fp)
-{
-#ifndef NO_FPE_SIGNALS
- volatile unsigned long *fpexnp = erts_get_current_fp_exception();
-#endif
- char *s = buf, *t, *dp;
-
- /* Robert says that something like this is what he really wanted:
- * (The [.,] radix test is NOT what Robert wanted - it was added later)
- *
- * 7 == sscanf(Tbuf, "%[+-]%[0-9][.,]%[0-9]%[eE]%[+-]%[0-9]%s", ....);
- * if (*s2 == 0 || *s3 == 0 || *s4 == 0 || *s6 == 0 || *s7)
- * break;
- */
-
- /* Scan string to check syntax. */
- if (*s == '+' || *s == '-') s++;
- if (!ISDIGIT(*s)) /* Leading digits. */
- return -1;
- while (ISDIGIT(*s)) s++;
- if (*s != '.' && *s != ',') /* Decimal part. */
- return -1;
- dp = s++; /* Remember decimal point pos just in case */
- if (!ISDIGIT(*s))
- return -1;
- while (ISDIGIT(*s)) s++;
- if (*s == 'e' || *s == 'E') {
- /* There is an exponent. */
- s++;
- if (*s == '+' || *s == '-') s++;
- if (!ISDIGIT(*s))
- return -1;
- while (ISDIGIT(*s)) s++;
- }
- if (*s) /* That should be it */
- return -1;
-
-#ifdef NO_FPE_SIGNALS
- errno = 0;
-#endif
- __ERTS_FP_CHECK_INIT(fpexnp);
- *fp = strtod(buf, &t);
- __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1);
- if (t != s) { /* Whole string not scanned */
- /* Try again with other radix char */
- *dp = (*dp == '.') ? ',' : '.';
- errno = 0;
- __ERTS_FP_CHECK_INIT(fpexnp);
- *fp = strtod(buf, &t);
- __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1);
- }
-
-#ifdef NO_FPE_SIGNALS
- if (errno == ERANGE) {
- if (*fp == HUGE_VAL || *fp == -HUGE_VAL) {
- /* overflow, should give error */
- return -1;
- } else if (t == s && *fp == 0.0) {
- /* This should give 0.0 - OTP-7178 */
- errno = 0;
-
- } else if (*fp == 0.0) {
- return -1;
- }
- }
-#endif
- return 0;
-}
-
-int
-matherr(struct exception *exc)
-{
-#if !defined(NO_FPE_SIGNALS)
- volatile unsigned long *fpexnp = erts_get_current_fp_exception();
- if (fpexnp != NULL)
- *fpexnp = (unsigned long)__builtin_return_address(0);
-#endif
- return 1;
-}
diff --git a/erts/emulator/sys/ose/sys_time.c b/erts/emulator/sys/ose/sys_time.c
deleted file mode 100644
index 5dac75956a..0000000000
--- a/erts/emulator/sys/ose/sys_time.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2005-2009. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include "sys.h"
-#include "global.h"
-
-/******************* Routines for time measurement *********************/
-
-int erts_ticks_per_sec = 0; /* Will be SYS_CLK_TCK in erl_unix_sys.h */
-
-int sys_init_time(void)
-{
- return SYS_CLOCK_RESOLUTION;
-}
-
-clock_t sys_times(SysTimes *now) {
- now->tms_utime = now->tms_stime = now->tms_cutime = now->tms_cstime = 0;
- return 0;
-}
-
-static OSTICK last_tick_count = 0;
-static SysHrTime wrap = 0;
-static OSTICK us_per_tick;
-
-void sys_init_hrtime() {
- us_per_tick = system_tick();
-}
-
-SysHrTime sys_gethrtime() {
- OSTICK ticks = get_ticks();
- if (ticks < (SysHrTime) last_tick_count) {
- wrap += 1ULL << 32;
- }
- last_tick_count = ticks;
- return ((((SysHrTime) ticks) + wrap) * 1000*us_per_tick);
-}
diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c
index a3c5c20641..8dd14bbac6 100644
--- a/erts/emulator/sys/unix/erl_child_setup.c
+++ b/erts/emulator/sys/unix/erl_child_setup.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2002-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2002-2015. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -19,109 +19,234 @@
*/
/*
- * After a vfork() (or fork()) the child exec()s to this program which
- * sets up the child and exec()s to the user program (see spawn_start()
- * in sys.c and ticket OTP-4389).
+ * This program is started at erts startup and all fork's that
+ * have to be done are done in here. This is done for a couple
+ * of reasons:
+ * - Allow usage of fork without a memory explosion.
+ * -- we do not want to use vfork, as it blocks the VM
+ * until the execv is done, and if the program that
+ * is to be executed is on an NFS that is unavailable,
+ * the execv can block for a very long time.
+ * -- we cannot do fork inside the VM as that would temporarily
+ * duplicate the memory usage of the VM per parallel exec.
+ *
+ * Some implementation notes:
+ * - A single Unix Domain Socket is setup in between the VM and
+ * this program. Over that UDS the file descriptors that should
+ * be used to talk to the child program are sent.
+ * The actual command to execute, together with options and the
+ * environment, is sent over the pipe represented by the
+ * file descriptors mentioned above. We don't send the
+ * command over the UDS as that would increase the likely hood
+ * that it's buffer would be full.
+ *
+ * - Since it is this program that execv's, it has to take care of
+ * all the SIGCHLD signals that the child programs generate. The
+ * signals are received and the pid+exit reason is sent as data
+ * on the UDS to the VM. The VM is then able to map the pid to the
+ * port of the child program that just exited and deliver the status
+ * code if requested.
*/
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
-#define NEED_CHILD_SETUP_DEFINES
-#include "sys.h"
-#include "erl_misc_utils.h"
+#include <stdlib.h>
+#include <stdio.h>
+#include <sys/wait.h>
-#ifdef SIG_SIGSET /* Old SysV */
-void sys_sigrelease(int sig)
+#define WANT_NONBLOCKING
+
+#include "erl_driver.h"
+#include "sys_uds.h"
+#include "hash.h"
+#include "erl_term.h"
+#include "erl_child_setup.h"
+
+#define SET_CLOEXEC(fd) fcntl(fd, F_SETFD, fcntl(fd, F_GETFD) | FD_CLOEXEC)
+
+#if defined(__ANDROID__)
+#define SHELL "/system/bin/sh"
+#else
+#define SHELL "/bin/sh"
+#endif /* __ANDROID__ */
+
+//#define HARD_DEBUG
+#ifdef HARD_DEBUG
+#define DEBUG_PRINT(fmt, ...) fprintf(stderr, fmt "\r\n", ##__VA_ARGS__)
+#else
+#define DEBUG_PRINT(fmt, ...)
+#endif
+
+#define ABORT(fmt, ...) do { \
+ fprintf(stderr, "erl_child_setup: " fmt "\r\n", ##__VA_ARGS__); \
+ abort(); \
+ } while(0)
+
+#ifdef DEBUG
+void
+erl_assert_error(const char* expr, const char* func, const char* file, int line)
{
- sigrelse(sig);
+ fflush(stdout);
+ fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n",
+ file, line, func, expr);
+ fflush(stderr);
+ abort();
}
-#else /* !SIG_SIGSET */
-#ifdef SIG_SIGNAL /* Old BSD */
-sys_sigrelease(int sig)
+#endif
+
+void sys_sigblock(int sig)
{
- sigsetmask(sigblock(0) & ~sigmask(sig));
+ sigset_t mask;
+
+ sigemptyset(&mask);
+ sigaddset(&mask, sig);
+ sigprocmask(SIG_BLOCK, &mask, (sigset_t *)NULL);
}
-#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */
+
void sys_sigrelease(int sig)
{
sigset_t mask;
-
sigemptyset(&mask);
sigaddset(&mask, sig);
sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL);
}
-#endif /* !SIG_SIGNAL */
-#endif /* !SIG_SIGSET */
-
-#if defined(__ANDROID__)
-static int system_properties_fd(void);
-#endif /* __ANDROID__ */
-#if defined(__ANDROID__)
-#define SHELL "/system/bin/sh"
-#else
-#define SHELL "/bin/sh"
-#endif /* __ANDROID__ */
+static void add_os_pid_to_port_id_mapping(Eterm, pid_t);
+static Eterm get_port_id(pid_t);
+static int forker_hash_init(void);
+static int max_files = -1;
+static int sigchld_pipe[2];
-int
-main(int argc, char *argv[])
+static int
+start_new_child(int pipes[])
{
- int i, from, to;
- int erts_spawn_executable = 0;
+ int size, res, i, pos = 0;
+ char *buff, *o_buff;
+
+ char *cmd, *wd, **new_environ, **args = NULL;
+
+ Sint cnt, flags;
- /* OBSERVE!
- * Keep child setup after fork() (implemented in sys.c) up to date
- * if changes are made here.
- */
+ /* only child executes here */
- if (argc != CS_ARGV_NO_OF_ARGS) {
- if (argc < CS_ARGV_NO_OF_ARGS) {
- return 1;
- } else {
- erts_spawn_executable = 1;
- }
+ do {
+ res = read(pipes[0], (char*)&size, sizeof(size));
+ } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK));
+
+ if (res <= 0) {
+ goto child_error;
}
- if (strcmp("false", argv[CS_ARGV_UNBIND_IX]) != 0)
- if (erts_unbind_from_cpu_str(argv[CS_ARGV_UNBIND_IX]) != 0)
- return 1;
+ buff = malloc(size);
+
+ DEBUG_PRINT("size = %d", size);
+
+ do {
+ if ((res = read(pipes[0], buff + pos, size - pos)) < 0) {
+ if (errno == ERRNO_BLOCK || errno == EINTR)
+ continue;
+ goto child_error;
+ }
+ if (res == 0) {
+ errno = EPIPE;
+ goto child_error;
+ }
+ pos += res;
+ } while(size - pos != 0);
+
+ o_buff = buff;
+
+ flags = get_int32(buff);
+ buff += sizeof(Sint32);
- for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) {
- if (argv[CS_ARGV_DUP2_OP_IX(i)][0] == '-'
- && argv[CS_ARGV_DUP2_OP_IX(i)][1] == '\0')
- break;
- if (sscanf(argv[CS_ARGV_DUP2_OP_IX(i)], "%d:%d", &from, &to) != 2)
- return 1;
- if (dup2(from, to) < 0)
- return 1;
+ DEBUG_PRINT("flags = %d", flags);
+
+ cmd = buff;
+ buff += strlen(buff) + 1;
+ if (*buff == '\0') {
+ wd = NULL;
+ } else {
+ wd = buff;
+ buff += strlen(buff) + 1;
}
+ buff++;
- if (sscanf(argv[CS_ARGV_FD_CR_IX], "%d:%d", &from, &to) != 2)
- return 1;
+ DEBUG_PRINT("wd = %s", wd);
-#if defined(HAVE_CLOSEFROM)
- closefrom(from);
-#elif defined(__ANDROID__)
- if (from <= to) {
- int spfd = system_properties_fd();
- for (i = from; i <= to; i++) {
- if (i != spfd) {
- (void) close(i);
- }
- }
+ cnt = get_int32(buff);
+ buff += sizeof(Sint32);
+ new_environ = malloc(sizeof(char*)*(cnt + 1));
+
+ DEBUG_PRINT("env_len = %ld", cnt);
+ for (i = 0; i < cnt; i++, buff++) {
+ new_environ[i] = buff;
+ while(*buff != '\0') buff++;
}
-#else /* !__ANDROID__ */
- for (i = from; i <= to; i++) {
- (void) close(i);
+ new_environ[cnt] = NULL;
+
+ if (o_buff + size != buff) {
+ /* This is a spawn executable call */
+ cnt = get_int32(buff);
+ buff += sizeof(Sint32);
+ args = malloc(sizeof(char*)*(cnt + 1));
+ for (i = 0; i < cnt; i++, buff++) {
+ args[i] = buff;
+ while(*buff != '\0') buff++;
+ }
+ args[cnt] = NULL;
}
-#endif /* HAVE_CLOSEFROM */
- if (!(argv[CS_ARGV_WD_IX][0] == '.' && argv[CS_ARGV_WD_IX][1] == '\0')
- && chdir(argv[CS_ARGV_WD_IX]) < 0)
- return 1;
+ if (o_buff + size != buff) {
+ errno = EINVAL;
+ goto child_error;
+ }
+
+ DEBUG_PRINT("read ack");
+ do {
+ ErtsSysForkerProto proto;
+ res = read(pipes[0], &proto, sizeof(proto));
+ if (res > 0) {
+ ASSERT(proto.action == ErtsSysForkerProtoAction_Ack);
+ ASSERT(res == sizeof(proto));
+ }
+ } while(res < 0 && (errno == EINTR || errno == ERRNO_BLOCK));
+ if (res < 1) {
+ errno = EPIPE;
+ goto child_error;
+ }
+
+ DEBUG_PRINT("Do that forking business: '%s'\n",cmd);
+
+ /* When the dup2'ing below is done, only
+ fd's 0, 1, 2 and maybe 3, 4 should survive the
+ exec. All other fds (i.e. the unix domain sockets
+ and stray pipe ends) should have CLOEXEC set on them
+ so they will be closed when the exec happens */
+ if (flags & FORKER_FLAG_USE_STDIO) {
+ /* stdin for process */
+ if (flags & FORKER_FLAG_DO_WRITE &&
+ dup2(pipes[0], 0) < 0)
+ goto child_error;
+ /* stdout for process */
+ if (flags & FORKER_FLAG_DO_READ &&
+ dup2(pipes[1], 1) < 0)
+ goto child_error;
+ }
+ else { /* XXX will fail if pipes[0] == 4 (unlikely..) */
+ if (flags & FORKER_FLAG_DO_READ && dup2(pipes[1], 4) < 0)
+ goto child_error;
+ if (flags & FORKER_FLAG_DO_WRITE && dup2(pipes[0], 3) < 0)
+ goto child_error;
+ }
+
+ if (dup2(pipes[2], 2) < 0)
+ goto child_error;
+
+ if (wd && chdir(wd) < 0)
+ goto child_error;
#if defined(USE_SETPGRP_NOARGS) /* SysV */
(void) setpgrp();
@@ -131,34 +256,301 @@ main(int argc, char *argv[])
(void) setsid();
#endif
+ close(pipes[0]);
+ close(pipes[1]);
+ close(pipes[2]);
+
sys_sigrelease(SIGCHLD);
- sys_sigrelease(SIGINT);
- sys_sigrelease(SIGUSR1);
-
- if (erts_spawn_executable) {
- if (argv[CS_ARGV_NO_OF_ARGS + 1] == NULL) {
- execl(argv[CS_ARGV_NO_OF_ARGS],argv[CS_ARGV_NO_OF_ARGS],
- (char *) NULL);
- } else {
- execv(argv[CS_ARGV_NO_OF_ARGS],&(argv[CS_ARGV_NO_OF_ARGS + 1]));
- }
+
+ if (args) {
+ /* spawn_executable */
+ execve(cmd, args, new_environ);
} else {
- execl(SHELL, "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL);
+ execle(SHELL, "sh", "-c", cmd, (char *) NULL, new_environ);
}
- return 1;
+child_error:
+ DEBUG_PRINT("exec error: %d\r\n",errno);
+ _exit(128 + errno);
+}
+
+
+/*
+ * [OTP-3906]
+ * Solaris signal management gets confused when threads are used and a
+ * lot of child processes dies. The confusion results in that SIGCHLD
+ * signals aren't delivered to the emulator which in turn results in
+ * a lot of defunct processes in the system.
+ *
+ * The problem seems to appear when a signal is frequently
+ * blocked/unblocked at the same time as the signal is frequently
+ * propagated. The child waiter thread is a workaround for this problem.
+ * The SIGCHLD signal is always blocked (in all threads), and the child
+ * waiter thread fetches the signal by a call to sigwait(). See
+ * child_waiter().
+ *
+ * This should be a non-issue since the fork:ing was moved outside of
+ * the emulator into erl_child_setup. I'm leaving the comment here
+ * for posterity. */
+
+static void handle_sigchld(int sig) {
+ int buff[2], res;
+
+ sys_sigblock(SIGCHLD);
+
+ while ((buff[0] = waitpid((pid_t)(-1), buff+1, WNOHANG)) > 0) {
+ do {
+ res = write(sigchld_pipe[1], buff, sizeof(buff));
+ } while (res < 0 && errno == EINTR);
+ if (res <= 0)
+ ABORT("Failed to write to sigchld_pipe (%d): %d (%d)", sigchld_pipe[1], res, errno);
+ DEBUG_PRINT("Reap child %d (%d)", buff[0], buff[1]);
+ }
+
+ sys_sigrelease(SIGCHLD);
}
#if defined(__ANDROID__)
static int system_properties_fd(void)
{
- int fd;
+ static int fd = -2;
char *env;
+ if (fd != -2) return fd;
env = getenv("ANDROID_PROPERTY_WORKSPACE");
if (!env) {
+ fd = -1;
return -1;
}
fd = atoi(env);
return fd;
}
#endif /* __ANDROID__ */
+
+int
+main(int argc, char *argv[])
+{
+ /* This fd should be open from beam */
+ int uds_fd = 3, max_fd = 3;
+#ifndef HAVE_CLOSEFROM
+ int i;
+#endif
+ struct sigaction sa;
+
+ if (argc < 1 || sscanf(argv[1],"%d",&max_files) != 1) {
+ ABORT("Invalid arguments to child_setup");
+ }
+
+/* We close all fds except the uds from beam.
+ All other fds from now on will have the
+ CLOEXEC flags set on them. This means that we
+ only have to close a very limited number of fds
+ after we fork before the exec. */
+#if defined(HAVE_CLOSEFROM)
+ closefrom(4);
+#else
+ for (i = 4; i < max_files; i++)
+#if defined(__ANDROID__)
+ if (i != system_properties_fd())
+#endif
+ (void) close(i);
+#endif
+
+ if (pipe(sigchld_pipe) < 0) {
+ ABORT("Failed to setup sigchld pipe (%d)", errno);
+ }
+
+ SET_CLOEXEC(sigchld_pipe[0]);
+ SET_CLOEXEC(sigchld_pipe[1]);
+
+ max_fd = max_fd < sigchld_pipe[0] ? sigchld_pipe[0] : max_fd;
+
+ sa.sa_handler = &handle_sigchld;
+ sigemptyset(&sa.sa_mask);
+ sa.sa_flags = SA_RESTART | SA_NOCLDSTOP;
+ if (sigaction(SIGCHLD, &sa, 0) == -1) {
+ perror(0);
+ exit(1);
+ }
+
+ forker_hash_init();
+
+ SET_CLOEXEC(uds_fd);
+
+ DEBUG_PRINT("Starting forker %d", max_files);
+
+ while (1) {
+ fd_set read_fds;
+ int res;
+ FD_ZERO(&read_fds);
+ FD_SET(uds_fd, &read_fds);
+ FD_SET(sigchld_pipe[0], &read_fds);
+ DEBUG_PRINT("child_setup selecting on %d, %d (%d)",
+ uds_fd, sigchld_pipe[0], max_fd);
+ res = select(max_fd+1, &read_fds, NULL, NULL, NULL);
+
+ if (res < 0) {
+ if (errno == EINTR) continue;
+ ABORT("Select failed: %d (%d)",res, errno);
+ }
+
+ if (FD_ISSET(uds_fd, &read_fds)) {
+ int pipes[3], res, os_pid;
+ ErtsSysForkerProto proto;
+ errno = 0;
+ if ((res = sys_uds_read(uds_fd, (char*)&proto, sizeof(proto),
+ pipes, 3, MSG_DONTWAIT)) < 0) {
+ if (errno == EINTR)
+ continue;
+ DEBUG_PRINT("erl_child_setup failed to read from uds: %d, %d", res, errno);
+ _exit(0);
+ }
+
+ if (res == 0) {
+ DEBUG_PRINT("uds was closed!");
+ _exit(0);
+ }
+ /* Since we use unix domain sockets and send the entire data in
+ one go we *should* get the entire payload at once. */
+ ASSERT(res == sizeof(proto));
+ ASSERT(proto.action == ErtsSysForkerProtoAction_Start);
+
+ sys_sigblock(SIGCHLD);
+
+ errno = 0;
+
+ os_pid = fork();
+ if (os_pid == 0)
+ start_new_child(pipes);
+
+ add_os_pid_to_port_id_mapping(proto.u.start.port_id, os_pid);
+
+ /* We write an ack here, but expect the reply on
+ the pipes[0] inside the fork */
+ proto.action = ErtsSysForkerProtoAction_Go;
+ proto.u.go.os_pid = os_pid;
+ proto.u.go.error_number = errno;
+ while (write(pipes[1], &proto, sizeof(proto)) < 0 && errno == EINTR)
+ ; /* remove gcc warning */
+
+#ifdef FORKER_PROTO_START_ACK
+ proto.action = ErtsSysForkerProtoAction_StartAck;
+ while (write(uds_fd, &proto, sizeof(proto)) < 0 && errno == EINTR)
+ ; /* remove gcc warning */
+#endif
+
+ sys_sigrelease(SIGCHLD);
+ close(pipes[0]);
+ close(pipes[1]);
+ close(pipes[2]);
+ }
+
+ if (FD_ISSET(sigchld_pipe[0], &read_fds)) {
+ int ibuff[2];
+ ErtsSysForkerProto proto;
+ res = read(sigchld_pipe[0], ibuff, sizeof(ibuff));
+ if (res <= 0) {
+ if (errno == EINTR)
+ continue;
+ ABORT("Failed to read from sigchld pipe: %d (%d)", res, errno);
+ }
+
+ proto.u.sigchld.port_id = get_port_id((pid_t)(ibuff[0]));
+
+ if (proto.u.sigchld.port_id == THE_NON_VALUE)
+ continue; /* exit status report not requested */
+
+ proto.action = ErtsSysForkerProtoAction_SigChld;
+ proto.u.sigchld.error_number = ibuff[1];
+ DEBUG_PRINT("send %s to %d", buff, uds_fd);
+ if (write(uds_fd, &proto, sizeof(proto)) < 0) {
+ if (errno == EINTR)
+ continue;
+ /* The uds was close, which most likely means that the VM
+ has exited. This will be detected when we try to read
+ from the uds_fd. */
+ DEBUG_PRINT("Failed to write to uds: %d (%d)", uds_fd, errno);
+ }
+ }
+ }
+ return 1;
+}
+
+typedef struct exit_status {
+ HashBucket hb;
+ pid_t os_pid;
+ Eterm port_id;
+} ErtsSysExitStatus;
+
+static Hash *forker_hash;
+
+static void add_os_pid_to_port_id_mapping(Eterm port_id, pid_t os_pid)
+{
+ if (port_id != THE_NON_VALUE) {
+ /* exit status report requested */
+ ErtsSysExitStatus es;
+ es.os_pid = os_pid;
+ es.port_id = port_id;
+ hash_put(forker_hash, &es);
+ }
+}
+
+static Eterm get_port_id(pid_t os_pid)
+{
+ ErtsSysExitStatus est, *es;
+ Eterm port_id;
+ est.os_pid = os_pid;
+ es = hash_remove(forker_hash, &est);
+ if (!es) return THE_NON_VALUE;
+ port_id = es->port_id;
+ free(es);
+ return port_id;
+}
+
+static int fcmp(void *a, void *b)
+{
+ ErtsSysExitStatus *sa = a;
+ ErtsSysExitStatus *sb = b;
+ return !(sa->os_pid == sb->os_pid);
+}
+
+static HashValue fhash(void *e)
+{
+ ErtsSysExitStatus *se = e;
+ Uint32 val = se->os_pid;
+ val = (val+0x7ed55d16) + (val<<12);
+ val = (val^0xc761c23c) ^ (val>>19);
+ val = (val+0x165667b1) + (val<<5);
+ val = (val+0xd3a2646c) ^ (val<<9);
+ val = (val+0xfd7046c5) + (val<<3);
+ val = (val^0xb55a4f09) ^ (val>>16);
+ return val;
+}
+
+static void *falloc(void *e)
+{
+ ErtsSysExitStatus *se = e;
+ ErtsSysExitStatus *ne = malloc(sizeof(ErtsSysExitStatus));
+ ne->os_pid = se->os_pid;
+ ne->port_id = se->port_id;
+ return ne;
+}
+
+static void *meta_alloc(int type, size_t size) { return malloc(size); }
+static void meta_free(int type, void *p) { free(p); }
+
+static int forker_hash_init(void)
+{
+ HashFunctions forker_hash_functions;
+ forker_hash_functions.hash = fhash;
+ forker_hash_functions.cmp = fcmp;
+ forker_hash_functions.alloc = falloc;
+ forker_hash_functions.free = free;
+ forker_hash_functions.meta_alloc = meta_alloc;
+ forker_hash_functions.meta_free = meta_free;
+ forker_hash_functions.meta_print = NULL;
+
+ forker_hash = hash_new(0, "forker_hash",
+ 16, forker_hash_functions);
+
+ return 1;
+}
diff --git a/erts/emulator/sys/unix/erl_child_setup.h b/erts/emulator/sys/unix/erl_child_setup.h
new file mode 100644
index 0000000000..a28b136bfc
--- /dev/null
+++ b/erts/emulator/sys/unix/erl_child_setup.h
@@ -0,0 +1,77 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2015-2015. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * This file defines the interface inbetween erts and child_setup.
+ */
+
+#ifndef _ERL_UNIX_FORKER_H
+#define _ERL_UNIX_FORKER_H
+
+#include "sys.h"
+
+#ifdef __FreeBSD__
+/* The freebsd sendmsg man page explicitly states that
+ you should not close fds before they are known
+ to have reached the other side, so this Ack protects
+ against that. */
+#define FORKER_PROTO_START_ACK 1
+#endif
+
+#define FORKER_ARGV_NO_OF_ARGS 3
+#define FORKER_ARGV_PROGNAME_IX 0 /* Program name */
+#define FORKER_ARGV_MAX_FILES 1 /* max_files */
+
+#define FORKER_FLAG_USE_STDIO (1 << 0) /* dup the pipe to stdin/stderr */
+#define FORKER_FLAG_EXIT_STATUS (1 << 1) /* send the exit status to parent */
+#define FORKER_FLAG_DO_READ (1 << 2) /* dup write fd */
+#define FORKER_FLAG_DO_WRITE (1 << 3) /* dup read fd */
+
+#if SIZEOF_VOID_P == SIZEOF_LONG
+typedef unsigned long ErtsSysPortId;
+#elif SIZEOF_VOID_P == SIZEOF_INT
+typedef unsigned int ErtsSysPortId;
+#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
+typedef unsigned long long ErtsSysPortId;
+#endif
+
+typedef struct ErtsSysForkerProto_ {
+ enum {
+ ErtsSysForkerProtoAction_Start,
+ ErtsSysForkerProtoAction_StartAck,
+ ErtsSysForkerProtoAction_Go,
+ ErtsSysForkerProtoAction_SigChld,
+ ErtsSysForkerProtoAction_Ack
+ } action;
+ union {
+ struct {
+ ErtsSysPortId port_id;
+ int fds[3];
+ } start;
+ struct {
+ pid_t os_pid;
+ int error_number;
+ } go;
+ struct {
+ ErtsSysPortId port_id;
+ int error_number;
+ } sigchld;
+ } u;
+} ErtsSysForkerProto;
+
+#endif /* #ifndef _ERL_UNIX_FORKER_H */
diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h
index b55180c509..e217c38ca9 100644
--- a/erts/emulator/sys/unix/erl_unix_sys.h
+++ b/erts/emulator/sys/unix/erl_unix_sys.h
@@ -30,9 +30,7 @@
#include <limits.h>
#include <stdlib.h>
#include <string.h>
-#ifndef QNX
#include <memory.h>
-#endif
#if defined(__sun__) && defined(__SVR4) && !defined(__EXTENSIONS__)
# define __EXTENSIONS__
@@ -92,11 +90,6 @@
#include <ieeefp.h>
#endif
-#ifdef QNX
-#include <process.h>
-#include <sys/qnx_glob.h>
-#endif
-
#include <pwd.h>
#ifndef HZ
@@ -108,6 +101,10 @@
#endif
#include <netdb.h>
+#ifdef HAVE_MACH_ABSOLUTE_TIME
+#include <mach/mach_time.h>
+#endif
+
#ifdef HAVE_POSIX_MEMALIGN
# define ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC 1
#endif
@@ -136,13 +133,6 @@
# define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
#endif
-#ifndef ENABLE_CHILD_WAITER_THREAD
-# ifdef ERTS_SMP
-# define ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN
-void erts_check_children(void);
-# endif
-#endif
-
typedef void *GETENV_STATE;
/*
@@ -171,6 +161,7 @@ typedef long long ErtsSysHrTime;
#endif
typedef ErtsMonotonicTime ErtsSystemTime;
+typedef ErtsSysHrTime ErtsSysPerfCounter;
#define ERTS_MONOTONIC_TIME_MIN (((ErtsMonotonicTime) 1) << 63)
#define ERTS_MONOTONIC_TIME_MAX (~ERTS_MONOTONIC_TIME_MIN)
@@ -219,6 +210,7 @@ ErtsSystemTime erts_os_system_time(void);
* It may or may not be monotonic.
*/
ErtsSysHrTime erts_sys_hrtime(void);
+#define ERTS_HRTIME_UNIT (1000*1000*1000)
struct erts_sys_time_read_only_data__ {
#ifdef ERTS_OS_MONOTONIC_INLINE_FUNC_PTR_CALL__
@@ -227,6 +219,8 @@ struct erts_sys_time_read_only_data__ {
#ifdef ERTS_OS_TIMES_INLINE_FUNC_PTR_CALL__
void (*os_times)(ErtsMonotonicTime *, ErtsSystemTime *);
#endif
+ ErtsSysPerfCounter (*perf_counter)(void);
+ ErtsSysPerfCounter perf_counter_unit;
int ticks_per_sec;
};
@@ -280,7 +274,24 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
#endif /* ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT */
/*
- *
+ * Functions for getting the performance counter
+ */
+
+ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void);
+#define erts_sys_perf_counter_unit() erts_sys_time_data__.r.o.perf_counter_unit
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+ERTS_GLB_INLINE ErtsSysPerfCounter
+erts_sys_perf_counter()
+{
+ return (*erts_sys_time_data__.r.o.perf_counter)();
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
+/*
+ * Functions for measuring CPU time
*/
#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME_CPU_TIME))
@@ -310,7 +321,6 @@ typedef void (*SIGFUNC)(int);
extern SIGFUNC sys_signal(int, SIGFUNC);
extern void sys_sigrelease(int);
extern void sys_sigblock(int);
-extern void sys_stop_cat(void);
extern void sys_init_suspend_handler(void);
/*
@@ -426,19 +436,6 @@ void erts_sys_unblock_fpe(int);
#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A)
-#ifdef NEED_CHILD_SETUP_DEFINES
-/* The child setup argv[] */
-#define CS_ARGV_PROGNAME_IX 0 /* Program name */
-#define CS_ARGV_UNBIND_IX 1 /* Unbind from cpu */
-#define CS_ARGV_WD_IX 2 /* Working directory */
-#define CS_ARGV_CMD_IX 3 /* Command */
-#define CS_ARGV_FD_CR_IX 4 /* Fd close range */
-#define CS_ARGV_DUP2_OP_IX(N) ((N) + 5) /* dup2 operations */
-
-#define CS_ARGV_NO_OF_DUP2_OPS 3 /* Number of dup2 ops */
-#define CS_ARGV_NO_OF_ARGS 8 /* Number of arguments */
-#endif /* #ifdef NEED_CHILD_SETUP_DEFINES */
-
/* Threads */
#ifdef USE_THREADS
extern int init_async(int);
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index a57b69aa89..4f992d3caf 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -49,7 +49,6 @@
#include <sys/ioctl.h>
#endif
-#define NEED_CHILD_SETUP_DEFINES
#define ERTS_WANT_BREAK_HANDLING
#define ERTS_WANT_GOT_SIGUSR1
#define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */
@@ -67,7 +66,7 @@
#include "erl_mseg.h"
extern char **environ;
-static erts_smp_rwmtx_t environ_rwmtx;
+erts_smp_rwmtx_t environ_rwmtx;
#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
* vector sock_sendv().
@@ -76,89 +75,12 @@ static erts_smp_rwmtx_t environ_rwmtx;
* Don't need global.h, but bif_table.h (included by bif.h),
* won't compile otherwise
*/
-#include "global.h"
+#include "global.h"
#include "bif.h"
-#include "erl_sys_driver.h"
#include "erl_check_io.h"
#include "erl_cpu_topology.h"
-#ifndef DISABLE_VFORK
-#define DISABLE_VFORK 0
-#endif
-
-#if defined IOV_MAX
-#define MAXIOV IOV_MAX
-#elif defined UIO_MAXIOV
-#define MAXIOV UIO_MAXIOV
-#else
-#define MAXIOV 16
-#endif
-
-#ifdef USE_THREADS
-# ifdef ENABLE_CHILD_WAITER_THREAD
-# define CHLDWTHR ENABLE_CHILD_WAITER_THREAD
-# else
-# define CHLDWTHR 0
-# endif
-# define FDBLOCK 1
-#else
-# define CHLDWTHR 0
-# define FDBLOCK 0
-#endif
-/*
- * [OTP-3906]
- * Solaris signal management gets confused when threads are used and a
- * lot of child processes dies. The confusion results in that SIGCHLD
- * signals aren't delivered to the emulator which in turn results in
- * a lot of defunct processes in the system.
- *
- * The problem seems to appear when a signal is frequently
- * blocked/unblocked at the same time as the signal is frequently
- * propagated. The child waiter thread is a workaround for this problem.
- * The SIGCHLD signal is always blocked (in all threads), and the child
- * waiter thread fetches the signal by a call to sigwait(). See
- * child_waiter().
- */
-
-typedef struct ErtsSysReportExit_ ErtsSysReportExit;
-struct ErtsSysReportExit_ {
- ErtsSysReportExit *next;
- Eterm port;
- int pid;
- int ifd;
- int ofd;
-#if CHLDWTHR && !defined(ERTS_SMP)
- int status;
-#endif
-};
-
-/* Used by the fd driver iff the fd could not be set to non-blocking */
-typedef struct ErtsSysBlocking_ {
- ErlDrvPDL pdl;
- int res;
- int err;
- unsigned int pkey;
-} ErtsSysBlocking;
-
-
-/* This data is shared by these drivers - initialized by spawn_init() */
-static struct driver_data {
- ErlDrvPort port_num;
- int ofd, packet_bytes;
- ErtsSysReportExit *report_exit;
- int pid;
- int alive;
- int status;
- int terminating;
- ErtsSysBlocking *blocking;
-} *driver_data; /* indexed by fd */
-
-static ErtsSysReportExit *report_exit_list;
-#if CHLDWTHR && !defined(ERTS_SMP)
-static ErtsSysReportExit *report_exit_transit_list;
-#endif
-
extern int driver_interrupt(int, int);
extern void do_break(void);
@@ -170,33 +92,6 @@ extern void erts_sys_init_float(void);
extern void erl_crash_dump(char* file, int line, char* fmt, ...);
-#define DIR_SEPARATOR_CHAR '/'
-
-#if defined(__ANDROID__)
-#define SHELL "/system/bin/sh"
-#else
-#define SHELL "/bin/sh"
-#endif /* __ANDROID__ */
-
-
-#if defined(DEBUG)
-#define ERL_BUILD_TYPE_MARKER ".debug"
-#elif defined(PURIFY)
-#define ERL_BUILD_TYPE_MARKER ".purify"
-#elif defined(QUANTIFY)
-#define ERL_BUILD_TYPE_MARKER ".quantify"
-#elif defined(PURECOV)
-#define ERL_BUILD_TYPE_MARKER ".purecov"
-#elif defined(VALGRIND)
-#define ERL_BUILD_TYPE_MARKER ".valgrind"
-#else /* opt */
-#define ERL_BUILD_TYPE_MARKER
-#endif
-
-#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER
-#if !DISABLE_VFORK
-static char *child_setup_prog;
-#endif
#ifdef DEBUG
static int debug_log = 0;
@@ -220,7 +115,7 @@ static volatile int have_prepared_crash_dump;
(have_prepared_crash_dump++)
#endif
-static erts_smp_atomic_t sys_misc_mem_sz;
+erts_smp_atomic_t sys_misc_mem_sz;
#if defined(ERTS_SMP)
static void smp_sig_notify(char c);
@@ -235,46 +130,6 @@ static int sig_suspend_fds[2] = {-1, -1};
jmp_buf erts_sys_sigsegv_jmp;
-#if CHLDWTHR || defined(ERTS_SMP)
-erts_mtx_t chld_stat_mtx;
-#endif
-#if CHLDWTHR
-static erts_tid_t child_waiter_tid;
-/* chld_stat_mtx is used to protect against concurrent accesses
- of the driver_data fields pid, alive, and status. */
-erts_cnd_t chld_stat_cnd;
-static long children_alive;
-#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx)
-#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx)
-#define CHLD_STAT_WAIT erts_cnd_wait(&chld_stat_cnd, &chld_stat_mtx)
-#define CHLD_STAT_SIGNAL erts_cnd_signal(&chld_stat_cnd)
-#elif defined(ERTS_SMP) /* ------------------------------------------------- */
-#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx)
-#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx)
-
-#else /* ------------------------------------------------------------------- */
-#define CHLD_STAT_LOCK
-#define CHLD_STAT_UNLOCK
-static volatile int children_died;
-#endif
-
-
-static struct fd_data {
- char pbuf[4]; /* hold partial packet bytes */
- int psz; /* size of pbuf */
- char *buf;
- char *cpos;
- int sz;
- int remain; /* for input on fd */
-} *fd_data; /* indexed by fd */
-
-/* static FUNCTION(int, write_fill, (int, char*, int)); unused? */
-static void note_child_death(int, int);
-
-#if CHLDWTHR
-static void* child_waiter(void *);
-#endif
-
static int crashdump_companion_cube_fd = -1;
/********************* General functions ****************************/
@@ -455,9 +310,10 @@ MALLOC_USE_HASH(1);
#ifdef USE_THREADS
#ifdef ERTS_THR_HAVE_SIG_FUNCS
+
/*
* Child thread inherits parents signal mask at creation. In order to
- * guarantee that the main thread will receive all SIGINT, SIGCHLD, and
+ * guarantee that the main thread will receive all SIGINT, and
* SIGUSR1 signals sent to the process, we block these signals in the
* parent thread when creating a new thread.
*/
@@ -553,14 +409,11 @@ erts_sys_pre_init(void)
#ifdef ERTS_THR_HAVE_SIG_FUNCS
sigemptyset(&thr_create_sigmask);
sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */
- sigaddset(&thr_create_sigmask, SIGCHLD); /* block child signals */
sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */
#endif
erts_thr_init(&eid);
- report_exit_list = NULL;
-
#ifdef ERTS_ENABLE_LOCK_COUNT
erts_lcnt_init();
#endif
@@ -571,17 +424,6 @@ erts_sys_pre_init(void)
#ifdef USE_THREADS
-#if CHLDWTHR || defined(ERTS_SMP)
- erts_mtx_init(&chld_stat_mtx, "child_status");
-#endif
-#if CHLDWTHR
-#ifndef ERTS_SMP
- report_exit_transit_list = NULL;
-#endif
- erts_cnd_init(&chld_stat_cnd);
- children_alive = 0;
-#endif
-
#ifdef ERTS_SMP
erts_smp_atomic32_init_nob(&erts_break_requested, 0);
erts_smp_atomic32_init_nob(&erts_got_sigusr1, 0);
@@ -591,9 +433,6 @@ erts_sys_pre_init(void)
erts_got_sigusr1 = 0;
have_prepared_crash_dump = 0;
#endif
-#if !CHLDWTHR && !defined(ERTS_SMP)
- children_died = 0;
-#endif
#endif /* USE_THREADS */
@@ -630,39 +469,6 @@ erts_sys_pre_init(void)
void
erl_sys_init(void)
{
-#if !DISABLE_VFORK
- {
- int res;
- char bindir[MAXPATHLEN];
- size_t bindirsz = sizeof(bindir);
- Uint csp_path_sz;
-
- res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz);
- if (res != 0) {
- if (res < 0)
- erl_exit(-1,
- "Environment variable BINDIR is not set\n");
- if (res > 0)
- erl_exit(-1,
- "Value of environment variable BINDIR is too large\n");
- }
- if (bindir[0] != DIR_SEPARATOR_CHAR)
- erl_exit(-1,
- "Environment variable BINDIR does not contain an"
- " absolute path\n");
- csp_path_sz = (strlen(bindir)
- + 1 /* DIR_SEPARATOR_CHAR */
- + sizeof(CHILD_SETUP_PROG_NAME)
- + 1);
- child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, csp_path_sz);
- erts_snprintf(child_setup_prog, csp_path_sz,
- "%s%c%s",
- bindir,
- DIR_SEPARATOR_CHAR,
- CHILD_SETUP_PROG_NAME);
- }
-#endif
#ifdef USE_SETLINEBUF
setlinebuf(stdout);
@@ -827,7 +633,7 @@ break_requested(void)
fprintf(stderr,"break!\n");
#endif
if (ERTS_BREAK_REQUESTED)
- erl_exit(ERTS_INTR_EXIT, "");
+ erts_exit(ERTS_INTR_EXIT, "");
ERTS_SET_BREAK_REQUESTED;
ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
@@ -866,7 +672,7 @@ sigusr1_exit(void)
}
prepare_crash_dump(secs);
- erl_exit(1, "Received SIGUSR1\n");
+ erts_exit(ERTS_ERROR_EXIT, "Received SIGUSR1\n");
}
#ifdef ETHR_UNUSABLE_SIGUSRX
@@ -922,7 +728,7 @@ static RETSIGTYPE suspend_signal(int signum)
static void
quit_requested(void)
{
- erl_exit(ERTS_INTR_EXIT, "");
+ erts_exit(ERTS_INTR_EXIT, "");
}
#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
@@ -984,43 +790,6 @@ int sys_max_files(void)
return(max_files);
}
-static void block_signals(void)
-{
-#if !CHLDWTHR
- sys_sigblock(SIGCHLD);
-#endif
-#ifndef ERTS_SMP
- sys_sigblock(SIGINT);
-#ifndef ETHR_UNUSABLE_SIGUSRX
- sys_sigblock(SIGUSR1);
-#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */
-#endif /* #ifndef ERTS_SMP */
-
-#ifdef ERTS_SYS_SUSPEND_SIGNAL
- sys_sigblock(ERTS_SYS_SUSPEND_SIGNAL);
-#endif
-
-}
-
-static void unblock_signals(void)
-{
- /* Update erl_child_setup.c if changed */
-#if !CHLDWTHR
- sys_sigrelease(SIGCHLD);
-#endif
-#ifndef ERTS_SMP
- sys_sigrelease(SIGINT);
-#ifndef ETHR_UNUSABLE_SIGUSRX
- sys_sigrelease(SIGUSR1);
-#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */
-#endif /* #ifndef ERTS_SMP */
-
-#ifdef ERTS_SYS_SUSPEND_SIGNAL
- sys_sigrelease(ERTS_SYS_SUSPEND_SIGNAL);
-#endif
-
-}
-
/************************** OS info *******************************/
/* Used by erlang:info/1. */
@@ -1108,1502 +877,6 @@ void fini_getenv_state(GETENV_STATE *state)
erts_smp_rwmtx_runlock(&environ_rwmtx);
}
-
-/************************** Port I/O *******************************/
-
-
-
-/* I. Common stuff */
-
-/*
- * Decreasing the size of it below 16384 is not allowed.
- */
-
-/* II. The spawn/fd/vanilla drivers */
-
-#define ERTS_SYS_READ_BUF_SZ (64*1024)
-
-/* Driver interfaces */
-static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*);
-static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*);
-#if FDBLOCK
-static void fd_async(void *);
-static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data);
-#endif
-static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT,
- char **, ErlDrvSizeT);
-static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*);
-static int spawn_init(void);
-static void fd_stop(ErlDrvData);
-static void fd_flush(ErlDrvData);
-static void stop(ErlDrvData);
-static void ready_input(ErlDrvData, ErlDrvEvent);
-static void ready_output(ErlDrvData, ErlDrvEvent);
-static void output(ErlDrvData, char*, ErlDrvSizeT);
-static void outputv(ErlDrvData, ErlIOVec*);
-static void stop_select(ErlDrvEvent, void*);
-
-struct erl_drv_entry spawn_driver_entry = {
- spawn_init,
- spawn_start,
- stop,
- output,
- ready_input,
- ready_output,
- "spawn",
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- ERL_DRV_FLAG_USE_PORT_LOCKING,
- NULL, NULL,
- stop_select
-};
-struct erl_drv_entry fd_driver_entry = {
- NULL,
- fd_start,
- fd_stop,
- output,
- ready_input,
- ready_output,
- "fd",
- NULL,
- NULL,
- fd_control,
- NULL,
- outputv,
-#if FDBLOCK
- fd_ready_async, /* ready_async */
-#else
- NULL,
-#endif
- fd_flush, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL, /* handle2 */
- NULL, /* process_exit */
- stop_select
-};
-struct erl_drv_entry vanilla_driver_entry = {
- NULL,
- vanilla_start,
- stop,
- output,
- ready_input,
- ready_output,
- "vanilla",
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL, /* flush */
- NULL, /* call */
- NULL, /* event */
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0, /* ERL_DRV_FLAGs */
- NULL, /* handle2 */
- NULL, /* process_exit */
- stop_select
-};
-
-/* Handle SIGCHLD signals. */
-#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL))
-static RETSIGTYPE onchld(void)
-#else
-static RETSIGTYPE onchld(int signum)
-#endif
-{
-#if CHLDWTHR
- ASSERT(0); /* We should *never* catch a SIGCHLD signal */
-#elif defined(ERTS_SMP)
- smp_sig_notify('C');
-#else
- children_died = 1;
- ERTS_CHK_IO_AS_INTR(); /* Make sure we don't sleep in poll */
-#endif
-}
-
-static int set_blocking_data(struct driver_data *dd) {
-
- dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking));
-
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking));
-
- dd->blocking->pdl = driver_pdl_create(dd->port_num);
- dd->blocking->res = 0;
- dd->blocking->err = 0;
- dd->blocking->pkey = driver_async_port_key(dd->port_num);
-
- return 1;
-}
-
-static int set_driver_data(ErlDrvPort port_num,
- int ifd,
- int ofd,
- int packet_bytes,
- int read_write,
- int exit_status,
- int pid,
- int is_blocking)
-{
- Port *prt;
- ErtsSysReportExit *report_exit;
-
- if (!exit_status)
- report_exit = NULL;
- else {
- report_exit = erts_alloc(ERTS_ALC_T_PRT_REP_EXIT,
- sizeof(ErtsSysReportExit));
- report_exit->next = report_exit_list;
- report_exit->port = erts_drvport2id(port_num);
- report_exit->pid = pid;
- report_exit->ifd = read_write & DO_READ ? ifd : -1;
- report_exit->ofd = read_write & DO_WRITE ? ofd : -1;
-#if CHLDWTHR && !defined(ERTS_SMP)
- report_exit->status = 0;
-#endif
- report_exit_list = report_exit;
- }
-
- prt = erts_drvport2port(port_num);
- if (prt != ERTS_INVALID_ERL_DRV_PORT)
- prt->os_pid = pid;
-
- if (read_write & DO_READ) {
- driver_data[ifd].packet_bytes = packet_bytes;
- driver_data[ifd].port_num = port_num;
- driver_data[ifd].report_exit = report_exit;
- driver_data[ifd].pid = pid;
- driver_data[ifd].alive = 1;
- driver_data[ifd].status = 0;
- driver_data[ifd].terminating = 0;
- driver_data[ifd].blocking = NULL;
- if (read_write & DO_WRITE) {
- driver_data[ifd].ofd = ofd;
- if (is_blocking && FDBLOCK)
- if (!set_blocking_data(driver_data+ifd))
- return -1;
- if (ifd != ofd)
- driver_data[ofd] = driver_data[ifd]; /* structure copy */
- } else { /* DO_READ only */
- driver_data[ifd].ofd = -1;
- }
- (void) driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1);
- return(ifd);
- } else { /* DO_WRITE only */
- driver_data[ofd].packet_bytes = packet_bytes;
- driver_data[ofd].port_num = port_num;
- driver_data[ofd].report_exit = report_exit;
- driver_data[ofd].ofd = ofd;
- driver_data[ofd].pid = pid;
- driver_data[ofd].alive = 1;
- driver_data[ofd].status = 0;
- driver_data[ofd].terminating = 0;
- driver_data[ofd].blocking = NULL;
- if (is_blocking && FDBLOCK)
- if (!set_blocking_data(driver_data+ofd))
- return -1;
- return(ofd);
- }
-}
-
-static int spawn_init()
-{
- int i;
-#if CHLDWTHR
- erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
-
- thr_opts.detached = 0;
- thr_opts.suggested_stack_size = 0; /* Smallest possible */
- thr_opts.name = "child_waiter";
-#endif
-
- sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */
- driver_data = (struct driver_data *)
- erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
- max_files * sizeof(struct driver_data));
-
- for (i = 0; i < max_files; i++)
- driver_data[i].pid = -1;
-
-#if CHLDWTHR
- sys_sigblock(SIGCHLD);
-#endif
-
- sys_signal(SIGCHLD, onchld); /* Reap children */
-
-#if CHLDWTHR
- erts_thr_create(&child_waiter_tid, child_waiter, NULL, &thr_opts);
-#endif
-
- return 1;
-}
-
-static void close_pipes(int ifd[2], int ofd[2], int read_write)
-{
- if (read_write & DO_READ) {
- (void) close(ifd[0]);
- (void) close(ifd[1]);
- }
- if (read_write & DO_WRITE) {
- (void) close(ofd[0]);
- (void) close(ofd[1]);
- }
-}
-
-static void init_fd_data(int fd, ErlDrvPort port_num)
-{
- fd_data[fd].buf = NULL;
- fd_data[fd].cpos = NULL;
- fd_data[fd].remain = 0;
- fd_data[fd].sz = 0;
- fd_data[fd].psz = 0;
-}
-
-static char **build_unix_environment(char *block)
-{
- int i;
- int j;
- int len;
- char *cp;
- char **cpp;
- char** old_env;
-
- ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx));
-
- cp = block;
- len = 0;
- while (*cp != '\0') {
- cp += strlen(cp) + 1;
- len++;
- }
- old_env = environ;
- while (*old_env++ != NULL) {
- len++;
- }
-
- cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT,
- sizeof(char *) * (len+1));
- if (cpp == NULL) {
- return NULL;
- }
-
- cp = block;
- len = 0;
- while (*cp != '\0') {
- cpp[len] = cp;
- cp += strlen(cp) + 1;
- len++;
- }
-
- i = len;
- for (old_env = environ; *old_env; old_env++) {
- char* old = *old_env;
-
- for (j = 0; j < len; j++) {
- char *s, *t;
-
- s = cpp[j];
- t = old;
- while (*s == *t && *s != '=') {
- s++, t++;
- }
- if (*s == '=' && *t == '=') {
- break;
- }
- }
-
- if (j == len) { /* New version not found */
- cpp[len++] = old;
- }
- }
-
- for (j = 0; j < i; ) {
- size_t last = strlen(cpp[j])-1;
- if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) {
- cpp[j] = cpp[--len];
- if (len < i) {
- i--;
- } else {
- j++;
- }
- }
- else {
- j++;
- }
- }
-
- cpp[len] = NULL;
- return cpp;
-}
-
-/*
- [arndt] In most Unix systems, including Solaris 2.5, 'fork' allocates memory
- in swap space for the child of a 'fork', whereas 'vfork' does not do this.
- The natural call to use here is therefore 'vfork'. Due to a bug in
- 'vfork' in Solaris 2.5 (apparently fixed in 2.6), using 'vfork'
- can be dangerous in what seems to be these circumstances:
- If the child code under a vfork sets the signal action to SIG_DFL
- (or SIG_IGN)
- for any signal which was previously set to a signal handler, the
- state of the parent is clobbered, so that the later arrival of
- such a signal yields a sigsegv in the parent. If the signal was
- not set to a signal handler, but ignored, all seems to work.
- If you change the forking code below, beware of this.
- */
-
-static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts)
-{
-#define CMD_LINE_PREFIX_STR "exec "
-#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1)
-
- int ifd[2], ofd[2], len, pid, i;
- char **volatile new_environ; /* volatile since a vfork() then cannot
- cause 'new_environ' to be clobbered
- in the parent process. */
- int saved_errno;
- long res;
- char *cmd_line;
-#ifndef QNX
- int unbind;
-#endif
-#if !DISABLE_VFORK
- int no_vfork;
- size_t no_vfork_sz = sizeof(no_vfork);
-
- no_vfork = (erts_sys_getenv_raw("ERL_NO_VFORK",
- (char *) &no_vfork,
- &no_vfork_sz) >= 0);
-#endif
-
- switch (opts->read_write) {
- case DO_READ:
- if (pipe(ifd) < 0)
- return ERL_DRV_ERROR_ERRNO;
- if (ifd[0] >= max_files) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = EMFILE;
- return ERL_DRV_ERROR_ERRNO;
- }
- ofd[1] = -1; /* keep purify happy */
- break;
- case DO_WRITE:
- if (pipe(ofd) < 0) return ERL_DRV_ERROR_ERRNO;
- if (ofd[1] >= max_files) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = EMFILE;
- return ERL_DRV_ERROR_ERRNO;
- }
- ifd[0] = -1; /* keep purify happy */
- break;
- case DO_READ|DO_WRITE:
- if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO;
- errno = EMFILE; /* default for next two conditions */
- if (ifd[0] >= max_files || pipe(ofd) < 0) {
- close_pipes(ifd, ofd, DO_READ);
- return ERL_DRV_ERROR_ERRNO;
- }
- if (ofd[1] >= max_files) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = EMFILE;
- return ERL_DRV_ERROR_ERRNO;
- }
- break;
- default:
- ASSERT(0);
- return ERL_DRV_ERROR_GENERAL;
- }
-
- if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
- /* started with spawn_executable, not with spawn */
- len = strlen(name);
- cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1);
- if (!cmd_line) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = ENOMEM;
- return ERL_DRV_ERROR_ERRNO;
- }
- memcpy((void *) cmd_line,(void *) name, len);
- cmd_line[len] = '\0';
- if (access(cmd_line,X_OK) != 0) {
- int save_errno = errno;
- erts_free(ERTS_ALC_T_TMP, cmd_line);
- errno = save_errno;
- return ERL_DRV_ERROR_ERRNO;
- }
- } else {
- /* make the string suitable for giving to "sh" */
- len = strlen(name);
- cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP,
- CMD_LINE_PREFIX_STR_SZ + len + 1);
- if (!cmd_line) {
- close_pipes(ifd, ofd, opts->read_write);
- errno = ENOMEM;
- return ERL_DRV_ERROR_ERRNO;
- }
- memcpy((void *) cmd_line,
- (void *) CMD_LINE_PREFIX_STR,
- CMD_LINE_PREFIX_STR_SZ);
- memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len);
- cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0';
- }
-
- erts_smp_rwmtx_rlock(&environ_rwmtx);
-
- if (opts->envir == NULL) {
- new_environ = environ;
- } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) {
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
- errno = ENOMEM;
- return ERL_DRV_ERROR_ERRNO;
- }
-
-#ifndef QNX
- /* Block child from SIGINT and SIGUSR1. Must be before fork()
- to be safe. */
- block_signals();
-
- CHLD_STAT_LOCK;
-
- unbind = erts_sched_bind_atfork_prepare();
-
-#if !DISABLE_VFORK
- /* See fork/vfork discussion before this function. */
- if (no_vfork) {
-#endif
-
- DEBUGF(("Using fork\n"));
- pid = fork();
-
- if (pid == 0) {
- /* The child! Setup child... */
-
- if (erts_sched_bind_atfork_child(unbind) != 0)
- goto child_error;
-
- /* OBSERVE!
- * Keep child setup after vfork() (implemented below and in
- * erl_child_setup.c) up to date if changes are made here.
- */
-
- if (opts->use_stdio) {
- if (opts->read_write & DO_READ) {
- /* stdout for process */
- if (dup2(ifd[1], 1) < 0)
- goto child_error;
- if(opts->redir_stderr)
- /* stderr for process */
- if (dup2(ifd[1], 2) < 0)
- goto child_error;
- }
- if (opts->read_write & DO_WRITE)
- /* stdin for process */
- if (dup2(ofd[0], 0) < 0)
- goto child_error;
- }
- else { /* XXX will fail if ofd[0] == 4 (unlikely..) */
- if (opts->read_write & DO_READ)
- if (dup2(ifd[1], 4) < 0)
- goto child_error;
- if (opts->read_write & DO_WRITE)
- if (dup2(ofd[0], 3) < 0)
- goto child_error;
- }
-
-#if defined(HAVE_CLOSEFROM)
- closefrom(opts->use_stdio ? 3 : 5);
-#else
- for (i = opts->use_stdio ? 3 : 5; i < max_files; i++)
- (void) close(i);
-#endif
-
- if (opts->wd && chdir(opts->wd) < 0)
- goto child_error;
-
-#if defined(USE_SETPGRP_NOARGS) /* SysV */
- (void) setpgrp();
-#elif defined(USE_SETPGRP) /* BSD */
- (void) setpgrp(0, getpid());
-#else /* POSIX */
- (void) setsid();
-#endif
-
- unblock_signals();
-
- if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
- if (opts->argv == NULL) {
- execle(cmd_line,cmd_line,(char *) NULL, new_environ);
- } else {
- if (opts->argv[0] == erts_default_arg0) {
- opts->argv[0] = cmd_line;
- }
- execve(cmd_line, opts->argv, new_environ);
- if (opts->argv[0] == cmd_line) {
- opts->argv[0] = erts_default_arg0;
- }
- }
- } else {
- execle(SHELL, "sh", "-c", cmd_line, (char *) NULL, new_environ);
- }
- child_error:
- _exit(1);
- }
-#if !DISABLE_VFORK
- }
-#define ENOUGH_BYTES (44)
- else { /* Use vfork() */
- char **cs_argv= erts_alloc(ERTS_ALC_T_TMP,(CS_ARGV_NO_OF_ARGS + 1)*
- sizeof(char *));
- char fd_close_range[ENOUGH_BYTES]; /* 44 bytes are enough to */
- char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][ENOUGH_BYTES]; /* hold any "%d:%d" string */
- /* on a 64-bit machine. */
-
- /* Setup argv[] for the child setup program (implemented in
- erl_child_setup.c) */
- i = 0;
- if (opts->use_stdio) {
- if (opts->read_write & DO_READ){
- /* stdout for process */
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 1);
- if(opts->redir_stderr)
- /* stderr for process */
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 2);
- }
- if (opts->read_write & DO_WRITE)
- /* stdin for process */
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 0);
- } else { /* XXX will fail if ofd[0] == 4 (unlikely..) */
- if (opts->read_write & DO_READ)
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 4);
- if (opts->read_write & DO_WRITE)
- erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 3);
- }
- for (; i < CS_ARGV_NO_OF_DUP2_OPS; i++)
- strcpy(&dup2_op[i][0], "-");
- erts_snprintf(fd_close_range, ENOUGH_BYTES, "%d:%d", opts->use_stdio ? 3 : 5, max_files-1);
-
- cs_argv[CS_ARGV_PROGNAME_IX] = child_setup_prog;
- cs_argv[CS_ARGV_WD_IX] = opts->wd ? opts->wd : ".";
- cs_argv[CS_ARGV_UNBIND_IX] = erts_sched_bind_atvfork_child(unbind);
- cs_argv[CS_ARGV_FD_CR_IX] = fd_close_range;
- for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++)
- cs_argv[CS_ARGV_DUP2_OP_IX(i)] = &dup2_op[i][0];
-
- if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
- int num = 0;
- int j = 0;
- if (opts->argv != NULL) {
- for(; opts->argv[num] != NULL; ++num)
- ;
- }
- cs_argv = erts_realloc(ERTS_ALC_T_TMP,cs_argv, (CS_ARGV_NO_OF_ARGS + 1 + num + 1) * sizeof(char *));
- cs_argv[CS_ARGV_CMD_IX] = "-";
- cs_argv[CS_ARGV_NO_OF_ARGS] = cmd_line;
- if (opts->argv != NULL) {
- for (;opts->argv[j] != NULL; ++j) {
- if (opts->argv[j] == erts_default_arg0) {
- cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = cmd_line;
- } else {
- cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = opts->argv[j];
- }
- }
- }
- cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = NULL;
- } else {
- cs_argv[CS_ARGV_CMD_IX] = cmd_line; /* Command */
- cs_argv[CS_ARGV_NO_OF_ARGS] = NULL;
- }
- DEBUGF(("Using vfork\n"));
- pid = vfork();
-
- if (pid == 0) {
- /* The child! */
-
- /* Observe!
- * OTP-4389: The child setup program (implemented in
- * erl_child_setup.c) will perform the necessary setup of the
- * child before it execs to the user program. This because
- * vfork() only allow an *immediate* execve() or _exit() in the
- * child.
- */
- execve(child_setup_prog, cs_argv, new_environ);
- _exit(1);
- }
- erts_free(ERTS_ALC_T_TMP,cs_argv);
- }
-#undef ENOUGH_BYTES
-#endif
-
- erts_sched_bind_atfork_parent(unbind);
-
- if (pid == -1) {
- saved_errno = errno;
- CHLD_STAT_UNLOCK;
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
- unblock_signals();
- close_pipes(ifd, ofd, opts->read_write);
- errno = saved_errno;
- return ERL_DRV_ERROR_ERRNO;
- }
-#else /* QNX */
- if (opts->use_stdio) {
- if (opts->read_write & DO_READ)
- qnx_spawn_options.iov[1] = ifd[1]; /* stdout for process */
- if (opts->read_write & DO_WRITE)
- qnx_spawn_options.iov[0] = ofd[0]; /* stdin for process */
- }
- else {
- if (opts->read_write & DO_READ)
- qnx_spawn_options.iov[4] = ifd[1];
- if (opts->read_write & DO_WRITE)
- qnx_spawn_options.iov[3] = ofd[0];
- }
- /* Close fds on exec */
- for (i = 3; i < max_files; i++)
- fcntl(i, F_SETFD, 1);
-
- qnx_spawn_options.flags = _SPAWN_SETSID;
- if ((pid = spawnl(P_NOWAIT, SHELL, SHELL, "-c", cmd_line,
- (char *) 0)) < 0) {
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
- reset_qnx_spawn();
- erts_smp_rwmtx_runlock(&environ_rwmtx);
- close_pipes(ifd, ofd, opts->read_write);
- return ERL_DRV_ERROR_GENERAL;
- }
- reset_qnx_spawn();
-#endif /* QNX */
-
- erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
-
- if (new_environ != environ)
- erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
-
- if (opts->read_write & DO_READ)
- (void) close(ifd[1]);
- if (opts->read_write & DO_WRITE)
- (void) close(ofd[0]);
-
- if (opts->read_write & DO_READ) {
- SET_NONBLOCKING(ifd[0]);
- init_fd_data(ifd[0], port_num);
- }
- if (opts->read_write & DO_WRITE) {
- SET_NONBLOCKING(ofd[1]);
- init_fd_data(ofd[1], port_num);
- }
-
- res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes,
- opts->read_write, opts->exit_status, pid, 0);
- /* Don't unblock SIGCHLD until now, since the call above must
- first complete putting away the info about our new subprocess. */
- unblock_signals();
-
-#if CHLDWTHR
- ASSERT(children_alive >= 0);
-
- if (!(children_alive++))
- CHLD_STAT_SIGNAL; /* Wake up child waiter thread if no children
- was alive before we fork()ed ... */
-#endif
- /* Don't unlock chld_stat_mtx until now of the same reason as above */
- CHLD_STAT_UNLOCK;
-
- erts_smp_rwmtx_runlock(&environ_rwmtx);
-
- return (ErlDrvData)res;
-#undef CMD_LINE_PREFIX_STR
-#undef CMD_LINE_PREFIX_STR_SZ
-}
-
-#ifdef QNX
-static reset_qnx_spawn()
-{
- int i;
-
- /* Reset qnx_spawn_options */
- qnx_spawn_options.flags = 0;
- qnx_spawn_options.iov[0] = 0xff;
- qnx_spawn_options.iov[1] = 0xff;
- qnx_spawn_options.iov[2] = 0xff;
- qnx_spawn_options.iov[3] = 0xff;
-}
-#endif
-
-#define FD_DEF_HEIGHT 24
-#define FD_DEF_WIDTH 80
-/* Control op */
-#define FD_CTRL_OP_GET_WINSIZE 100
-
-static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height)
-{
-#ifdef TIOCGWINSZ
- struct winsize ws;
- if (ioctl(fd,TIOCGWINSZ,&ws) == 0) {
- *width = (Uint32) ws.ws_col;
- *height = (Uint32) ws.ws_row;
- return 0;
- }
-#endif
- return -1;
-}
-
-static ErlDrvSSizeT fd_control(ErlDrvData drv_data,
- unsigned int command,
- char *buf, ErlDrvSizeT len,
- char **rbuf, ErlDrvSizeT rlen)
-{
- int fd = (int)(long)drv_data;
- char resbuff[2*sizeof(Uint32)];
- switch (command) {
- case FD_CTRL_OP_GET_WINSIZE:
- {
- Uint32 w,h;
- if (fd_get_window_size(fd,&w,&h))
- return 0;
- memcpy(resbuff,&w,sizeof(Uint32));
- memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32));
- }
- break;
- default:
- return 0;
- }
- if (rlen < 2*sizeof(Uint32)) {
- *rbuf = driver_alloc(2*sizeof(Uint32));
- }
- memcpy(*rbuf,resbuff,2*sizeof(Uint32));
- return 2*sizeof(Uint32);
-}
-
-static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
- SysDriverOpts* opts)
-{
- ErlDrvData res;
- int non_blocking = 0;
-
- if (((opts->read_write & DO_READ) && opts->ifd >= max_files) ||
- ((opts->read_write & DO_WRITE) && opts->ofd >= max_files))
- return ERL_DRV_ERROR_GENERAL;
-
- /*
- * Historical:
- *
- * "Note about nonblocking I/O.
- *
- * At least on Solaris, setting the write end of a TTY to nonblocking,
- * will set the input end to nonblocking as well (and vice-versa).
- * If erl is run in a pipeline like this: cat | erl
- * the input end of the TTY will be the standard input of cat.
- * And cat is not prepared to handle nonblocking I/O."
- *
- * Actually, the reason for this is not that the tty itself gets set
- * in non-blocking mode, but that the "input end" (cat's stdin) and
- * the "output end" (erlang's stdout) are typically the "same" file
- * descriptor, dup()'ed from a single fd by one of this process'
- * ancestors.
- *
- * The workaround for this problem used to be a rather bad kludge,
- * interposing an extra process ("internal cat") between erlang's
- * stdout and the original stdout, allowing erlang to set its stdout
- * in non-blocking mode without affecting the stdin of the preceding
- * process in the pipeline - and being a kludge, it caused all kinds
- * of weird problems.
- *
- * So, this is the current logic:
- *
- * The only reason to set non-blocking mode on the output fd at all is
- * if it's something that can cause a write() to block, of course,
- * i.e. primarily if it points to a tty, socket, pipe, or fifo.
- *
- * If we don't set non-blocking mode when we "should" have, and output
- * becomes blocked, the entire runtime system will be suspended - this
- * is normally bad of course, and can happen fairly "easily" - e.g. user
- * hits ^S on tty - but doesn't necessarily happen.
- *
- * If we do set non-blocking mode when we "shouldn't" have, the runtime
- * system will end up seeing EOF on the input fd (due to the preceding
- * process dying), which typically will cause the entire runtime system
- * to terminate immediately (due to whatever erlang process is seeing
- * the EOF taking it as a signal to halt the system). This is *very* bad.
- *
- * I.e. we should take a conservative approach, and only set non-
- * blocking mode when we a) need to, and b) are reasonably certain
- * that it won't be a problem. And as in the example above, the problem
- * occurs when input fd and output fd point to different "things".
- *
- * However, determining that they are not just the same "type" of
- * "thing", but actually the same instance of that type of thing, is
- * unreasonably complex in many/most cases.
- *
- * Also, with pipes, sockets, and fifos it's far from obvious that the
- * user *wants* non-blocking output: If you're running erlang inside
- * some complex pipeline, you're probably not running a real-time system
- * that must never stop, but rather *want* it to suspend if the output
- * channel is "full".
- *
- * So, the bottom line: We will only set the output fd non-blocking if
- * it points to a tty, and either a) the input fd also points to a tty,
- * or b) we can make sure that setting the output fd non-blocking
- * doesn't interfere with someone else's input, via a somewhat milder
- * kludge than the above.
- *
- * Also keep in mind that while this code is almost exclusively run as
- * a result of an erlang open_port({fd,0,1}, ...), that isn't the only
- * case - it can be called with any old pre-existing file descriptors,
- * the relations between which (if they're even two) we can only guess
- * at - still, we try our best...
- *
- * Added note OTP 18: Some systems seem to use stdout/stderr to log data
- * using unix pipes, so we cannot allow the system to block on a write.
- * Therefore we use an async thread to write the data to fd's that could
- * not be set to non-blocking. When no async threads are available we
- * fall back on the old behaviour.
- *
- * Also the guarantee about what is delivered to the OS has changed.
- * Pre 18 the fd driver did no flushing of data before terminating.
- * Now it does. This is because we want to be able to guarantee that things
- * such as escripts and friends really have outputted all data before
- * terminating. This could potentially block the termination of the system
- * for a very long time, but if the user wants to terminate fast she should
- * use erlang:halt with flush=false.
- */
-
- if (opts->read_write & DO_READ) {
- init_fd_data(opts->ifd, port_num);
- }
- if (opts->read_write & DO_WRITE) {
- init_fd_data(opts->ofd, port_num);
-
- /* If we don't have a read end, all bets are off - no non-blocking. */
- if (opts->read_write & DO_READ) {
-
- if (isatty(opts->ofd)) { /* output fd is a tty:-) */
-
- if (isatty(opts->ifd)) { /* input fd is also a tty */
-
- /* To really do this "right", we should also check that
- input and output fd point to the *same* tty - but
- this seems like overkill; ttyname() isn't for free,
- and this is a very common case - and it's hard to
- imagine a scenario where setting non-blocking mode
- here would cause problems - go ahead and do it. */
-
- non_blocking = 1;
- SET_NONBLOCKING(opts->ofd);
-
- } else { /* output fd is a tty, input fd isn't */
-
- /* This is a "problem case", but also common (see the
- example above) - i.e. it makes sense to try a bit
- harder before giving up on non-blocking mode: Try to
- re-open the tty that the output fd points to, and if
- successful replace the original one with the "new" fd
- obtained this way, and set *that* one in non-blocking
- mode. (Yes, this is a kludge.)
-
- However, re-opening the tty may fail in a couple of
- (unusual) cases:
-
- 1) The name of the tty (or an equivalent one, i.e.
- same major/minor number) can't be found, because
- it actually lives somewhere other than /dev (or
- wherever ttyname() looks for it), and isn't
- equivalent to any of those that do live in the
- "standard" place - this should be *very* unusual.
-
- 2) Permissions on the tty don't allow us to open it -
- it's perfectly possible to have an fd open to an
- object whose permissions wouldn't allow us to open
- it. This is not as unusual as it sounds, one case
- is if the user has su'ed to someone else (not
- root) - we have a read/write fd open to the tty
- (because it has been inherited all the way down
- here), but we have neither read nor write
- permission for the tty.
-
- In these cases, we finally give up, and don't set the
- output fd in non-blocking mode. */
-
- char *tty;
- int nfd;
-
- if ((tty = ttyname(opts->ofd)) != NULL &&
- (nfd = open(tty, O_WRONLY)) != -1) {
- dup2(nfd, opts->ofd);
- close(nfd);
- non_blocking = 1;
- SET_NONBLOCKING(opts->ofd);
- }
- }
- }
- }
- }
- CHLD_STAT_LOCK;
- res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd,
- opts->packet_bytes,
- opts->read_write, 0, -1,
- !non_blocking);
- CHLD_STAT_UNLOCK;
- return res;
-}
-
-static void clear_fd_data(int fd)
-{
- if (fd_data[fd].sz > 0) {
- erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf);
- ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fd_data[fd].sz);
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fd_data[fd].sz);
- }
- fd_data[fd].buf = NULL;
- fd_data[fd].sz = 0;
- fd_data[fd].remain = 0;
- fd_data[fd].cpos = NULL;
- fd_data[fd].psz = 0;
-}
-
-static void nbio_stop_fd(ErlDrvPort prt, int fd)
-{
- driver_select(prt,fd,DO_READ|DO_WRITE,0);
- clear_fd_data(fd);
- SET_BLOCKING(fd);
-}
-
-static void fd_stop(ErlDrvData ev) /* Does not close the fds */
-{
- int ofd;
- int fd = (int)(long)ev;
- ErlDrvPort prt = driver_data[fd].port_num;
-
-#if FDBLOCK
- if (driver_data[fd].blocking) {
- erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking);
- driver_data[fd].blocking = NULL;
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking));
- }
-#endif
-
- nbio_stop_fd(prt, fd);
- ofd = driver_data[fd].ofd;
- if (ofd != fd && ofd != -1)
- nbio_stop_fd(prt, ofd);
-}
-
-static void fd_flush(ErlDrvData fd)
-{
- if (!driver_data[(int)(long)fd].terminating)
- driver_data[(int)(long)fd].terminating = 1;
-}
-
-static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name,
- SysDriverOpts* opts)
-{
- int flags, fd;
- ErlDrvData res;
-
- flags = (opts->read_write == DO_READ ? O_RDONLY :
- opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC :
- O_RDWR|O_CREAT);
- if ((fd = open(name, flags, 0666)) < 0)
- return ERL_DRV_ERROR_GENERAL;
- if (fd >= max_files) {
- close(fd);
- return ERL_DRV_ERROR_GENERAL;
- }
- SET_NONBLOCKING(fd);
- init_fd_data(fd, port_num);
-
- CHLD_STAT_LOCK;
- res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd,
- opts->packet_bytes,
- opts->read_write, 0, -1, 0);
- CHLD_STAT_UNLOCK;
- return res;
-}
-
-/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */
-/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */
-
-static void stop(ErlDrvData fd)
-{
- ErlDrvPort prt;
- int ofd;
-
- prt = driver_data[(int)(long)fd].port_num;
- nbio_stop_fd(prt, (int)(long)fd);
-
- ofd = driver_data[(int)(long)fd].ofd;
- if (ofd != (int)(long)fd && (int)(long)ofd != -1)
- nbio_stop_fd(prt, ofd);
- else
- ofd = -1;
-
- CHLD_STAT_LOCK;
-
- /* Mark as unused. */
- driver_data[(int)(long)fd].pid = -1;
-
- CHLD_STAT_UNLOCK;
-
- /* SMP note: Close has to be last thing done (open file descriptors work
- as locks on driver_data[] entries) */
- driver_select(prt, (int)(long)fd, ERL_DRV_USE, 0); /* close(fd); */
- if (ofd >= 0) {
- driver_select(prt, (int)(long)ofd, ERL_DRV_USE, 0); /* close(ofd); */
- }
-}
-
-/* used by fd_driver */
-static void outputv(ErlDrvData e, ErlIOVec* ev)
-{
- int fd = (int)(long)e;
- ErlDrvPort ix = driver_data[fd].port_num;
- int pb = driver_data[fd].packet_bytes;
- int ofd = driver_data[fd].ofd;
- ssize_t n;
- ErlDrvSizeT sz;
- char lb[4];
- char* lbp;
- ErlDrvSizeT len = ev->size;
-
- /* (len > ((unsigned long)-1 >> (4-pb)*8)) */
- /* if (pb >= 0 && (len & (((ErlDrvSizeT)1 << (pb*8))) - 1) != len) {*/
- if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) {
- driver_failure_posix(ix, EINVAL);
- return; /* -1; */
- }
- /* Handles 0 <= pb <= 4 only */
- put_int32((Uint32) len, lb);
- lbp = lb + (4-pb);
-
- ev->iov[0].iov_base = lbp;
- ev->iov[0].iov_len = pb;
- ev->size += pb;
-
- if (driver_data[fd].blocking && FDBLOCK)
- driver_pdl_lock(driver_data[fd].blocking->pdl);
-
- if ((sz = driver_sizeq(ix)) > 0) {
- driver_enqv(ix, ev, 0);
-
- if (driver_data[fd].blocking && FDBLOCK)
- driver_pdl_unlock(driver_data[fd].blocking->pdl);
-
- if (sz + ev->size >= (1 << 13))
- set_busy_port(ix, 1);
- }
- else if (!driver_data[fd].blocking || !FDBLOCK) {
- /* We try to write directly if the fd in non-blocking */
- int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize;
-
- n = writev(ofd, (const void *) (ev->iov), vsize);
- if (n == ev->size)
- return; /* 0;*/
- if (n < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
- driver_failure_posix(ix, errno);
- return; /* -1;*/
- }
- n = 0;
- }
- driver_enqv(ix, ev, n); /* n is the skip value */
- driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
- }
-#if FDBLOCK
- else {
- if (ev->size != 0) {
- driver_enqv(ix, ev, 0);
- driver_pdl_unlock(driver_data[fd].blocking->pdl);
- driver_async(ix, &driver_data[fd].blocking->pkey,
- fd_async, driver_data+fd, NULL);
- } else {
- driver_pdl_unlock(driver_data[fd].blocking->pdl);
- }
- }
-#endif
- /* return 0;*/
-}
-
-/* Used by spawn_driver and vanilla driver */
-static void output(ErlDrvData e, char* buf, ErlDrvSizeT len)
-{
- int fd = (int)(long)e;
- ErlDrvPort ix = driver_data[fd].port_num;
- int pb = driver_data[fd].packet_bytes;
- int ofd = driver_data[fd].ofd;
- ssize_t n;
- ErlDrvSizeT sz;
- char lb[4];
- char* lbp;
- struct iovec iv[2];
-
- /* (len > ((unsigned long)-1 >> (4-pb)*8)) */
- if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) {
- driver_failure_posix(ix, EINVAL);
- return; /* -1; */
- }
- put_int32(len, lb);
- lbp = lb + (4-pb);
-
- if ((sz = driver_sizeq(ix)) > 0) {
- driver_enq(ix, lbp, pb);
- driver_enq(ix, buf, len);
- if (sz + len + pb >= (1 << 13))
- set_busy_port(ix, 1);
- }
- else {
- iv[0].iov_base = lbp;
- iv[0].iov_len = pb; /* should work for pb=0 */
- iv[1].iov_base = buf;
- iv[1].iov_len = len;
- n = writev(ofd, iv, 2);
- if (n == pb+len)
- return; /* 0; */
- if (n < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
- driver_failure_posix(ix, errno);
- return; /* -1; */
- }
- n = 0;
- }
- if (n < pb) {
- driver_enq(ix, lbp+n, pb-n);
- driver_enq(ix, buf, len);
- }
- else {
- n -= pb;
- driver_enq(ix, buf+n, len-n);
- }
- driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
- }
- return; /* 0; */
-}
-
-static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res)
- /* Result: 0 (eof) or -1 (error) */
-{
- int err = errno;
-
- ASSERT(res <= 0);
- (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0);
- clear_fd_data(ready_fd);
-
- if (driver_data[ready_fd].blocking && FDBLOCK) {
- driver_pdl_lock(driver_data[ready_fd].blocking->pdl);
- if (driver_sizeq(driver_data[ready_fd].port_num) > 0) {
- driver_pdl_unlock(driver_data[ready_fd].blocking->pdl);
- /* We have stuff in the output queue, so we just
- set the state to terminating and wait for fd_async_ready
- to terminate the port */
- if (res == 0)
- driver_data[ready_fd].terminating = 2;
- else
- driver_data[ready_fd].terminating = -err;
- return 0;
- }
- driver_pdl_unlock(driver_data[ready_fd].blocking->pdl);
- }
-
- if (res == 0) {
- if (driver_data[ready_fd].report_exit) {
- CHLD_STAT_LOCK;
-
- if (driver_data[ready_fd].alive) {
- /*
- * We have eof and want to report exit status, but the process
- * hasn't exited yet. When it does report_exit_status() will
- * driver_select() this fd which will make sure that we get
- * back here with driver_data[ready_fd].alive == 0 and
- * driver_data[ready_fd].status set.
- */
- CHLD_STAT_UNLOCK;
- return 0;
- }
- else {
- int status = driver_data[ready_fd].status;
- CHLD_STAT_UNLOCK;
-
- /* We need not be prepared for stopped/continued processes. */
- if (WIFSIGNALED(status))
- status = 128 + WTERMSIG(status);
- else
- status = WEXITSTATUS(status);
-
- driver_report_exit(driver_data[ready_fd].port_num, status);
- }
- }
- driver_failure_eof(port_num);
- } else {
- driver_failure_posix(port_num, err);
- }
- return 0;
-}
-
-/* fd is the drv_data that is returned from the */
-/* initial start routine */
-/* ready_fd is the descriptor that is ready to read */
-
-static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd)
-{
- int fd = (int)(long)e;
- ErlDrvPort port_num;
- int packet_bytes;
- int res;
- Uint h;
-
- port_num = driver_data[fd].port_num;
- packet_bytes = driver_data[fd].packet_bytes;
-
-
- if (packet_bytes == 0) {
- byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
- ERTS_SYS_READ_BUF_SZ);
- res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ);
- if (res < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK))
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res == 0)
- port_inp_failure(port_num, ready_fd, res);
- else
- driver_output(port_num, (char*) read_buf, res);
- erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf);
- }
- else if (fd_data[ready_fd].remain > 0) { /* We try to read the remainder */
- /* space is allocated in buf */
- res = read(ready_fd, fd_data[ready_fd].cpos,
- fd_data[ready_fd].remain);
- if (res < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK))
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res == 0) {
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res == fd_data[ready_fd].remain) { /* we're done */
- driver_output(port_num, fd_data[ready_fd].buf,
- fd_data[ready_fd].sz);
- clear_fd_data(ready_fd);
- }
- else { /* if (res < fd_data[ready_fd].remain) */
- fd_data[ready_fd].cpos += res;
- fd_data[ready_fd].remain -= res;
- }
- }
- else if (fd_data[ready_fd].remain == 0) { /* clean fd */
- byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
- ERTS_SYS_READ_BUF_SZ);
- /* We make one read attempt and see what happens */
- res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ);
- if (res < 0) {
- if ((errno != EINTR) && (errno != ERRNO_BLOCK))
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res == 0) { /* eof */
- port_inp_failure(port_num, ready_fd, res);
- }
- else if (res < packet_bytes - fd_data[ready_fd].psz) {
- memcpy(fd_data[ready_fd].pbuf+fd_data[ready_fd].psz,
- read_buf, res);
- fd_data[ready_fd].psz += res;
- }
- else { /* if (res >= packet_bytes) */
- unsigned char* cpos = read_buf;
- int bytes_left = res;
-
- while (1) {
- int psz = fd_data[ready_fd].psz;
- char* pbp = fd_data[ready_fd].pbuf + psz;
-
- while(bytes_left && (psz < packet_bytes)) {
- *pbp++ = *cpos++;
- bytes_left--;
- psz++;
- }
-
- if (psz < packet_bytes) {
- fd_data[ready_fd].psz = psz;
- break;
- }
- fd_data[ready_fd].psz = 0;
-
- switch (packet_bytes) {
- case 1: h = get_int8(fd_data[ready_fd].pbuf); break;
- case 2: h = get_int16(fd_data[ready_fd].pbuf); break;
- case 4: h = get_int32(fd_data[ready_fd].pbuf); break;
- default: ASSERT(0); return; /* -1; */
- }
-
- if (h <= (bytes_left)) {
- driver_output(port_num, (char*) cpos, h);
- cpos += h;
- bytes_left -= h;
- continue;
- }
- else { /* The last message we got was split */
- char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h);
- if (!buf) {
- errno = ENOMEM;
- port_inp_failure(port_num, ready_fd, -1);
- }
- else {
- erts_smp_atomic_add_nob(&sys_misc_mem_sz, h);
- sys_memcpy(buf, cpos, bytes_left);
- fd_data[ready_fd].buf = buf;
- fd_data[ready_fd].sz = h;
- fd_data[ready_fd].remain = h - bytes_left;
- fd_data[ready_fd].cpos = buf + bytes_left;
- }
- break;
- }
- }
- }
- erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf);
- }
-}
-
-
-/* fd is the drv_data that is returned from the */
-/* initial start routine */
-/* ready_fd is the descriptor that is ready to read */
-
-static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd)
-{
- int fd = (int)(long)e;
- ErlDrvPort ix = driver_data[fd].port_num;
- int n;
- struct iovec* iv;
- int vsize;
-
-
- if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) {
- driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
- if (driver_data[fd].terminating)
- driver_failure_atom(driver_data[fd].port_num,"normal");
- return; /* 0; */
- }
- vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize;
- if ((n = writev(ready_fd, iv, vsize)) > 0) {
- if (driver_deq(ix, n) == 0)
- set_busy_port(ix, 0);
- }
- else if (n < 0) {
- if (errno == ERRNO_BLOCK || errno == EINTR)
- return; /* 0; */
- else {
- int res = errno;
- driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
- driver_failure_posix(ix, res);
- return; /* -1; */
- }
- }
- return; /* 0; */
-}
-
-static void stop_select(ErlDrvEvent fd, void* _)
-{
- close((int)fd);
-}
-
-#if FDBLOCK
-
-static void
-fd_async(void *async_data)
-{
- int res;
- struct driver_data *dd = (struct driver_data*)async_data;
- SysIOVec *iov0;
- SysIOVec *iov;
- int iovlen;
- int err = 0;
- /* much of this code is stolen from efile_drv:invoke_writev */
- driver_pdl_lock(dd->blocking->pdl);
- iov0 = driver_peekq(dd->port_num, &iovlen);
- iovlen = iovlen < MAXIOV ? iovlen : MAXIOV;
- iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF,
- sizeof(SysIOVec)*iovlen);
- if (!iov) {
- res = -1;
- err = ENOMEM;
- driver_pdl_unlock(dd->blocking->pdl);
- } else {
- memcpy(iov,iov0,iovlen*sizeof(SysIOVec));
- driver_pdl_unlock(dd->blocking->pdl);
-
- do {
- res = writev(dd->ofd, iov, iovlen);
- } while (res < 0 && errno == EINTR);
- if (res < 0)
- err = errno;
-
- erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov);
- }
- dd->blocking->res = res;
- dd->blocking->err = err;
-}
-
-void fd_ready_async(ErlDrvData drv_data,
- ErlDrvThreadData thread_data) {
- struct driver_data *dd = (struct driver_data *)thread_data;
- ErlDrvPort port_num = dd->port_num;
-
- ASSERT(dd->blocking);
- ASSERT(dd == (driver_data + (int)(long)drv_data));
-
- if (dd->blocking->res > 0) {
- driver_pdl_lock(dd->blocking->pdl);
- if (driver_deq(port_num, dd->blocking->res) == 0) {
- driver_pdl_unlock(dd->blocking->pdl);
- set_busy_port(port_num, 0);
- if (dd->terminating) {
- /* The port is has been ordered to terminate
- from either fd_flush or port_inp_failure */
- if (dd->terminating == 1)
- driver_failure_atom(port_num, "normal");
- else if (dd->terminating == 2)
- driver_failure_eof(port_num);
- else if (dd->terminating < 0)
- driver_failure_posix(port_num, -dd->terminating);
- return; /* -1; */
- }
- } else {
- driver_pdl_unlock(dd->blocking->pdl);
- /* still data left to write in queue */
- driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
- return /* 0; */;
- }
- } else if (dd->blocking->res < 0) {
- if (dd->blocking->err == ERRNO_BLOCK) {
- set_busy_port(port_num, 1);
- /* still data left to write in queue */
- driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
- } else
- driver_failure_posix(port_num, dd->blocking->err);
- return; /* -1; */
- }
- return; /* 0; */
-}
-
-#endif
-
void erts_do_break_handling(void)
{
struct termios temp_mode;
@@ -2744,10 +1017,6 @@ erts_sys_unsetenv(char *key)
void
sys_init_io(void)
{
- fd_data = (struct fd_data *)
- erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data));
- erts_smp_atomic_add_nob(&sys_misc_mem_sz,
- max_files * sizeof(struct fd_data));
}
#if (0) /* unused? */
@@ -2941,179 +1210,6 @@ erl_debug(char* fmt, ...)
#endif /* DEBUG */
-static ERTS_INLINE void
-report_exit_status(ErtsSysReportExit *rep, int status)
-{
- Port *pp;
-#ifdef ERTS_SMP
- CHLD_STAT_UNLOCK;
- pp = erts_thr_id2port_sflgs(rep->port,
- ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
- CHLD_STAT_LOCK;
-#else
- pp = erts_id2port_sflgs(rep->port,
- NULL,
- 0,
- ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP);
-#endif
- if (pp) {
- if (rep->ifd >= 0) {
- driver_data[rep->ifd].alive = 0;
- driver_data[rep->ifd].status = status;
- (void) driver_select(ERTS_Port2ErlDrvPort(pp),
- rep->ifd,
- (ERL_DRV_READ|ERL_DRV_USE),
- 1);
- }
- if (rep->ofd >= 0) {
- driver_data[rep->ofd].alive = 0;
- driver_data[rep->ofd].status = status;
- (void) driver_select(ERTS_Port2ErlDrvPort(pp),
- rep->ofd,
- (ERL_DRV_WRITE|ERL_DRV_USE),
- 1);
- }
-#ifdef ERTS_SMP
- erts_thr_port_release(pp);
-#else
- erts_port_release(pp);
-#endif
- }
- erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep);
-}
-
-#if !CHLDWTHR /* ---------------------------------------------------------- */
-
-#define ERTS_REPORT_EXIT_STATUS report_exit_status
-
-static int check_children(void)
-{
- int res = 0;
- int pid;
- int status;
-
-#ifndef ERTS_SMP
- if (children_died)
-#endif
- {
- sys_sigblock(SIGCHLD);
- CHLD_STAT_LOCK;
- while ((pid = waitpid(-1, &status, WNOHANG)) > 0)
- note_child_death(pid, status);
-#ifndef ERTS_SMP
- children_died = 0;
-#endif
- CHLD_STAT_UNLOCK;
- sys_sigrelease(SIGCHLD);
- res = 1;
- }
- return res;
-}
-
-#ifdef ERTS_SMP
-
-void
-erts_check_children(void)
-{
- (void) check_children();
-}
-
-#endif
-
-#elif CHLDWTHR && defined(ERTS_SMP) /* ------------------------------------- */
-
-#define ERTS_REPORT_EXIT_STATUS report_exit_status
-
-#define check_children() (0)
-
-
-#else /* CHLDWTHR && !defined(ERTS_SMP) ------------------------------------ */
-
-#define ERTS_REPORT_EXIT_STATUS initiate_report_exit_status
-
-static ERTS_INLINE void
-initiate_report_exit_status(ErtsSysReportExit *rep, int status)
-{
- rep->next = report_exit_transit_list;
- rep->status = status;
- report_exit_transit_list = rep;
- erts_sys_schedule_interrupt(1);
-}
-
-static int check_children(void)
-{
- int res;
- ErtsSysReportExit *rep;
- CHLD_STAT_LOCK;
- rep = report_exit_transit_list;
- res = rep != NULL;
- while (rep) {
- ErtsSysReportExit *curr_rep = rep;
- rep = rep->next;
- report_exit_status(curr_rep, curr_rep->status);
- }
- report_exit_transit_list = NULL;
- CHLD_STAT_UNLOCK;
- return res;
-}
-
-#endif /* ------------------------------------------------------------------ */
-
-static void note_child_death(int pid, int status)
-{
- ErtsSysReportExit **repp = &report_exit_list;
- ErtsSysReportExit *rep = report_exit_list;
-
- while (rep) {
- if (pid == rep->pid) {
- *repp = rep->next;
- ERTS_REPORT_EXIT_STATUS(rep, status);
- break;
- }
- repp = &rep->next;
- rep = rep->next;
- }
-}
-
-#if CHLDWTHR
-
-static void *
-child_waiter(void *unused)
-{
- int pid;
- int status;
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
- erts_lc_set_thread_name("child waiter");
-#endif
-
- while(1) {
-#ifdef DEBUG
- int waitpid_errno;
-#endif
- pid = waitpid(-1, &status, 0);
-#ifdef DEBUG
- waitpid_errno = errno;
-#endif
- CHLD_STAT_LOCK;
- if (pid < 0) {
- ASSERT(waitpid_errno == ECHILD);
- }
- else {
- children_alive--;
- ASSERT(children_alive >= 0);
- note_child_death(pid, status);
- }
- while (!children_alive)
- CHLD_STAT_WAIT; /* Wait for children to wait on... :) */
- CHLD_STAT_UNLOCK;
- }
-
- return NULL;
-}
-
-#endif
-
/*
* Called from schedule() when it runs out of runnable processes,
* or when Erlang code has performed INPUT_REDUCTIONS reduction
@@ -3122,13 +1218,8 @@ child_waiter(void *unused)
void
erl_sys_schedule(int runnable)
{
-#ifdef ERTS_SMP
ERTS_CHK_IO(!runnable);
-#else
- ERTS_CHK_IO(runnable ? 0 : !check_children());
-#endif
ERTS_SMP_LC_ASSERT(!erts_thr_progress_is_blocking());
- (void) check_children();
}
@@ -3156,10 +1247,6 @@ smp_sig_notify(char c)
static void *
signal_dispatcher_thread_func(void *unused)
{
-#if !CHLDWTHR
- int initialized = 0;
- int notify_check_children = 0;
-#endif
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_set_thread_name("signal_dispatcher");
#endif
@@ -3171,7 +1258,7 @@ signal_dispatcher_thread_func(void *unused)
if (res < 0) {
if (errno == EINTR)
continue;
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"signal-dispatcher thread got unexpected error: %s (%d)\n",
erl_errno_id(errno),
errno);
@@ -3197,19 +1284,7 @@ signal_dispatcher_thread_func(void *unused)
*/
switch (buf[i]) {
case 0: /* Emulator initialized */
-#if !CHLDWTHR
- initialized = 1;
- if (!notify_check_children)
-#endif
- break;
-#if !CHLDWTHR
- case 'C': /* SIGCHLD */
- if (initialized)
- erts_smp_notify_check_children_needed();
- else
- notify_check_children = 1;
- break;
-#endif
+ break;
case 'I': /* SIGINT */
break_requested();
break;
@@ -3220,7 +1295,7 @@ signal_dispatcher_thread_func(void *unused)
sigusr1_exit();
break;
default:
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"signal-dispatcher thread received unknown "
"signal notification: '%c'\n",
buf[i]);
@@ -3239,7 +1314,7 @@ init_smp_sig_notify(void)
thr_opts.name = "sys_sig_dispatcher";
if (pipe(sig_notify_fds) < 0) {
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Failed to create signal-dispatcher pipe: %s (%d)\n",
erl_errno_id(errno),
errno);
@@ -3256,7 +1331,7 @@ static void
init_smp_sig_suspend(void) {
#ifdef ERTS_SYS_SUSPEND_SIGNAL
if (pipe(sig_suspend_fds) < 0) {
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Failed to create sig_suspend pipe: %s (%d)\n",
erl_errno_id(errno),
errno);
@@ -3273,7 +1348,7 @@ static void initialize_darwin_main_thread_pipes(void)
{
if (pipe(erts_darwin_main_thread_pipe) < 0 ||
pipe(erts_darwin_main_thread_result_pipe) < 0) {
- erl_exit(1,"Fatal error initializing Darwin main thread stealing");
+ erts_exit(ERTS_ERROR_EXIT,"Fatal error initializing Darwin main thread stealing");
}
}
diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c
new file mode 100644
index 0000000000..82fea1b330
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_drivers.c
@@ -0,0 +1,1862 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 1996-2014. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#ifdef ISC32
+#define _POSIX_SOURCE
+#define _XOPEN_SOURCE
+#endif
+
+#include <sys/times.h> /* ! */
+#include <time.h>
+#include <signal.h>
+#include <sys/wait.h>
+#include <sys/uio.h>
+#include <termios.h>
+#include <ctype.h>
+#include <sys/utsname.h>
+#include <sys/select.h>
+#include <arpa/inet.h>
+
+#ifdef ISC32
+#include <sys/bsdtypes.h>
+#endif
+
+#include <termios.h>
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
+#ifdef HAVE_SYS_IOCTL_H
+#include <sys/ioctl.h>
+#endif
+
+#define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */
+#include "sys.h"
+
+#ifdef USE_THREADS
+#include "erl_threads.h"
+#endif
+
+extern char **environ;
+extern erts_smp_rwmtx_t environ_rwmtx;
+
+extern erts_smp_atomic_t sys_misc_mem_sz;
+
+static Eterm forker_port;
+
+#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
+ * vector sock_sendv().
+ */
+/*
+ * Don't need global.h, but erl_cpu_topology.h won't compile otherwise
+ */
+#include "global.h"
+#include "erl_cpu_topology.h"
+
+#include "erl_sys_driver.h"
+#include "sys_uds.h"
+
+#include "erl_child_setup.h"
+
+#if defined IOV_MAX
+#define MAXIOV IOV_MAX
+#elif defined UIO_MAXIOV
+#define MAXIOV UIO_MAXIOV
+#else
+#define MAXIOV 16
+#endif
+
+#ifdef USE_THREADS
+# define FDBLOCK 1
+#else
+# define FDBLOCK 0
+#endif
+
+/* Used by the fd driver iff the fd could not be set to non-blocking */
+typedef struct ErtsSysBlocking_ {
+ ErlDrvPDL pdl;
+ int res;
+ int err;
+ unsigned int pkey;
+} ErtsSysBlocking;
+
+typedef struct fd_data {
+ int fd;
+ char pbuf[4]; /* hold partial packet bytes */
+ int psz; /* size of pbuf */
+ char *buf;
+ char *cpos;
+ int sz;
+ int remain; /* for input on fd */
+} ErtsSysFdData;
+
+typedef struct driver_data {
+ ErlDrvPort port_num;
+ ErtsSysFdData *ofd;
+ ErtsSysFdData *ifd;
+ int packet_bytes;
+ int pid;
+ int alive;
+ int status;
+ int terminating;
+ ErtsSysBlocking *blocking;
+} ErtsSysDriverData;
+
+#define DIR_SEPARATOR_CHAR '/'
+
+#if defined(__ANDROID__)
+#define SHELL "/system/bin/sh"
+#else
+#define SHELL "/bin/sh"
+#endif /* __ANDROID__ */
+
+#if defined(DEBUG)
+#define ERL_BUILD_TYPE_MARKER ".debug"
+#elif defined(PURIFY)
+#define ERL_BUILD_TYPE_MARKER ".purify"
+#elif defined(QUANTIFY)
+#define ERL_BUILD_TYPE_MARKER ".quantify"
+#elif defined(PURECOV)
+#define ERL_BUILD_TYPE_MARKER ".purecov"
+#elif defined(VALGRIND)
+#define ERL_BUILD_TYPE_MARKER ".valgrind"
+#else /* opt */
+#define ERL_BUILD_TYPE_MARKER
+#endif
+
+#ifdef DEBUG
+#define close(fd) do { int res = close(fd); ASSERT(res > -1); } while(0)
+#endif
+
+#define CHILD_SETUP_PROG_NAME "erl_child_setup" ERL_BUILD_TYPE_MARKER
+
+// #define HARD_DEBUG
+#ifdef HARD_DEBUG
+#define driver_select(port_num, fd, flags, onoff) \
+ do { \
+ if (((flags) & ERL_DRV_READ) && onoff) \
+ fprintf(stderr,"%010d %p: read select %d\r\n", __LINE__, port_num, (int)fd); \
+ if (((flags) & ERL_DRV_WRITE) && onoff) \
+ fprintf(stderr,"%010d %p: writ select %d\r\n", __LINE__, port_num, (int)fd); \
+ if (((flags) & ERL_DRV_READ) && !onoff) \
+ fprintf(stderr,"%010d %p: read unsele %d\r\n", __LINE__, port_num, (int)fd); \
+ if (((flags) & ERL_DRV_WRITE) && !onoff) \
+ fprintf(stderr,"%010d %p: writ unsele %d\r\n", __LINE__, port_num, (int)fd); \
+ driver_select_nkp(port_num, fd, flags, onoff); \
+ } while(0)
+#endif
+
+/*
+ * Decreasing the size of it below 16384 is not allowed.
+ */
+
+#define ERTS_SYS_READ_BUF_SZ (64*1024)
+
+/* I. Initialization */
+
+void
+erl_sys_late_init(void)
+{
+ SysDriverOpts opts;
+#ifdef ERTS_SMP
+ Port *port;
+#endif
+
+ sys_signal(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */
+
+ opts.packet_bytes = 0;
+ opts.use_stdio = 1;
+ opts.redir_stderr = 0;
+ opts.read_write = 0;
+ opts.hide_window = 0;
+ opts.wd = NULL;
+ opts.envir = NULL;
+ opts.exit_status = 0;
+ opts.overlapped_io = 0;
+ opts.spawn_type = ERTS_SPAWN_ANY;
+ opts.argv = NULL;
+ opts.parallelism = erts_port_parallelism;
+
+#ifdef ERTS_SMP
+ port =
+#endif
+ erts_open_driver(&forker_driver, make_internal_pid(0), "forker", &opts, NULL, NULL);
+#ifdef ERTS_SMP
+ erts_mtx_unlock(port->lock);
+#endif
+}
+
+/* II. Prototypes */
+
+/* II.I Spawn prototypes */
+static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*);
+static ErlDrvSSizeT spawn_control(ErlDrvData, unsigned int, char *,
+ ErlDrvSizeT, char **, ErlDrvSizeT);
+
+/* II.II Vanilla prototypes */
+static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*);
+
+
+/* II.III FD prototypes */
+static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*);
+#if FDBLOCK
+static void fd_async(void *);
+static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data);
+#endif
+static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT,
+ char **, ErlDrvSizeT);
+static void fd_stop(ErlDrvData);
+static void fd_flush(ErlDrvData);
+
+/* II.IV Common prototypes */
+static void stop(ErlDrvData);
+static void ready_input(ErlDrvData, ErlDrvEvent);
+static void ready_output(ErlDrvData, ErlDrvEvent);
+static void output(ErlDrvData, char*, ErlDrvSizeT);
+static void outputv(ErlDrvData, ErlIOVec*);
+static void stop_select(ErlDrvEvent, void*);
+
+/* II.V Forker prototypes */
+static ErlDrvData forker_start(ErlDrvPort, char*, SysDriverOpts*);
+static void forker_stop(ErlDrvData);
+static void forker_ready_input(ErlDrvData, ErlDrvEvent);
+static void forker_ready_output(ErlDrvData, ErlDrvEvent);
+static ErlDrvSSizeT forker_control(ErlDrvData, unsigned int, char *,
+ ErlDrvSizeT, char **, ErlDrvSizeT);
+
+/* III Driver entries */
+
+/* III.I The spawn driver */
+struct erl_drv_entry spawn_driver_entry = {
+ NULL,
+ spawn_start,
+ stop,
+ output,
+ ready_input,
+ ready_output,
+ "spawn",
+ NULL,
+ NULL,
+ spawn_control,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ ERL_DRV_FLAG_USE_PORT_LOCKING | ERL_DRV_FLAG_USE_INIT_ACK,
+ NULL, NULL,
+ stop_select
+};
+
+/* III.II The fd driver */
+struct erl_drv_entry fd_driver_entry = {
+ NULL,
+ fd_start,
+ fd_stop,
+ output,
+ ready_input,
+ ready_output,
+ "fd",
+ NULL,
+ NULL,
+ fd_control,
+ NULL,
+ outputv,
+#if FDBLOCK
+ fd_ready_async, /* ready_async */
+#else
+ NULL,
+#endif
+ fd_flush, /* flush */
+ NULL, /* call */
+ NULL, /* event */
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0, /* ERL_DRV_FLAGs */
+ NULL, /* handle2 */
+ NULL, /* process_exit */
+ stop_select
+};
+
+/* III.III The vanilla driver */
+struct erl_drv_entry vanilla_driver_entry = {
+ NULL,
+ vanilla_start,
+ stop,
+ output,
+ ready_input,
+ ready_output,
+ "vanilla",
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL, /* flush */
+ NULL, /* call */
+ NULL, /* event */
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0, /* ERL_DRV_FLAGs */
+ NULL, /* handle2 */
+ NULL, /* process_exit */
+ stop_select
+};
+
+/* III.III The forker driver */
+struct erl_drv_entry forker_driver_entry = {
+ NULL,
+ forker_start,
+ forker_stop,
+ NULL,
+ forker_ready_input,
+ forker_ready_output,
+ "spawn_forker",
+ NULL,
+ NULL,
+ forker_control,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0,
+ NULL, NULL,
+ stop_select
+};
+
+/* Untility functions */
+
+static int set_blocking_data(ErtsSysDriverData *dd) {
+
+ dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking));
+
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking));
+
+ dd->blocking->pdl = driver_pdl_create(dd->port_num);
+ dd->blocking->res = 0;
+ dd->blocking->err = 0;
+ dd->blocking->pkey = driver_async_port_key(dd->port_num);
+
+ return 1;
+}
+
+static void init_fd_data(ErtsSysFdData *fd_data, int fd)
+{
+ fd_data->fd = fd;
+ fd_data->buf = NULL;
+ fd_data->cpos = NULL;
+ fd_data->remain = 0;
+ fd_data->sz = 0;
+ fd_data->psz = 0;
+}
+
+static ErtsSysDriverData *
+create_driver_data(ErlDrvPort port_num,
+ int ifd,
+ int ofd,
+ int packet_bytes,
+ int read_write,
+ int exit_status,
+ int pid,
+ int is_blocking)
+{
+ Port *prt;
+ ErtsSysDriverData *driver_data;
+ char *data;
+ int size = sizeof(ErtsSysDriverData);
+
+ if (read_write & DO_READ)
+ size += sizeof(ErtsSysFdData);
+
+ if ((read_write & DO_WRITE) &&
+ ((ifd != ofd || ofd == -1) || !(read_write & DO_READ)))
+ size += sizeof(ErtsSysFdData);
+
+ data = erts_alloc(ERTS_ALC_T_DRV_TAB,size);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, size);
+
+ driver_data = (ErtsSysDriverData*)data;
+ data += sizeof(*driver_data);
+
+ prt = erts_drvport2port(port_num);
+ if (prt != ERTS_INVALID_ERL_DRV_PORT)
+ prt->os_pid = pid;
+
+ driver_data->packet_bytes = packet_bytes;
+ driver_data->port_num = port_num;
+ driver_data->pid = pid;
+ driver_data->alive = exit_status ? 1 : 0;
+ driver_data->status = 0;
+ driver_data->terminating = 0;
+ driver_data->blocking = NULL;
+
+ if (read_write & DO_READ) {
+ driver_data->ifd = (ErtsSysFdData*)data;
+ data += sizeof(*driver_data->ifd);
+ init_fd_data(driver_data->ifd, ifd);
+ driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1);
+ } else {
+ driver_data->ifd = NULL;
+ }
+
+ if (read_write & DO_WRITE) {
+ if (ofd != -1 && ifd == ofd && read_write & DO_READ) {
+ /* This is for when ifd and ofd are the same fd */
+ driver_data->ofd = driver_data->ifd;
+ } else {
+ driver_data->ofd = (ErtsSysFdData*)data;
+ data += sizeof(*driver_data->ofd);
+ init_fd_data(driver_data->ofd, ofd);
+ }
+ if (is_blocking && FDBLOCK)
+ if (!set_blocking_data(driver_data)) {
+ erts_free(ERTS_ALC_T_DRV_TAB, driver_data);
+ return NULL;
+ }
+ } else {
+ driver_data->ofd = NULL;
+ }
+
+ return driver_data;
+}
+
+/* Spawn driver */
+
+static void close_pipes(int ifd[2], int ofd[2])
+{
+ close(ifd[0]);
+ close(ifd[1]);
+ close(ofd[0]);
+ close(ofd[1]);
+}
+
+static char **build_unix_environment(char *block)
+{
+ int i;
+ int j;
+ int len;
+ char *cp;
+ char **cpp;
+ char** old_env;
+
+ ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx));
+
+ cp = block;
+ len = 0;
+ while (*cp != '\0') {
+ cp += strlen(cp) + 1;
+ len++;
+ }
+ old_env = environ;
+ while (*old_env++ != NULL) {
+ len++;
+ }
+
+ cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT,
+ sizeof(char *) * (len+1));
+ if (cpp == NULL) {
+ return NULL;
+ }
+
+ cp = block;
+ len = 0;
+ while (*cp != '\0') {
+ cpp[len] = cp;
+ cp += strlen(cp) + 1;
+ len++;
+ }
+
+ i = len;
+ for (old_env = environ; *old_env; old_env++) {
+ char* old = *old_env;
+
+ for (j = 0; j < len; j++) {
+ char *s, *t;
+
+ /* check if cpp[j] equals old
+ before the = sign,
+ i.e.
+ "TMPDIR=/tmp/" */
+ s = cpp[j];
+ t = old;
+ while (*s == *t && *s != '=') {
+ s++, t++;
+ }
+ if (*s == '=' && *t == '=') {
+ break;
+ }
+ }
+
+ if (j == len) { /* New version not found */
+ cpp[len++] = old;
+ }
+ }
+
+ for (j = 0; j < i; ) {
+ size_t last = strlen(cpp[j])-1;
+ if (cpp[j][last] == '=' && strchr(cpp[j], '=') == cpp[j]+last) {
+ cpp[j] = cpp[--len];
+ if (len < i) {
+ i--;
+ } else {
+ j++;
+ }
+ }
+ else {
+ j++;
+ }
+ }
+
+ cpp[len] = NULL;
+ return cpp;
+}
+
+static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
+ SysDriverOpts* opts)
+{
+#define CMD_LINE_PREFIX_STR "exec "
+#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1)
+
+ int len;
+ char **new_environ;
+ ErtsSysDriverData *dd;
+ char *cmd_line;
+ char wd_buff[MAXPATHLEN+1];
+ char *wd;
+ int ifd[2], ofd[2], stderrfd;
+
+ if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO;
+ errno = EMFILE; /* default for next three conditions */
+ if (ifd[0] >= sys_max_files() || pipe(ofd) < 0) {
+ close(ifd[0]);
+ close(ifd[1]);
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ if (ofd[1] >= sys_max_files()) {
+ close_pipes(ifd, ofd);
+ errno = EMFILE;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+
+ SET_NONBLOCKING(ifd[0]);
+ SET_NONBLOCKING(ofd[1]);
+
+ stderrfd = opts->redir_stderr ? ifd[1] : dup(2);
+
+ if (stderrfd >= sys_max_files() || stderrfd < 0) {
+ close_pipes(ifd, ofd);
+ if (stderrfd > -1)
+ close(stderrfd);
+ return ERL_DRV_ERROR_ERRNO;
+ }
+
+ if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
+ /* started with spawn_executable, not with spawn */
+ len = strlen(name);
+ cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1);
+ if (!cmd_line) {
+ close_pipes(ifd, ofd);
+ errno = ENOMEM;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ memcpy((void *) cmd_line,(void *) name, len);
+ cmd_line[len] = '\0';
+ len = len + 1;
+ if (access(cmd_line,X_OK) != 0) {
+ int save_errno = errno;
+ erts_free(ERTS_ALC_T_TMP, cmd_line);
+ close_pipes(ifd, ofd);
+ errno = save_errno;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ } else {
+ /* make the string suitable for giving to "sh" */
+ len = strlen(name);
+ cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP,
+ CMD_LINE_PREFIX_STR_SZ + len + 1);
+ if (!cmd_line) {
+ close_pipes(ifd, ofd);
+ errno = ENOMEM;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ memcpy((void *) cmd_line,
+ (void *) CMD_LINE_PREFIX_STR,
+ CMD_LINE_PREFIX_STR_SZ);
+ memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len);
+ cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0';
+ len = CMD_LINE_PREFIX_STR_SZ + len + 1;
+ }
+
+ erts_smp_rwmtx_rlock(&environ_rwmtx);
+
+ if (opts->envir == NULL) {
+ new_environ = environ;
+ } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) {
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ close_pipes(ifd, ofd);
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+ errno = ENOMEM;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+
+ if (opts->wd == NULL) {
+ if ((wd = getcwd(wd_buff, MAXPATHLEN+1)) == NULL) {
+ /* on some OSs this call opens a fd in the
+ background which means that this can
+ return EMFILE */
+ int err = errno;
+ close_pipes(ifd, ofd);
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+ if (new_environ != environ)
+ erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ errno = err;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ } else {
+ wd = opts->wd;
+ }
+
+ {
+ struct iovec *io_vector;
+ int iov_len = 5;
+ char nullbuff[] = "\0";
+ int j, i = 0, res;
+ Sint32 buffsz = 0, env_len = 0, argv_len = 0,
+ flags = (opts->use_stdio ? FORKER_FLAG_USE_STDIO : 0)
+ | (opts->exit_status ? FORKER_FLAG_EXIT_STATUS : 0)
+ | (opts->read_write & DO_READ ? FORKER_FLAG_DO_READ : 0)
+ | (opts->read_write & DO_WRITE ? FORKER_FLAG_DO_WRITE : 0);
+
+ /* count number of elements in environment */
+ while(new_environ[env_len] != NULL)
+ env_len++;
+ iov_len += 1 + env_len; /* num envs including size int */
+
+ /* count number of element in argument list */
+ if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
+ if (opts->argv != NULL) {
+ while(opts->argv[argv_len] != NULL)
+ argv_len++;
+ } else {
+ argv_len++;
+ }
+ iov_len += 1 + argv_len; /* num argvs including size int */
+ }
+
+ io_vector = erts_alloc_fnf(ERTS_ALC_T_TMP, sizeof(struct iovec) * iov_len);
+
+ if (!io_vector) {
+ close_pipes(ifd, ofd);
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+ if (new_environ != environ)
+ erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
+ errno = ENOMEM;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+
+ io_vector[i].iov_base = (void*)&buffsz;
+ io_vector[i++].iov_len = sizeof(buffsz);
+
+ io_vector[i].iov_base = (void*)&flags;
+ flags = htonl(flags);
+ io_vector[i++].iov_len = sizeof(flags);
+ buffsz += sizeof(flags);
+
+ io_vector[i].iov_base = cmd_line;
+ io_vector[i++].iov_len = len;
+ buffsz += len;
+
+ io_vector[i].iov_base = wd;
+ io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1;
+ buffsz += io_vector[i++].iov_len;
+
+ io_vector[i].iov_base = nullbuff;
+ io_vector[i++].iov_len = 1;
+ buffsz += io_vector[i-1].iov_len;
+
+ io_vector[i].iov_base = (void*)&env_len;
+ env_len = htonl(env_len);
+ io_vector[i++].iov_len = sizeof(env_len);
+ buffsz += io_vector[i-1].iov_len;
+
+ for (j = 0; new_environ[j] != NULL; j++) {
+ io_vector[i].iov_base = new_environ[j];
+ io_vector[i++].iov_len = strlen(new_environ[j]) + 1;
+ buffsz += io_vector[i-1].iov_len;
+ }
+
+ /* only append arguments if this was a spawn_executable */
+ if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) {
+
+ io_vector[i].iov_base = (void*)&argv_len;
+ argv_len = htonl(argv_len);
+ io_vector[i++].iov_len = sizeof(argv_len);
+ buffsz += io_vector[i-1].iov_len;
+
+ if (opts->argv) {
+ /* If there are arguments we copy in the references to
+ them into the iov */
+ for (j = 0; opts->argv[j]; j++) {
+ if (opts->argv[j] == erts_default_arg0)
+ io_vector[i].iov_base = cmd_line;
+ else
+ io_vector[i].iov_base = opts->argv[j];
+ io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1;
+ buffsz += io_vector[i++].iov_len;
+ }
+ } else {
+ io_vector[i].iov_base = cmd_line;
+ io_vector[i].iov_len = strlen(io_vector[i].iov_base) + 1;
+ buffsz += io_vector[i++].iov_len;
+ }
+ }
+
+ /* we send the request to do the fork */
+ if ((res = writev(ofd[1], io_vector, iov_len > MAXIOV ? MAXIOV : iov_len)) < 0) {
+ if (errno == ERRNO_BLOCK) {
+ res = 0;
+ } else {
+ int err = errno;
+ close_pipes(ifd, ofd);
+ erts_free(ERTS_ALC_T_TMP, io_vector);
+ if (new_environ != environ)
+ erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+ errno = err;
+ return ERL_DRV_ERROR_ERRNO;
+ }
+ }
+
+ if (res < buffsz) {
+ /* we only wrote part of the command payload. Enqueue the rest. */
+ for (i = 0; i < iov_len; i++) {
+ driver_enq(port_num, io_vector[i].iov_base, io_vector[i].iov_len);
+ }
+ driver_deq(port_num, res);
+ driver_select(port_num, ofd[1], ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ }
+
+ erts_free(ERTS_ALC_T_TMP, io_vector);
+ }
+
+ erts_free(ERTS_ALC_T_TMP, (void *) cmd_line);
+
+ if (new_environ != environ)
+ erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ);
+
+ erts_smp_rwmtx_runlock(&environ_rwmtx);
+
+ dd = create_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes,
+ DO_WRITE | DO_READ, opts->exit_status,
+ 0, 0);
+
+ {
+ /* send ofd[0] + ifd[1] + stderrfd to forker port */
+ ErtsSysForkerProto *proto =
+ erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA,
+ sizeof(ErtsSysForkerProto));
+ memset(proto, 0, sizeof(ErtsSysForkerProto));
+ proto->action = ErtsSysForkerProtoAction_Start;
+ proto->u.start.fds[0] = ofd[0];
+ proto->u.start.fds[1] = ifd[1];
+ proto->u.start.fds[2] = stderrfd;
+ proto->u.start.port_id = opts->exit_status ? erts_drvport2id(port_num) : THE_NON_VALUE;
+ if (erl_drv_port_control(forker_port, 'S', (char*)proto, sizeof(*proto))) {
+ /* The forker port has been killed, we close both fd's which will
+ make open_port throw an epipe error */
+ close(ofd[0]);
+ close(ifd[1]);
+ }
+ }
+
+ /* we set these fds to negative to mark if
+ they should be closed after the handshake */
+ if (!(opts->read_write & DO_READ))
+ dd->ifd->fd *= -1;
+
+ if (!(opts->read_write & DO_WRITE))
+ dd->ofd->fd *= -1;
+
+ return (ErlDrvData)dd;
+#undef CMD_LINE_PREFIX_STR
+#undef CMD_LINE_PREFIX_STR_SZ
+}
+
+static ErlDrvSSizeT spawn_control(ErlDrvData e, unsigned int cmd, char *buf,
+ ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf;
+
+ ASSERT(len == sizeof(*proto));
+ ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld);
+
+ dd->status = proto->u.sigchld.error_number;
+ dd->alive = -1;
+
+ if (dd->ifd)
+ driver_select(dd->port_num, abs(dd->ifd->fd), ERL_DRV_READ | ERL_DRV_USE, 1);
+
+ if (dd->ofd)
+ driver_select(dd->port_num, abs(dd->ofd->fd), ERL_DRV_WRITE | ERL_DRV_USE, 1);
+
+ return 0;
+}
+
+#define FD_DEF_HEIGHT 24
+#define FD_DEF_WIDTH 80
+/* Control op */
+#define FD_CTRL_OP_GET_WINSIZE 100
+
+static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height)
+{
+#ifdef TIOCGWINSZ
+ struct winsize ws;
+ if (ioctl(fd,TIOCGWINSZ,&ws) == 0) {
+ *width = (Uint32) ws.ws_col;
+ *height = (Uint32) ws.ws_row;
+ return 0;
+ }
+#endif
+ return -1;
+}
+
+static ErlDrvSSizeT fd_control(ErlDrvData drv_data,
+ unsigned int command,
+ char *buf, ErlDrvSizeT len,
+ char **rbuf, ErlDrvSizeT rlen)
+{
+ int fd = (int)(long)drv_data;
+ char resbuff[2*sizeof(Uint32)];
+ switch (command) {
+ case FD_CTRL_OP_GET_WINSIZE:
+ {
+ Uint32 w,h;
+ if (fd_get_window_size(fd,&w,&h))
+ return 0;
+ memcpy(resbuff,&w,sizeof(Uint32));
+ memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32));
+ }
+ break;
+ default:
+ return 0;
+ }
+ if (rlen < 2*sizeof(Uint32)) {
+ *rbuf = driver_alloc(2*sizeof(Uint32));
+ }
+ memcpy(*rbuf,resbuff,2*sizeof(Uint32));
+ return 2*sizeof(Uint32);
+}
+
+static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
+ SysDriverOpts* opts)
+{
+ int non_blocking = 0;
+
+ if (((opts->read_write & DO_READ) && opts->ifd >= sys_max_files()) ||
+ ((opts->read_write & DO_WRITE) && opts->ofd >= sys_max_files()))
+ return ERL_DRV_ERROR_GENERAL;
+
+ /*
+ * Historical:
+ *
+ * "Note about nonblocking I/O.
+ *
+ * At least on Solaris, setting the write end of a TTY to nonblocking,
+ * will set the input end to nonblocking as well (and vice-versa).
+ * If erl is run in a pipeline like this: cat | erl
+ * the input end of the TTY will be the standard input of cat.
+ * And cat is not prepared to handle nonblocking I/O."
+ *
+ * Actually, the reason for this is not that the tty itself gets set
+ * in non-blocking mode, but that the "input end" (cat's stdin) and
+ * the "output end" (erlang's stdout) are typically the "same" file
+ * descriptor, dup()'ed from a single fd by one of this process'
+ * ancestors.
+ *
+ * The workaround for this problem used to be a rather bad kludge,
+ * interposing an extra process ("internal cat") between erlang's
+ * stdout and the original stdout, allowing erlang to set its stdout
+ * in non-blocking mode without affecting the stdin of the preceding
+ * process in the pipeline - and being a kludge, it caused all kinds
+ * of weird problems.
+ *
+ * So, this is the current logic:
+ *
+ * The only reason to set non-blocking mode on the output fd at all is
+ * if it's something that can cause a write() to block, of course,
+ * i.e. primarily if it points to a tty, socket, pipe, or fifo.
+ *
+ * If we don't set non-blocking mode when we "should" have, and output
+ * becomes blocked, the entire runtime system will be suspended - this
+ * is normally bad of course, and can happen fairly "easily" - e.g. user
+ * hits ^S on tty - but doesn't necessarily happen.
+ *
+ * If we do set non-blocking mode when we "shouldn't" have, the runtime
+ * system will end up seeing EOF on the input fd (due to the preceding
+ * process dying), which typically will cause the entire runtime system
+ * to terminate immediately (due to whatever erlang process is seeing
+ * the EOF taking it as a signal to halt the system). This is *very* bad.
+ *
+ * I.e. we should take a conservative approach, and only set non-
+ * blocking mode when we a) need to, and b) are reasonably certain
+ * that it won't be a problem. And as in the example above, the problem
+ * occurs when input fd and output fd point to different "things".
+ *
+ * However, determining that they are not just the same "type" of
+ * "thing", but actually the same instance of that type of thing, is
+ * unreasonably complex in many/most cases.
+ *
+ * Also, with pipes, sockets, and fifos it's far from obvious that the
+ * user *wants* non-blocking output: If you're running erlang inside
+ * some complex pipeline, you're probably not running a real-time system
+ * that must never stop, but rather *want* it to suspend if the output
+ * channel is "full".
+ *
+ * So, the bottom line: We will only set the output fd non-blocking if
+ * it points to a tty, and either a) the input fd also points to a tty,
+ * or b) we can make sure that setting the output fd non-blocking
+ * doesn't interfere with someone else's input, via a somewhat milder
+ * kludge than the above.
+ *
+ * Also keep in mind that while this code is almost exclusively run as
+ * a result of an erlang open_port({fd,0,1}, ...), that isn't the only
+ * case - it can be called with any old pre-existing file descriptors,
+ * the relations between which (if they're even two) we can only guess
+ * at - still, we try our best...
+ *
+ * Added note OTP 18: Some systems seem to use stdout/stderr to log data
+ * using unix pipes, so we cannot allow the system to block on a write.
+ * Therefore we use an async thread to write the data to fd's that could
+ * not be set to non-blocking. When no async threads are available we
+ * fall back on the old behaviour.
+ *
+ * Also the guarantee about what is delivered to the OS has changed.
+ * Pre 18 the fd driver did no flushing of data before terminating.
+ * Now it does. This is because we want to be able to guarantee that things
+ * such as escripts and friends really have outputted all data before
+ * terminating. This could potentially block the termination of the system
+ * for a very long time, but if the user wants to terminate fast she should
+ * use erlang:halt with flush=false.
+ */
+
+ /* Try to figure out if we can use non-blocking writes */
+ if (opts->read_write & DO_WRITE) {
+
+ /* If we don't have a read end, all bets are off - no non-blocking. */
+ if (opts->read_write & DO_READ) {
+
+ if (isatty(opts->ofd)) { /* output fd is a tty:-) */
+
+ if (isatty(opts->ifd)) { /* input fd is also a tty */
+
+ /* To really do this "right", we should also check that
+ input and output fd point to the *same* tty - but
+ this seems like overkill; ttyname() isn't for free,
+ and this is a very common case - and it's hard to
+ imagine a scenario where setting non-blocking mode
+ here would cause problems - go ahead and do it. */
+
+ non_blocking = 1;
+ SET_NONBLOCKING(opts->ofd);
+
+ } else { /* output fd is a tty, input fd isn't */
+
+ /* This is a "problem case", but also common (see the
+ example above) - i.e. it makes sense to try a bit
+ harder before giving up on non-blocking mode: Try to
+ re-open the tty that the output fd points to, and if
+ successful replace the original one with the "new" fd
+ obtained this way, and set *that* one in non-blocking
+ mode. (Yes, this is a kludge.)
+
+ However, re-opening the tty may fail in a couple of
+ (unusual) cases:
+
+ 1) The name of the tty (or an equivalent one, i.e.
+ same major/minor number) can't be found, because
+ it actually lives somewhere other than /dev (or
+ wherever ttyname() looks for it), and isn't
+ equivalent to any of those that do live in the
+ "standard" place - this should be *very* unusual.
+
+ 2) Permissions on the tty don't allow us to open it -
+ it's perfectly possible to have an fd open to an
+ object whose permissions wouldn't allow us to open
+ it. This is not as unusual as it sounds, one case
+ is if the user has su'ed to someone else (not
+ root) - we have a read/write fd open to the tty
+ (because it has been inherited all the way down
+ here), but we have neither read nor write
+ permission for the tty.
+
+ In these cases, we finally give up, and don't set the
+ output fd in non-blocking mode. */
+
+ char *tty;
+ int nfd;
+
+ if ((tty = ttyname(opts->ofd)) != NULL &&
+ (nfd = open(tty, O_WRONLY)) != -1) {
+ dup2(nfd, opts->ofd);
+ close(nfd);
+ non_blocking = 1;
+ SET_NONBLOCKING(opts->ofd);
+ }
+ }
+ }
+ }
+ }
+ return (ErlDrvData)create_driver_data(port_num, opts->ifd, opts->ofd,
+ opts->packet_bytes,
+ opts->read_write, 0, -1,
+ !non_blocking);
+}
+
+static void clear_fd_data(ErtsSysFdData *fdd)
+{
+ if (fdd->sz > 0) {
+ erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fdd->buf);
+ ASSERT(erts_smp_atomic_read_nob(&sys_misc_mem_sz) >= fdd->sz);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*fdd->sz);
+ }
+ fdd->buf = NULL;
+ fdd->sz = 0;
+ fdd->remain = 0;
+ fdd->cpos = NULL;
+ fdd->psz = 0;
+}
+
+static void nbio_stop_fd(ErlDrvPort prt, ErtsSysFdData *fdd)
+{
+ driver_select(prt, abs(fdd->fd), DO_READ|DO_WRITE, 0);
+ clear_fd_data(fdd);
+ SET_BLOCKING(abs(fdd->fd));
+
+}
+
+static void fd_stop(ErlDrvData ev) /* Does not close the fds */
+{
+ ErtsSysDriverData* dd = (ErtsSysDriverData*)ev;
+ ErlDrvPort prt = dd->port_num;
+ int sz = sizeof(ErtsSysDriverData);
+
+#if FDBLOCK
+ if (dd->blocking) {
+ erts_free(ERTS_ALC_T_SYS_BLOCKING, dd->blocking);
+ dd->blocking = NULL;
+ sz += sizeof(ErtsSysBlocking);
+ }
+#endif
+
+ if (dd->ifd) {
+ sz += sizeof(ErtsSysFdData);
+ nbio_stop_fd(prt, dd->ifd);
+ }
+ if (dd->ofd && dd->ofd != dd->ifd) {
+ sz += sizeof(ErtsSysFdData);
+ nbio_stop_fd(prt, dd->ofd);
+ }
+
+ erts_free(ERTS_ALC_T_DRV_TAB, dd);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sz);
+}
+
+static void fd_flush(ErlDrvData ev)
+{
+ ErtsSysDriverData* dd = (ErtsSysDriverData*)ev;
+ if (!dd->terminating)
+ dd->terminating = 1;
+}
+
+static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name,
+ SysDriverOpts* opts)
+{
+ int flags, fd;
+ ErlDrvData res;
+
+ flags = (opts->read_write == DO_READ ? O_RDONLY :
+ opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC :
+ O_RDWR|O_CREAT);
+ if ((fd = open(name, flags, 0666)) < 0)
+ return ERL_DRV_ERROR_GENERAL;
+ if (fd >= sys_max_files()) {
+ close(fd);
+ return ERL_DRV_ERROR_GENERAL;
+ }
+ SET_NONBLOCKING(fd);
+
+ res = (ErlDrvData)(long)create_driver_data(port_num, fd, fd,
+ opts->packet_bytes,
+ opts->read_write, 0, -1, 0);
+ return res;
+}
+
+/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */
+/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */
+
+static void stop(ErlDrvData ev)
+{
+ ErtsSysDriverData* dd = (ErtsSysDriverData*)ev;
+ ErlDrvPort prt = dd->port_num;
+
+ if (dd->ifd) {
+ nbio_stop_fd(prt, dd->ifd);
+ driver_select(prt, abs(dd->ifd->fd), ERL_DRV_USE, 0); /* close(ifd); */
+ }
+
+ if (dd->ofd && dd->ofd != dd->ifd) {
+ nbio_stop_fd(prt, dd->ofd);
+ driver_select(prt, abs(dd->ofd->fd), ERL_DRV_USE, 0); /* close(ofd); */
+ }
+
+ erts_free(ERTS_ALC_T_DRV_TAB, dd);
+}
+
+/* used by fd_driver */
+static void outputv(ErlDrvData e, ErlIOVec* ev)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErlDrvPort ix = dd->port_num;
+ int pb = dd->packet_bytes;
+ int ofd = dd->ofd ? dd->ofd->fd : -1;
+ ssize_t n;
+ ErlDrvSizeT sz;
+ char lb[4];
+ char* lbp;
+ ErlDrvSizeT len = ev->size;
+
+ /* (len > ((unsigned long)-1 >> (4-pb)*8)) */
+ /* if (pb >= 0 && (len & (((ErlDrvSizeT)1 << (pb*8))) - 1) != len) {*/
+ if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) {
+ driver_failure_posix(ix, EINVAL);
+ return; /* -1; */
+ }
+ /* Handles 0 <= pb <= 4 only */
+ put_int32((Uint32) len, lb);
+ lbp = lb + (4-pb);
+
+ ev->iov[0].iov_base = lbp;
+ ev->iov[0].iov_len = pb;
+ ev->size += pb;
+
+ if (dd->blocking && FDBLOCK)
+ driver_pdl_lock(dd->blocking->pdl);
+
+ if ((sz = driver_sizeq(ix)) > 0) {
+ driver_enqv(ix, ev, 0);
+
+ if (dd->blocking && FDBLOCK)
+ driver_pdl_unlock(dd->blocking->pdl);
+
+ if (sz + ev->size >= (1 << 13))
+ set_busy_port(ix, 1);
+ }
+ else if (!dd->blocking || !FDBLOCK) {
+ /* We try to write directly if the fd in non-blocking */
+ int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize;
+
+ n = writev(ofd, (const void *) (ev->iov), vsize);
+ if (n == ev->size)
+ return; /* 0;*/
+ if (n < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
+ driver_failure_posix(ix, errno);
+ return; /* -1;*/
+ }
+ n = 0;
+ }
+ driver_enqv(ix, ev, n); /* n is the skip value */
+ driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ }
+#if FDBLOCK
+ else {
+ if (ev->size != 0) {
+ driver_enqv(ix, ev, 0);
+ driver_pdl_unlock(dd->blocking->pdl);
+ driver_async(ix, &dd->blocking->pkey,
+ fd_async, dd, NULL);
+ } else {
+ driver_pdl_unlock(dd->blocking->pdl);
+ }
+ }
+#endif
+ /* return 0;*/
+}
+
+/* Used by spawn_driver and vanilla driver */
+static void output(ErlDrvData e, char* buf, ErlDrvSizeT len)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErlDrvPort ix = dd->port_num;
+ int pb = dd->packet_bytes;
+ int ofd = dd->ofd ? dd->ofd->fd : -1;
+ ssize_t n;
+ ErlDrvSizeT sz;
+ char lb[4];
+ char* lbp;
+ struct iovec iv[2];
+
+ /* (len > ((unsigned long)-1 >> (4-pb)*8)) */
+ if (((pb == 2) && (len > 0xffff))
+ || (pb == 1 && len > 0xff)
+ || dd->pid == 0 /* Attempt at output before port is ready */) {
+ driver_failure_posix(ix, EINVAL);
+ return; /* -1; */
+ }
+ put_int32(len, lb);
+ lbp = lb + (4-pb);
+
+ if ((sz = driver_sizeq(ix)) > 0) {
+ driver_enq(ix, lbp, pb);
+ driver_enq(ix, buf, len);
+ if (sz + len + pb >= (1 << 13))
+ set_busy_port(ix, 1);
+ }
+ else {
+ iv[0].iov_base = lbp;
+ iv[0].iov_len = pb; /* should work for pb=0 */
+ iv[1].iov_base = buf;
+ iv[1].iov_len = len;
+ n = writev(ofd, iv, 2);
+ if (n == pb+len)
+ return; /* 0; */
+ if (n < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK)) {
+ driver_failure_posix(ix, errno);
+ return; /* -1; */
+ }
+ n = 0;
+ }
+ if (n < pb) {
+ driver_enq(ix, lbp+n, pb-n);
+ driver_enq(ix, buf, len);
+ }
+ else {
+ n -= pb;
+ driver_enq(ix, buf+n, len-n);
+ }
+ driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ }
+ return; /* 0; */
+}
+
+static int port_inp_failure(ErtsSysDriverData *dd, int res)
+ /* Result: 0 (eof) or -1 (error) */
+{
+ int err = errno;
+
+ ASSERT(res <= 0);
+ if (dd->ifd) {
+ driver_select(dd->port_num, dd->ifd->fd, ERL_DRV_READ|ERL_DRV_WRITE, 0);
+ clear_fd_data(dd->ifd);
+ }
+
+ if (dd->blocking && FDBLOCK) {
+ driver_pdl_lock(dd->blocking->pdl);
+ if (driver_sizeq(dd->port_num) > 0) {
+ driver_pdl_unlock(dd->blocking->pdl);
+ /* We have stuff in the output queue, so we just
+ set the state to terminating and wait for fd_async_ready
+ to terminate the port */
+ if (res == 0)
+ dd->terminating = 2;
+ else
+ dd->terminating = -err;
+ return 0;
+ }
+ driver_pdl_unlock(dd->blocking->pdl);
+ }
+
+ if (res == 0) {
+ if (dd->alive == 1) {
+ /*
+ * We have eof and want to report exit status, but the process
+ * hasn't exited yet. When it does ready_input will
+ * driver_select() this fd which will make sure that we get
+ * back here with dd->alive == -1 and dd->status set.
+ */
+ return 0;
+ }
+ else if (dd->alive == -1) {
+ int status = dd->status;
+
+ /* We need not be prepared for stopped/continued processes. */
+ if (WIFSIGNALED(status))
+ status = 128 + WTERMSIG(status);
+ else
+ status = WEXITSTATUS(status);
+ driver_report_exit(dd->port_num, status);
+ }
+ driver_failure_eof(dd->port_num);
+ } else if (dd->ifd) {
+ erl_drv_init_ack(dd->port_num, ERL_DRV_ERROR_ERRNO);
+ } else {
+ driver_failure_posix(dd->port_num, err);
+ }
+ return 0;
+}
+
+/* fd is the drv_data that is returned from the */
+/* initial start routine */
+/* ready_fd is the descriptor that is ready to read */
+
+static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErlDrvPort port_num;
+ int packet_bytes;
+ int res;
+ Uint h;
+
+ port_num = dd->port_num;
+ packet_bytes = dd->packet_bytes;
+
+ ASSERT(abs(dd->ifd->fd) == ready_fd);
+
+ if (dd->pid == 0) {
+ /* the pid is sent from erl_child_setup. spawn driver only. */
+ ErtsSysForkerProto proto;
+ int res;
+
+ if((res = read(ready_fd, &proto, sizeof(proto))) <= 0) {
+ /* hmm, child setup seems to have closed the pipe too early...
+ we close the port as there is not much else we can do */
+ if (res < 0 && errno == ERRNO_BLOCK)
+ return;
+ driver_select(port_num, ready_fd, ERL_DRV_READ, 0);
+ if (res == 0)
+ errno = EPIPE;
+ port_inp_failure(dd, -1);
+ return;
+ }
+
+ ASSERT(proto.action == ErtsSysForkerProtoAction_Go);
+ dd->pid = proto.u.go.os_pid;
+
+ if (dd->pid == -1) {
+ /* Setup failed! The only reason why this should happen is if
+ the fork fails. */
+ errno = proto.u.go.error_number;
+ port_inp_failure(dd, -1);
+ return;
+ }
+
+ proto.action = ErtsSysForkerProtoAction_Ack;
+
+ if (driver_sizeq(port_num) > 0) {
+ driver_enq(port_num, (char*)&proto, sizeof(proto));
+ } else {
+ if (write(abs(dd->ofd->fd), &proto, sizeof(proto)) < 0)
+ if (errno == ERRNO_BLOCK || errno == EINTR)
+ driver_enq(port_num, (char*)&proto, sizeof(proto));
+ /* do nothing on failure here. If the ofd is broken, then
+ the ifd will probably also be broken and trigger
+ a port_inp_failure */
+ }
+
+ if (dd->ifd->fd < 0) {
+ driver_select(port_num, abs(dd->ifd->fd), ERL_DRV_READ|ERL_DRV_USE, 0);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData));
+ dd->ifd = NULL;
+ }
+
+ if (dd->ofd->fd < 0 || driver_sizeq(port_num) > 0)
+ /* we select in order to close fd or write to queue,
+ child setup will close this fd if fd < 0 */
+ driver_select(port_num, abs(dd->ofd->fd), ERL_DRV_WRITE|ERL_DRV_USE, 1);
+
+ erl_drv_set_os_pid(port_num, dd->pid);
+ erl_drv_init_ack(port_num, e);
+ return;
+ }
+
+ if (packet_bytes == 0) {
+ byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
+ ERTS_SYS_READ_BUF_SZ);
+ res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ);
+ if (res < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK))
+ port_inp_failure(dd, res);
+ }
+ else if (res == 0)
+ port_inp_failure(dd, res);
+ else
+ driver_output(port_num, (char*) read_buf, res);
+ erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf);
+ }
+ else if (dd->ifd->remain > 0) { /* We try to read the remainder */
+ /* space is allocated in buf */
+ res = read(ready_fd, dd->ifd->cpos,
+ dd->ifd->remain);
+ if (res < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK))
+ port_inp_failure(dd, res);
+ }
+ else if (res == 0) {
+ port_inp_failure(dd, res);
+ }
+ else if (res == dd->ifd->remain) { /* we're done */
+ driver_output(port_num, dd->ifd->buf,
+ dd->ifd->sz);
+ clear_fd_data(dd->ifd);
+ }
+ else { /* if (res < dd->ifd->remain) */
+ dd->ifd->cpos += res;
+ dd->ifd->remain -= res;
+ }
+ }
+ else if (dd->ifd->remain == 0) { /* clean fd */
+ byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
+ ERTS_SYS_READ_BUF_SZ);
+ /* We make one read attempt and see what happens */
+ res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ);
+ if (res < 0) {
+ if ((errno != EINTR) && (errno != ERRNO_BLOCK))
+ port_inp_failure(dd, res);
+ }
+ else if (res == 0) { /* eof */
+ port_inp_failure(dd, res);
+ }
+ else if (res < packet_bytes - dd->ifd->psz) {
+ memcpy(dd->ifd->pbuf+dd->ifd->psz,
+ read_buf, res);
+ dd->ifd->psz += res;
+ }
+ else { /* if (res >= packet_bytes) */
+ unsigned char* cpos = read_buf;
+ int bytes_left = res;
+
+ while (1) {
+ int psz = dd->ifd->psz;
+ char* pbp = dd->ifd->pbuf + psz;
+
+ while(bytes_left && (psz < packet_bytes)) {
+ *pbp++ = *cpos++;
+ bytes_left--;
+ psz++;
+ }
+
+ if (psz < packet_bytes) {
+ dd->ifd->psz = psz;
+ break;
+ }
+ dd->ifd->psz = 0;
+
+ switch (packet_bytes) {
+ case 1: h = get_int8(dd->ifd->pbuf); break;
+ case 2: h = get_int16(dd->ifd->pbuf); break;
+ case 4: h = get_int32(dd->ifd->pbuf); break;
+ default: ASSERT(0); return; /* -1; */
+ }
+
+ if (h <= (bytes_left)) {
+ driver_output(port_num, (char*) cpos, h);
+ cpos += h;
+ bytes_left -= h;
+ continue;
+ }
+ else { /* The last message we got was split */
+ char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h);
+ if (!buf) {
+ errno = ENOMEM;
+ port_inp_failure(dd, -1);
+ }
+ else {
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, h);
+ sys_memcpy(buf, cpos, bytes_left);
+ dd->ifd->buf = buf;
+ dd->ifd->sz = h;
+ dd->ifd->remain = h - bytes_left;
+ dd->ifd->cpos = buf + bytes_left;
+ }
+ break;
+ }
+ }
+ }
+ erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf);
+ }
+}
+
+
+/* fd is the drv_data that is returned from the */
+/* initial start routine */
+/* ready_fd is the descriptor that is ready to read */
+
+static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd)
+{
+ ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
+ ErlDrvPort ix = dd->port_num;
+ int n;
+ struct iovec* iv;
+ int vsize;
+
+ if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) {
+ driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
+ if (dd->pid > 0 && dd->ofd->fd < 0) {
+ /* The port was opened with 'in' option, which means we
+ should close the output fd as soon as the command has
+ been sent. */
+ driver_select(ix, ready_fd, ERL_DRV_WRITE|ERL_DRV_USE, 0);
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -sizeof(ErtsSysFdData));
+ dd->ofd = NULL;
+ }
+ if (dd->terminating)
+ driver_failure_atom(dd->port_num,"normal");
+ return; /* 0; */
+ }
+ vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize;
+ if ((n = writev(ready_fd, iv, vsize)) > 0) {
+ if (driver_deq(ix, n) == 0)
+ set_busy_port(ix, 0);
+ }
+ else if (n < 0) {
+ if (errno == ERRNO_BLOCK || errno == EINTR)
+ return; /* 0; */
+ else {
+ int res = errno;
+ driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
+ driver_failure_posix(ix, res);
+ return; /* -1; */
+ }
+ }
+ return; /* 0; */
+}
+
+static void stop_select(ErlDrvEvent fd, void* _)
+{
+ close((int)fd);
+}
+
+#if FDBLOCK
+
+static void
+fd_async(void *async_data)
+{
+ int res;
+ ErtsSysDriverData *dd = (ErtsSysDriverData *)async_data;
+ SysIOVec *iov0;
+ SysIOVec *iov;
+ int iovlen;
+ int err = 0;
+ /* much of this code is stolen from efile_drv:invoke_writev */
+ driver_pdl_lock(dd->blocking->pdl);
+ iov0 = driver_peekq(dd->port_num, &iovlen);
+ iovlen = iovlen < MAXIOV ? iovlen : MAXIOV;
+ iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF,
+ sizeof(SysIOVec)*iovlen);
+ if (!iov) {
+ res = -1;
+ err = ENOMEM;
+ driver_pdl_unlock(dd->blocking->pdl);
+ } else {
+ memcpy(iov,iov0,iovlen*sizeof(SysIOVec));
+ driver_pdl_unlock(dd->blocking->pdl);
+
+ do {
+ res = writev(dd->ofd->fd, iov, iovlen);
+ } while (res < 0 && errno == EINTR);
+ if (res < 0)
+ err = errno;
+ err = errno;
+
+ erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov);
+ }
+ dd->blocking->res = res;
+ dd->blocking->err = err;
+}
+
+void fd_ready_async(ErlDrvData drv_data,
+ ErlDrvThreadData thread_data) {
+ ErtsSysDriverData *dd = (ErtsSysDriverData *)thread_data;
+ ErlDrvPort port_num = dd->port_num;
+
+ ASSERT(dd->blocking);
+
+ if (dd->blocking->res > 0) {
+ driver_pdl_lock(dd->blocking->pdl);
+ if (driver_deq(port_num, dd->blocking->res) == 0) {
+ driver_pdl_unlock(dd->blocking->pdl);
+ set_busy_port(port_num, 0);
+ if (dd->terminating) {
+ /* The port is has been ordered to terminate
+ from either fd_flush or port_inp_failure */
+ if (dd->terminating == 1)
+ driver_failure_atom(port_num, "normal");
+ else if (dd->terminating == 2)
+ driver_failure_eof(port_num);
+ else if (dd->terminating < 0)
+ driver_failure_posix(port_num, -dd->terminating);
+ return; /* -1; */
+ }
+ } else {
+ driver_pdl_unlock(dd->blocking->pdl);
+ /* still data left to write in queue */
+ driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
+ return /* 0; */;
+ }
+ } else if (dd->blocking->res < 0) {
+ if (dd->blocking->err == ERRNO_BLOCK) {
+ set_busy_port(port_num, 1);
+ /* still data left to write in queue */
+ driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
+ } else
+ driver_failure_posix(port_num, dd->blocking->err);
+ return; /* -1; */
+ }
+ return; /* 0; */
+}
+
+#endif
+
+/* Forker driver */
+
+static int forker_fd;
+
+static ErlDrvData forker_start(ErlDrvPort port_num, char* name,
+ SysDriverOpts* opts)
+{
+
+ int i;
+ int fds[2];
+ int res, unbind;
+ char bindir[MAXPATHLEN];
+ size_t bindirsz = sizeof(bindir);
+ Uint csp_path_sz;
+ char *child_setup_prog;
+
+ forker_port = erts_drvport2id(port_num);
+
+ res = erts_sys_getenv_raw("BINDIR", bindir, &bindirsz);
+ if (res != 0) {
+ if (res < 0)
+ erts_exit(1,
+ "Environment variable BINDIR is not set\n");
+ if (res > 0)
+ erts_exit(1,
+ "Value of environment variable BINDIR is too large\n");
+ }
+ if (bindir[0] != DIR_SEPARATOR_CHAR)
+ erts_exit(1,
+ "Environment variable BINDIR does not contain an"
+ " absolute path\n");
+ csp_path_sz = (strlen(bindir)
+ + 1 /* DIR_SEPARATOR_CHAR */
+ + sizeof(CHILD_SETUP_PROG_NAME)
+ + 1);
+ child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz);
+ erts_snprintf(child_setup_prog, csp_path_sz,
+ "%s%c%s",
+ bindir,
+ DIR_SEPARATOR_CHAR,
+ CHILD_SETUP_PROG_NAME);
+ if (socketpair(AF_UNIX, SOCK_STREAM, 0, fds) < 0) {
+ erts_exit(ERTS_ABORT_EXIT,
+ "Could not open unix domain socket in spawn_init: %d\n",
+ errno);
+ }
+
+ forker_fd = fds[0];
+
+ unbind = erts_sched_bind_atfork_prepare();
+
+ i = fork();
+
+ if (i == 0) {
+ /* The child */
+ char *cs_argv[FORKER_ARGV_NO_OF_ARGS] =
+ {CHILD_SETUP_PROG_NAME, NULL, NULL};
+ char buff[128];
+
+ erts_sched_bind_atfork_child(unbind);
+
+ snprintf(buff, 128, "%d", sys_max_files());
+ cs_argv[FORKER_ARGV_MAX_FILES] = buff;
+
+ /* We preallocate fd 3 for the uds fd */
+ if (fds[1] != 3) {
+ dup2(fds[1], 3);
+ }
+
+#if defined(USE_SETPGRP_NOARGS) /* SysV */
+ (void) setpgrp();
+#elif defined(USE_SETPGRP) /* BSD */
+ (void) setpgrp(0, getpid());
+#else /* POSIX */
+ (void) setsid();
+#endif
+
+ execv(child_setup_prog, cs_argv);
+ _exit(1);
+ }
+
+ erts_sched_bind_atfork_parent(unbind);
+
+ erts_free(ERTS_ALC_T_CS_PROG_PATH, child_setup_prog);
+
+ close(fds[1]);
+
+ SET_NONBLOCKING(forker_fd);
+
+ driver_select(port_num, forker_fd, ERL_DRV_READ|ERL_DRV_USE, 1);
+
+ return (ErlDrvData)port_num;
+}
+
+static void forker_stop(ErlDrvData e)
+{
+ /* we probably should do something here,
+ the port has been closed by the user. */
+}
+
+static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd)
+{
+ int res;
+ ErtsSysForkerProto *proto;
+
+ proto = erts_alloc(ERTS_ALC_T_DRV_CTRL_DATA, sizeof(*proto));
+
+ if ((res = read(fd, proto, sizeof(*proto))) < 0) {
+ if (errno == ERRNO_BLOCK)
+ return;
+ erts_exit(ERTS_DUMP_EXIT, "Failed to read from erl_child_setup: %d\n", errno);
+ }
+
+ if (res == 0)
+ erts_exit(ERTS_DUMP_EXIT, "erl_child_setup closed\n");
+
+ ASSERT(res == sizeof(*proto));
+
+#ifdef FORKER_PROTO_START_ACK
+ if (proto->action == ErtsSysForkerProtoAction_StartAck) {
+ /* Ideally we would like to not have to ack each Start
+ command being sent over the uds, but it would seem
+ that some operating systems (only observed on FreeBSD)
+ throw away data on the uds when the socket becomes full,
+ so we have to.
+ */
+ ErlDrvPort port_num = (ErlDrvPort)e;
+ int vlen;
+ SysIOVec *iov = driver_peekq(port_num, &vlen);
+ ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base;
+
+ close(proto->u.start.fds[0]);
+ close(proto->u.start.fds[1]);
+ if (proto->u.start.fds[1] != proto->u.start.fds[2])
+ close(proto->u.start.fds[2]);
+
+ driver_deq(port_num, sizeof(*proto));
+
+ if (driver_sizeq(port_num) > 0)
+ driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ } else
+#endif
+ {
+ ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld);
+
+ /* ideally this would be a port_command call, but as command is
+ already used by the spawn_driver, we use control instead.
+ Note that when using erl_drv_port_control it is an asynchronous
+ control. */
+ erl_drv_port_control(proto->u.sigchld.port_id, 'S',
+ (char*)proto, sizeof(*proto));
+ }
+
+}
+
+static void forker_ready_output(ErlDrvData e, ErlDrvEvent fd)
+{
+ ErlDrvPort port_num = (ErlDrvPort)e;
+
+#ifndef FORKER_PROTO_START_ACK
+ while (driver_sizeq(port_num) > 0) {
+#endif
+ int vlen;
+ SysIOVec *iov = driver_peekq(port_num, &vlen);
+ ErtsSysForkerProto *proto = (ErtsSysForkerProto *)iov[0].iov_base;
+ ASSERT(iov[0].iov_len >= (sizeof(*proto)));
+ if (sys_uds_write(forker_fd, (char*)proto, sizeof(*proto),
+ proto->u.start.fds, 3, 0) < 0) {
+ if (errno == ERRNO_BLOCK)
+ return;
+ erts_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno);
+ }
+#ifndef FORKER_PROTO_START_ACK
+ close(proto->u.start.fds[0]);
+ close(proto->u.start.fds[1]);
+ if (proto->u.start.fds[1] != proto->u.start.fds[2])
+ close(proto->u.start.fds[2]);
+ driver_deq(port_num, sizeof(*proto));
+ }
+#endif
+
+ driver_select(port_num, forker_fd, ERL_DRV_WRITE, 0);
+}
+
+static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf,
+ ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen)
+{
+ ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf;
+ ErlDrvPort port_num = (ErlDrvPort)e;
+ int res;
+
+ driver_enq(port_num, buf, len);
+ if (driver_sizeq(port_num) > sizeof(*proto)) {
+ return 0;
+ }
+
+ if ((res = sys_uds_write(forker_fd, (char*)proto, sizeof(*proto),
+ proto->u.start.fds, 3, 0)) < 0) {
+ if (errno == ERRNO_BLOCK) {
+ driver_select(port_num, forker_fd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ return 0;
+ }
+ erts_exit(ERTS_DUMP_EXIT, "Failed to write to erl_child_setup: %d\n", errno);
+ }
+
+#ifndef FORKER_PROTO_START_ACK
+ ASSERT(res == sizeof(*proto));
+ close(proto->u.start.fds[0]);
+ close(proto->u.start.fds[1]);
+ if (proto->u.start.fds[1] != proto->u.start.fds[2])
+ close(proto->u.start.fds[2]);
+ driver_deq(port_num, sizeof(*proto));
+#endif
+
+ return 0;
+}
diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c
index 1ef9e5eef7..89e2484b17 100644
--- a/erts/emulator/sys/unix/sys_float.c
+++ b/erts/emulator/sys/unix/sys_float.c
@@ -90,7 +90,7 @@ void erts_fp_check_init_error(volatile unsigned long *fpexnp)
snprintf(buf, sizeof buf, "ERTS_FP_CHECK_INIT at %p: detected unhandled FPE at %p\r\n",
__builtin_return_address(0), (void*)*fpexnp);
if (write(2, buf, strlen(buf)) <= 0)
- erl_exit(ERTS_ABORT_EXIT, "%s", buf);
+ erts_exit(ERTS_ABORT_EXIT, "%s", buf);
*fpexnp = 0;
#if defined(__i386__) || defined(__x86_64__)
erts_restore_fpu();
@@ -499,18 +499,8 @@ static int mask_fpe(void)
#define mc_pc(mc) ((mc)->gregs[REG_RIP])
#elif defined(__linux__) && defined(__i386__)
#define mc_pc(mc) ((mc)->gregs[REG_EIP])
-#elif defined(__DARWIN__) && defined(__i386__)
-#ifdef DARWIN_MODERN_MCONTEXT
-#define mc_pc(mc) ((mc)->__ss.__eip)
-#else
-#define mc_pc(mc) ((mc)->ss.eip)
-#endif
-#elif defined(__DARWIN__) && defined(__x86_64__)
-#ifdef DARWIN_MODERN_MCONTEXT
-#define mc_pc(mc) ((mc)->__ss.__rip)
-#else
-#define mc_pc(mc) ((mc)->ss.rip)
-#endif
+#elif defined(__DARWIN__)
+# error "Floating-point exceptions not supported on MacOS X"
#elif defined(__FreeBSD__) && defined(__x86_64__)
#define mc_pc(mc) ((mc)->mc_rip)
#elif defined(__FreeBSD__) && defined(__i386__)
@@ -575,17 +565,7 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc)
regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */
#endif
#elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__))
-#ifdef DARWIN_MODERN_MCONTEXT
- mcontext_t mc = uc->uc_mcontext;
- pc = mc_pc(mc);
- mc->__fs.__fpu_mxcsr = 0x1F80;
- *(unsigned short *)&mc->__fs.__fpu_fsw &= ~0xFF;
-#else
- mcontext_t mc = uc->uc_mcontext;
- pc = mc_pc(mc);
- mc->fs.fpu_mxcsr = 0x1F80;
- *(unsigned short *)&mc->fs.fpu_fsw &= ~0xFF;
-#endif /* DARWIN_MODERN_MCONTEXT */
+# error "Floating-point exceptions not supported on MacOS X"
#elif defined(__DARWIN__) && defined(__ppc__)
mcontext_t mc = uc->uc_mcontext;
pc = mc->ss.srr0;
diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c
index 2e1914f564..8ce02506ab 100644
--- a/erts/emulator/sys/unix/sys_time.c
+++ b/erts/emulator/sys/unix/sys_time.c
@@ -65,6 +65,8 @@
# include <fcntl.h>
#endif
+static void init_perf_counter(void);
+
/******************* Routines for time measurement *********************/
#undef ERTS_SYS_TIME_INTERNAL_STATE_WRITE_FREQ__
@@ -342,7 +344,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
* times() (CLK_TCK), the resolution is always one millisecond..
*/
if ((erts_sys_time_data__.r.o.ticks_per_sec = TICKS_PER_SEC()) < 0)
- erl_exit(ERTS_ABORT_EXIT, "Can't get clock ticks/sec\n");
+ erts_exit(ERTS_ABORT_EXIT, "Can't get clock ticks/sec\n");
#if defined(OS_MONOTONIC_TIME_USING_TIMES)
#if ERTS_COMPILE_TIME_MONOTONIC_TIME_UNIT
@@ -404,6 +406,8 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
# error Missing erts_os_system_time() implementation
#endif
+ init_perf_counter();
+
}
void
@@ -450,7 +454,7 @@ posix_clock_gettime(clockid_t id, char *name)
if (clock_gettime(id, &ts) != 0) {
int err = errno;
char *errstr = err ? strerror(err) : "unknown";
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"clock_gettime(%s, _) failed: %s (%d)\n",
name, errstr, err);
}
@@ -495,13 +499,13 @@ posix_clock_gettime_times(clockid_t mid, char *mname,
if (mres != 0) {
char *errstr = merr ? strerror(merr) : "unknown";
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"clock_gettime(%s, _) failed: %s (%d)\n",
mname, errstr, merr);
}
if (sres != 0) {
char *errstr = serr ? strerror(serr) : "unknown";
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"clock_gettime(%s, _) failed: %s (%d)\n",
sname, errstr, serr);
}
@@ -674,7 +678,7 @@ mach_clocks_init(void)
clck_srv_p = &internal_state.r.o.mach.clock.monotonic.srv;
kret = host_get_clock_service(host, id, clck_srv_p);
if (kret != KERN_SUCCESS) {
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"host_get_clock_service(_, %s, _) failed\n",
name);
}
@@ -686,7 +690,7 @@ mach_clocks_init(void)
clck_srv_p = &internal_state.r.o.mach.clock.wall.srv;
kret = host_get_clock_service(host, id, clck_srv_p);
if (kret != KERN_SUCCESS) {
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"host_get_clock_service(_, %s, _) failed\n",
name);
}
@@ -695,7 +699,7 @@ mach_clocks_init(void)
if (atexit(mach_clocks_fini) != 0) {
int err = errno;
char *errstr = err ? strerror(err) : "unknown";
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"Failed to register mach_clocks_fini() "
"for call at exit: %s (%d)\n",
errstr, err);
@@ -717,7 +721,7 @@ mach_clock_getres(ErtsMachClock *clk)
(clock_attr_t) attr,
&cnt);
if (kret != KERN_SUCCESS || cnt != 1) {
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"clock_get_attributes(%s, _) failed\n",
clk->name);
}
@@ -735,7 +739,7 @@ mach_clock_get_time(ErtsMachClock *clk)
kret = clock_get_time(clk->srv, &time_spec);
if (kret != KERN_SUCCESS)
- erl_exit(ERTS_ABORT_EXIT, "clock_get_time(%s, _) failed\n", clk->name);
+ erts_exit(ERTS_ABORT_EXIT, "clock_get_time(%s, _) failed\n", clk->name);
return ERTS_TimeSpec2Sint64(&time_spec);
}
@@ -781,11 +785,11 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
&sys_time_spec);
if (mkret != KERN_SUCCESS)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"clock_get_time(%s, _) failed\n",
internal_state.r.o.mach.clock.monotonic.name);
if (skret != KERN_SUCCESS)
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"clock_get_time(%s, _) failed\n",
internal_state.r.o.mach.clock.wall.name);
@@ -850,7 +854,7 @@ erts_os_system_time(void)
if (gettimeofday(&tv, NULL) != 0) {
int err = errno;
char *errstr = err ? strerror(err) : "unknown";
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"gettimeofday(_, NULL) failed: %s (%d)\n",
errstr, err);
}
@@ -908,10 +912,120 @@ erts_os_times(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
#endif
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
+ * Performance counter functions *
+\* */
+
+
+/* What resolution to spin to in micro seconds */
+#define RESOLUTION 100
+/* How many iterations to spin */
+#define ITERATIONS 1
+/* How many significant figures to round to */
+#define SIGFIGS 3
+
+static ErtsSysPerfCounter calculate_perf_counter_unit(void) {
+ int i;
+ ErtsSysPerfCounter pre, post;
+ double value = 0;
+ double round_factor;
+#if defined(HAVE_GETHRTIME) && defined(GETHRTIME_WITH_CLOCK_GETTIME)
+ struct timespec basetime,comparetime;
+#define __GETTIME(arg) clock_gettime(CLOCK_MONOTONIC,arg)
+#define __GETUSEC(arg) (arg.tv_nsec / 1000)
+#else
+ SysTimeval basetime,comparetime;
+#define __GETTIME(arg) sys_gettimeofday(arg)
+#define __GETUSEC(arg) arg.tv_usec
+#endif
+
+ for (i = 0; i < ITERATIONS; i++) {
+ /* Make sure usec just flipped over at current resolution */
+ __GETTIME(&basetime);
+ do {
+ __GETTIME(&comparetime);
+ } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION));
+
+ pre = erts_sys_perf_counter();
+
+ __GETTIME(&basetime);
+ do {
+ __GETTIME(&comparetime);
+ } while ((__GETUSEC(basetime) / RESOLUTION) == (__GETUSEC(comparetime) / RESOLUTION));
+
+ post = erts_sys_perf_counter();
+
+ value += post - pre;
+ }
+ /* After this value is ticks per us */
+ value /= (RESOLUTION*ITERATIONS);
+
+ /* We round to 3 significant figures */
+ round_factor = pow(10.0, SIGFIGS - ceil(log10(value)));
+ value = ((ErtsSysPerfCounter)(value * round_factor + 0.5)) / round_factor;
+
+ /* convert to ticks per second */
+ return 1000000 * value;
+}
+
+static int have_rdtscp(void)
+{
+#if defined(ETHR_X86_RUNTIME_CONF__)
+ /* On early x86 cpu's the tsc varies with the current speed of the cpu,
+ which means that the time per tick vary depending on the current
+ load of the cpu. We do not want this as it would give very scewed
+ numbers when the cpu is mostly idle.
+ The linux kernel seems to think that checking for constant and
+ reliable is enough to trust the counter so we do the same.
+
+ If this test is not good enough, I don't know what we'll do.
+ Maybe fallback on erts_sys_hrtime always, but that would be a shame as
+ rdtsc is about 3 times faster than hrtime... */
+ return ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ &&
+ ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__;
+#else
+ return 0;
+#endif
+}
+
+static ErtsSysPerfCounter rdtsc(void)
+{
+ /* It may have been a good idea to put the cpuid instruction before
+ the rdtsc, but I decided against it because it is not really
+ needed for msacc, and it slows it down by quite a bit (5-7 times slower).
+ As a result though, this timestamp becomes much less
+ accurate as it might be re-ordered to be executed way before or after this
+ function is called.
+ */
+ ErtsSysPerfCounter ts;
+#if defined(__x86_64__)
+ __asm__ __volatile__ ("rdtsc\n\t"
+ "shl $32, %%rdx\n\t"
+ "or %%rdx, %0" : "=a" (ts) : : "rdx");
+#elif defined(__i386__)
+ __asm__ __volatile__ ("rdtsc\n\t"
+ : "=A" (ts) );
+#endif
+ return ts;
+}
+
+static void init_perf_counter(void)
+{
+ if (have_rdtscp()) {
+ erts_sys_time_data__.r.o.perf_counter = rdtsc;
+ erts_sys_time_data__.r.o.perf_counter_unit = calculate_perf_counter_unit();
+ } else {
+ erts_sys_time_data__.r.o.perf_counter = erts_sys_hrtime;
+ erts_sys_time_data__.r.o.perf_counter_unit = ERTS_HRTIME_UNIT;
+ }
+}
+
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
#ifdef HAVE_GETHRVTIME_PROCFS_IOCTL
+/* The code below only has effect on solaris < 10,
+ needed in order for gehhrvtime to work properly */
int sys_start_hrvtime(void)
{
long msacct = PR_MSACCT;
diff --git a/erts/emulator/sys/unix/sys_uds.c b/erts/emulator/sys/unix/sys_uds.c
new file mode 100644
index 0000000000..015d0346a1
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_uds.c
@@ -0,0 +1,155 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-2009. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "sys_uds.h"
+
+int
+sys_uds_readv(int fd, struct iovec *iov, size_t iov_len,
+ int *fds, int fd_count, int flags) {
+ struct msghdr msg;
+ struct cmsghdr *cmsg = NULL;
+ char ancillary_buff[256] = {0};
+ int res, i = 0;
+
+ /* setup a place to fill in message contents */
+ memset(&msg, 0, sizeof(struct msghdr));
+ msg.msg_iov = iov;
+ msg.msg_iovlen = iov_len;
+
+ /* provide space for the ancillary data */
+ msg.msg_control = ancillary_buff;
+ msg.msg_controllen = sizeof(ancillary_buff);
+
+ if((res = recvmsg(fd, &msg, flags)) < 0) {
+#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
+ /* When some OS X versions run out of fd's
+ they give EMSGSIZE instead of EMFILE.
+ We remap this as we want the correct
+ error to appear for the user */
+ if (errno == EMSGSIZE)
+ errno = EMFILE;
+#endif
+ return res;
+ }
+
+ if((msg.msg_flags & MSG_CTRUNC) == MSG_CTRUNC)
+ {
+ /* We assume that we have given enough space for any header
+ that are sent to us. So the only remaining reason to get
+ this flag set is if the caller has run out of file descriptors.
+ */
+ errno = EMFILE;
+ return -1;
+ }
+
+ for (cmsg = CMSG_FIRSTHDR(&msg); cmsg; cmsg = CMSG_NXTHDR(&msg, cmsg) ) {
+ if ((cmsg->cmsg_level == SOL_SOCKET) &&
+ (cmsg->cmsg_type == SCM_RIGHTS)) {
+ int *cmsg_data = (int *)CMSG_DATA(cmsg);
+ while ((char*)cmsg_data < (char*)cmsg + cmsg->cmsg_len) {
+ if (i < fd_count) {
+ fds[i++] = *cmsg_data++;
+ } else {
+ /* for some strange reason, we have received more FD's
+ than we wanted... close them if we are not running
+ debug. */
+ if(i >= fd_count) abort();
+ close(*cmsg_data++);
+ }
+ }
+ }
+ }
+
+ return res;
+}
+
+int
+sys_uds_read(int fd, char *buff, size_t len,
+ int *fds, int fd_count, int flags) {
+ struct iovec iov;
+ iov.iov_base = buff;
+ iov.iov_len = len;
+ return sys_uds_readv(fd, &iov, 1, fds, fd_count, flags);
+}
+
+
+int
+sys_uds_writev(int fd, struct iovec *iov, size_t iov_len,
+ int *fds, int fd_count, int flags) {
+
+ struct msghdr msg;
+ struct cmsghdr *cmsg = NULL;
+ int res, i;
+
+ /* initialize socket message */
+ memset(&msg, 0, sizeof(struct msghdr));
+
+ /* We flatten the iov if it is too long */
+ if (iov_len > MAXIOV) {
+ int size = 0;
+ char *buff;
+ for (i = 0; i < iov_len; i++)
+ size += iov[i].iov_len;
+ buff = malloc(size);
+
+ for (i = 0; i < iov_len; i++) {
+ memcpy(buff, iov[i].iov_base, iov[i].iov_len);
+ buff += iov[i].iov_len;
+ }
+
+ iov[0].iov_base = buff - size;
+ iov[0].iov_len = size;
+ msg.msg_iov = iov;
+ msg.msg_iovlen = 1;
+ } else {
+ msg.msg_iov = iov;
+ msg.msg_iovlen = iov_len;
+ }
+
+ /* initialize the ancillary data */
+ msg.msg_control = calloc(1, CMSG_SPACE(sizeof(int) * fd_count));
+ msg.msg_controllen = CMSG_SPACE(sizeof(int) * fd_count);
+
+ /* copy the fd array into the ancillary data */
+ cmsg = CMSG_FIRSTHDR(&msg);
+ if(!cmsg) abort();
+ cmsg->cmsg_level = SOL_SOCKET;
+ cmsg->cmsg_type = SCM_RIGHTS;
+ cmsg->cmsg_len = CMSG_LEN(sizeof(int) * fd_count);
+ memcpy(CMSG_DATA(cmsg), fds, sizeof(int) * fd_count);
+
+ res = sendmsg(fd, &msg, flags);
+
+ if (iov_len > MAXIOV)
+ free(iov[0].iov_base);
+
+ free(msg.msg_control);
+
+ return res;
+}
+
+int
+sys_uds_write(int fd, char *buff, size_t len,
+ int *fds, int fd_count, int flags) {
+ struct iovec iov;
+ iov.iov_base = buff;
+ iov.iov_len = len;
+ return sys_uds_writev(fd, &iov, 1, fds, fd_count, flags);
+}
diff --git a/erts/emulator/sys/unix/sys_uds.h b/erts/emulator/sys/unix/sys_uds.h
new file mode 100644
index 0000000000..844a2804d8
--- /dev/null
+++ b/erts/emulator/sys/unix/sys_uds.h
@@ -0,0 +1,57 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2002-2009. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifndef _ERL_UNIX_UDS_H
+#define _ERL_UNIX_UDS_H
+
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#if defined(__sun__) && !defined(_XOPEN_SOURCE)
+#define _XOPEN_SOURCE 500
+#endif
+
+#include <limits.h>
+
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/uio.h>
+
+#if defined IOV_MAX
+#define MAXIOV IOV_MAX
+#elif defined UIO_MAXIOV
+#define MAXIOV UIO_MAXIOV
+#else
+#define MAXIOV 16
+#endif
+
+#include "sys.h"
+
+int sys_uds_readv(int fd, struct iovec *iov, size_t iov_len,
+ int *fds, int fd_count, int flags);
+int sys_uds_read(int fd, char *buff, size_t len,
+ int *fds, int fd_count, int flags);
+int sys_uds_writev(int fd, struct iovec *iov, size_t iov_len,
+ int *fds, int fd_count, int flags);
+int sys_uds_write(int fd, char *buff, size_t len,
+ int *fds, int fd_count, int flags);
+
+#endif /* #ifndef _ERL_UNIX_UDS_H */
diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c
index 466f4a3b48..9c1bef5f4f 100644
--- a/erts/emulator/sys/win32/erl_poll.c
+++ b/erts/emulator/sys/win32/erl_poll.c
@@ -27,6 +27,7 @@
#include "erl_alloc.h"
#include "erl_poll.h"
#include "erl_time.h"
+#include "erl_msacc.h"
/*
* Some debug macros
@@ -436,7 +437,7 @@ wakeup_cause(ErtsPollSet ps)
break;
default:
res = 0;
- erl_exit(ERTS_ABORT_EXIT,
+ erts_exit(ERTS_ABORT_EXIT,
"%s:%d: Internal error: Invalid wakeup_state=%d\n",
__FILE__, __LINE__, (int) wakeup_state);
}
@@ -576,7 +577,7 @@ static void signal_standby(ErtsPollSet ps)
--(ps->standby_wait_counter);
if (ps->standby_wait_counter < 0) {
LeaveCriticalSection(&(ps->standby_crit));
- erl_exit(1,"Standby signalled by more threads than expected");
+ erts_exit(ERTS_ERROR_EXIT,"Standby signalled by more threads than expected");
}
if (!(ps->standby_wait_counter)) {
SetEvent(ps->standby_wait_event);
@@ -738,7 +739,7 @@ static void *break_waiter(void *param)
erts_mtx_unlock(&break_waiter_lock);
break;
default:
- erl_exit(1,"Unexpected event in break_waiter");
+ erts_exit(ERTS_ERROR_EXIT,"Unexpected event in break_waiter");
}
}
}
@@ -1157,7 +1158,7 @@ int erts_poll_wait(ErtsPollSet ps,
HARDDEBUGF(("Oups!"));
/* Oups, got signalled before we took the lock, can't reset */
if(!is_io_ready(ps)) {
- erl_exit(1,"Internal error: "
+ erts_exit(ERTS_ERROR_EXIT,"Internal error: "
"Inconsistent io structures in erl_poll.\n");
}
START_WAITER(ps,w);
@@ -1188,16 +1189,19 @@ int erts_poll_wait(ErtsPollSet ps,
if (timeout > 0 && !erts_atomic32_read_nob(&break_waiter_state)) {
HANDLE harr[2] = {ps->event_io_ready, break_happened_event};
int num_h = 2;
+ ERTS_MSACC_PUSH_STATE_M();
HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout));
ERTS_POLLSET_UNLOCK(ps);
#ifdef ERTS_SMP
erts_thr_progress_prepare_wait(NULL);
#endif
+ ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
WaitForMultipleObjects(num_h, harr, FALSE, timeout);
#ifdef ERTS_SMP
erts_thr_progress_finalize_wait(NULL);
#endif
+ ERTS_MSACC_POP_STATE_M();
ERTS_POLLSET_LOCK(ps);
HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout));
woke_up(ps);
@@ -1215,7 +1219,7 @@ int erts_poll_wait(ErtsPollSet ps,
ERTS_SET_BREAK_REQUESTED;
break;
case BREAK_WAITER_GOT_HALT:
- erl_exit(0,"");
+ erts_exit(0,"");
break;
default:
break;
diff --git a/erts/emulator/sys/win32/erl_win32_sys_ddll.c b/erts/emulator/sys/win32/erl_win32_sys_ddll.c
index 9a5557e93d..7c24a77e31 100644
--- a/erts/emulator/sys/win32/erl_win32_sys_ddll.c
+++ b/erts/emulator/sys/win32/erl_win32_sys_ddll.c
@@ -52,7 +52,8 @@ void erl_sys_ddll_init(void) {
#define ERL_NIF_API_FUNC_DECL(RET,NAME,ARGS) nif_callbacks.NAME = NAME
#include "erl_nif_api_funcs.h"
#undef ERL_NIF_API_FUNC_DECL
-
+ nif_callbacks.erts_alc_test = erts_alc_test;
+
return;
}
diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h
index 5e62320be4..9c699fdba0 100644
--- a/erts/emulator/sys/win32/erl_win_dyn_driver.h
+++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h
@@ -103,6 +103,11 @@ WDD_TYPEDEF(ErlDrvSInt, driver_pdl_inc_refc, (ErlDrvPDL));
WDD_TYPEDEF(ErlDrvSInt, driver_pdl_dec_refc, (ErlDrvPDL));
WDD_TYPEDEF(void, driver_system_info, (ErlDrvSysInfo *, size_t));
WDD_TYPEDEF(int, driver_get_now, (ErlDrvNowData *));
+WDD_TYPEDEF(ErlDrvTime, erl_drv_monotonic_time, (ErlDrvTimeUnit));
+WDD_TYPEDEF(ErlDrvTime, erl_drv_time_offset, (ErlDrvTimeUnit));
+WDD_TYPEDEF(ErlDrvTime, erl_drv_convert_time_unit, (ErlDrvTime,
+ ErlDrvTimeUnit,
+ ErlDrvTimeUnit));
WDD_TYPEDEF(int, driver_monitor_process, (ErlDrvPort port,
ErlDrvTermData process,
ErlDrvMonitor *monitor));
@@ -145,8 +150,8 @@ WDD_TYPEDEF(ErlDrvTid, erl_drv_thread_self, (void));
WDD_TYPEDEF(int, erl_drv_equal_tids, (ErlDrvTid tid1, ErlDrvTid tid2));
WDD_TYPEDEF(void, erl_drv_thread_exit, (void *resp));
WDD_TYPEDEF(int, erl_drv_thread_join, (ErlDrvTid, void **respp));
-WDD_TYPEDEF(int, erl_drv_putenv, (char *key, char *value));
-WDD_TYPEDEF(int, erl_drv_getenv, (char *key, char *value, size_t *value_size));
+WDD_TYPEDEF(int, erl_drv_putenv, (const char *key, char *value));
+WDD_TYPEDEF(int, erl_drv_getenv, (const char *key, char *value, size_t *value_size));
typedef struct {
WDD_FTYPE(null_func) *null_func;
@@ -217,6 +222,9 @@ typedef struct {
WDD_FTYPE(driver_pdl_dec_refc) *driver_pdl_dec_refc;
WDD_FTYPE(driver_system_info) *driver_system_info;
WDD_FTYPE(driver_get_now) *driver_get_now;
+ WDD_FTYPE(erl_drv_monotonic_time) *erl_drv_monotonic_time;
+ WDD_FTYPE(erl_drv_time_offset) *erl_drv_time_offset;
+ WDD_FTYPE(erl_drv_convert_time_unit) *erl_drv_convert_time_unit;
WDD_FTYPE(driver_monitor_process) *driver_monitor_process;
WDD_FTYPE(driver_demonitor_process) *driver_demonitor_process;
WDD_FTYPE(driver_get_monitored_process) *driver_get_monitored_process;
@@ -328,6 +336,9 @@ extern TWinDynDriverCallbacks WinDynDriverCallbacks;
#define driver_pdl_dec_refc (WinDynDriverCallbacks.driver_pdl_dec_refc)
#define driver_system_info (WinDynDriverCallbacks.driver_system_info)
#define driver_get_now (WinDynDriverCallbacks.driver_get_now)
+#define erl_drv_monotonic_time (WinDynDriverCallbacks.erl_drv_monotonic_time)
+#define erl_drv_time_offset (WinDynDriverCallbacks.erl_drv_time_offset)
+#define erl_drv_convert_time_unit (WinDynDriverCallbacks.erl_drv_convert_time_unit)
#define driver_monitor_process \
(WinDynDriverCallbacks.driver_monitor_process)
#define driver_demonitor_process \
@@ -463,6 +474,9 @@ do { \
((W).driver_pdl_dec_refc) = driver_pdl_dec_refc; \
((W).driver_system_info) = driver_system_info; \
((W).driver_get_now) = driver_get_now; \
+((W).erl_drv_monotonic_time) = erl_drv_monotonic_time; \
+((W).erl_drv_time_offset) = erl_drv_time_offset; \
+((W).erl_drv_convert_time_unit) = erl_drv_convert_time_unit; \
((W).driver_monitor_process) = driver_monitor_process; \
((W).driver_demonitor_process) = driver_demonitor_process; \
((W).driver_get_monitored_process) = driver_get_monitored_process; \
diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h
index 7e8dd8a4ca..99c1066ab3 100644
--- a/erts/emulator/sys/win32/erl_win_sys.h
+++ b/erts/emulator/sys/win32/erl_win_sys.h
@@ -183,6 +183,7 @@ typedef LONGLONG ErtsSysHrTime;
#endif
typedef ErtsMonotonicTime ErtsSystemTime;
+typedef ErtsMonotonicTime ErtsSysPerfCounter;
ErtsSystemTime erts_os_system_time(void);
@@ -213,6 +214,7 @@ ERTS_GLB_INLINE ErtsMonotonicTime erts_os_monotonic_time(void);
ERTS_GLB_INLINE void erts_os_times(ErtsMonotonicTime *,
ErtsSystemTime *);
ERTS_GLB_INLINE ErtsSysHrTime erts_sys_hrtime(void);
+ERTS_GLB_INLINE ErtsSysPerfCounter erts_sys_perf_counter(void);
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
@@ -234,6 +236,18 @@ erts_sys_hrtime(void)
return (*erts_sys_time_data__.r.o.sys_hrtime)();
}
+ERTS_GLB_INLINE ErtsSysPerfCounter
+erts_sys_perf_counter(void)
+{
+ return (*erts_sys_time_data__.r.o.sys_hrtime)();
+}
+
+ERTS_GLB_INLINE ErtsSysPerfCounter
+erts_sys_perf_counter_unit(void)
+{
+ return 1000 * 1000 * 1000;
+}
+
#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
extern void sys_gettimeofday(SysTimeval *tv);
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index fce76db28f..ea7523ddc2 100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -38,7 +38,7 @@
void erts_sys_init_float(void);
void erl_start(int, char**);
-void erl_exit(int n, char*, ...);
+void erts_exit(int n, char*, ...);
void erl_error(char*, va_list);
void erl_crash_dump(char*, int, char*, ...);
@@ -200,7 +200,7 @@ erts_sys_misc_mem_sz(void)
*/
void sys_tty_reset(int exit_code)
{
- if (exit_code > 0)
+ if (exit_code == ERTS_ERROR_EXIT)
ConWaitForExit();
else
ConNormalExit();
@@ -1334,10 +1334,8 @@ spawn_start(ErlDrvPort port_num, char* utf8_name, SysDriverOpts* opts)
retval = set_driver_data(dp, hFromChild, hToChild, opts->read_write,
opts->exit_status);
if (retval != ERL_DRV_ERROR_GENERAL && retval != ERL_DRV_ERROR_ERRNO) {
- Port *prt = erts_drvport2port(port_num);
- /* We assume that this cannot generate a negative number */
- ASSERT(prt != ERTS_INVALID_ERL_DRV_PORT);
- prt->os_pid = (SWord) pid;
+ /* We assume that this cannot generate a negative number */
+ erl_drv_set_os_pid(port_num, pid);
}
}
@@ -1528,8 +1526,8 @@ create_child_process
* Parse out the program name from the command line (it can be quoted and
* contain spaces).
*/
- newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, 2048*sizeof(wchar_t));
cmdlength = parse_command(origcmd);
+ newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, (MAX_PATH+wcslen(origcmd)-cmdlength)*sizeof(wchar_t));
thecommand = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, (cmdlength+1)*sizeof(wchar_t));
wcsncpy(thecommand, origcmd, cmdlength);
thecommand[cmdlength] = L'\0';
@@ -3110,13 +3108,13 @@ check_supported_os_version(void)
|| int_os_version.dwMajorVersion < major
|| (int_os_version.dwMajorVersion == major
&& int_os_version.dwMinorVersion < minor))
- erl_exit(-1,
+ erts_exit(1,
"Windows version not supported "
"(min required: winnt %d.%d)\n",
major, minor);
}
#else
- erl_exit(-1,
+ erts_exit(1,
"Windows version not supported "
"(min required: win %d.%d)\n",
nt_major, nt_minor);
@@ -3273,6 +3271,12 @@ void erl_sys_init(void)
}
void
+erl_sys_late_init(void)
+{
+ /* do nothing */
+}
+
+void
erts_sys_schedule_interrupt(int set)
{
erts_check_io_interrupt(set);
diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c
index d6178de03c..a89211fa8e 100644
--- a/erts/emulator/sys/win32/sys_interrupt.c
+++ b/erts/emulator/sys/win32/sys_interrupt.c
@@ -81,7 +81,7 @@ BOOL WINAPI ctrl_handler_ignore_break(DWORD dwCtrlType)
return TRUE;
/* else pour through... */
case CTRL_CLOSE_EVENT:
- erl_exit(0, "");
+ erts_exit(0, "");
break;
}
return TRUE;
@@ -106,7 +106,7 @@ BOOL WINAPI ctrl_handler_replace_intr(DWORD dwCtrlType)
/* else pour through... */
case CTRL_CLOSE_EVENT:
case CTRL_SHUTDOWN_EVENT:
- erl_exit(0, "");
+ erts_exit(0, "");
break;
}
return TRUE;
@@ -133,7 +133,7 @@ BOOL WINAPI ctrl_handler(DWORD dwCtrlType)
return TRUE;
/* else pour through... */
case CTRL_CLOSE_EVENT:
- erl_exit(0, "");
+ erts_exit(0, "");
break;
}
return TRUE;
diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c
index 9e5f78703a..9a9d90610d 100644
--- a/erts/emulator/sys/win32/sys_time.c
+++ b/erts/emulator/sys/win32/sys_time.c
@@ -147,7 +147,7 @@ os_monotonic_time_qpc(void)
LARGE_INTEGER pc;
if (!(*internal_state.r.o.pQueryPerformanceCounter)(&pc))
- erl_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
+ erts_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
return (ErtsMonotonicTime) pc.QuadPart;
}
@@ -164,7 +164,7 @@ os_times_qpc(ErtsMonotonicTime *mtimep, ErtsSystemTime *stimep)
GetSystemTime(&st);
if (!qpcr)
- erl_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
+ erts_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
*mtimep = (ErtsMonotonicTime) pc.QuadPart;
@@ -251,7 +251,7 @@ sys_hrtime_qpc(void)
LARGE_INTEGER pc;
if (!(*internal_state.r.o.pQueryPerformanceCounter)(&pc))
- erl_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
+ erts_exit(ERTS_ABORT_EXIT, "QueryPerformanceCounter() failed\n");
ASSERT(pc.QuadPart > 0);
@@ -397,6 +397,7 @@ sys_init_time(ErtsSysInitTimeResult *init_resp)
erts_sys_time_data__.r.o.os_monotonic_time = os_mtime_func;
erts_sys_time_data__.r.o.os_times = os_times_func;
+ erts_sys_time_data__.r.o.sys_hrtime = sys_hrtime_func;
init_resp->os_monotonic_time_unit = time_unit;
init_resp->have_os_monotonic_time = 1;
init_resp->have_corrected_os_monotonic_time = 0;
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index 77614d455c..318db4b45e 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -74,11 +74,13 @@ MODULES= \
match_spec_SUITE \
module_info_SUITE \
monitor_SUITE \
+ multi_load_SUITE \
nested_SUITE \
nif_SUITE \
node_container_SUITE \
nofrag_SUITE \
num_bif_SUITE \
+ message_queue_data_SUITE \
op_SUITE \
port_SUITE \
port_bif_SUITE \
@@ -157,7 +159,7 @@ RELSYSDIR = $(RELEASE_PATH)/emulator_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
# ----------------------------------------------------
# Targets
diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl
index 16f060fe34..5b3a213154 100644
--- a/erts/emulator/test/a_SUITE.erl
+++ b/erts/emulator/test/a_SUITE.erl
@@ -27,68 +27,43 @@
%%%-------------------------------------------------------------------
-module(a_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, long_timers/1, pollset_size/1]).
+-export([all/0, suite/0,
+ long_timers/1, pollset_size/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
all() ->
[long_timers, pollset_size].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-long_timers(doc) ->
- [];
-long_timers(suite) ->
- [];
long_timers(Config) when is_list(Config) ->
- Dir = ?config(data_dir, Config),
- ?line long_timers_test:start(Dir),
- ?line {comment,
- "Testcase started! This test will run in parallel with the "
- "erts testsuite and ends in the z_SUITE:long_timers testcase."}.
+ Dir = proplists:get_value(data_dir, Config),
+ long_timers_test:start(Dir),
+ {comment, "Testcase started! This test will run in parallel with the "
+ "erts testsuite and ends in the z_SUITE:long_timers testcase."}.
-pollset_size(doc) ->
- [];
-pollset_size(suite) ->
- [];
pollset_size(Config) when is_list(Config) ->
%% Ensure inet_gethost_native port program started, in order to
%% allow other suites to use it...
inet_gethost_native:gethostbyname("localhost"),
- ?line Parent = self(),
- ?line Go = make_ref(),
- ?line spawn(fun () ->
- Name = pollset_size_testcase_initial_state_holder,
- true = register(Name, self()),
- ChkIo = get_check_io_info(),
- io:format("Initial: ~p~n", [ChkIo]),
- Parent ! Go,
- receive
- {get_initial_check_io_result, Pid} ->
- Pid ! {initial_check_io_result, ChkIo}
- end
- end),
- ?line receive Go -> ok end,
- ?line {comment,
- "Testcase started! This test will run in parallel with the "
- "erts testsuite and ends in the z_SUITE:pollset_size testcase."}.
+ Parent = self(),
+ Go = make_ref(),
+ spawn(fun () ->
+ Name = pollset_size_testcase_initial_state_holder,
+ true = register(Name, self()),
+ ChkIo = get_check_io_info(),
+ io:format("Initial: ~p~n", [ChkIo]),
+ Parent ! Go,
+ receive
+ {get_initial_check_io_result, Pid} ->
+ Pid ! {initial_check_io_result, ChkIo}
+ end
+ end),
+ receive Go -> ok end,
+ {comment, "Testcase started! This test will run in parallel with the "
+ "erts testsuite and ends in the z_SUITE:pollset_size testcase."}.
%%
%% Internal functions...
@@ -106,5 +81,3 @@ display_check_io(ChkIo) ->
get_check_io_info() ->
z_SUITE:get_check_io_info().
-
-
diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl
index 5017a83185..a72cd8deea 100644
--- a/erts/emulator/test/after_SUITE.erl
+++ b/erts/emulator/test/after_SUITE.erl
@@ -22,92 +22,66 @@
%% Tests receive after.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
t_after/1, receive_after/1, receive_after_big/1,
receive_after_errors/1, receive_var_zero/1, receive_zero/1,
multi_timeout/1, receive_after_32bit/1,
receive_after_blast/1]).
--export([init_per_testcase/2, end_per_testcase/2]).
-
%% Internal exports.
-export([timeout_g/0]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
[t_after, receive_after, receive_after_big,
receive_after_errors, receive_var_zero, receive_zero,
multi_timeout, receive_after_32bit, receive_after_blast].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(3)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
%% Tests for an old round-off error in 'receive after'."
t_after(Config) when is_list(Config) ->
- ?line spawn(fun frequent_process/0),
- ?line Period = test_server:minutes(1),
- ?line Before = erlang:monotonic_time(),
+ spawn(fun frequent_process/0),
+ Period = test_server:minutes(1),
+ Before = erlang:monotonic_time(),
receive
- after Period ->
- ?line After = erlang:monotonic_time(),
- ?line report(Period, Before, After)
- end.
+ after Period ->
+ After = erlang:monotonic_time(),
+ report(Period, Before, After)
+ end.
report(Period, Before, After) ->
case erlang:convert_time_unit(After - Before, native, 100*1000) / Period of
- Percent when Percent > 100.10 ->
- test_server:fail({too_inaccurate, Percent});
- Percent when Percent < 100.0 ->
- test_server:fail({too_early, Percent});
- Percent ->
- Comment = io_lib:format("Elapsed/expected: ~.2f %", [Percent]),
- {comment, lists:flatten(Comment)}
+ Percent when Percent > 100.10 ->
+ ct:fail({too_inaccurate, Percent});
+ Percent when Percent < 100.0 ->
+ ct:fail({too_early, Percent});
+ Percent ->
+ Comment = io_lib:format("Elapsed/expected: ~.2f %", [Percent]),
+ {comment, lists:flatten(Comment)}
end.
frequent_process() ->
receive
- after 100 ->
- ?line frequent_process()
- end.
+ after 100 ->
+ frequent_process()
+ end.
-receive_after(doc) ->
- "Test that 'receive after' works (doesn't hang). "
- "The test takes 10 seconds to complete.";
+%% Test that 'receive after' works (doesn't hang).
+%% The test takes 10 seconds to complete.
receive_after(Config) when is_list(Config) ->
- ?line receive_after1(5000).
+ receive_after1(5000).
receive_after1(1) ->
- ?line io:format("Testing: receive after ~p~n", [1]),
- ?line receive after 1 -> ok end;
+ io:format("Testing: receive after ~p~n", [1]),
+ receive after 1 -> ok end;
receive_after1(N) ->
- ?line io:format("Testing: receive after ~p~n", [N]),
- ?line receive after N -> receive_after1(N div 2) end.
+ io:format("Testing: receive after ~p~n", [N]),
+ receive after N -> receive_after1(N div 2) end.
receive_after_big(Config) when is_list(Config) ->
%% Test that 'receive after' with a 32 bit number works.
@@ -119,14 +93,14 @@ receive_after_big1(Timeout) ->
erlang:yield(),
spawn(fun() -> Self ! here_is_a_message end),
ok = receive
- here_is_a_message ->
- ok
- after Timeout ->
- %% We test that the timeout can be set,
- %% not that an timeout occurs after the appropriate delay
- %% (48 days, 56 minutes, 48 seconds)!
- timeout
- end.
+ here_is_a_message ->
+ ok
+ after Timeout ->
+ %% We test that the timeout can be set,
+ %% not that an timeout occurs after the appropriate delay
+ %% (48 days, 56 minutes, 48 seconds)!
+ timeout
+ end.
receive_after_big2() ->
Self = self(),
@@ -147,38 +121,38 @@ receive_after_big2() ->
%% Test error cases for 'receive after'.
receive_after_errors(Config) when is_list(Config) ->
- ?line ?TryAfter(-1),
- ?line ?TryAfter(0.0),
- ?line ?TryAfter(3.14),
- ?line ?TryAfter(16#100000000),
- ?line ?TryAfter(392347129847294724972398472984729847129874),
- ?line ?TryAfter(16#3fffffffffffffff),
- ?line ?TryAfter(16#ffffffffffffffff),
- ?line ?TryAfter(-16#100000000),
- ?line ?TryAfter(-3891278094774921784123987129848),
- ?line ?TryAfter(xxx),
+ ?TryAfter(-1),
+ ?TryAfter(0.0),
+ ?TryAfter(3.14),
+ ?TryAfter(16#100000000),
+ ?TryAfter(392347129847294724972398472984729847129874),
+ ?TryAfter(16#3fffffffffffffff),
+ ?TryAfter(16#ffffffffffffffff),
+ ?TryAfter(-16#100000000),
+ ?TryAfter(-3891278094774921784123987129848),
+ ?TryAfter(xxx),
ok.
try_after(Timeout) ->
{'EXIT',{timeout_value,_}} = (catch receive after Timeout -> ok end).
-receive_var_zero(doc) -> "Test 'after Z', when Z == 0.";
+%% Test 'after Z', when Z == 0.
receive_var_zero(Config) when is_list(Config) ->
self() ! x,
self() ! y,
Z = zero(),
timeout = receive
- z -> ok
- after Z -> timeout
- end,
+ z -> ok
+ after Z -> timeout
+ end,
timeout = receive
- after Z -> timeout
- end,
+ after Z -> timeout
+ end,
self() ! w,
receive
x -> ok;
Other ->
- ?line ?t:fail({bad_message,Other})
+ ct:fail({bad_message,Other})
end.
zero() -> 0.
@@ -188,44 +162,43 @@ receive_zero(Config) when is_list(Config) ->
self() ! x,
self() ! y,
timeout = receive
- z -> ok
- after 0 ->
- timeout
- end,
+ z -> ok
+ after 0 ->
+ timeout
+ end,
self() ! w,
timeout = receive
after 0 -> timeout
end,
receive
- x -> ok;
- Other ->
- ?line ?t:fail({bad_message,Other})
+ x -> ok;
+ Other ->
+ ct:fail({bad_message,Other})
end.
-multi_timeout(doc) ->
- "Test for catching invalid assertion in erl_message.c (in queue_message)."
- "This failed (dumped core) with debug-compiled emulator.";
+%% Test for catching invalid assertion in erl_message.c (in queue_message)
+%% This failed (dumped core) with debug-compiled emulator.
multi_timeout(Config) when is_list(Config) ->
- ?line P = spawn(?MODULE, timeout_g, []),
- ?line P ! a,
- ?line P ! b,
- ?line receive
- after 1000 -> ok
- end,
- ?line P ! c,
- ?line receive
- after 1000 -> ok
- end,
- ?line P ! d,
+ P = spawn(?MODULE, timeout_g, []),
+ P ! a,
+ P ! b,
+ receive
+ after 1000 -> ok
+ end,
+ P ! c,
+ receive
+ after 1000 -> ok
+ end,
+ P ! d,
ok.
timeout_g() ->
- ?line receive
- a -> ok
+ receive
+ a -> ok
+ end,
+ receive
+ after 100000 -> ok
end,
- ?line receive
- after 100000 -> ok
- end,
ok.
%% OTP-7493: Timeout for 32 bit numbers (such as 16#ffffFFFF) could
@@ -264,8 +237,8 @@ receive_after_blast(Config) when is_list(Config) ->
TimeoutTime = erlang:monotonic_time(milli_seconds) + 5000,
lists:foreach(fun ({P, _}) -> P ! {go, TimeoutTime} end, PMs),
lists:foreach(fun ({P, M}) ->
- receive
- {'DOWN', M, process, P, normal} ->
- ok
- end
- end, PMs).
+ receive
+ {'DOWN', M, process, P, normal} ->
+ ok
+ end
+ end, PMs).
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 7c7ddde5d4..1f690c5015 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -19,8 +19,7 @@
-module(alloc_SUITE).
-author('[email protected]').
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
+-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]).
-export([basic/1,
coalesce/1,
@@ -31,44 +30,23 @@
rbtree/1,
mseg_clear_cache/1,
erts_mmap/1,
- cpool/1]).
+ cpool/1,
+ migration/1]).
--export([init_per_testcase/2, end_per_testcase/2]).
+-include_lib("common_test/include/ct.hrl").
--include_lib("test_server/include/test_server.hrl").
-
--define(DEFAULT_TIMETRAP_SECS, 240).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
[basic, coalesce, threads, realloc_copy, bucket_index,
- bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
+ bucket_mask, rbtree, mseg_clear_cache, erts_mmap, cpool, migration].
init_per_testcase(Case, Config) when is_list(Config) ->
- Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)),
- [{watchdog, Dog},{testcase, Case}|Config].
+ [{testcase, Case},{debug,false}|Config].
end_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -76,52 +54,39 @@ end_per_testcase(_Case, Config) when is_list(Config) ->
%% Testcases %%
%% %%
-basic(suite) -> [];
-basic(doc) -> [];
-basic(Cfg) -> ?line drv_case(Cfg).
+basic(Cfg) -> drv_case(Cfg).
-coalesce(suite) -> [];
-coalesce(doc) -> [];
-coalesce(Cfg) -> ?line drv_case(Cfg).
+coalesce(Cfg) -> drv_case(Cfg).
-threads(suite) -> [];
-threads(doc) -> [];
-threads(Cfg) -> ?line drv_case(Cfg).
+threads(Cfg) -> drv_case(Cfg).
-realloc_copy(suite) -> [];
-realloc_copy(doc) -> [];
-realloc_copy(Cfg) -> ?line drv_case(Cfg).
+realloc_copy(Cfg) -> drv_case(Cfg).
-bucket_index(suite) -> [];
-bucket_index(doc) -> [];
-bucket_index(Cfg) -> ?line drv_case(Cfg).
+bucket_index(Cfg) -> drv_case(Cfg).
-bucket_mask(suite) -> [];
-bucket_mask(doc) -> [];
-bucket_mask(Cfg) -> ?line drv_case(Cfg).
+bucket_mask(Cfg) -> drv_case(Cfg).
-rbtree(suite) -> [];
-rbtree(doc) -> [];
-rbtree(Cfg) -> ?line drv_case(Cfg).
+rbtree(Cfg) -> drv_case(Cfg).
-mseg_clear_cache(suite) -> [];
-mseg_clear_cache(doc) -> [];
-mseg_clear_cache(Cfg) -> ?line drv_case(Cfg).
+mseg_clear_cache(Cfg) -> drv_case(Cfg).
-cpool(suite) -> [];
-cpool(doc) -> [];
-cpool(Cfg) -> ?line drv_case(Cfg).
+cpool(Cfg) -> drv_case(Cfg).
+
+migration(Cfg) ->
+ case erlang:system_info(smp_support) of
+ true ->
+ drv_case(Cfg, concurrent, "+MZe true");
+ false ->
+ {skipped, "No smp"}
+ end.
erts_mmap(Config) when is_list(Config) ->
- case {?t:os_type(), is_halfword_vm()} of
- {{unix, _}, false} ->
+ case test_server:os_type() of
+ {unix, _} ->
[erts_mmap_do(Config, SCO, SCRPM, SCRFSD)
|| SCO <-[true,false], SCRFSD <-[1234,0], SCRPM <- [true,false]];
-
- {_,true} ->
- {skipped, "No supercarrier support on halfword vm"};
{SkipOs,_} ->
- ?line {skipped,
+ {skipped,
lists:flatten(["Not run on "
| io_lib:format("~p",[SkipOs])])}
end.
@@ -176,88 +141,224 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) ->
%% %%
drv_case(Config) ->
- drv_case(Config, "").
+ drv_case(Config, one_shot, "").
-drv_case(Config, Command) when is_list(Config),
- is_list(Command) ->
- case ?t:os_type() of
+drv_case(Config, Mode, NodeOpts) when is_list(Config) ->
+ case test_server:os_type() of
{Family, _} when Family == unix; Family == win32 ->
- ?line {ok, Node} = start_node(Config),
- ?line Self = self(),
- ?line Ref = make_ref(),
- ?line spawn_link(Node,
+ {ok, Node} = start_node(Config, NodeOpts),
+ Self = self(),
+ Ref = make_ref(),
+ spawn_link(Node,
fun () ->
- Res = run_drv_case(Config, Command),
+ Res = run_drv_case(Config, Mode),
Self ! {Ref, Res}
end),
- ?line Result = receive {Ref, Rslt} -> Rslt end,
- ?line stop_node(Node),
- ?line Result;
+ Result = receive {Ref, Rslt} -> Rslt end,
+ stop_node(Node),
+ Result;
SkipOs ->
- ?line {skipped,
+ {skipped,
lists:flatten(["Not run on "
| io_lib:format("~p",[SkipOs])])}
end.
-run_drv_case(Config, Command) ->
- ?line DataDir = ?config(data_dir,Config),
- ?line CaseName = ?config(testcase,Config),
- case erl_ddll:load_driver(DataDir, CaseName) of
- ok -> ok;
- {error, Error} ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- ?line ?t:fail()
+run_drv_case(Config, Mode) ->
+ DataDir = proplists:get_value(data_dir,Config),
+ CaseName = proplists:get_value(testcase,Config),
+ File = filename:join(DataDir, CaseName),
+ {ok,CaseName,Bin} = compile:file(File, [binary,return_errors]),
+ {module,CaseName} = erlang:load_module(CaseName,Bin),
+ print_stats(CaseName),
+ ok = CaseName:init(File),
+
+ SlaveState = slave_init(CaseName),
+ case Mode of
+ one_shot ->
+ Result = one_shot(CaseName);
+
+ concurrent ->
+ Result = concurrent(CaseName)
end,
- ?line Port = open_port({spawn, atom_to_list(CaseName)}, []),
- ?line true = is_port(Port),
- ?line Port ! {self(), {command, Command}},
- ?line Result = receive_drv_result(Port, CaseName),
- ?line Port ! {self(), close},
- ?line receive
- {Port, closed} ->
- ok
- end,
- ?line ok = erl_ddll:unload_driver(CaseName),
- ?line Result.
-
-receive_drv_result(Port, CaseName) ->
- ?line receive
- {print, Port, CaseName, Str} ->
- ?line ?t:format("~s", [Str]),
- ?line receive_drv_result(Port, CaseName);
- {'EXIT', Port, Error} ->
- ?line ?t:fail(Error);
- {'EXIT', error, Error} ->
- ?line ?t:fail(Error);
- {failed, Port, CaseName, Comment} ->
- ?line ?t:fail(Comment);
- {skipped, Port, CaseName, Comment} ->
- ?line {skipped, Comment};
- {succeeded, Port, CaseName, ""} ->
- ?line succeeded;
- {succeeded, Port, CaseName, Comment} ->
- ?line {comment, Comment}
- end.
-
-start_node(Config) ->
- start_node(Config, []).
+
+ wait_for_memory_deallocations(),
+ print_stats(CaseName),
+
+ true = erlang:delete_module(CaseName),
+ slave_end(SlaveState),
+ Result.
+
+slave_init(migration) ->
+ A0 = case application:start(sasl) of
+ ok -> [sasl];
+ _ -> []
+ end,
+ case application:start(os_mon) of
+ ok -> [os_mon|A0];
+ _ -> A0
+ end;
+slave_init(_) -> [].
+
+slave_end(Apps) ->
+ lists:foreach(fun (A) -> application:stop(A) end, Apps).
+
+wait_for_memory_deallocations() ->
+ try
+ erts_debug:set_internal_state(wait, deallocations)
+ catch
+ error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ wait_for_memory_deallocations()
+ end.
+
+print_stats(migration) ->
+ {Btot,Ctot} = lists:foldl(fun({instance,Inr,Istats}, {Bacc,Cacc}) ->
+ {mbcs,MBCS} = lists:keyfind(mbcs, 1, Istats),
+ Btup = lists:keyfind(blocks, 1, MBCS),
+ Ctup = lists:keyfind(carriers, 1, MBCS),
+ io:format("{instance,~p,~p,~p}\n", [Inr, Btup, Ctup]),
+ {tuple_add(Bacc,Btup),tuple_add(Cacc,Ctup)};
+ (_, Acc) -> Acc
+ end,
+ {{blocks,0,0,0},{carriers,0,0,0}},
+ erlang:system_info({allocator,test_alloc})),
+
+ io:format("Number of blocks : ~p\n", [Btot]),
+ io:format("Number of carriers: ~p\n", [Ctot]);
+print_stats(_) -> ok.
+
+tuple_add(T1, T2) ->
+ list_to_tuple(lists:zipwith(fun(E1,E2) when is_number(E1), is_number(E2) ->
+ E1 + E2;
+ (A,A) ->
+ A
+ end,
+ tuple_to_list(T1), tuple_to_list(T2))).
+
+
+one_shot(CaseName) ->
+ State = CaseName:start({1, 0, erlang:system_info(build_type)}),
+ Result0 = CaseName:run(State),
+ false = (Result0 =:= continue),
+ Result1 = handle_result(State, Result0),
+ CaseName:stop(State),
+ Result1.
+
+
+many_shot(CaseName, I, Mem) ->
+ State = CaseName:start({I, Mem, erlang:system_info(build_type)}),
+ Result1 = repeat_while(fun() ->
+ Result0 = CaseName:run(State),
+ handle_result(State, Result0)
+ end,
+ 10*1000, I),
+ CaseName:stop(State),
+ flush_log(),
+ Result1.
+
+concurrent(CaseName) ->
+ NSched = erlang:system_info(schedulers),
+ Mem = (free_memory() * 3) div 4,
+ PRs = lists:map(fun(I) -> spawn_opt(fun() ->
+ many_shot(CaseName, I,
+ Mem div NSched)
+ end,
+ [monitor, {scheduler,I}])
+ end,
+ lists:seq(1, NSched)),
+ lists:foreach(fun({Pid,Ref}) ->
+ receive {'DOWN', Ref, process, Pid, Reason} ->
+ Reason
+ end
+ end,
+ PRs),
+ ok.
+
+repeat_while(Fun, Timeout, I) ->
+ TRef = erlang:start_timer(Timeout, self(), timeout),
+ R = repeat_while_loop(Fun, TRef, I),
+ erlang:cancel_timer(TRef, [{async,true},{info,false}]),
+ R.
+
+repeat_while_loop(Fun, TRef, I) ->
+ receive
+ {timeout, TRef, timeout} ->
+ io:format("~p: Timeout, enough is enough.",[I]),
+ succeeded
+ after 0 ->
+ %%io:format("~p calls fun\n", [self()]),
+ case Fun() of
+ continue -> repeat_while_loop(Fun, TRef, I);
+ R -> R
+ end
+ end.
+
+flush_log() ->
+ receive
+ {print, Str} ->
+ io:format("~s", [Str]),
+ flush_log()
+ after 0 ->
+ ok
+ end.
+
+handle_result(_State, Result0) ->
+ flush_log(),
+ case Result0 of
+ {'EXIT', Error} ->
+ ct:fail(Error);
+ {'EXIT', error, Error} ->
+ ct:fail(Error);
+ {failed, Comment} ->
+ ct:fail(Comment);
+ {skipped, Comment} ->
+ {skipped, Comment};
+ {succeeded, ""} ->
+ succeeded;
+ {succeeded, Comment} ->
+ {comment, Comment};
+ continue ->
+ continue
+ end.
+
start_node(Config, Opts) when is_list(Config), is_list(Opts) ->
+ case proplists:get_value(debug,Config) of
+ true -> {ok, node()};
+ _ -> start_node_1(Config, Opts)
+ end.
+
+start_node_1(Config, Opts) ->
Pa = filename:dirname(code:which(?MODULE)),
Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
- ++ atom_to_list(?config(testcase, Config))
+ ++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
++ integer_to_list(erlang:system_time(seconds))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
- ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
+ test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
+stop_node(Node) when Node =:= node() -> ok;
stop_node(Node) ->
- ?t:stop_node(Node).
-
-is_halfword_vm() ->
- case {erlang:system_info({wordsize, internal}),
- erlang:system_info({wordsize, external})} of
- {4, 8} -> true;
- {WS, WS} -> false
+ test_server:stop_node(Node).
+
+free_memory() ->
+ %% Free memory in MB.
+ try
+ SMD = memsup:get_system_memory_data(),
+ {value, {free_memory, Free}} = lists:keysearch(free_memory, 1, SMD),
+ TotFree = (Free +
+ case lists:keysearch(cached_memory, 1, SMD) of
+ {value, {cached_memory, Cached}} -> Cached;
+ false -> 0
+ end +
+ case lists:keysearch(buffered_memory, 1, SMD) of
+ {value, {buffered_memory, Buffed}} -> Buffed;
+ false -> 0
+ end),
+ TotFree div (1024*1024)
+ catch
+ error : undef ->
+ ct:fail({"os_mon not built"})
end.
+
diff --git a/erts/emulator/test/alloc_SUITE_data/Makefile.src b/erts/emulator/test/alloc_SUITE_data/Makefile.src
index a441fe946b..e31de54e1b 100644
--- a/erts/emulator/test/alloc_SUITE_data/Makefile.src
+++ b/erts/emulator/test/alloc_SUITE_data/Makefile.src
@@ -25,7 +25,8 @@ TEST_DRVS = basic@dll@ \
bucket_mask@dll@ \
rbtree@dll@ \
mseg_clear_cache@dll@ \
- cpool@dll@
+ cpool@dll@ \
+ migration@dll@
CC = @CC@
LD = @LD@
diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h
index 1d6b2f4907..97ee58cdad 100644
--- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h
+++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h
@@ -20,9 +20,20 @@
#ifndef ALLOCATOR_TEST_H__
#define ALLOCATOR_TEST_H__
-typedef ErlDrvUInt Ulong;
+#if SIZEOF_VOID_P == SIZEOF_INT
+typedef unsigned int Ulong;
+#elif SIZEOF_VOID_P == SIZEOF_LONG
+typedef unsigned long Ulong;
+#elif SIZEOF_VOID_P == SIZEOF_LONG_LONG
+typedef unsigned long long Ulong;
+#else
+# error No pointer sized integer type found ???
+#endif
-#ifndef __WIN32__
+#ifdef __WIN32__
+typedef Ulong erts_alc_test_Fn(Ulong, Ulong, Ulong, Ulong);
+# define erts_alc_test ((erts_alc_test_Fn*)WinDynNifCallbacks.erts_alc_test)
+#else
Ulong erts_alc_test(Ulong, Ulong, Ulong, Ulong);
#endif
@@ -85,6 +96,7 @@ typedef void* erts_cond;
#define CPOOL_DELETE(A,B) ((Carrier_t *) ALC_TEST2(0x022, (A), (B)))
#define CPOOL_IS_EMPTY(A) ((int) ALC_TEST1(0x023, (A)))
#define CPOOL_IS_IN_POOL(A,B) ((int) ALC_TEST2(0x024, (A), (B)))
+#define UMEM2BLK_TEST(P) ((Block_t*) ALC_TEST1(0x025, (P)))
/* From erl_goodfit_alloc.c */
#define BKT_IX(A, S) ((Ulong) ALC_TEST2(0x100, (A), (S)))
@@ -142,5 +154,9 @@ typedef void* erts_cond;
#define THR_JOIN(T) ((void) ALC_TEST1(0xf11, (T)))
#define THR_EXIT(R) ((void) ALC_TEST1(0xf12, (R)))
#define IS_SMP_ENABLED ((int) ALC_TEST0(0xf13))
+#define ALLOC_TEST(S) ((void*) ALC_TEST1(0xf14, (S)))
+#define FREE_TEST(P) ((void) ALC_TEST1(0xf15, (P)))
+#define SET_TEST_MBC_USER_HEADER(SZ,CMBC,DMBC) ((int)ALC_TEST3(0xf16, (SZ), (CMBC), (DMBC)))
+#define GET_TEST_MBC_SIZE() ((int) ALC_TEST0(0xf17))
#endif
diff --git a/erts/emulator/test/alloc_SUITE_data/basic.c b/erts/emulator/test/alloc_SUITE_data/basic.c
index 323a24a11f..debb3d7ebe 100644
--- a/erts/emulator/test/alloc_SUITE_data/basic.c
+++ b/erts/emulator/test/alloc_SUITE_data/basic.c
@@ -60,3 +60,6 @@ testcase_cleanup(TestCaseState_t *tcs)
if (tcs->extra)
STOP_ALC((Allctr_t *) tcs->extra);
}
+
+ERL_NIF_INIT(basic, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/basic.erl b/erts/emulator/test/alloc_SUITE_data/basic.erl
new file mode 100644
index 0000000000..a018fd5582
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/basic.erl
@@ -0,0 +1,10 @@
+-module(basic).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.c b/erts/emulator/test/alloc_SUITE_data/bucket_index.c
index c13f229049..45cb53fbf7 100644
--- a/erts/emulator/test/alloc_SUITE_data/bucket_index.c
+++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.c
@@ -113,3 +113,5 @@ test_it(TestCaseState_t *tcs, unsigned sbct)
sbct ? sbct_buf : "default");
}
+ERL_NIF_INIT(bucket_index, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.erl b/erts/emulator/test/alloc_SUITE_data/bucket_index.erl
new file mode 100644
index 0000000000..c54f54e2f5
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.erl
@@ -0,0 +1,10 @@
+-module(bucket_index).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c
index 8d6166771e..c94c265f4e 100644
--- a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c
+++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c
@@ -52,7 +52,7 @@ testcase_run(TestCaseState_t *tcs)
typedef struct linked_block {
struct linked_block* next;
}Linked;
- Linked* link;
+ Linked* link = NULL;
Linked* fence_list;
Linked* pad_list;
void* tmp;
@@ -183,3 +183,5 @@ testcase_run(TestCaseState_t *tcs)
tcs->extra = NULL;
}
+ERL_NIF_INIT(bucket_mask, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl b/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl
new file mode 100644
index 0000000000..589a50e1fa
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.erl
@@ -0,0 +1,10 @@
+-module(bucket_mask).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c
index 0a5e0c5b0e..7791409a34 100644
--- a/erts/emulator/test/alloc_SUITE_data/coalesce.c
+++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c
@@ -317,3 +317,6 @@ testcase_cleanup(TestCaseState_t *tcs)
if (tcs->extra)
STOP_ALC((Allctr_t *) tcs->extra);
}
+
+ERL_NIF_INIT(coalesce, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.erl b/erts/emulator/test/alloc_SUITE_data/coalesce.erl
new file mode 100644
index 0000000000..453c726c4e
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/coalesce.erl
@@ -0,0 +1,10 @@
+-module(coalesce).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.c b/erts/emulator/test/alloc_SUITE_data/cpool.c
index 75c2bc13ae..73026cc758 100644
--- a/erts/emulator/test/alloc_SUITE_data/cpool.c
+++ b/erts/emulator/test/alloc_SUITE_data/cpool.c
@@ -86,13 +86,13 @@ thread_func(void *arg)
for (i = 0; i < (TEST_NO_CARRIERS_PER_THREAD+TEST_CARRIERS_OFFSET); i++) {
int d;
if (i < TEST_NO_CARRIERS_PER_THREAD) {
- CPOOL_INSERT(alloc, crr[i]);
+ (void) CPOOL_INSERT(alloc, crr[i]);
if ((i & 0x7) == 0)
FATAL_ASSERT(CPOOL_IS_IN_POOL(alloc, crr[i]));
}
d = i-TEST_CARRIERS_OFFSET;
if (d >= 0) {
- CPOOL_DELETE(alloc, crr[d]);
+ (void) CPOOL_DELETE(alloc, crr[d]);
if ((d & 0x7) == 0)
FATAL_ASSERT(!CPOOL_IS_IN_POOL(alloc, crr[d]));
}
@@ -129,7 +129,7 @@ testcase_run(TestCaseState_t *tcs)
for (c = 0; c < TEST_NO_CARRIERS_PER_THREAD; c++) {
Carrier_t *crr = (Carrier_t *) p;
p += zcrr_sz;
- ZERO_CRR_INIT(alloc, crr);
+ (void) ZERO_CRR_INIT(alloc, crr);
threads[t].crr[c] = crr;
}
}
@@ -156,3 +156,6 @@ testcase_run(TestCaseState_t *tcs)
ASSERT(tcs, no_threads == TEST_NO_THREADS);
}
+
+ERL_NIF_INIT(cpool, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.erl b/erts/emulator/test/alloc_SUITE_data/cpool.erl
new file mode 100644
index 0000000000..89053471fa
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/cpool.erl
@@ -0,0 +1,10 @@
+-module(cpool).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/migration.c b/erts/emulator/test/alloc_SUITE_data/migration.c
new file mode 100644
index 0000000000..b006360043
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/migration.c
@@ -0,0 +1,343 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2014. All Rights Reserved.
+ *
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+/*
+ * Test the carrier migration logic
+ */
+
+#ifndef __WIN32__
+#include <sys/types.h>
+#include <unistd.h>
+#include <errno.h>
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include "testcase_driver.h"
+#include "allocator_test.h"
+
+#define FATAL_ASSERT(A) \
+ ((void) ((A) \
+ ? 1 \
+ : (fatal_assert_failed(#A, \
+ (char *) __FILE__, \
+ __LINE__), \
+ 0)))
+
+static void
+fatal_assert_failed(char* expr, char* file, int line)
+{
+ fflush(stdout);
+ fprintf(stderr, "%s:%d: Assertion failed: %s\n",
+ file, line, expr);
+ fflush(stderr);
+ abort();
+}
+
+
+char *
+testcase_name(void)
+{
+ return "migration";
+}
+
+/* Turns out random_r() is a nonstandard glibc extension.
+#define HAVE_RANDOM_R
+*/
+#ifdef HAVE_RANDOM_R
+
+typedef struct { struct random_data rnd; char rndbuf[32]; } MyRandState;
+
+static void myrand_init(MyRandState* mrs, unsigned int seed)
+{
+ int res;
+ memset(&mrs->rnd, 0, sizeof(mrs->rnd));
+ res = initstate_r(seed, mrs->rndbuf, sizeof(mrs->rndbuf), &mrs->rnd);
+ FATAL_ASSERT(res == 0);
+}
+
+static int myrand(MyRandState* mrs)
+{
+ int32_t x;
+ int res = random_r(&mrs->rnd, &x);
+ FATAL_ASSERT(res == 0);
+ return (int)x;
+}
+
+#else /* !HAVE_RANDOM_R */
+
+typedef unsigned int MyRandState;
+
+static void myrand_init(MyRandState* mrs, unsigned int seed)
+{
+ *mrs = seed;
+}
+
+static int myrand(MyRandState* mrs)
+{
+ /* Taken from rand(3) man page.
+ * Modified to return a full 31-bit value by using low half of *mrs as well.
+ */
+ *mrs = (*mrs) * 1103515245 + 12345;
+ return (int) (((*mrs >> 16) | (*mrs << 16)) & ~(1 << 31));
+}
+
+#endif /* !HAVE_RANDOM_R */
+
+#define MAX_BLOCK_PER_THR 200
+#define BLOCKS_PER_MBC 10
+#define MAX_ROUNDS 10000
+
+typedef struct MyBlock_ {
+ struct MyBlock_* next;
+ struct MyBlock_** prevp;
+} MyBlock;
+
+typedef struct {
+ MyBlock* blockv[MAX_BLOCK_PER_THR];
+ MyRandState rand_state;
+ enum { GROWING, SHRINKING, CLEANUP, DONE } phase;
+ int nblocks;
+ int goal_nblocks;
+ int round;
+ int nr_of_migrations;
+ int nr_of_carriers;
+ int max_blocks_in_mbc;
+ int block_size;
+ int max_nblocks;
+} MigrationState;
+
+typedef struct {
+ ErlNifMutex* mtx;
+ int nblocks;
+ MyBlock* first;
+ MigrationState* employer;
+} MyCrrInfo;
+
+
+static int crr_info_offset = -1;
+static void (*orig_create_mbc_fn)(Allctr_t *allctr, Carrier_t *carrier);
+static void (*orig_destroying_mbc_fn)(Allctr_t *allctr, Carrier_t *carrier);
+
+static void my_creating_mbc(Allctr_t *allctr, Carrier_t *carrier)
+{
+ MyCrrInfo* mci = (MyCrrInfo*) ((char*)carrier + crr_info_offset);
+ if (orig_create_mbc_fn)
+ orig_create_mbc_fn(allctr, carrier);
+
+ mci->mtx = enif_mutex_create("alloc_SUITE.migration");
+ mci->nblocks = 0;
+ mci->first = NULL;
+ mci->employer = NULL;
+}
+
+static void my_destroying_mbc(Allctr_t *allctr, Carrier_t *carrier)
+{
+ MyCrrInfo* mci = (MyCrrInfo*) ((char*)carrier + crr_info_offset);
+
+ FATAL_ASSERT(mci->nblocks == 0);
+ FATAL_ASSERT(mci->first == NULL);
+ enif_mutex_destroy(mci->mtx);
+
+ if (orig_destroying_mbc_fn)
+ orig_destroying_mbc_fn(allctr, carrier);
+}
+
+static int migration_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+{
+ void* creating_mbc_arg = (void*)my_creating_mbc;
+ void* destroying_mbc_arg = (void*)my_destroying_mbc;
+
+ if (testcase_nif_init(env, priv_data, load_info))
+ return -1;
+
+ crr_info_offset = SET_TEST_MBC_USER_HEADER(sizeof(MyCrrInfo),
+ &creating_mbc_arg,
+ &destroying_mbc_arg);
+ FATAL_ASSERT(crr_info_offset >= 0);
+ orig_create_mbc_fn = creating_mbc_arg;
+ orig_destroying_mbc_fn = destroying_mbc_arg;
+
+ return 0;
+}
+
+static void add_block(MyBlock* p, MigrationState* state)
+{
+ MyCrrInfo* mci = (MyCrrInfo*)((char*)BLK_TO_MBC(UMEM2BLK_TEST(p)) + crr_info_offset);
+
+ enif_mutex_lock(mci->mtx);
+ if (++mci->nblocks > state->max_blocks_in_mbc)
+ state->max_blocks_in_mbc = mci->nblocks;
+ p->next = mci->first;
+ p->prevp = &mci->first;
+ mci->first = p;
+ if (p->next)
+ p->next->prevp = &p->next;
+ if (mci->employer != state) {
+ if (!mci->employer) {
+ FATAL_ASSERT(mci->nblocks == 1);
+ state->nr_of_carriers++;
+ }
+ else {
+ state->nr_of_migrations++;
+ }
+ mci->employer = state;
+ }
+ enif_mutex_unlock(mci->mtx);
+}
+
+static void remove_block(MyBlock* p)
+{
+ MyCrrInfo* mci = (MyCrrInfo*)((char*)BLK_TO_MBC(UMEM2BLK_TEST(p)) + crr_info_offset);
+
+ enif_mutex_lock(mci->mtx);
+ mci->nblocks--;
+ if (p->next)
+ p->next->prevp = p->prevp;
+ *p->prevp = p->next;
+ enif_mutex_unlock(mci->mtx);
+}
+
+static int rand_int(MigrationState* state, int low, int high)
+{
+ int x;
+ FATAL_ASSERT(high >= low);
+ x = myrand(&state->rand_state);
+ return low + (x % (high+1-low));
+}
+
+
+static void do_cleanup(TestCaseState_t *tcs, MigrationState* state)
+{
+ if (state->nblocks == 0) {
+ state->phase = DONE;
+ testcase_printf(tcs, "%d: Done %d rounds", tcs->thr_nr, state->round);
+ testcase_printf(tcs, "%d: Cleanup all blocks", tcs->thr_nr);
+ testcase_printf(tcs, "%d: Empty carriers detected = %d", tcs->thr_nr,
+ state->nr_of_carriers);
+ testcase_printf(tcs, "%d: Migrations detected = %d", tcs->thr_nr,
+ state->nr_of_migrations);
+ testcase_printf(tcs, "%d: Max blocks in carrier = %d", tcs->thr_nr,
+ state->max_blocks_in_mbc);
+ }
+ else {
+ state->nblocks--;
+ if (state->blockv[state->nblocks]) {
+ remove_block(state->blockv[state->nblocks]);
+ FREE_TEST(state->blockv[state->nblocks]);
+ }
+ }
+}
+
+
+void
+testcase_run(TestCaseState_t *tcs)
+{
+ MigrationState* state = (MigrationState*) tcs->extra;
+
+ if (!tcs->extra) {
+ if (!IS_SMP_ENABLED)
+ testcase_skipped(tcs, "No SMP support");
+
+ tcs->extra = enif_alloc(sizeof(MigrationState));
+ state = (MigrationState*) tcs->extra;
+ memset(state->blockv, 0, sizeof(state->blockv));
+ myrand_init(&state->rand_state, tcs->thr_nr);
+ state->phase = GROWING;
+ state->nblocks = 0;
+ state->round = 0;
+ state->nr_of_migrations = 0;
+ state->nr_of_carriers = 0;
+ state->max_blocks_in_mbc = 0;
+ state->block_size = GET_TEST_MBC_SIZE() / (BLOCKS_PER_MBC+1);
+ if (MAX_BLOCK_PER_THR * state->block_size < tcs->free_mem) {
+ state->max_nblocks = MAX_BLOCK_PER_THR;
+ } else {
+ state->max_nblocks = tcs->free_mem / state->block_size;
+ }
+ state->goal_nblocks = rand_int(state, 1, state->max_nblocks);
+ }
+
+ switch (state->phase) {
+ case GROWING: {
+ MyBlock* p;
+ FATAL_ASSERT(!state->blockv[state->nblocks]);
+ p = ALLOC_TEST(rand_int(state, state->block_size/2, state->block_size));
+ FATAL_ASSERT(p);
+ add_block(p, state);
+ state->blockv[state->nblocks] = p;
+ if (++state->nblocks >= state->goal_nblocks) {
+ /*testcase_printf(tcs, "%d: Grown to %d blocks", tcs->thr_nr, state->nblocks);*/
+ state->phase = SHRINKING;
+ state->goal_nblocks = rand_int(state, 0, state->goal_nblocks-1);
+ }
+ else
+ FATAL_ASSERT(!state->blockv[state->nblocks]);
+ break;
+ }
+ case SHRINKING: {
+ int ix = rand_int(state, 0, state->nblocks-1);
+ FATAL_ASSERT(state->blockv[ix]);
+ remove_block(state->blockv[ix]);
+ FREE_TEST(state->blockv[ix]);
+ state->blockv[ix] = state->blockv[--state->nblocks];
+ state->blockv[state->nblocks] = NULL;
+
+ if (state->nblocks <= state->goal_nblocks) {
+ /*testcase_printf(tcs, "%d: Shrunk to %d blocks", tcs->thr_nr, state->nblocks);*/
+ if (++state->round >= MAX_ROUNDS) {
+ state->phase = CLEANUP;
+ } else {
+ state->phase = GROWING;
+ state->goal_nblocks = rand_int(state, state->goal_nblocks+1, state->max_nblocks);
+ }
+ }
+ break;
+ }
+ case CLEANUP:
+ do_cleanup(tcs, state);
+ break;
+
+ default:
+ FATAL_ASSERT(!"Invalid phase");
+ }
+
+ if (state->phase == DONE) {
+ }
+ else {
+ testcase_continue(tcs);
+ }
+}
+
+void
+testcase_cleanup(TestCaseState_t *tcs)
+{
+ MigrationState* state = (MigrationState*) tcs->extra;
+
+ while (state->phase != DONE)
+ do_cleanup(tcs, state);
+
+ enif_free(tcs->extra);
+ tcs->extra = NULL;
+}
+
+
+ERL_NIF_INIT(migration, testcase_nif_funcs, migration_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/migration.erl b/erts/emulator/test/alloc_SUITE_data/migration.erl
new file mode 100644
index 0000000000..440a99becd
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/migration.erl
@@ -0,0 +1,10 @@
+-module(migration).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c
index 9c03f3a331..e5df3d647f 100644
--- a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c
+++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c
@@ -101,3 +101,6 @@ testcase_cleanup(TestCaseState_t *tcs)
tcs->extra = NULL;
}
}
+
+ERL_NIF_INIT(mseg_clear_cache, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl
new file mode 100644
index 0000000000..befd6c2e8e
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.erl
@@ -0,0 +1,10 @@
+-module(mseg_clear_cache).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.c b/erts/emulator/test/alloc_SUITE_data/rbtree.c
index 8d4d5535a8..38bbbdf90c 100644
--- a/erts/emulator/test/alloc_SUITE_data/rbtree.c
+++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c
@@ -20,7 +20,7 @@
#include "testcase_driver.h"
#include "allocator_test.h"
-#define NO_BLOCKS 100000
+int NO_BLOCKS;
#define RIGHT_VISITED (1 << 0)
#define LEFT_VISITED (1 << 1)
@@ -265,9 +265,10 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size)
ASSERT(tcs, curr_blacks == 0);
ASSERT(tcs, i == -1);
+ /*
testcase_printf(tcs, "Red-Black Tree OK! Max depth = %d; "
"Black depth = %d\n", max_i+1, blacks < 0 ? 0 : blacks);
-
+ */
return res;
}
@@ -468,6 +469,12 @@ testcase_run(TestCaseState_t *tcs)
Allctr_t *a;
rbtree_test_data *td;
+ NO_BLOCKS = 100*1000;
+ if (enif_is_identical(tcs->build_type,
+ enif_make_atom(tcs->curr_env,"valgrind"))) {
+ NO_BLOCKS /= 10;
+ }
+
/* Best fit... */
testcase_printf(tcs, "Setup...\n");
@@ -577,3 +584,6 @@ testcase_run(TestCaseState_t *tcs)
testcase_printf(tcs, "aoffcaobf test succeeded!\n");
}
+
+ERL_NIF_INIT(rbtree, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.erl b/erts/emulator/test/alloc_SUITE_data/rbtree.erl
new file mode 100644
index 0000000000..f5b7120ff2
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/rbtree.erl
@@ -0,0 +1,10 @@
+-module(rbtree).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c
index e405f06225..c4147eb00d 100644
--- a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c
+++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c
@@ -278,3 +278,5 @@ testcase_cleanup(TestCaseState_t *tcs)
STOP_ALC((Allctr_t *) tcs->extra);
}
+ERL_NIF_INIT(realloc_copy, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl b/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl
new file mode 100644
index 0000000000..cc6617bf64
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.erl
@@ -0,0 +1,10 @@
+-module(realloc_copy).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c
index bc674c56b7..7dcca544e5 100644
--- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c
+++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c
@@ -23,141 +23,147 @@
#include <stdarg.h>
#include <setjmp.h>
#include <string.h>
+#include <limits.h>
#ifdef __WIN32__
-#undef HAVE_VSNPRINTF
-#define HAVE_VSNPRINTF 1
-#define vsnprintf _vsnprintf
+static void my_vsnprintf(char *outBuf, size_t size, const char *format, va_list ap)
+{
+ _vsnprintf(outBuf, size, format, ap);
+ outBuf[size-1] = 0; /* be sure string is terminated */
+}
+#elif defined(HAVE_VSNPRINTF)
+# define my_vsnprintf(B,S,F,A) (void)vsnprintf(B,S,F,A)
+#else
+# warning Using unsafe 'vsprintf' without buffer overflow protection
+# define my_vsnprintf(B,S,F,A) (void)vsprintf(B,F,A)
#endif
-#ifndef HAVE_VSNPRINTF
-#define HAVE_VSNPRINTF 0
-#endif
+static void my_snprintf(char *outBuf, size_t size, const char *format, ...)
+{
+ va_list ap;
+ va_start(ap, format);
+ my_vsnprintf(outBuf, size, format, ap);
+ va_end(ap);
+}
#define COMMENT_BUF_SZ 4096
#define TESTCASE_FAILED 0
#define TESTCASE_SKIPPED 1
#define TESTCASE_SUCCEEDED 2
+#define TESTCASE_CONTINUE 3
typedef struct {
TestCaseState_t visible;
- ErlDrvPort port;
- ErlDrvTermData port_id;
int result;
- jmp_buf done_jmp_buf;
+ jmp_buf* done_jmp_buf;
char *comment;
char comment_buf[COMMENT_BUF_SZ];
} InternalTestCaseState_t;
-ErlDrvData testcase_drv_start(ErlDrvPort port, char *command);
-void testcase_drv_stop(ErlDrvData drv_data);
-void testcase_drv_run(ErlDrvData drv_data, char *buf, ErlDrvSizeT len);
-
-static ErlDrvEntry testcase_drv_entry = {
- NULL,
- testcase_drv_start,
- testcase_drv_stop,
- testcase_drv_run,
- NULL,
- NULL,
- "testcase_drv",
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- NULL,
- ERL_DRV_EXTENDED_MARKER,
- ERL_DRV_EXTENDED_MAJOR_VERSION,
- ERL_DRV_EXTENDED_MINOR_VERSION,
- 0,
- NULL,
- NULL,
- NULL
+ERL_NIF_TERM testcase_nif_start(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+ERL_NIF_TERM testcase_nif_stop(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+ERL_NIF_TERM testcase_nif_run(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
+ErlNifFunc testcase_nif_funcs[] =
+{
+ {"start", 1, testcase_nif_start},
+ {"run", 1, testcase_nif_run},
+ {"stop", 1, testcase_nif_stop}
};
+static ErlNifResourceType* testcase_rt;
+static ERL_NIF_TERM print_atom;
-DRIVER_INIT(testcase_drv)
+int testcase_nif_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
{
- testcase_drv_entry.driver_name = testcase_name();
- return &testcase_drv_entry;
+ testcase_rt = enif_open_resource_type(env, NULL, "testcase_rt", NULL,
+ ERL_NIF_RT_CREATE, NULL);
+
+ print_atom = enif_make_atom(env, "print");
+ return 0;
}
-ErlDrvData
-testcase_drv_start(ErlDrvPort port, char *command)
-{
+ERL_NIF_TERM
+testcase_nif_start(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{ /* (ThrNr, FreeMeg, BuildType) */
+ ERL_NIF_TERM ret;
InternalTestCaseState_t *itcs = (InternalTestCaseState_t *)
- driver_alloc(sizeof(InternalTestCaseState_t));
- if (!itcs) {
- return ERL_DRV_ERROR_GENERAL;
+ enif_alloc_resource(testcase_rt, sizeof(InternalTestCaseState_t));
+ int free_megabyte;
+ const int max_megabyte = INT_MAX / (1024*1024);
+ const ERL_NIF_TERM* tpl;
+ int tpl_arity;
+
+ if (!itcs
+ || !enif_get_tuple(env, argv[0], &tpl_arity, &tpl)
+ || tpl_arity != 3
+ || !enif_get_int(env, tpl[0], &itcs->visible.thr_nr)
+ || !enif_get_int(env, tpl[1], &free_megabyte)) {
+ enif_make_badarg(env);
}
-
+ itcs->visible.free_mem = (free_megabyte < max_megabyte ?
+ free_megabyte : max_megabyte) * (1024*1024);
itcs->visible.testcase_name = testcase_name();
+ itcs->visible.build_type = tpl[2];
itcs->visible.extra = NULL;
- itcs->port = port;
- itcs->port_id = driver_mk_port(port);
itcs->result = TESTCASE_FAILED;
itcs->comment = "";
- return (ErlDrvData) itcs;
+ ret = enif_make_resource(env, itcs);
+ enif_release_resource(itcs);
+ return ret;
}
-void
-testcase_drv_stop(ErlDrvData drv_data)
+ERL_NIF_TERM
+testcase_nif_stop(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- testcase_cleanup((TestCaseState_t *) drv_data);
- driver_free((void *) drv_data);
+ InternalTestCaseState_t *itcs;
+ if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs))
+ return enif_make_badarg(env);
+ testcase_cleanup(&itcs->visible);
+ return enif_make_atom(env,"ok");
}
-void
-testcase_drv_run(ErlDrvData drv_data, char *buf, ErlDrvSizeT len)
+ERL_NIF_TERM
+testcase_nif_run(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) drv_data;
- ErlDrvTermData result_atom;
- ErlDrvTermData msg[12];
+ InternalTestCaseState_t *itcs;
+ const char* result_atom;
+ jmp_buf the_jmp_buf;
+
+ if (!enif_get_resource(env, argv[0], testcase_rt, (void**)&itcs))
+ return enif_make_badarg(env);
- itcs->visible.command = buf;
- itcs->visible.command_len = len;
+ itcs->visible.curr_env = env;
- if (setjmp(itcs->done_jmp_buf) == 0) {
- testcase_run((TestCaseState_t *) itcs);
+ /* For some unknown reason, first call to setjmp crashes on win64
+ * when jmp_buf is allocated as part of the resource. But it works when
+ * allocated on stack. It used to work when this was a driver.
+ */
+ itcs->done_jmp_buf = &the_jmp_buf;
+
+ if (setjmp(the_jmp_buf) == 0) {
+ testcase_run(&itcs->visible);
itcs->result = TESTCASE_SUCCEEDED;
}
switch (itcs->result) {
- case TESTCASE_SUCCEEDED:
- result_atom = driver_mk_atom("succeeded");
- break;
- case TESTCASE_SKIPPED:
- result_atom = driver_mk_atom("skipped");
- break;
- case TESTCASE_FAILED:
+ case TESTCASE_CONTINUE:
+ return enif_make_atom(env, "continue");
+
+ case TESTCASE_SUCCEEDED: result_atom = "succeeded"; break;
+ case TESTCASE_SKIPPED: result_atom = "skipped"; break;
+ case TESTCASE_FAILED: result_atom = "failed"; break;
default:
- result_atom = driver_mk_atom("failed");
- break;
+ result_atom = "failed";
+ my_snprintf(itcs->comment_buf, sizeof(itcs->comment_buf),
+ "Unexpected test result code %d.", itcs->result);
+ itcs->comment = itcs->comment_buf;
}
- msg[0] = ERL_DRV_ATOM;
- msg[1] = (ErlDrvTermData) result_atom;
-
- msg[2] = ERL_DRV_PORT;
- msg[3] = itcs->port_id;
-
- msg[4] = ERL_DRV_ATOM;
- msg[5] = driver_mk_atom(itcs->visible.testcase_name);
-
- msg[6] = ERL_DRV_STRING;
- msg[7] = (ErlDrvTermData) itcs->comment;
- msg[8] = (ErlDrvTermData) strlen(itcs->comment);
-
- msg[9] = ERL_DRV_TUPLE;
- msg[10] = (ErlDrvTermData) 4;
-
- erl_drv_output_term(itcs->port_id, msg, 11);
+ return enif_make_tuple2(env, enif_make_atom(env, result_atom),
+ enif_make_string(env, itcs->comment, ERL_NIF_LATIN1));
}
int
@@ -172,34 +178,22 @@ testcase_assertion_failed(TestCaseState_t *tcs,
void
testcase_printf(TestCaseState_t *tcs, char *frmt, ...)
{
- InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs;
- ErlDrvTermData msg[12];
+ InternalTestCaseState_t* itcs = (InternalTestCaseState_t*)tcs;
+ ErlNifPid pid;
+ ErlNifEnv* msg_env = enif_alloc_env();
+ ERL_NIF_TERM msg;
va_list va;
va_start(va, frmt);
-#if HAVE_VSNPRINTF
- vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va);
-#else
- vsprintf(itcs->comment_buf, frmt, va);
-#endif
+ my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va);
va_end(va);
- msg[0] = ERL_DRV_ATOM;
- msg[1] = (ErlDrvTermData) driver_mk_atom("print");
+ msg = enif_make_tuple2(msg_env, print_atom,
+ enif_make_string(msg_env, itcs->comment_buf, ERL_NIF_LATIN1));
- msg[2] = ERL_DRV_PORT;
- msg[3] = itcs->port_id;
+ enif_send(itcs->visible.curr_env, enif_self(itcs->visible.curr_env, &pid),
+ msg_env, msg);
- msg[4] = ERL_DRV_ATOM;
- msg[5] = driver_mk_atom(itcs->visible.testcase_name);
-
- msg[6] = ERL_DRV_STRING;
- msg[7] = (ErlDrvTermData) itcs->comment_buf;
- msg[8] = (ErlDrvTermData) strlen(itcs->comment_buf);
-
- msg[9] = ERL_DRV_TUPLE;
- msg[10] = (ErlDrvTermData) 4;
-
- erl_drv_output_term(itcs->port_id, msg, 11);
+ enif_free_env(msg_env);
}
@@ -208,17 +202,13 @@ void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...)
InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs;
va_list va;
va_start(va, frmt);
-#if HAVE_VSNPRINTF
- vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va);
-#else
- vsprintf(itcs->comment_buf, frmt, va);
-#endif
+ my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va);
va_end(va);
itcs->result = TESTCASE_SUCCEEDED;
itcs->comment = itcs->comment_buf;
- longjmp(itcs->done_jmp_buf, 1);
+ longjmp(*itcs->done_jmp_buf, 1);
}
void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...)
@@ -226,17 +216,20 @@ void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...)
InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs;
va_list va;
va_start(va, frmt);
-#if HAVE_VSNPRINTF
- vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va);
-#else
- vsprintf(itcs->comment_buf, frmt, va);
-#endif
+ my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va);
va_end(va);
itcs->result = TESTCASE_SKIPPED;
itcs->comment = itcs->comment_buf;
- longjmp(itcs->done_jmp_buf, 1);
+ longjmp(*itcs->done_jmp_buf, 1);
+}
+
+void testcase_continue(TestCaseState_t *tcs)
+{
+ InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs;
+ itcs->result = TESTCASE_CONTINUE;
+ longjmp(*itcs->done_jmp_buf, 1);
}
void testcase_failed(TestCaseState_t *tcs, char *frmt, ...)
@@ -246,37 +239,33 @@ void testcase_failed(TestCaseState_t *tcs, char *frmt, ...)
size_t bufsz = sizeof(buf);
va_list va;
va_start(va, frmt);
-#if HAVE_VSNPRINTF
- vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va);
-#else
- vsprintf(itcs->comment_buf, frmt, va);
-#endif
+ my_vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va);
va_end(va);
itcs->result = TESTCASE_FAILED;
itcs->comment = itcs->comment_buf;
- if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0
+ if (enif_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0
&& strcmp("true", buf) == 0) {
fprintf(stderr, "Testcase \"%s\" failed: %s\n",
itcs->visible.testcase_name, itcs->comment);
abort();
}
- longjmp(itcs->done_jmp_buf, 1);
+ longjmp(*itcs->done_jmp_buf, 1);
}
void *testcase_alloc(size_t size)
{
- return driver_alloc(size);
+ return enif_alloc(size);
}
void *testcase_realloc(void *ptr, size_t size)
{
- return driver_realloc(ptr, size);
+ return enif_realloc(ptr, size);
}
void testcase_free(void *ptr)
{
- driver_free(ptr);
+ enif_free(ptr);
}
diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h
index 5d17eaec64..f0ca91bd06 100644
--- a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h
+++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h
@@ -20,13 +20,15 @@
#ifndef TESTCASE_DRIVER_H__
#define TESTCASE_DRIVER_H__
-#include "erl_driver.h"
+#include "erl_nif.h"
#include <stdlib.h>
typedef struct {
+ ErlNifEnv* curr_env;
char *testcase_name;
- char *command;
- int command_len;
+ int thr_nr;
+ int free_mem; /* in bytes */
+ ERL_NIF_TERM build_type; /* opt, debug, valgrind, ... */
void *extra;
} TestCaseState_t;
@@ -34,9 +36,11 @@ typedef struct {
((void) ((B) ? 1 : testcase_assertion_failed((TCS), __FILE__, __LINE__, #B)))
+int testcase_nif_init(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info);
void testcase_printf(TestCaseState_t *tcs, char *frmt, ...);
void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...);
void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...);
+void testcase_continue(TestCaseState_t *tcs);
void testcase_failed(TestCaseState_t *tcs, char *frmt, ...);
int testcase_assertion_failed(TestCaseState_t *tcs, char *file, int line,
char *assertion);
@@ -45,8 +49,11 @@ void *testcase_realloc(void *ptr, size_t size);
void testcase_free(void *ptr);
+/* Implemented by testcase: */
char *testcase_name(void);
void testcase_run(TestCaseState_t *tcs);
void testcase_cleanup(TestCaseState_t *tcs);
-#endif
+extern ErlNifFunc testcase_nif_funcs[3];
+
+#endif /* TESTCASE_DRIVER_H__ */
diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c
index edad24ee6b..44d982b6c7 100644
--- a/erts/emulator/test/alloc_SUITE_data/threads.c
+++ b/erts/emulator/test/alloc_SUITE_data/threads.c
@@ -86,7 +86,7 @@ static void fail(int t_no, char *frmt, ...)
tc_failed = 1;
- if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0
+ if (enif_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0
&& strcmp("true", buf) == 0) {
fprintf(stderr, "Testcase \"%s\" failed: %s\n",
testcase_name(), err_buf);
@@ -96,16 +96,11 @@ static void fail(int t_no, char *frmt, ...)
exit_thread(t_no, 0);
}
-static Allctr_t *alloc_not_ts = NULL;
static Allctr_t *alloc_ts_1 = NULL;
static Allctr_t *alloc_ts_2 = NULL;
static void stop_allocators(void)
{
- if (alloc_not_ts) {
- STOP_ALC(alloc_not_ts);
- alloc_not_ts = NULL;
- }
if (alloc_ts_1) {
STOP_ALC(alloc_ts_1);
alloc_ts_1 = NULL;
@@ -155,7 +150,6 @@ testcase_run(TestCaseState_t *tcs)
if (!IS_THREADS_ENABLED)
testcase_skipped(tcs, "Threads not enabled");
- alloc_not_ts = NULL;
alloc_ts_1 = NULL;
alloc_ts_2 = NULL;
@@ -164,16 +158,12 @@ testcase_run(TestCaseState_t *tcs)
sprintf(sbct_buf, "%d", SBC_THRESHOLD/1024);
memcpy((void *) argv, argv_org, sizeof(argv_org));
- alloc_not_ts = START_ALC("threads_not_ts", 0, argv);
- ASSERT(tcs, alloc_not_ts);
- memcpy((void *) argv, argv_org, sizeof(argv_org));
alloc_ts_1 = START_ALC("threads_ts_1", 1, argv);
ASSERT(tcs, alloc_ts_1);
memcpy((void *) argv, argv_org, sizeof(argv_org));
alloc_ts_2 = START_ALC("threads_ts_2", 1, argv);
ASSERT(tcs, alloc_ts_2);
- ASSERT(tcs, !IS_ALLOC_THREAD_SAFE(alloc_not_ts));
ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_1));
ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_2));
@@ -187,16 +177,10 @@ testcase_run(TestCaseState_t *tcs)
for(i = 1; i <= NO_OF_THREADS; i++) {
char *alc;
- int res;
threads[i].arg.no_ops_per_bl = NO_OF_OPS_PER_BL;
- if (i == 1) {
- alc = "threads_not_ts";
- threads[i].arg.no_ops_per_bl *= 2;
- threads[i].arg.a = alloc_not_ts;
- }
- else if (i % 2 == 0) {
+ if (i % 2 == 0) {
alc = "threads_ts_1";
threads[i].arg.a = alloc_ts_1;
}
@@ -397,7 +381,7 @@ alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up)
bp->p = (unsigned char *) ALLOC(a, bp->s);
if(!bp->p)
fail(t_no, "ALLOC(%lu) failed [id=%d])\n", bp->s, id);
- memset((void *) bp->p, id, (size_t) bp->s);
+ memset((void *) bp->p, (unsigned char)id, (size_t) bp->s);
}
else {
unsigned char *p = (unsigned char *) REALLOC(a, bp->p, bp->as[bp->i]);
@@ -407,7 +391,7 @@ alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up)
if(bp->s < bp->as[bp->i]) {
CHECK_BLOCK_DATA(t_no, p, bp->s, id);
- memset((void *) p, id, (size_t) bp->as[bp->i]);
+ memset((void *) p, (unsigned char)id, (size_t) bp->as[bp->i]);
}
else
CHECK_BLOCK_DATA(t_no, p, bp->as[bp->i], id);
@@ -446,3 +430,6 @@ thread_func(void *arg)
exit_thread(td->t_no, 1);
return NULL;
}
+
+ERL_NIF_INIT(threads, testcase_nif_funcs, testcase_nif_init,
+ NULL, NULL, NULL);
diff --git a/erts/emulator/test/alloc_SUITE_data/threads.erl b/erts/emulator/test/alloc_SUITE_data/threads.erl
new file mode 100644
index 0000000000..a7b4965f5e
--- /dev/null
+++ b/erts/emulator/test/alloc_SUITE_data/threads.erl
@@ -0,0 +1,10 @@
+-module(threads).
+
+-export([init/1, start/1, run/1, stop/1]).
+
+init(File) ->
+ ok = erlang:load_nif(File, 0).
+
+start(_) -> erlang:nif_error(not_loaded).
+run(_) -> erlang:nif_error(not_loaded).
+stop(_) -> erlang:nif_error(not_loaded).
diff --git a/erts/emulator/test/async_ports_SUITE.erl b/erts/emulator/test/async_ports_SUITE.erl
index c89b3655ff..f0f5fb5687 100644
--- a/erts/emulator/test/async_ports_SUITE.erl
+++ b/erts/emulator/test/async_ports_SUITE.erl
@@ -1,8 +1,10 @@
-module(async_ports_SUITE).
--include_lib("common_test/include/ct.hrl").
+-export([all/0, suite/0]).
+-export([permanent_busy_test/1]).
+-export([run_loop/5]).
--compile(export_all).
+-include_lib("common_test/include/ct.hrl").
-define(PACKET_SIZE, (10 * 1024 * 8)).
-define(CPORT_DELAY, 100).
@@ -11,17 +13,15 @@
-define(TEST_PROCS_COUNT, 2).
-define(TC_TIMETRAP_SECONDS, 10).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, ?TC_TIMETRAP_SECONDS}}].
all() ->
- [
- permanent_busy_test
- ].
+ [permanent_busy_test].
permanent_busy_test(Config) ->
- ct:timetrap({seconds, ?TC_TIMETRAP_SECONDS}),
- ExePath = filename:join(?config(data_dir, Config), "cport"),
-
+ ExePath = filename:join(proplists:get_value(data_dir, Config), "cport"),
Self = self(),
spawn_link(
fun() ->
@@ -29,17 +29,16 @@ permanent_busy_test(Config) ->
Port = open_port(ExePath),
- Testers =
- lists:map(
- fun(_) ->
- erlang:spawn_link(?MODULE, run_loop,
- [Self,
- Port,
- Block,
- ?TEST_LOOPS_COUNT,
- 0])
- end,
- lists:seq(1, ?TEST_PROCS_COUNT)),
+ Testers = lists:map(
+ fun(_) ->
+ spawn_link(?MODULE, run_loop,
+ [Self,
+ Port,
+ Block,
+ ?TEST_LOOPS_COUNT,
+ 0])
+ end,
+ lists:seq(1, ?TEST_PROCS_COUNT)),
Self ! {test_info, Port, Testers},
endless_flush(Port)
end),
diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl
index 706a4a1c16..07dfeb6633 100644
--- a/erts/emulator/test/beam_SUITE.erl
+++ b/erts/emulator/test/beam_SUITE.erl
@@ -28,7 +28,7 @@
-export([applied/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -61,15 +61,15 @@ apply_last(Config) when is_list(Config) ->
{Pid, finished} ->
stack_size(Pid)
after 30000 ->
- ?t:fail("applied/2 timed out.")
+ ct:fail("applied/2 timed out.")
end,
Pid ! die,
- ?t:format("Size: ~p~n", [Size]),
+ io:format("Size: ~p~n", [Size]),
if
Size < 700 ->
ok;
true ->
- ?t:fail("10000 apply() grew stack too much.")
+ ct:fail("10000 apply() grew stack too much.")
end,
ok.
@@ -95,7 +95,7 @@ apply_last_bif(Config) when is_list(Config) ->
%% Test three high register numbers in a put_list instruction
%% (to test whether packing works properly).
packed_registers(Config) when is_list(Config) ->
- PrivDir = ?config(priv_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
Mod = packed_regs,
Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"),
@@ -132,8 +132,7 @@ verify_packed_regs([], _, -1) -> ok;
verify_packed_regs([{Term, N}| T], Term, N) ->
verify_packed_regs(T, Term, N-1);
verify_packed_regs(L, Term, N) ->
- ok = io:format("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]),
- test_server:fail().
+ ct:fail("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]).
buildo_mucho(Config) when is_list(Config) ->
buildo_mucho_1(),
@@ -319,7 +318,7 @@ fconv(Config) when is_list(Config) ->
do_fconv(Type) ->
try
do_fconv(Type, 1.0),
- test_server:fail()
+ ct:fail(no_badarith)
catch
error:badarith ->
ok
diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl
index 9f14ca26e5..b013ff5fbb 100644
--- a/erts/emulator/test/beam_literals_SUITE.erl
+++ b/erts/emulator/test/beam_literals_SUITE.erl
@@ -28,7 +28,7 @@
put_list/1, fconv/1, literal_case_expression/1,
increment/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -55,7 +55,7 @@ end_per_group(_GroupName, Config) ->
Config.
-putting(doc) -> "Test creating lists and tuples containing big number literals.";
+%% Test creating lists and tuples containing big number literals.
putting(Config) when is_list(Config) ->
-773973888575883407313908 = chksum(putting1(8987697898797)).
@@ -64,23 +64,22 @@ putting1(X) ->
[X|349873987387373],
[329878349873|-387394729872], -773973937933873929749873}.
-matching_bigs(doc) -> "Test matching of a few big number literals (in Beam,"
- "select_val/3 will NOT be used).";
+%% Test matching of a few big number literals (in Beam select_val/3 will NOT be used).
matching_bigs(Config) when is_list(Config) ->
a = matching1(3972907842873739),
b = matching1(-389789298378939783333333333333333333784),
other = matching1(3141699999999999999999999999999999999),
other = matching1(42).
-matching_smalls(doc) -> "Test matching small numbers (both positive and negative).";
+%% Test matching small numbers (both positive and negative).
matching_smalls(Config) when is_list(Config) ->
- ?line a = m_small(-42),
- ?line b = m_small(0),
- ?line c = m_small(105),
- ?line d = m_small(-13),
- ?line e = m_small(337848),
- ?line other = m_small(324),
- ?line other = m_small(-7),
+ a = m_small(-42),
+ b = m_small(0),
+ c = m_small(105),
+ d = m_small(-13),
+ e = m_small(337848),
+ other = m_small(324),
+ other = m_small(-7),
ok.
m_small(-42) -> a;
@@ -90,17 +89,16 @@ m_small(-13) -> d;
m_small(337848) -> e;
m_small(_) -> other.
-matching_smalls_jt(doc) ->
- "Test matching small numbers (both positive and negative). "
- "Make sure that a jump table is used.";
+%% Test matching small numbers (both positive and negative).
+%% Make sure that a jump table is used.
matching_smalls_jt(Config) when is_list(Config) ->
- ?line a = m_small_jt(-2),
- ?line b = m_small_jt(-1),
- ?line c = m_small_jt(0),
- ?line d = m_small_jt(2),
- ?line e = m_small_jt(3),
- ?line other = m_small(324),
- ?line other = m_small(-7),
+ a = m_small_jt(-2),
+ b = m_small_jt(-1),
+ c = m_small_jt(0),
+ d = m_small_jt(2),
+ e = m_small_jt(3),
+ other = m_small(324),
+ other = m_small(-7),
ok.
m_small_jt(-2) -> a;
@@ -117,8 +115,7 @@ matching1(-389789298378939783333333333333333333784) -> b;
matching1(_) -> other.
-matching_more_bigs(doc) -> "Test matching of a big number literals (in Beam,"
- "a select_val/3 instruction will be used).";
+%% Test matching of a big number literals (in Beam, a select_val/3 instruction will be used)
matching_more_bigs(Config) when is_list(Config) ->
a = matching2(-999766349740978337),
b = matching2(9734097866575478),
@@ -137,8 +134,7 @@ matching2(13987294872948990) -> d;
matching2(777723896192459245) -> e;
matching2(_) -> other.
-matching_bigs_and_smalls(doc) -> "Test matching of a mix of big numbers and literals.";
-matching_bigs_and_smalls(suite) -> [];
+%% Test matching of a mix of big numbers and literals.
matching_bigs_and_smalls(Config) when is_list(Config) ->
a = matching3(38472928723987239873873),
b = matching3(0),
@@ -159,30 +155,30 @@ matching3(42) -> e;
matching3(-4533) -> f;
matching3(_) -> other.
-badmatch(doc) -> "Test literal badmatches with big number and floats.";
+%% Test literal badmatches with big number and floats.
badmatch(Config) when is_list(Config) ->
%% We are satisfied if we can load this module and run it.
Big = id(32984798729847892498297824872982972978239874),
Float = id(3.1415927),
- ?line catch a = Big,
- ?line catch b = Float,
- ?line {'EXIT',{{badmatch,3879373498378993387},_}} =
+ catch a = Big,
+ catch b = Float,
+ {'EXIT',{{badmatch,3879373498378993387},_}} =
(catch c = 3879373498378993387),
- ?line {'EXIT',{{badmatch,7.0},_}} = (catch d = 7.0),
- ?line case Big of
- Big -> ok
- end,
- ?line case Float of
- Float -> ok
- end,
+ {'EXIT',{{badmatch,7.0},_}} = (catch d = 7.0),
+ case Big of
+ Big -> ok
+ end,
+ case Float of
+ Float -> ok
+ end,
ok.
case_clause(Config) when is_list(Config) ->
- ?line {'EXIT',{{case_clause,337.0},_}} = (catch case_clause_float()),
- ?line {'EXIT',{{try_clause,42.0},_}} = (catch try_case_clause_float()),
- ?line {'EXIT',{{case_clause,37932749837839747383847398743789348734987},_}} =
+ {'EXIT',{{case_clause,337.0},_}} = (catch case_clause_float()),
+ {'EXIT',{{try_clause,42.0},_}} = (catch try_case_clause_float()),
+ {'EXIT',{{case_clause,37932749837839747383847398743789348734987},_}} =
(catch case_clause_big()),
- ?line {'EXIT',{{try_clause,977387349872349870423364354398566348},_}} =
+ {'EXIT',{{try_clause,977387349872349870423364354398566348},_}} =
(catch try_case_clause_big()),
ok.
@@ -210,8 +206,7 @@ try_case_clause_big() ->
error
end.
-receiving(doc) -> "Test receive with a big number literal (more than 27 bits, "
- "less than 32 bits).";
+%% Test receive with a big number literal (more than 27 bits, less than 32 bits).
receiving(Config) when is_list(Config) ->
Self = self(),
spawn(fun() -> Self ! here_is_a_message end),
@@ -222,11 +217,11 @@ receiving(Config) when is_list(Config) ->
timeout
end.
-literal_type_tests(doc) -> "Test type tests on literal values.";
+%% Test type tests on literal values.
literal_type_tests(Config) when is_list(Config) ->
%% Generate an Erlang module with all different type of type tests.
- ?line Tests = make_test([{T, L} || T <- type_tests(), L <- literals()]),
- ?line Mod = literal_test,
+ Tests = make_test([{T, L} || T <- type_tests(), L <- literals()]),
+ Mod = literal_test,
Anno = erl_anno:new(0),
Func = {function, Anno, test, 0, [{clause,Anno,[],[],Tests}]},
Form = [{attribute,Anno,module,Mod},
@@ -234,22 +229,22 @@ literal_type_tests(Config) when is_list(Config) ->
Func, {eof,Anno}],
%% Print generated code for inspection.
- ?line lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form),
+ lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form),
%% Test compile:form/1. This implies full optimization (default).
- ?line {ok,Mod,Code1} = compile:forms(Form),
- ?line {module,Mod} = code:load_binary(Mod, Mod, Code1),
- ?line Mod:test(),
- ?line true = code:delete(Mod),
- ?line code:purge(Mod),
+ {ok,Mod,Code1} = compile:forms(Form),
+ {module,Mod} = code:load_binary(Mod, Mod, Code1),
+ Mod:test(),
+ true = code:delete(Mod),
+ code:purge(Mod),
%% Test compile:form/2. Turn off all optimizations.
- ?line {ok,Mod,Code2} = compile:forms(Form, [binary,report,time,
+ {ok,Mod,Code2} = compile:forms(Form, [binary,report,time,
no_copt,no_postopt]),
- ?line {module,Mod} = code:load_binary(Mod, Mod, Code2),
- ?line Mod:test(),
- ?line true = code:delete(Mod),
- ?line code:purge(Mod),
+ {module,Mod} = code:load_binary(Mod, Mod, Code2),
+ Mod:test(),
+ true = code:delete(Mod),
+ code:purge(Mod),
ok.
make_test([{is_function=T,L}|Ts]) ->
@@ -299,34 +294,34 @@ type_tests() ->
put_list(Config) when is_list(Config) ->
%% put_list x0 Literal Reg
- ?line [Config|8739757395764] = put_list_rqr(Config),
- ?line {[Config|7779757395764],Config} = put_list_rqx(Config),
- ?line [Config|98765432100000] = put_list_rqy(Config),
+ [Config|8739757395764] = put_list_rqr(Config),
+ {[Config|7779757395764],Config} = put_list_rqx(Config),
+ [Config|98765432100000] = put_list_rqy(Config),
%% put_list x Literal Reg
- ?line [Config|16#FFFFF77777137483769] = put_list_xqr(ignore, Config),
- ?line {[Config|16#AAAAAFFFFF77777],{a,b},Config} = put_list_xqx({a,b}, Config),
- ?line [Config|12777765432979879] = put_list_xqy(ignore, Config),
+ [Config|16#FFFFF77777137483769] = put_list_xqr(ignore, Config),
+ {[Config|16#AAAAAFFFFF77777],{a,b},Config} = put_list_xqx({a,b}, Config),
+ [Config|12777765432979879] = put_list_xqy(ignore, Config),
%% put_list y Literal Reg
- ?line [Config|17424134793676869867] = put_list_yqr(Config),
- ?line {[Config|77424134793676869867],Config} = put_list_yqx(Config),
- ?line {Config,[Config|16#BCDEFF4241676869867]} = put_list_yqy(Config),
+ [Config|17424134793676869867] = put_list_yqr(Config),
+ {[Config|77424134793676869867],Config} = put_list_yqx(Config),
+ {Config,[Config|16#BCDEFF4241676869867]} = put_list_yqy(Config),
%% put_list Literal x0 Reg
- ?line [42.0|Config] = put_list_qrr(Config),
- ?line [Config,42.0|Config] = put_list_qrx(Config),
- ?line [100.0|Config] = put_list_qry(Config),
+ [42.0|Config] = put_list_qrr(Config),
+ [Config,42.0|Config] = put_list_qrx(Config),
+ [100.0|Config] = put_list_qry(Config),
%% put_list Literal x1 Reg
- ?line [127.0|Config] = put_list_qxr({ignore,me}, Config),
- ?line [Config,130.0|Config] = put_list_qxx(ignore, Config),
- ?line [99.0|Config] = put_list_qxy(Config),
+ [127.0|Config] = put_list_qxr({ignore,me}, Config),
+ [Config,130.0|Config] = put_list_qxx(ignore, Config),
+ [99.0|Config] = put_list_qxy(Config),
%% put_list Literal y0 Reg
- ?line [200.0|Config] = put_list_qyr(Config),
- ?line [Config,210.0|Config] = put_list_qyx(Config),
- ?line [[300.0|Config]|Config] = put_list_qyy(Config),
+ [200.0|Config] = put_list_qyr(Config),
+ [Config,210.0|Config] = put_list_qyx(Config),
+ [[300.0|Config]|Config] = put_list_qyy(Config),
ok.
@@ -417,8 +412,8 @@ put_list_qyy(Config) ->
[Res|Config].
fconv(Config) when is_list(Config) ->
- ?line 5.0 = fconv_1(-34444444450.0),
- ?line 13.0 = fconv_2(7.0),
+ 5.0 = fconv_1(-34444444450.0),
+ 13.0 = fconv_2(7.0),
ok.
fconv_1(F) when is_float(F) ->
@@ -428,19 +423,18 @@ fconv_2(F) when is_float(F) ->
6.0 + F.
literal_case_expression(Config) when is_list(Config) ->
- ?line DataDir = ?config(data_dir, Config),
- ?line Src = filename:join(DataDir, "literal_case_expression"),
- ?line {ok,literal_case_expression=Mod,Code} =
- compile:file(Src, [from_asm,binary]),
- ?line {module,Mod} = code:load_binary(Mod, Src, Code),
- ?line ok = Mod:x(),
- ?line ok = Mod:y(),
- ?line ok = Mod:zi1(),
- ?line ok = Mod:zi2(),
- ?line ok = Mod:za1(),
- ?line ok = Mod:za2(),
- ?line true = code:delete(Mod),
- ?line code:purge(Mod),
+ DataDir = proplists:get_value(data_dir, Config),
+ Src = filename:join(DataDir, "literal_case_expression"),
+ {ok,literal_case_expression=Mod,Code} = compile:file(Src, [from_asm,binary]),
+ {module,Mod} = code:load_binary(Mod, Src, Code),
+ ok = Mod:x(),
+ ok = Mod:y(),
+ ok = Mod:zi1(),
+ ok = Mod:zi2(),
+ ok = Mod:za1(),
+ ok = Mod:za2(),
+ true = code:delete(Mod),
+ code:purge(Mod),
ok.
%% Test the i_increment instruction.
@@ -452,27 +446,27 @@ increment(Config) when is_list(Config) ->
Neg32 = -(1 bsl 27),
Big32 = id(1 bsl 32),
Result32 = (1 bsl 32) + (1 bsl 27),
- ?line Result32 = Big32 + (1 bsl 27),
- ?line Result32 = Big32 - Neg32,
+ Result32 = Big32 + (1 bsl 27),
+ Result32 = Big32 - Neg32,
%% Same thing, but for the 64-bit emulator.
Neg64 = -(1 bsl 59),
Big64 = id(1 bsl 64),
Result64 = (1 bsl 64) + (1 bsl 59),
- ?line Result64 = Big64 + (1 bsl 59),
- ?line Result64 = Big64 - Neg64,
+ Result64 = Big64 + (1 bsl 59),
+ Result64 = Big64 - Neg64,
%% Test error handling for the i_increment instruction.
Bad = id(bad),
- ?line {'EXIT',{badarith,_}} = (catch Bad + 42),
+ {'EXIT',{badarith,_}} = (catch Bad + 42),
%% Small operands, but a big result.
Res32 = 1 bsl 27,
Small32 = id(Res32-1),
- ?line Res32 = Small32 + 1,
+ Res32 = Small32 + 1,
Res64 = 1 bsl 59,
Small64 = id(Res64-1),
- ?line Res64 = Small64 + 1,
+ Res64 = Small64 + 1,
ok.
%% Help functions.
diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl
index d6a771e7b9..43d00e699a 100644
--- a/erts/emulator/test/bif_SUITE.erl
+++ b/erts/emulator/test/bif_SUITE.erl
@@ -20,21 +20,22 @@
-module(bif_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
+-export([all/0, suite/0,
display/1, display_huge/0,
erl_bif_types/1,guard_bifs_in_erl_bif_types/1,
shadow_comments/1,
specs/1,improper_bif_stubs/1,auto_imports/1,
t_list_to_existing_atom/1,os_env/1,otp_7526/1,
binary_to_atom/1,binary_to_existing_atom/1,
- atom_to_binary/1,min_max/1, erlang_halt/1]).
+ atom_to_binary/1,min_max/1, erlang_halt/1,
+ is_builtin/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
all() ->
[erl_bif_types, guard_bifs_in_erl_bif_types, shadow_comments,
@@ -42,37 +43,9 @@ all() ->
t_list_to_existing_atom, os_env, otp_7526,
display,
atom_to_binary, binary_to_atom, binary_to_existing_atom,
- min_max, erlang_halt].
+ min_max, erlang_halt, is_builtin].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(1)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-
-display(suite) ->
- [];
-display(doc) ->
- ["Uses erlang:display to test that erts_printf does not do deep recursion"];
+%% Uses erlang:display to test that erts_printf does not do deep recursion
display(Config) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
{ok, Node} = test_server:start_node(display_huge_term,peer,
@@ -117,7 +90,7 @@ erl_bif_types_2(List) ->
[_|_] ->
io:put_chars("Bifs with bad arity\n"),
io:format("~p\n", [BadArity]),
- ?line ?t:fail({length(BadArity),bad_arity})
+ ct:fail({length(BadArity),bad_arity})
end.
erl_bif_types_3(List) ->
@@ -141,7 +114,7 @@ erl_bif_types_3(List) ->
io:put_chars("Bifs with failing calls to erlang_bif_types:type/3 "
"(or with bogus return values):\n"),
io:format("~p\n", [BadSmokeTest]),
- ?line ?t:fail({length(BadSmokeTest),bad_smoke_test})
+ ct:fail({length(BadSmokeTest),bad_smoke_test})
end.
guard_bifs_in_erl_bif_types(_Config) ->
@@ -162,7 +135,7 @@ guard_bifs_in_erl_bif_types(_Config) ->
"The following guard BIFs have no type information "
"in erl_bif_types:\n\n",
[io_lib:format(" ~p/~p\n", [F,A]) || {F,A} <- Not]]),
- ?t:fail()
+ ct:fail(erl_bif_types)
end.
shadow_comments(_Config) ->
@@ -202,7 +175,7 @@ shadow_comments(_Config) ->
"obvious.\n\nThe following comments are missing:\n\n",
[io_lib:format("%% Shadowed by erl_bif_types: ~p:~p/~p\n",
[M,F,A]) || {M,F,A} <- NoComments]]),
- ?t:fail()
+ ct:fail(bif_stub)
end,
case NoBifSpecs of
@@ -216,7 +189,7 @@ shadow_comments(_Config) ->
"Therefore, the following comments should be removed:\n\n",
[io_lib:format("%% Shadowed by erl_bif_types: ~p:~p/~p\n",
[M,F,A]) || {M,F,A} <- NoBifSpecs]]),
- ?t:fail()
+ ct:fail(erl_bif_types)
end.
extract_comments(Mod, Path) ->
@@ -238,7 +211,7 @@ ensure_erl_bif_types_compiled() ->
case erlang:function_exported(erl_bif_types, module_info, 0) of
false ->
%% Fail cleanly.
- ?t:fail("erl_bif_types not compiled");
+ ct:fail("erl_bif_types not compiled");
true ->
ok
end.
@@ -276,7 +249,7 @@ specs(_) ->
[_|_] ->
io:put_chars("The following BIFs don't have specs:\n"),
[print_mfa(MFA) || MFA <- NoSpecs],
- ?t:fail()
+ ct:fail(no_spec)
end.
is_operator({erlang,F,A}) ->
@@ -336,7 +309,7 @@ auto_imports([{erlang,F,A}|T], Errors) ->
auto_imports([], 0) ->
ok;
auto_imports([], Errors) ->
- ?t:fail({Errors,inconsistencies}).
+ ct:fail({Errors,inconsistencies}).
extract_functions(M, Abstr) ->
[{{M,F,A},Body} || {function,_,F,A,Body} <- Abstr].
@@ -355,40 +328,36 @@ check_stub({_,F,A}, B) ->
io:put_chars(erl_pp:function(Func)),
io:nl(),
io:put_chars("The body should be: erlang:nif_error(undef)"),
- ?t:fail()
+ ct:fail(invalid_body)
end.
t_list_to_existing_atom(Config) when is_list(Config) ->
- ?line all = list_to_existing_atom("all"),
- ?line ?MODULE = list_to_existing_atom(?MODULE_STRING),
- ?line UnlikelyStr = "dsfj923874390867er869fds9864y97jhg3973qerueoru",
+ all = list_to_existing_atom("all"),
+ ?MODULE = list_to_existing_atom(?MODULE_STRING),
+ UnlikelyStr = "dsfj923874390867er869fds9864y97jhg3973qerueoru",
try
- ?line list_to_existing_atom(UnlikelyStr),
- ?line ?t:fail()
+ list_to_existing_atom(UnlikelyStr),
+ ct:fail(atom_exists)
catch
error:badarg -> ok
end,
%% The compiler has become smarter! We need the call to id/1 in
%% the next line.
- ?line UnlikelyAtom = list_to_atom(id(UnlikelyStr)),
- ?line UnlikelyAtom = list_to_existing_atom(UnlikelyStr),
+ UnlikelyAtom = list_to_atom(id(UnlikelyStr)),
+ UnlikelyAtom = list_to_existing_atom(UnlikelyStr),
ok.
-os_env(doc) ->
- [];
-os_env(suite) ->
- [];
os_env(Config) when is_list(Config) ->
- ?line EnvVar1 = "MjhgvFDrresdCghN mnjkUYg vfrD",
- ?line false = os:getenv(EnvVar1),
- ?line true = os:putenv(EnvVar1, "mors"),
- ?line "mors" = os:getenv(EnvVar1),
- ?line true = os:putenv(EnvVar1, ""),
- ?line case os:getenv(EnvVar1) of
- "" -> ?line ok;
- false -> ?line ok;
- BadVal -> ?line ?t:fail(BadVal)
+ EnvVar1 = "MjhgvFDrresdCghN mnjkUYg vfrD",
+ false = os:getenv(EnvVar1),
+ true = os:putenv(EnvVar1, "mors"),
+ "mors" = os:getenv(EnvVar1),
+ true = os:putenv(EnvVar1, ""),
+ case os:getenv(EnvVar1) of
+ "" -> ok;
+ false -> ok;
+ BadVal -> ct:fail(BadVal)
end,
true = os:putenv(EnvVar1, "mors"),
true = os:unsetenv(EnvVar1),
@@ -396,19 +365,18 @@ os_env(Config) when is_list(Config) ->
true = os:unsetenv(EnvVar1), % unset unset variable
%% os:putenv, os:getenv and os:unsetenv currently use a temp
%% buffer of size 1024 for storing key+value
- ?line os_env_long(1010, 1030, "hej hopp").
+ os_env_long(1010, 1030, "hej hopp").
os_env_long(Min, Max, _Value) when Min > Max ->
- ?line ok;
+ ok;
os_env_long(Min, Max, Value) ->
- ?line EnvVar = lists:duplicate(Min, $X),
- ?line true = os:putenv(EnvVar, Value),
- ?line Value = os:getenv(EnvVar),
+ EnvVar = lists:duplicate(Min, $X),
+ true = os:putenv(EnvVar, Value),
+ Value = os:getenv(EnvVar),
true = os:unsetenv(EnvVar),
- ?line os_env_long(Min+1, Max, Value).
+ os_env_long(Min+1, Max, Value).
-otp_7526(doc) ->
- ["Test that string:to_integer does not Halloc in wrong order."];
+%% Test that string:to_integer does not Halloc in wrong order.
otp_7526(Config) when is_list(Config) ->
ok = test_7526(256).
@@ -423,15 +391,15 @@ do_test_7526(N,M) ->
{Self, Ref} = {self(), make_ref()},
T = erlang:make_tuple(M,0),
spawn_opt(fun()->
- L = iterate_7526(N, []),
- BadList = [X || X <- L, X =/= 9223372036854775808],
- BadLen = length(BadList),
- M = length(tuple_to_list(T)),
- %%io:format("~b bad conversions: ~p~n", [BadLen, BadList]),
- Self ! {done, Ref, BadLen}
- end,
- [link,{fullsweep_after,0}]),
- receive {done, Ref, Len} -> Len end.
+ L = iterate_7526(N, []),
+ BadList = [X || X <- L, X =/= 9223372036854775808],
+ BadLen = length(BadList),
+ M = length(tuple_to_list(T)),
+ %%io:format("~b bad conversions: ~p~n", [BadLen, BadList]),
+ Self ! {done, Ref, BadLen}
+ end,
+ [link,{fullsweep_after,0}]),
+ receive {done, Ref, Len} -> Len end.
test_7526(0) ->
@@ -455,57 +423,53 @@ binary_to_atom(Config) when is_list(Config) ->
LongBin = list_to_binary(Long),
%% latin1
- ?line '' = test_binary_to_atom(<<>>, latin1),
- ?line '\377' = test_binary_to_atom(<<255>>, latin1),
- ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, latin1),
- ?line LongAtom = test_binary_to_atom(LongBin, latin1),
+ '' = test_binary_to_atom(<<>>, latin1),
+ '\377' = test_binary_to_atom(<<255>>, latin1),
+ HalfLongAtom = test_binary_to_atom(HalfLongBin, latin1),
+ LongAtom = test_binary_to_atom(LongBin, latin1),
%% utf8
- ?line '' = test_binary_to_atom(<<>>, utf8),
- ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, utf8),
- ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, unicode),
- ?line [] = [C || C <- lists:seq(128, 255),
+ '' = test_binary_to_atom(<<>>, utf8),
+ HalfLongAtom = test_binary_to_atom(HalfLongBin, utf8),
+ HalfLongAtom = test_binary_to_atom(HalfLongBin, unicode),
+ [] = [C || C <- lists:seq(128, 255),
begin
list_to_atom([C]) =/=
test_binary_to_atom(<<C/utf8>>, utf8)
end],
%% badarg failures.
- ?line fail_binary_to_atom(atom),
- ?line fail_binary_to_atom(42),
- ?line fail_binary_to_atom({a,b,c}),
- ?line fail_binary_to_atom([1,2,3]),
- ?line fail_binary_to_atom([]),
- ?line fail_binary_to_atom(42.0),
- ?line fail_binary_to_atom(self()),
- ?line fail_binary_to_atom(make_ref()),
- ?line fail_binary_to_atom(<<0:7>>),
- ?line fail_binary_to_atom(<<42:13>>),
- ?line ?BADARG(binary_to_atom(id(<<>>), blurf)),
- ?line ?BADARG(binary_to_atom(id(<<>>), [])),
+ fail_binary_to_atom(atom),
+ fail_binary_to_atom(42),
+ fail_binary_to_atom({a,b,c}),
+ fail_binary_to_atom([1,2,3]),
+ fail_binary_to_atom([]),
+ fail_binary_to_atom(42.0),
+ fail_binary_to_atom(self()),
+ fail_binary_to_atom(make_ref()),
+ fail_binary_to_atom(<<0:7>>),
+ fail_binary_to_atom(<<42:13>>),
+ ?BADARG(binary_to_atom(id(<<>>), blurf)),
+ ?BADARG(binary_to_atom(id(<<>>), [])),
%% Bad UTF8 sequences.
- ?line ?BADARG(binary_to_atom(id(<<255>>), utf8)),
- ?line ?BADARG(binary_to_atom(id(<<255,0>>), utf8)),
- ?line ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0.
- ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) ||
- C <- lists:seq(256, 16#D7FF)],
- ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) ||
- C <- lists:seq(16#E000, 16#FFFD)],
- ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) ||
- C <- lists:seq(16#10000, 16#8FFFF)],
- ?line [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) ||
- C <- lists:seq(16#90000, 16#10FFFF)],
+ ?BADARG(binary_to_atom(id(<<255>>), utf8)),
+ ?BADARG(binary_to_atom(id(<<255,0>>), utf8)),
+ ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0.
+ [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(256, 16#D7FF)],
+ [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#E000, 16#FFFD)],
+ [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#10000, 16#8FFFF)],
+ [?BADARG(binary_to_atom(<<C/utf8>>, utf8)) || C <- lists:seq(16#90000, 16#10FFFF)],
%% system_limit failures.
- ?line ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)),
- ?line ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255,0>>), utf8)),
- ?line ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, latin1)),
- ?line ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, latin1)),
- ?line ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, latin1)),
- ?line ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, utf8)),
- ?line ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, utf8)),
- ?line ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, utf8)),
+ ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)),
+ ?SYS_LIMIT(binary_to_atom(id(<<0:512/unit:8,255,0>>), utf8)),
+ ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, latin1)),
+ ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, latin1)),
+ ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, latin1)),
+ ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, utf8)),
+ ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, utf8)),
+ ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, utf8)),
ok.
test_binary_to_atom(Bin0, Encoding) ->
@@ -518,49 +482,49 @@ test_binary_to_atom(Bin0, Encoding) ->
fail_binary_to_atom(Bin) ->
try
- binary_to_atom(Bin, latin1)
+ binary_to_atom(Bin, latin1)
catch
- error:badarg ->
- ok
+ error:badarg ->
+ ok
end,
try
- binary_to_atom(Bin, utf8)
+ binary_to_atom(Bin, utf8)
catch
- error:badarg ->
- ok
+ error:badarg ->
+ ok
end,
try
- binary_to_existing_atom(Bin, latin1)
+ binary_to_existing_atom(Bin, latin1)
catch
- error:badarg ->
- ok
+ error:badarg ->
+ ok
end,
try
- binary_to_existing_atom(Bin, utf8)
+ binary_to_existing_atom(Bin, utf8)
catch
- error:badarg ->
- ok
+ error:badarg ->
+ ok
end.
binary_to_existing_atom(Config) when is_list(Config) ->
- ?line UnlikelyBin = <<"ou0897979655678dsfj923874390867er869fds973qerueoru">>,
+ UnlikelyBin = <<"ou0897979655678dsfj923874390867er869fds973qerueoru">>,
try
- ?line binary_to_existing_atom(UnlikelyBin, latin1),
- ?line ?t:fail()
+ binary_to_existing_atom(UnlikelyBin, latin1),
+ ct:fail(atom_exists)
catch
error:badarg -> ok
end,
try
- ?line binary_to_existing_atom(UnlikelyBin, utf8),
- ?line ?t:fail()
+ binary_to_existing_atom(UnlikelyBin, utf8),
+ ct:fail(atom_exists)
catch
error:badarg -> ok
end,
- ?line UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1),
- ?line UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1),
+ UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1),
+ UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1),
ok.
@@ -573,32 +537,32 @@ atom_to_binary(Config) when is_list(Config) ->
LongBin = list_to_binary(Long),
%% latin1
- ?line <<>> = atom_to_binary('', latin1),
- ?line <<"abc">> = atom_to_binary(abc, latin1),
- ?line <<127>> = atom_to_binary('\177', latin1),
- ?line HalfLongBin = atom_to_binary(HalfLongAtom, latin1),
- ?line LongBin = atom_to_binary(LongAtom, latin1),
+ <<>> = atom_to_binary('', latin1),
+ <<"abc">> = atom_to_binary(abc, latin1),
+ <<127>> = atom_to_binary('\177', latin1),
+ HalfLongBin = atom_to_binary(HalfLongAtom, latin1),
+ LongBin = atom_to_binary(LongAtom, latin1),
%% utf8.
- ?line <<>> = atom_to_binary('', utf8),
- ?line <<>> = atom_to_binary('', unicode),
- ?line <<127>> = atom_to_binary('\177', utf8),
- ?line <<"abcdef">> = atom_to_binary(abcdef, utf8),
- ?line HalfLongBin = atom_to_binary(HalfLongAtom, utf8),
- ?line LongAtomBin = atom_to_binary(LongAtom, utf8),
- ?line verify_long_atom_bin(LongAtomBin, 0),
+ <<>> = atom_to_binary('', utf8),
+ <<>> = atom_to_binary('', unicode),
+ <<127>> = atom_to_binary('\177', utf8),
+ <<"abcdef">> = atom_to_binary(abcdef, utf8),
+ HalfLongBin = atom_to_binary(HalfLongAtom, utf8),
+ LongAtomBin = atom_to_binary(LongAtom, utf8),
+ verify_long_atom_bin(LongAtomBin, 0),
%% Failing cases.
- ?line fail_atom_to_binary(<<1>>),
- ?line fail_atom_to_binary(42),
- ?line fail_atom_to_binary({a,b,c}),
- ?line fail_atom_to_binary([1,2,3]),
- ?line fail_atom_to_binary([]),
- ?line fail_atom_to_binary(42.0),
- ?line fail_atom_to_binary(self()),
- ?line fail_atom_to_binary(make_ref()),
- ?line ?BADARG(atom_to_binary(id(a), blurf)),
- ?line ?BADARG(atom_to_binary(id(b), [])),
+ fail_atom_to_binary(<<1>>),
+ fail_atom_to_binary(42),
+ fail_atom_to_binary({a,b,c}),
+ fail_atom_to_binary([1,2,3]),
+ fail_atom_to_binary([]),
+ fail_atom_to_binary(42.0),
+ fail_atom_to_binary(self()),
+ fail_atom_to_binary(make_ref()),
+ ?BADARG(atom_to_binary(id(a), blurf)),
+ ?BADARG(atom_to_binary(id(b), [])),
ok.
verify_long_atom_bin(<<I/utf8,T/binary>>, I) ->
@@ -607,74 +571,73 @@ verify_long_atom_bin(<<>>, 255) -> ok.
fail_atom_to_binary(Term) ->
try
- atom_to_binary(Term, latin1)
+ atom_to_binary(Term, latin1)
catch
- error:badarg ->
- ok
+ error:badarg ->
+ ok
end,
try
- atom_to_binary(Term, utf8)
+ atom_to_binary(Term, utf8)
catch
- error:badarg ->
- ok
+ error:badarg ->
+ ok
end.
min_max(Config) when is_list(Config) ->
- ?line a = erlang:min(id(a), a),
- ?line a = erlang:min(id(a), b),
- ?line a = erlang:min(id(b), a),
- ?line b = erlang:min(id(b), b),
- ?line a = erlang:max(id(a), a),
- ?line b = erlang:max(id(a), b),
- ?line b = erlang:max(id(b), a),
- ?line b = erlang:max(id(b), b),
-
- ?line 42.0 = erlang:min(42.0, 42),
- ?line 42.0 = erlang:max(42.0, 42),
+ a = erlang:min(id(a), a),
+ a = erlang:min(id(a), b),
+ a = erlang:min(id(b), a),
+ b = erlang:min(id(b), b),
+ a = erlang:max(id(a), a),
+ b = erlang:max(id(a), b),
+ b = erlang:max(id(b), a),
+ b = erlang:max(id(b), b),
+
+ 42.0 = erlang:min(42.0, 42),
+ 42.0 = erlang:max(42.0, 42),
%% And now (R14) they are also autoimported!
- ?line a = min(id(a), a),
- ?line a = min(id(a), b),
- ?line a = min(id(b), a),
- ?line b = min(id(b), b),
- ?line a = max(id(a), a),
- ?line b = max(id(a), b),
- ?line b = max(id(b), a),
- ?line b = max(id(b), b),
-
- ?line 42.0 = min(42.0, 42),
- ?line 42.0 = max(42.0, 42),
-
+ a = min(id(a), a),
+ a = min(id(a), b),
+ a = min(id(b), a),
+ b = min(id(b), b),
+ a = max(id(a), a),
+ b = max(id(a), b),
+ b = max(id(b), a),
+ b = max(id(b), b),
+
+ 42.0 = min(42.0, 42),
+ 42.0 = max(42.0, 42),
ok.
erlang_halt(Config) when is_list(Config) ->
try erlang:halt(undefined) of
- _-> ?t:fail({erlang,halt,{undefined}})
+ _-> ct:fail({erlang,halt,{undefined}})
catch error:badarg -> ok end,
try halt(undefined) of
- _-> ?t:fail({halt,{undefined}})
+ _-> ct:fail({halt,{undefined}})
catch error:badarg -> ok end,
try erlang:halt(undefined, []) of
- _-> ?t:fail({erlang,halt,{undefined,[]}})
+ _-> ct:fail({erlang,halt,{undefined,[]}})
catch error:badarg -> ok end,
try halt(undefined, []) of
- _-> ?t:fail({halt,{undefined,[]}})
+ _-> ct:fail({halt,{undefined,[]}})
catch error:badarg -> ok end,
try halt(0, undefined) of
- _-> ?t:fail({halt,{0,undefined}})
+ _-> ct:fail({halt,{0,undefined}})
catch error:badarg -> ok end,
try halt(0, [undefined]) of
- _-> ?t:fail({halt,{0,[undefined]}})
+ _-> ct:fail({halt,{0,[undefined]}})
catch error:badarg -> ok end,
try halt(0, [{undefined,true}]) of
- _-> ?t:fail({halt,{0,[{undefined,true}]}})
+ _-> ct:fail({halt,{0,[{undefined,true}]}})
catch error:badarg -> ok end,
try halt(0, [{flush,undefined}]) of
- _-> ?t:fail({halt,{0,[{flush,undefined}]}})
+ _-> ct:fail({halt,{0,[{flush,undefined}]}})
catch error:badarg -> ok end,
try halt(0, [{flush,true,undefined}]) of
- _-> ?t:fail({halt,{0,[{flush,true,undefined}]}})
+ _-> ct:fail({halt,{0,[{flush,true,undefined}]}})
catch error:badarg -> ok end,
H = hostname(),
{ok,N1} = slave:start(H, halt_node1),
@@ -716,6 +679,22 @@ wait_until_stable_size(File,PrevSz) ->
wait_until_stable_size(File,NewSz)
end.
+is_builtin(_Config) ->
+ Exp0 = [{M,F,A} || {M,_} <- code:all_loaded(),
+ {F,A} <- M:module_info(exports)],
+ Exp = ordsets:from_list(Exp0),
+
+ %% erlang:apply/3 is considered to be built-in, but is not
+ %% implemented as other BIFs.
+
+ Builtins0 = [{erlang,apply,3}|erlang:system_info(snifs)],
+ Builtins = ordsets:from_list(Builtins0),
+ NotBuiltin = ordsets:subtract(Exp, Builtins),
+ _ = [true = erlang:is_builtin(M, F, A) || {M,F,A} <- Builtins],
+ _ = [false = erlang:is_builtin(M, F, A) || {M,F,A} <- NotBuiltin],
+
+ ok.
+
%% Helpers
diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl
index e8f881f2a4..d331083661 100644
--- a/erts/emulator/test/big_SUITE.erl
+++ b/erts/emulator/test/big_SUITE.erl
@@ -20,8 +20,8 @@
-module(big_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
+-export([all/0, suite/0, groups/0]).
+
-export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1,
borders/1, negative/1, big_float_1/1, big_float_2/1,
shift_limit_1/1, powmod/1, system_limit/1, toobig/1, otp_6692/1]).
@@ -32,11 +32,12 @@
-export([fac/1, fib/1, pow/2, gcd/2, lcm/2]).
--export([init_per_testcase/2, end_per_testcase/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 3}}].
all() ->
[t_div, eq_28, eq_32, eq_big, eq_math, big_literals,
@@ -46,27 +47,6 @@ all() ->
groups() ->
[{big_float, [], [big_float_1, big_float_2]}].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(3)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
%%
%% Syntax of data files:
%% Expr1 = Expr2.
@@ -95,7 +75,7 @@ eq_math(Config) when is_list(Config) ->
test(TestFile).
-borders(doc) -> "Tests border cases between small/big.";
+%% Tests border cases between small/big.
borders(Config) when is_list(Config) ->
TestFile = test_file(Config, "borders.dat"),
test(TestFile).
@@ -107,7 +87,7 @@ negative(Config) when is_list(Config) ->
%% Find test file
test_file(Config, Name) ->
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
filename:join(DataDir, Name).
%%
@@ -119,12 +99,12 @@ test(File) ->
test(File, [node()]).
test(File, Nodes) ->
- ?line {ok,Fd} = file:open(File, [read]),
+ {ok,Fd} = file:open(File, [read]),
Res = test(File, Fd, Nodes),
file:close(Fd),
case Res of
{0,Cases} -> {comment, integer_to_list(Cases) ++ " cases"};
- {_,_} -> test_server:fail()
+ {_,_} -> ct:fail("failed")
end.
test(File, Fd, Ns) ->
@@ -156,7 +136,7 @@ multi_match(Ns, Expr) ->
multi_match(Ns, Expr, []).
multi_match([Node|Ns], Expr, Rs) ->
- ?line X = rpc:call(Node, big_SUITE, eval, [Expr]),
+ X = rpc:call(Node, big_SUITE, eval, [Expr]),
if X == 0 -> multi_match(Ns, Expr, Rs);
true -> multi_match(Ns, Expr, [{Node,X}|Rs])
end;
@@ -248,10 +228,10 @@ lcm(Q, R) ->
%% Test case t_div cut in from R2D test suite.
t_div(Config) when is_list(Config) ->
- ?line 'try'(fun() -> 98765432101234 div 98765432101235 end, 0),
+ 'try'(fun() -> 98765432101234 div 98765432101235 end, 0),
% Big remainder, small quotient.
- ?line 'try'(fun() -> 339254531512 div 68719476736 end, 4),
+ 'try'(fun() -> 339254531512 div 68719476736 end, 4),
ok.
'try'(Fun, Result) ->
@@ -265,65 +245,60 @@ t_div(Config) when is_list(Config) ->
{result, Result} ->
'try'(Iter-1, Fun, Result, [0|Filler]);
{result, Other} ->
- io:format("Expected ~p; got ~p~n", [Result, Other]),
- test_server:fail()
+ ct:fail("Expected ~p; got ~p~n", [Result, Other])
end.
init(ReplyTo, Fun, _Filler) ->
ReplyTo ! {result, Fun()}.
-big_literals(doc) ->
- "Tests that big-number literals work correctly.";
+%% Tests that big-number literals work correctly.
big_literals(Config) when is_list(Config) ->
%% Note: The literal test cannot be compiler on a pre-R4 Beam emulator,
%% so we compile it now.
- ?line DataDir = ?config(data_dir, Config),
- ?line Test = filename:join(DataDir, "literal_test"),
- ?line {ok, Mod, Bin} = compile:file(Test, [binary]),
- ?line {module, Mod} = code:load_binary(Mod, Mod, Bin),
- ?line ok = Mod:t(),
+ DataDir = proplists:get_value(data_dir, Config),
+ Test = filename:join(DataDir, "literal_test"),
+ {ok, Mod, Bin} = compile:file(Test, [binary]),
+ {module, Mod} = code:load_binary(Mod, Mod, Bin),
+ ok = Mod:t(),
ok.
-big_float_1(doc) ->
- ["OTP-2436, part 1"];
+%% OTP-2436, part 1
big_float_1(Config) when is_list(Config) ->
%% F is a number very close to a maximum float.
- ?line F = id(1.7e308),
- ?line I = trunc(F),
- ?line true = (I == F),
- ?line false = (I /= F),
- ?line true = (I > F/2),
- ?line false = (I =< F/2),
- ?line true = (I*2 >= F),
- ?line false = (I*2 < F),
- ?line true = (I*I > F),
- ?line false = (I*I =< F),
-
- ?line true = (F == I),
- ?line false = (F /= I),
- ?line false = (F/2 > I),
- ?line true = (F/2 =< I),
- ?line false = (F >= I*2),
- ?line true = (F < I*2),
- ?line false = (F > I*I),
- ?line true = (F =< I*I),
+ F = id(1.7e308),
+ I = trunc(F),
+ true = (I == F),
+ false = (I /= F),
+ true = (I > F/2),
+ false = (I =< F/2),
+ true = (I*2 >= F),
+ false = (I*2 < F),
+ true = (I*I > F),
+ false = (I*I =< F),
+
+ true = (F == I),
+ false = (F /= I),
+ false = (F/2 > I),
+ true = (F/2 =< I),
+ false = (F >= I*2),
+ true = (F < I*2),
+ false = (F > I*I),
+ true = (F =< I*I),
ok.
-big_float_2(doc) ->
- ["OTP-2436, part 2"];
+%% "OTP-2436, part 2
big_float_2(Config) when is_list(Config) ->
- ?line F = id(1.7e308),
- ?line I = trunc(F),
- ?line {'EXIT', _} = (catch 1/(2*I)),
- ?line _Ignore = 2/I,
- ?line {'EXIT', _} = (catch 4/(2*I)),
+ F = id(1.7e308),
+ I = trunc(F),
+ {'EXIT', _} = (catch 1/(2*I)),
+ _Ignore = 2/I,
+ {'EXIT', _} = (catch 4/(2*I)),
ok.
-shift_limit_1(doc) ->
- ["OTP-3256"];
+%% OTP-3256
shift_limit_1(Config) when is_list(Config) ->
- ?line case catch (id(1) bsl 100000000) of
+ case catch (id(1) bsl 100000000) of
{'EXIT', {system_limit, _}} ->
ok
end,
@@ -352,16 +327,16 @@ powmod(A, B, C) ->
end.
system_limit(Config) when is_list(Config) ->
- ?line Maxbig = maxbig(),
- ?line {'EXIT',{system_limit,_}} = (catch Maxbig+1),
- ?line {'EXIT',{system_limit,_}} = (catch -Maxbig-1),
- ?line {'EXIT',{system_limit,_}} = (catch 2*Maxbig),
- ?line {'EXIT',{system_limit,_}} = (catch bnot Maxbig),
- ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])),
- ?line {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2),
- ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])),
- ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)),
- ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)),
+ Maxbig = maxbig(),
+ {'EXIT',{system_limit,_}} = (catch Maxbig+1),
+ {'EXIT',{system_limit,_}} = (catch -Maxbig-1),
+ {'EXIT',{system_limit,_}} = (catch 2*Maxbig),
+ {'EXIT',{system_limit,_}} = (catch bnot Maxbig),
+ {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])),
+ {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2),
+ {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])),
+ {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)),
+ {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)),
ok.
maxbig() ->
@@ -372,7 +347,7 @@ maxbig() ->
id(I) -> I.
toobig(Config) when is_list(Config) ->
- ?line {'EXIT',{{badmatch,_},_}} = (catch toobig()),
+ {'EXIT',{{badmatch,_},_}} = (catch toobig()),
ok.
toobig() ->
@@ -381,12 +356,9 @@ toobig() ->
<<ANr:ASize>> = A, % should fail
ANr band ANr.
-otp_6692(suite) ->
- [];
-otp_6692(doc) ->
- ["Tests for DIV/REM bug reported in OTP-6692"];
+%% Tests for DIV/REM bug reported in OTP-6692
otp_6692(Config) when is_list(Config)->
- ?line loop1(1,1000).
+ loop1(1,1000).
fact(N) ->
fact(N,1).
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 96ba2f64d4..fcd49e43d3 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -40,7 +40,7 @@
%% phash2(Binary, N)
%%
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
@@ -106,17 +106,17 @@ end_per_testcase(_Func, _Config) ->
copy_terms(Config) when is_list(Config) ->
Self = self(),
- ?line Pid = spawn_link(fun() -> copy_server(Self) end),
+ Pid = spawn_link(fun() -> copy_server(Self) end),
F = fun(Term) ->
Pid ! Term,
receive
Term -> ok;
Other ->
io:format("Sent: ~P\nGot back:~P", [Term,12,Other,12]),
- ?t:fail(bad_term)
+ ct:fail(bad_term)
end
end,
- ?line test_terms(F),
+ test_terms(F),
ok.
copy_server(Parent) ->
@@ -129,154 +129,152 @@ copy_server(Parent) ->
%% Tests list_to_binary/1, binary_to_list/1 and size/1,
%% using flat lists.
-conversions(suite) -> [];
conversions(Config) when is_list(Config) ->
- ?line test_bin([]),
- ?line test_bin([1]),
- ?line test_bin([1, 2]),
- ?line test_bin([1, 2, 3]),
- ?line test_bin(lists:seq(0, ?heap_binary_size)),
- ?line test_bin(lists:seq(0, ?heap_binary_size+1)),
- ?line test_bin(lists:seq(0, 255)),
- ?line test_bin(lists:duplicate(50000, $@)),
+ test_bin([]),
+ test_bin([1]),
+ test_bin([1, 2]),
+ test_bin([1, 2, 3]),
+ test_bin(lists:seq(0, ?heap_binary_size)),
+ test_bin(lists:seq(0, ?heap_binary_size+1)),
+ test_bin(lists:seq(0, 255)),
+ test_bin(lists:duplicate(50000, $@)),
%% Binary in list.
List = [1,2,3,4,5],
- ?line B1 = make_sub_binary(list_to_binary(List)),
- ?line 5 = size(B1),
- ?line 5 = size(make_unaligned_sub_binary(B1)),
- ?line 40 = bit_size(B1),
- ?line 40 = bit_size(make_unaligned_sub_binary(B1)),
- ?line B2 = list_to_binary([42,B1,19]),
- ?line B2 = list_to_binary([42,make_unaligned_sub_binary(B1),19]),
- ?line B2 = iolist_to_binary(B2),
- ?line B2 = iolist_to_binary(make_unaligned_sub_binary(B2)),
- ?line 7 = size(B2),
- ?line 7 = size(make_sub_binary(B2)),
- ?line 56 = bit_size(B2),
- ?line 56 = bit_size(make_sub_binary(B2)),
- ?line [42,1,2,3,4,5,19] = binary_to_list(B2),
- ?line [42,1,2,3,4,5,19] = binary_to_list(make_sub_binary(B2)),
- ?line [42,1,2,3,4,5,19] = binary_to_list(make_unaligned_sub_binary(B2)),
- ?line [42,1,2,3,4,5,19] = bitstring_to_list(B2),
- ?line [42,1,2,3,4,5,19] = bitstring_to_list(make_sub_binary(B2)),
- ?line [42,1,2,3,4,5,19] = bitstring_to_list(make_unaligned_sub_binary(B2)),
+ B1 = make_sub_binary(list_to_binary(List)),
+ 5 = size(B1),
+ 5 = size(make_unaligned_sub_binary(B1)),
+ 40 = bit_size(B1),
+ 40 = bit_size(make_unaligned_sub_binary(B1)),
+ B2 = list_to_binary([42,B1,19]),
+ B2 = list_to_binary([42,make_unaligned_sub_binary(B1),19]),
+ B2 = iolist_to_binary(B2),
+ B2 = iolist_to_binary(make_unaligned_sub_binary(B2)),
+ 7 = size(B2),
+ 7 = size(make_sub_binary(B2)),
+ 56 = bit_size(B2),
+ 56 = bit_size(make_sub_binary(B2)),
+ [42,1,2,3,4,5,19] = binary_to_list(B2),
+ [42,1,2,3,4,5,19] = binary_to_list(make_sub_binary(B2)),
+ [42,1,2,3,4,5,19] = binary_to_list(make_unaligned_sub_binary(B2)),
+ [42,1,2,3,4,5,19] = bitstring_to_list(B2),
+ [42,1,2,3,4,5,19] = bitstring_to_list(make_sub_binary(B2)),
+ [42,1,2,3,4,5,19] = bitstring_to_list(make_unaligned_sub_binary(B2)),
ok.
test_bin(List) ->
- ?line Size = length(List),
- ?line Bin = list_to_binary(List),
- ?line Bin = iolist_to_binary(List),
- ?line Bin = list_to_bitstring(List),
- ?line Size = iolist_size(List),
- ?line Size = iolist_size(Bin),
- ?line Size = iolist_size(make_unaligned_sub_binary(Bin)),
- ?line Size = size(Bin),
- ?line Size = size(make_sub_binary(Bin)),
- ?line Size = size(make_unaligned_sub_binary(Bin)),
- ?line List = binary_to_list(Bin),
- ?line List = binary_to_list(make_sub_binary(Bin)),
- ?line List = binary_to_list(make_unaligned_sub_binary(Bin)),
- ?line List = bitstring_to_list(Bin),
- ?line List = bitstring_to_list(make_unaligned_sub_binary(Bin)).
+ Size = length(List),
+ Bin = list_to_binary(List),
+ Bin = iolist_to_binary(List),
+ Bin = list_to_bitstring(List),
+ Size = iolist_size(List),
+ Size = iolist_size(Bin),
+ Size = iolist_size(make_unaligned_sub_binary(Bin)),
+ Size = size(Bin),
+ Size = size(make_sub_binary(Bin)),
+ Size = size(make_unaligned_sub_binary(Bin)),
+ List = binary_to_list(Bin),
+ List = binary_to_list(make_sub_binary(Bin)),
+ List = binary_to_list(make_unaligned_sub_binary(Bin)),
+ List = bitstring_to_list(Bin),
+ List = bitstring_to_list(make_unaligned_sub_binary(Bin)).
%% Tests list_to_binary/1, iolist_to_binary/1, list_to_bitstr/1, binary_to_list/1,3,
%% bitstr_to_list/1, and size/1, using deep lists.
deep_lists(Config) when is_list(Config) ->
- ?line test_deep_list(["abc"]),
- ?line test_deep_list([[12,13,[123,15]]]),
- ?line test_deep_list([[12,13,[lists:seq(0, 255), []]]]),
+ test_deep_list(["abc"]),
+ test_deep_list([[12,13,[123,15]]]),
+ test_deep_list([[12,13,[lists:seq(0, 255), []]]]),
ok.
test_deep_list(List) ->
- ?line FlatList = lists:flatten(List),
- ?line Size = length(FlatList),
- ?line Bin = list_to_binary(List),
- ?line Bin = iolist_to_binary(List),
- ?line Bin = iolist_to_binary(Bin),
- ?line Bin = list_to_bitstring(List),
- ?line Size = size(Bin),
- ?line Size = iolist_size(List),
- ?line Size = iolist_size(FlatList),
- ?line Size = iolist_size(Bin),
- ?line Bitsize = bit_size(Bin),
- ?line Bitsize = 8*Size,
- ?line FlatList = binary_to_list(Bin),
- ?line FlatList = bitstring_to_list(Bin),
+ FlatList = lists:flatten(List),
+ Size = length(FlatList),
+ Bin = list_to_binary(List),
+ Bin = iolist_to_binary(List),
+ Bin = iolist_to_binary(Bin),
+ Bin = list_to_bitstring(List),
+ Size = size(Bin),
+ Size = iolist_size(List),
+ Size = iolist_size(FlatList),
+ Size = iolist_size(Bin),
+ Bitsize = bit_size(Bin),
+ Bitsize = 8*Size,
+ FlatList = binary_to_list(Bin),
+ FlatList = bitstring_to_list(Bin),
io:format("testing plain binary..."),
- ?line t_binary_to_list_3(FlatList, Bin, 1, Size),
+ t_binary_to_list_3(FlatList, Bin, 1, Size),
io:format("testing unaligned sub binary..."),
- ?line t_binary_to_list_3(FlatList, make_unaligned_sub_binary(Bin), 1, Size).
+ t_binary_to_list_3(FlatList, make_unaligned_sub_binary(Bin), 1, Size).
t_binary_to_list_3(List, Bin, From, To) ->
- ?line going_up(List, Bin, From, To),
- ?line going_down(List, Bin, From, To),
- ?line going_center(List, Bin, From, To).
+ going_up(List, Bin, From, To),
+ going_down(List, Bin, From, To),
+ going_center(List, Bin, From, To).
going_up(List, Bin, From, To) when From =< To ->
- ?line List = binary_to_list(Bin, From, To),
- ?line going_up(tl(List), Bin, From+1, To);
+ List = binary_to_list(Bin, From, To),
+ going_up(tl(List), Bin, From+1, To);
going_up(_List, _Bin, From, To) when From > To ->
ok.
going_down(List, Bin, From, To) when To > 0->
- ?line compare(List, binary_to_list(Bin, From, To), To-From+1),
- ?line going_down(List, Bin, From, To-1);
+ compare(List, binary_to_list(Bin, From, To), To-From+1),
+ going_down(List, Bin, From, To-1);
going_down(_List, _Bin, _From, _To) ->
ok.
going_center(List, Bin, From, To) when From >= To ->
- ?line compare(List, binary_to_list(Bin, From, To), To-From+1),
- ?line going_center(tl(List), Bin, From+1, To-1);
+ compare(List, binary_to_list(Bin, From, To), To-From+1),
+ going_center(tl(List), Bin, From+1, To-1);
going_center(_List, _Bin, _From, _To) ->
ok.
compare([X|Rest1], [X|Rest2], Left) when Left > 0 ->
- ?line compare(Rest1, Rest2, Left-1);
+ compare(Rest1, Rest2, Left-1);
compare([_X|_], [_Y|_], _Left) ->
- ?line test_server:fail();
+ ct:fail("compare fail");
compare(_List, [], 0) ->
ok.
deep_bitstr_lists(Config) when is_list(Config) ->
- ?line {<<7:3>>,[<<7:3>>]} = test_deep_bitstr([<<7:3>>]),
- ?line {<<42,5:3>>=Bin,[42,<<5:3>>]=List} = test_deep_bitstr([42,<<5:3>>]),
- ?line {Bin,List} = test_deep_bitstr([42|<<5:3>>]),
- ?line {Bin,List} = test_deep_bitstr([<<42,5:3>>]),
- ?line {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>|<<5:3>>]),
- ?line {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>,<<5:3>>]),
- ?line {Bin,List} = test_deep_bitstr([[<<1:3>>,<<10:5>>],[],<<5:3>>]),
- ?line {Bin,List} = test_deep_bitstr([[[<<1:3>>]|<<10:5>>],[],<<5:3>>]),
- ?line {Bin,List} = test_deep_bitstr([[<<0:1>>,<<0:1>>,[],<<1:1>>,<<10:5>>],
+ {<<7:3>>,[<<7:3>>]} = test_deep_bitstr([<<7:3>>]),
+ {<<42,5:3>>=Bin,[42,<<5:3>>]=List} = test_deep_bitstr([42,<<5:3>>]),
+ {Bin,List} = test_deep_bitstr([42|<<5:3>>]),
+ {Bin,List} = test_deep_bitstr([<<42,5:3>>]),
+ {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>|<<5:3>>]),
+ {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>,<<5:3>>]),
+ {Bin,List} = test_deep_bitstr([[<<1:3>>,<<10:5>>],[],<<5:3>>]),
+ {Bin,List} = test_deep_bitstr([[[<<1:3>>]|<<10:5>>],[],<<5:3>>]),
+ {Bin,List} = test_deep_bitstr([[<<0:1>>,<<0:1>>,[],<<1:1>>,<<10:5>>],
<<1:1>>,<<0:1>>,<<1:1>>]),
ok.
test_deep_bitstr(List) ->
- %%?line {'EXIT',{badarg,_}} = list_to_binary(List),
+ %%{'EXIT',{badarg,_}} = list_to_binary(List),
Bin = list_to_bitstring(List),
{Bin,bitstring_to_list(Bin)}.
-bad_list_to_binary(suite) -> [];
bad_list_to_binary(Config) when is_list(Config) ->
- ?line test_bad_bin(atom),
- ?line test_bad_bin(42),
- ?line test_bad_bin([1|2]),
- ?line test_bad_bin([256]),
- ?line test_bad_bin([255, [256]]),
- ?line test_bad_bin([-1]),
- ?line test_bad_bin([atom_in_list]),
- ?line test_bad_bin([[<<8>>]|bad_tail]),
+ test_bad_bin(atom),
+ test_bad_bin(42),
+ test_bad_bin([1|2]),
+ test_bad_bin([256]),
+ test_bad_bin([255, [256]]),
+ test_bad_bin([-1]),
+ test_bad_bin([atom_in_list]),
+ test_bad_bin([[<<8>>]|bad_tail]),
{'EXIT',{badarg,_}} = (catch list_to_binary(id(<<1,2,3>>))),
{'EXIT',{badarg,_}} = (catch list_to_binary(id([<<42:7>>]))),
{'EXIT',{badarg,_}} = (catch list_to_bitstring(id(<<1,2,3>>))),
%% Funs used to be implemented as a type of binary internally.
- ?line test_bad_bin(fun(X, Y) -> X*Y end),
- ?line test_bad_bin([1,fun(X) -> X + 1 end,2|fun() -> 0 end]),
- ?line test_bad_bin([fun(X) -> X + 1 end]),
+ test_bad_bin(fun(X, Y) -> X*Y end),
+ test_bad_bin([1,fun(X) -> X + 1 end,2|fun() -> 0 end]),
+ test_bad_bin([fun(X) -> X + 1 end]),
%% Test iolists that do not fit in the address space.
%% Unfortunately, it would be too slow to test in a 64-bit emulator.
@@ -287,15 +285,15 @@ bad_list_to_binary(Config) when is_list(Config) ->
huge_iolists() ->
FourGigs = 1 bsl 32,
- ?line Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++
+ Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++
[1 bsl N || N <- lists:seq(33, 37)],
- ?line Base = <<0:(1 bsl 20)/unit:8>>,
+ Base = <<0:(1 bsl 20)/unit:8>>,
[begin
L = build_iolist(Sz, Base),
- ?line {'EXIT',{system_limit,_}} = (catch list_to_binary([L])),
- ?line {'EXIT',{system_limit,_}} = (catch list_to_bitstring([L])),
- ?line {'EXIT',{system_limit,_}} = (catch binary:list_to_bin([L])),
- ?line {'EXIT',{system_limit,_}} = (catch iolist_to_binary(L))
+ {'EXIT',{system_limit,_}} = (catch list_to_binary([L])),
+ {'EXIT',{system_limit,_}} = (catch list_to_bitstring([L])),
+ {'EXIT',{system_limit,_}} = (catch binary:list_to_bin([L])),
+ {'EXIT',{system_limit,_}} = (catch iolist_to_binary(L))
end || Sz <- Sizes],
ok.
@@ -305,15 +303,15 @@ test_bad_bin(List) ->
{'EXIT',{badarg,_}} = (catch list_to_bitstring(List)),
{'EXIT',{badarg,_}} = (catch iolist_size(List)).
-bad_binary_to_list(doc) -> "Tries binary_to_list/1,3 with bad arguments.";
+%% Tries binary_to_list/1,3 with bad arguments.
bad_binary_to_list(Config) when is_list(Config) ->
- ?line bad_bin_to_list(fun(X) -> X * 42 end),
+ bad_bin_to_list(fun(X) -> X * 42 end),
GoodBin = list_to_binary(lists:seq(1, 10)),
- ?line bad_bin_to_list(fun(X) -> X * 44 end, 1, 2),
- ?line bad_bin_to_list(GoodBin, 0, 1),
- ?line bad_bin_to_list(GoodBin, 2, 1),
- ?line bad_bin_to_list(GoodBin, 11, 11),
+ bad_bin_to_list(fun(X) -> X * 44 end, 1, 2),
+ bad_bin_to_list(GoodBin, 0, 1),
+ bad_bin_to_list(GoodBin, 2, 1),
+ bad_bin_to_list(GoodBin, 11, 11),
{'EXIT',{badarg,_}} = (catch binary_to_list(id(<<42:7>>))),
ok.
@@ -327,63 +325,61 @@ bad_bin_to_list(Bin, First, Last) ->
%% Tries to split a binary at all possible positions.
-t_split_binary(suite) -> [];
t_split_binary(Config) when is_list(Config) ->
- ?line L = lists:seq(0, ?heap_binary_size-5), %Heap binary.
- ?line B = list_to_binary(L),
- ?line split(L, B, size(B)),
+ L = lists:seq(0, ?heap_binary_size-5), %Heap binary.
+ B = list_to_binary(L),
+ split(L, B, size(B)),
%% Sub binary of heap binary.
- ?line split(L, make_sub_binary(B), size(B)),
+ split(L, make_sub_binary(B), size(B)),
{X,_Y} = split_binary(B, size(B) div 2),
- ?line split(binary_to_list(X), X, size(X)),
+ split(binary_to_list(X), X, size(X)),
%% Unaligned sub binary of heap binary.
- ?line split(L, make_unaligned_sub_binary(B), size(B)),
+ split(L, make_unaligned_sub_binary(B), size(B)),
{X,_Y} = split_binary(B, size(B) div 2),
- ?line split(binary_to_list(X), X, size(X)),
+ split(binary_to_list(X), X, size(X)),
%% Reference-counted binary.
- ?line L2 = lists:seq(0, ?heap_binary_size+1),
- ?line B2 = list_to_binary(L2),
- ?line split(L2, B2, size(B2)),
+ L2 = lists:seq(0, ?heap_binary_size+1),
+ B2 = list_to_binary(L2),
+ split(L2, B2, size(B2)),
%% Sub binary of reference-counted binary.
- ?line split(L2, make_sub_binary(B2), size(B2)),
+ split(L2, make_sub_binary(B2), size(B2)),
{X2,_Y2} = split_binary(B2, size(B2) div 2),
- ?line split(binary_to_list(X2), X2, size(X2)),
+ split(binary_to_list(X2), X2, size(X2)),
%% Unaligned sub binary of reference-counted binary.
- ?line split(L2, make_unaligned_sub_binary(B2), size(B2)),
+ split(L2, make_unaligned_sub_binary(B2), size(B2)),
{X2,_Y2} = split_binary(B2, size(B2) div 2),
- ?line split(binary_to_list(X2), X2, size(X2)),
+ split(binary_to_list(X2), X2, size(X2)),
ok.
split(L, B, Pos) when Pos > 0 ->
- ?line {B1, B2} = split_binary(B, Pos),
- ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)),
- ?line B2 = list_to_binary(lists:nthtail(Pos, L)),
- ?line split(L, B, Pos-1);
+ {B1, B2} = split_binary(B, Pos),
+ B1 = list_to_binary(lists:sublist(L, 1, Pos)),
+ B2 = list_to_binary(lists:nthtail(Pos, L)),
+ split(L, B, Pos-1);
split(_L, _B, 0) ->
ok.
-bad_split(doc) -> "Tries split_binary/2 with bad arguments.";
-bad_split(suite) -> [];
+%% Tries split_binary/2 with bad arguments.
bad_split(Config) when is_list(Config) ->
GoodBin = list_to_binary([1,2,3]),
- ?line bad_split(GoodBin, -1),
- ?line bad_split(GoodBin, 4),
- ?line bad_split(GoodBin, a),
+ bad_split(GoodBin, -1),
+ bad_split(GoodBin, 4),
+ bad_split(GoodBin, a),
%% Funs are a kind of binaries.
- ?line bad_split(fun(_X) -> 1 end, 1),
+ bad_split(fun(_X) -> 1 end, 1),
ok.
bad_split(Bin, Pos) ->
{'EXIT',{badarg,_}} = (catch split_binary(Bin, Pos)).
-t_hash(doc) -> "Test hash/2 with different type of binaries.";
+%% Test hash/2 with different type of binaries.
t_hash(Config) when is_list(Config) ->
test_hash([]),
test_hash([253]),
@@ -396,36 +392,34 @@ test_hash(List) ->
Bin = list_to_binary(List),
Sbin = make_sub_binary(List),
Unaligned = make_unaligned_sub_binary(Sbin),
- ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:hash/2),
- ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash/2),
- ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash2/2).
+ test_hash_1(Bin, Sbin, Unaligned, fun erlang:hash/2),
+ test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash/2),
+ test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash2/2).
test_hash_1(Bin, Sbin, Unaligned, Hash) when is_function(Hash, 2) ->
N = 65535,
case {Hash(Bin, N),Hash(Sbin, N),Hash(Unaligned, N)} of
{H,H,H} -> ok;
{H1,H2,H3} ->
- io:format("Different hash values: ~p, ~p, ~p\n", [H1,H2,H3]),
- ?t:fail()
+ ct:fail("Different hash values: ~p, ~p, ~p\n", [H1,H2,H3])
end.
-bad_size(doc) -> "Try bad arguments to size/1.";
-bad_size(suite) -> [];
+%% Try bad arguments to size/1.
bad_size(Config) when is_list(Config) ->
- ?line {'EXIT',{badarg,_}} = (catch size(fun(X) -> X + 33 end)),
+ {'EXIT',{badarg,_}} = (catch size(fun(X) -> X + 33 end)),
ok.
bad_term_to_binary(Config) when is_list(Config) ->
T = id({a,b,c}),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, not_a_list)),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [blurf])),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,-1}])),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,10}])),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,cucumber}])),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed}])),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{version,1}|bad_tail])),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,-1}])),
- ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,x}])),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, not_a_list)),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, [blurf])),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,-1}])),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,10}])),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,cucumber}])),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed}])),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{version,1}|bad_tail])),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,-1}])),
+ {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,x}])),
ok.
@@ -464,7 +458,7 @@ terms(Config) when is_list(Config) ->
UnalignedC = make_unaligned_sub_binary(BinC),
Term = binary_to_term_stress(UnalignedC)
end,
- ?line test_terms(TestFun),
+ test_terms(TestFun),
ok.
terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 ->
@@ -476,7 +470,7 @@ terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 ->
terms_compression_levels(_, _, _) -> ok.
terms_float(Config) when is_list(Config) ->
- ?line test_floats(fun(Term) ->
+ test_floats(fun(Term) ->
Bin0 = term_to_binary(Term, [{minor_version,0}]),
Term = binary_to_term_stress(Bin0),
Bin1 = term_to_binary(Term),
@@ -492,22 +486,21 @@ terms_float(Config) when is_list(Config) ->
float_middle_endian(Config) when is_list(Config) ->
%% Testing for roundtrip is not enough.
- ?line <<131,70,63,240,0,0,0,0,0,0>> = term_to_binary(1.0, [{minor_version,1}]),
- ?line 1.0 = binary_to_term_stress(<<131,70,63,240,0,0,0,0,0,0>>).
+ <<131,70,63,240,0,0,0,0,0,0>> = term_to_binary(1.0, [{minor_version,1}]),
+ 1.0 = binary_to_term_stress(<<131,70,63,240,0,0,0,0,0,0>>).
external_size(Config) when is_list(Config) ->
%% Build a term whose external size only fits in a big num (on 32-bit CPU).
- ?line external_size_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF),
+ external_size_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF),
%% Test that the same binary aligned and unaligned has the same external size.
- ?line Bin = iolist_to_binary([1,2,3,96]),
- ?line Unaligned = make_unaligned_sub_binary(Bin),
+ Bin = iolist_to_binary([1,2,3,96]),
+ Unaligned = make_unaligned_sub_binary(Bin),
case {erlang:external_size(Bin),erlang:external_size(Unaligned)} of
{X,X} -> ok;
{Sz1,Sz2} ->
- io:format(" Aligned size: ~p\n", [Sz1]),
- io:format("Unaligned size: ~p\n", [Sz2]),
- ?line ?t:fail()
+ ct:fail(" Aligned size: ~p\n"
+ "Unaligned size: ~p\n", [Sz1,Sz2])
end,
true = (erlang:external_size(Bin) =:= erlang:external_size(Bin, [{minor_version, 1}])),
true = (erlang:external_size(Unaligned) =:= erlang:external_size(Unaligned, [{minor_version, 1}])).
@@ -521,30 +514,29 @@ external_size_1(Term, Size0, Limit) when Size0 < Limit ->
external_size_1(_, _, _) -> ok.
t_iolist_size(Config) when is_list(Config) ->
- ?line Seed = {erlang:monotonic_time(),
- erlang:time_offset(),
- erlang:unique_integer([positive])},
- ?line io:format("Seed: ~p", [Seed]),
- ?line random:seed(Seed),
- ?line Base = <<0:(1 bsl 20)/unit:8>>,
- ?line Powers = [1 bsl N || N <- lists:seq(2, 37)],
- ?line Sizes0 = [[N - random:uniform(N div 2),
- lists:seq(N-2, N+2),
- N+N div 2,
- N + random:uniform(N div 2)] ||
- N <- Powers],
+ _ = rand:uniform(), %Seed generator
+ io:format("Seed: ~p", [rand:export_seed()]),
+
+ Base = <<0:(1 bsl 20)/unit:8>>,
+ Powers = [1 bsl N || N <- lists:seq(2, 37)],
+ Sizes0 = [[N - rand:uniform(N div 2),
+ lists:seq(N-2, N+2),
+ N+N div 2,
+ N + rand:uniform(N div 2)] ||
+ N <- Powers],
+
%% Test sizes around 1^32 more thoroughly.
FourGigs = 1 bsl 32,
- ?line Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0,
- ?line Sizes2 = lists:flatten(Sizes1),
- ?line Sizes = lists:usort(Sizes2),
+ Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0,
+ Sizes2 = lists:flatten(Sizes1),
+ Sizes = lists:usort(Sizes2),
io:format("~p sizes:", [length(Sizes)]),
io:format("~p\n", [Sizes]),
- ?line [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes],
+ _ = [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes],
ok.
build_iolist(N, Base) when N < 16 ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 ->
<<Bin:N/binary,_/binary>> = Base,
Bin;
@@ -552,7 +544,7 @@ build_iolist(N, Base) when N < 16 ->
lists:seq(1, N)
end;
build_iolist(N, Base) when N =< byte_size(Base) ->
- case random:uniform(3) of
+ case rand:uniform(3) of
1 ->
<<Bin:N/binary,_/binary>> = Base,
Bin;
@@ -570,7 +562,7 @@ build_iolist(N, Base) when N =< byte_size(Base) ->
end
end;
build_iolist(N0, Base) ->
- Small = random:uniform(15),
+ Small = rand:uniform(15),
Seq = lists:seq(1, Small),
N = N0 - Small,
case N rem 2 of
@@ -583,33 +575,32 @@ build_iolist(N0, Base) ->
end.
-bad_binary_to_term_2(doc) -> "OTP-4053.";
-bad_binary_to_term_2(suite) -> [];
+%% OTP-4053
bad_binary_to_term_2(Config) when is_list(Config) ->
- ?line {ok, N} = test_server:start_node(plopp, slave, []),
- ?line R = rpc:call(N, erlang, binary_to_term, [<<131,111,255,255,255,0>>]),
- ?line case R of
+ {ok, N} = test_server:start_node(plopp, slave, []),
+ R = rpc:call(N, erlang, binary_to_term, [<<131,111,255,255,255,0>>]),
+ case R of
{badrpc, {'EXIT', _}} ->
ok;
_Other ->
- test_server:fail({rpcresult, R})
+ ct:fail({rpcresult, R})
end,
- ?line test_server:stop_node(N),
+ test_server:stop_node(N),
ok.
-bad_binary_to_term(doc) -> "Try bad input to binary_to_term/1.";
+%% Try bad input to binary_to_term/1.
bad_binary_to_term(Config) when is_list(Config) ->
- ?line bad_bin_to_term(an_atom),
- ?line bad_bin_to_term({an,tuple}),
- ?line bad_bin_to_term({a,list}),
- ?line bad_bin_to_term(fun() -> self() end),
- ?line bad_bin_to_term(fun(X) -> 42*X end),
- ?line bad_bin_to_term(fun(X, Y) -> {X,Y} end),
- ?line bad_bin_to_term(fun(X, Y, Z) -> {X,Y,Z} end),
- ?line bad_bin_to_term(bit_sized_binary(term_to_binary({you,should,'not',see,this,term}))),
+ bad_bin_to_term(an_atom),
+ bad_bin_to_term({an,tuple}),
+ bad_bin_to_term({a,list}),
+ bad_bin_to_term(fun() -> self() end),
+ bad_bin_to_term(fun(X) -> 42*X end),
+ bad_bin_to_term(fun(X, Y) -> {X,Y} end),
+ bad_bin_to_term(fun(X, Y, Z) -> {X,Y,Z} end),
+ bad_bin_to_term(bit_sized_binary(term_to_binary({you,should,'not',see,this,term}))),
%% Bad float.
- ?line bad_bin_to_term(<<131,70,-1:64>>),
+ bad_bin_to_term(<<131,70,-1:64>>),
ok.
bad_bin_to_term(BadBin) ->
@@ -618,25 +609,24 @@ bad_bin_to_term(BadBin) ->
bad_bin_to_term(BadBin,Opts) ->
{'EXIT',{badarg,_}} = (catch binary_to_term_stress(BadBin,Opts)).
-safe_binary_to_term2(doc) -> "Test safety options for binary_to_term/2";
+%% Test safety options for binary_to_term/2
safe_binary_to_term2(Config) when is_list(Config) ->
- ?line bad_bin_to_term(<<131,100,0,14,"undefined_atom">>, [safe]),
- ?line bad_bin_to_term(<<131,100,0,14,"other_bad_atom">>, [safe]),
+ bad_bin_to_term(<<131,100,0,14,"undefined_atom">>, [safe]),
+ bad_bin_to_term(<<131,100,0,14,"other_bad_atom">>, [safe]),
BadHostAtom = <<100,0,14,"badguy@badhost">>,
Empty = <<0,0,0,0>>,
BadRef = <<131,114,0,3,BadHostAtom/binary,0,<<0,0,0,255>>/binary,
Empty/binary,Empty/binary>>,
- ?line bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom
- ?line fullsweep_after = binary_to_term_stress(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom
+ bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom
+ fullsweep_after = binary_to_term_stress(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom
BadExtFun = <<131,113,100,0,4,98,108,117,101,100,0,4,109,111,111,110,97,3>>,
- ?line bad_bin_to_term(BadExtFun, [safe]),
+ bad_bin_to_term(BadExtFun, [safe]),
ok.
%% Tests bad input to binary_to_term/1.
-bad_terms(suite) -> [];
bad_terms(Config) when is_list(Config) ->
- ?line test_terms(fun corrupter/1),
+ test_terms(fun corrupter/1),
{'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,3:32,0,11,22,33>>)),
{'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,3:32,9,11,22,33>>)),
{'EXIT',{badarg,_}} = (catch binary_to_term(<<131,$M,0:32,1,11,22,33>>)),
@@ -669,7 +659,7 @@ corrupter(Term) ->
corrupter0(Term).
corrupter0(Term) ->
- ?line try
+ try
S = io_lib:format("About to corrupt: ~P", [Term,12]),
io:put_chars(S)
catch
@@ -677,42 +667,41 @@ corrupter0(Term) ->
io:format("About to corrupt: <<bit-level-binary:~p",
[bit_size(Term)])
end,
- ?line Bin = term_to_binary(Term),
- ?line corrupter(Bin, size(Bin)-1),
- ?line CompressedBin = term_to_binary(Term, [compressed]),
- ?line corrupter(CompressedBin, size(CompressedBin)-1).
+ Bin = term_to_binary(Term),
+ corrupter(Bin, size(Bin)-1),
+ CompressedBin = term_to_binary(Term, [compressed]),
+ corrupter(CompressedBin, size(CompressedBin)-1).
corrupter(Bin, Pos) when Pos >= 0 ->
- ?line {ShorterBin, Rest} = split_binary(Bin, Pos),
- ?line catch binary_to_term_stress(ShorterBin), %% emulator shouldn't crash
- ?line MovedBin = list_to_binary([ShorterBin]),
- ?line catch binary_to_term_stress(MovedBin), %% emulator shouldn't crash
+ {ShorterBin, Rest} = split_binary(Bin, Pos),
+ catch binary_to_term_stress(ShorterBin), %% emulator shouldn't crash
+ MovedBin = list_to_binary([ShorterBin]),
+ catch binary_to_term_stress(MovedBin), %% emulator shouldn't crash
%% Bit faults, shouldn't crash
<<Byte,Tail/binary>> = Rest,
Fun = fun(M) -> FaultyByte = Byte bxor M,
catch binary_to_term_stress(<<ShorterBin/binary,
FaultyByte, Tail/binary>>) end,
- ?line lists:foreach(Fun,[1,2,4,8,16,32,64,128,255]),
- ?line corrupter(Bin, Pos-1);
+ lists:foreach(Fun,[1,2,4,8,16,32,64,128,255]),
+ corrupter(Bin, Pos-1);
corrupter(_Bin, _) ->
ok.
-more_bad_terms(suite) -> [];
more_bad_terms(Config) when is_list(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line BadFile = filename:join(Data, "bad_binary"),
- ?line ok = io:format("File: ~s\n", [BadFile]),
- ?line case file:read_file(BadFile) of
+ Data = proplists:get_value(data_dir, Config),
+ BadFile = filename:join(Data, "bad_binary"),
+ ok = io:format("File: ~s\n", [BadFile]),
+ case file:read_file(BadFile) of
{ok,Bin} ->
- ?line {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)),
+ {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)),
ok;
Other ->
- ?line ?t:fail(Other)
+ ct:fail(Other)
end.
otp_5484(Config) when is_list(Config) ->
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch
binary_to_term_stress(
<<131,
@@ -725,7 +714,7 @@ otp_5484(Config) when is_list(Config) ->
255,
106>>)),
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch
binary_to_term_stress(
<<131,
@@ -737,13 +726,13 @@ otp_5484(Config) when is_list(Config) ->
2,
106>>)),
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch
binary_to_term_stress(
%% A old-type fun in a list containing a bad creator pid.
<<131,108,0,0,0,1,117,0,0,0,0,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,255,255,0,25,255,0,0,0,0,100,0,1,116,97,0,98,6,142,121,72,106>>)),
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch
binary_to_term_stress(
%% A new-type fun in a list containing a bad creator pid.
@@ -755,7 +744,7 @@ otp_5484(Config) when is_list(Config) ->
106, %[] instead of an atom.
0,0,0,27,0,0,0,0,0,106>>)),
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch
binary_to_term_stress(
%% A new-type fun in a list containing a bad module.
@@ -766,7 +755,7 @@ otp_5484(Config) when is_list(Config) ->
107,0,1,64, %String instead of atom (same length).
97,0,98,6,64,82,230,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)),
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch
binary_to_term_stress(
%% A new-type fun in a list containing a bad index.
@@ -778,7 +767,7 @@ otp_5484(Config) when is_list(Config) ->
104,0, %Tuple {} instead of integer.
98,6,64,82,230,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)),
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch
binary_to_term_stress(
%% A new-type fun in a list containing a bad unique value.
@@ -792,46 +781,46 @@ otp_5484(Config) when is_list(Config) ->
103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)),
%% An absurdly large atom.
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch binary_to_term_stress(iolist_to_binary([<<131,100,65000:16>>|
lists:duplicate(65000, 42)]))),
%% Longer than 255 characters.
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch binary_to_term_stress(iolist_to_binary([<<131,100,256:16>>|
lists:duplicate(256, 42)]))),
%% OTP-7218. Thanks to Matthew Dempsky. Also make sure that we
%% cover the other error cases for external funs (EXPORT_EXT).
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch binary_to_term_stress(
<<131,
113, %EXPORT_EXP
97,13, %Integer: 13
97,13, %Integer: 13
97,13>>)), %Integer: 13
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch binary_to_term_stress(
<<131,
113, %EXPORT_EXP
100,0,1,64, %Atom: '@'
97,13, %Integer: 13
97,13>>)), %Integer: 13
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch binary_to_term_stress(
<<131,
113, %EXPORT_EXP
100,0,1,64, %Atom: '@'
100,0,1,64, %Atom: '@'
106>>)), %NIL
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch binary_to_term_stress(
<<131,
113, %EXPORT_EXP
100,0,1,64, %Atom: '@'
100,0,1,64, %Atom: '@'
98,255,255,255,255>>)), %Integer: -1
- ?line {'EXIT',_} =
+ {'EXIT',_} =
(catch binary_to_term_stress(
<<131,
113, %EXPORT_EXP
@@ -840,7 +829,7 @@ otp_5484(Config) when is_list(Config) ->
113,97,13,97,13,97,13>>)), %fun 13:13/13
%% Bad funs.
- ?line {'EXIT',_} = (catch binary_to_term_stress(fake_fun(0, lists:seq(0, 256)))),
+ {'EXIT',_} = (catch binary_to_term_stress(fake_fun(0, lists:seq(0, 256)))),
ok.
fake_fun(Arity, Env0) ->
@@ -863,9 +852,9 @@ fake_fun(Arity, Env0) ->
%% More bad terms submitted by Matthias Lang.
otp_5933(Config) when is_list(Config) ->
- ?line try_bad_lengths(<<131,$m>>), %binary
- ?line try_bad_lengths(<<131,$n>>), %bignum
- ?line try_bad_lengths(<<131,$o>>), %huge bignum
+ try_bad_lengths(<<131,$m>>), %binary
+ try_bad_lengths(<<131,$n>>), %bignum
+ try_bad_lengths(<<131,$o>>), %huge bignum
ok.
try_bad_lengths(B) ->
@@ -884,7 +873,7 @@ otp_6817(Config) when is_list(Config) ->
%% Floats are only validated when the heap fragment has been allocated.
BadFloat = <<131,99,53,46,48,$X,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,101,45,48,49,0,0,0,0,0>>,
- ?line otp_6817_try_bin(BadFloat),
+ otp_6817_try_bin(BadFloat),
%% {Binary,BadFloat}: When the error in float is discovered, a refc-binary
%% has been allocated and the list of refc-binaries goes through the
@@ -904,7 +893,7 @@ otp_6817(Config) when is_list(Config) ->
230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,
249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48,
48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>,
- ?line otp_6817_try_bin(BinAndFloat),
+ otp_6817_try_bin(BinAndFloat),
%% {Fun,BadFloat}
FunAndFloat =
@@ -912,14 +901,14 @@ otp_6817(Config) when is_list(Config) ->
71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111,
110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48,
$Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>,
- ?line otp_6817_try_bin(FunAndFloat),
+ otp_6817_try_bin(FunAndFloat),
%% [ExternalPid|BadFloat]
ExtPidAndFloat =
<<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101,
114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48,
48,48,48,48,48,101,43,48,48,0,0,0,0,0>>,
- ?line otp_6817_try_bin(ExtPidAndFloat),
+ otp_6817_try_bin(ExtPidAndFloat),
ok.
otp_6817_try_bin(Bin) ->
@@ -937,8 +926,7 @@ otp_6817_try_bin(Bin) ->
%% Will crash if the bug is present.
erlang:garbage_collect().
-otp_8117(doc) -> "Some bugs in binary_to_term when 32-bit integers are negative.";
-otp_8117(suite) -> [];
+%% Some bugs in binary_to_term when 32-bit integers are negative.
otp_8117(Config) when is_list(Config) ->
[otp_8117_do(Op,-(1 bsl N)) || Op <- ['fun',named_fun,list,tuple],
N <- lists:seq(0,31)],
@@ -947,23 +935,22 @@ otp_8117(Config) when is_list(Config) ->
otp_8117_do('fun',Neg) ->
% Fun with negative num_free
FunBin = term_to_binary(fun() -> ok end),
- ?line <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin,
- ?line bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>);
+ <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin,
+ bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>);
otp_8117_do(named_fun,Neg) ->
% Named fun with negative num_free
FunBin = term_to_binary(fun F() -> F end),
- ?line <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin,
- ?line bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>);
+ <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin,
+ bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>);
otp_8117_do(list,Neg) ->
%% List with negative length
- ?line bad_bin_to_term(<<131,104,2,108,Neg:32,97,11,104,1,97,12,97,13,106,97,14>>);
+ bad_bin_to_term(<<131,104,2,108,Neg:32,97,11,104,1,97,12,97,13,106,97,14>>);
otp_8117_do(tuple,Neg) ->
%% Tuple with negative arity
- ?line bad_bin_to_term(<<131,104,2,105,Neg:32,97,11,97,12,97,13,97,14>>).
+ bad_bin_to_term(<<131,104,2,105,Neg:32,97,11,97,12,97,13,97,14>>).
-ordering(doc) -> "Tests ordering of binaries.";
-ordering(suite) -> [];
+%% Tests ordering of binaries.
ordering(Config) when is_list(Config) ->
B1 = list_to_binary([7,8,9]),
B2 = make_sub_binary([1,2,3,4]),
@@ -972,54 +959,54 @@ ordering(Config) when is_list(Config) ->
%% From R8 binaries are compared as strings.
- ?line false = B1 == B2,
- ?line false = B1 =:= B2,
- ?line true = B1 /= B2,
- ?line true = B1 =/= B2,
+ false = B1 == B2,
+ false = B1 =:= B2,
+ true = B1 /= B2,
+ true = B1 =/= B2,
- ?line true = B1 > B2,
- ?line true = B2 < B3,
- ?line true = B2 =< B1,
- ?line true = B2 =< B3,
+ true = B1 > B2,
+ true = B2 < B3,
+ true = B2 =< B1,
+ true = B2 =< B3,
- ?line true = B2 =:= Unaligned,
- ?line true = B2 == Unaligned,
- ?line true = Unaligned < B3,
- ?line true = Unaligned =< B3,
+ true = B2 =:= Unaligned,
+ true = B2 == Unaligned,
+ true = Unaligned < B3,
+ true = Unaligned =< B3,
%% Binaries are greater than all other terms.
- ?line true = B1 > 0,
- ?line true = B1 > 39827491247298471289473333333333333333333333333333,
- ?line true = B1 > -3489274937438742190467869234328742398347,
- ?line true = B1 > 3.14,
- ?line true = B1 > [],
- ?line true = B1 > [a],
- ?line true = B1 > {a},
- ?line true = B1 > self(),
- ?line true = B1 > make_ref(),
- ?line true = B1 > xxx,
- ?line true = B1 > fun() -> 1 end,
- ?line true = B1 > fun erlang:send/2,
-
- ?line Path = ?config(priv_dir, Config),
- ?line AFile = filename:join(Path, "vanilla_file"),
- ?line Port = open_port(AFile, [out]),
- ?line true = B1 > Port,
-
- ?line true = B1 >= 0,
- ?line true = B1 >= 39827491247298471289473333333333333333333333333333,
- ?line true = B1 >= -3489274937438742190467869234328742398347,
- ?line true = B1 >= 3.14,
- ?line true = B1 >= [],
- ?line true = B1 >= [a],
- ?line true = B1 >= {a},
- ?line true = B1 >= self(),
- ?line true = B1 >= make_ref(),
- ?line true = B1 >= xxx,
- ?line true = B1 >= fun() -> 1 end,
- ?line true = B1 >= fun erlang:send/2,
- ?line true = B1 >= Port,
+ true = B1 > 0,
+ true = B1 > 39827491247298471289473333333333333333333333333333,
+ true = B1 > -3489274937438742190467869234328742398347,
+ true = B1 > 3.14,
+ true = B1 > [],
+ true = B1 > [a],
+ true = B1 > {a},
+ true = B1 > self(),
+ true = B1 > make_ref(),
+ true = B1 > xxx,
+ true = B1 > fun() -> 1 end,
+ true = B1 > fun erlang:send/2,
+
+ Path = proplists:get_value(priv_dir, Config),
+ AFile = filename:join(Path, "vanilla_file"),
+ Port = open_port(AFile, [out]),
+ true = B1 > Port,
+
+ true = B1 >= 0,
+ true = B1 >= 39827491247298471289473333333333333333333333333333,
+ true = B1 >= -3489274937438742190467869234328742398347,
+ true = B1 >= 3.14,
+ true = B1 >= [],
+ true = B1 >= [a],
+ true = B1 >= {a},
+ true = B1 >= self(),
+ true = B1 >= make_ref(),
+ true = B1 >= xxx,
+ true = B1 >= fun() -> 1 end,
+ true = B1 >= fun erlang:send/2,
+ true = B1 >= Port,
ok.
@@ -1032,153 +1019,153 @@ unaligned_order(Config) when is_list(Config) ->
test_unaligned_order(I, J) ->
Align = {I,J},
io:format("~p ~p", [I,J]),
- ?line true = test_unaligned_order_1('=:=', <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>,
+ true = test_unaligned_order_1('=:=', <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>,
<<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>,
Align),
- ?line false = test_unaligned_order_1('=/=', <<1,2,3>>, <<1,2,3>>, Align),
- ?line true = test_unaligned_order_1('==', <<4,5,6>>, <<4,5,6>>, Align),
- ?line false = test_unaligned_order_1('/=', <<1,2,3>>, <<1,2,3>>, Align),
+ false = test_unaligned_order_1('=/=', <<1,2,3>>, <<1,2,3>>, Align),
+ true = test_unaligned_order_1('==', <<4,5,6>>, <<4,5,6>>, Align),
+ false = test_unaligned_order_1('/=', <<1,2,3>>, <<1,2,3>>, Align),
- ?line true = test_unaligned_order_1('<', <<1,2>>, <<1,2,3>>, Align),
- ?line true = test_unaligned_order_1('=<', <<1,2>>, <<1,2,3>>, Align),
- ?line true = test_unaligned_order_1('=<', <<1,2,7,8>>, <<1,2,7,8>>, Align),
+ true = test_unaligned_order_1('<', <<1,2>>, <<1,2,3>>, Align),
+ true = test_unaligned_order_1('=<', <<1,2>>, <<1,2,3>>, Align),
+ true = test_unaligned_order_1('=<', <<1,2,7,8>>, <<1,2,7,8>>, Align),
ok.
test_unaligned_order_1(Op, A, B, {Aa,Ba}) ->
erlang:Op(unaligned_sub_bin(A, Aa), unaligned_sub_bin(B, Ba)).
test_terms(Test_Func) ->
- ?line Test_Func(atom),
- ?line Test_Func(''),
- ?line Test_Func('a'),
- ?line Test_Func('ab'),
- ?line Test_Func('abc'),
- ?line Test_Func('abcd'),
- ?line Test_Func('abcde'),
- ?line Test_Func('abcdef'),
- ?line Test_Func('abcdefg'),
- ?line Test_Func('abcdefgh'),
-
- ?line Test_Func(fun() -> ok end),
+ Test_Func(atom),
+ Test_Func(''),
+ Test_Func('a'),
+ Test_Func('ab'),
+ Test_Func('abc'),
+ Test_Func('abcd'),
+ Test_Func('abcde'),
+ Test_Func('abcdef'),
+ Test_Func('abcdefg'),
+ Test_Func('abcdefgh'),
+
+ Test_Func(fun() -> ok end),
X = id([a,{b,c},c]),
Y = id({x,y,z}),
Z = id(1 bsl 8*257),
- ?line Test_Func(fun() -> X end),
- ?line Test_Func(fun() -> {X,Y} end),
- ?line Test_Func([fun() -> {X,Y,Z} end,
+ Test_Func(fun() -> X end),
+ Test_Func(fun() -> {X,Y} end),
+ Test_Func([fun() -> {X,Y,Z} end,
fun() -> {Z,X,Y} end,
fun() -> {Y,Z,X} end]),
- ?line Test_Func({trace_ts,{even_bigger,{some_data,fun() -> ok end}},{1,2,3}}),
- ?line Test_Func({trace_ts,{even_bigger,{some_data,<<1,2,3,4,5,6,7,8,9,10>>}},
+ Test_Func({trace_ts,{even_bigger,{some_data,fun() -> ok end}},{1,2,3}}),
+ Test_Func({trace_ts,{even_bigger,{some_data,<<1,2,3,4,5,6,7,8,9,10>>}},
{1,2,3}}),
- ?line Test_Func(1),
- ?line Test_Func(42),
- ?line Test_Func(-23),
- ?line Test_Func(256),
- ?line Test_Func(25555),
- ?line Test_Func(-3333),
+ Test_Func(1),
+ Test_Func(42),
+ Test_Func(-23),
+ Test_Func(256),
+ Test_Func(25555),
+ Test_Func(-3333),
- ?line Test_Func(1.0),
+ Test_Func(1.0),
- ?line Test_Func(183749783987483978498378478393874),
- ?line Test_Func(-37894183749783987483978498378478393874),
+ Test_Func(183749783987483978498378478393874),
+ Test_Func(-37894183749783987483978498378478393874),
Very_Big = very_big_num(),
- ?line Test_Func(Very_Big),
- ?line Test_Func(-Very_Big+1),
-
- ?line Test_Func([]),
- ?line Test_Func("abcdef"),
- ?line Test_Func([a, b, 1, 2]),
- ?line Test_Func([a|b]),
-
- ?line Test_Func({}),
- ?line Test_Func({1}),
- ?line Test_Func({a, b}),
- ?line Test_Func({a, b, c}),
- ?line Test_Func(list_to_tuple(lists:seq(0, 255))),
- ?line Test_Func(list_to_tuple(lists:seq(0, 256))),
-
- ?line Test_Func(make_ref()),
- ?line Test_Func([make_ref(), make_ref()]),
-
- ?line Test_Func(make_port()),
-
- ?line Test_Func(make_pid()),
-
- ?line Test_Func(Bin0 = list_to_binary(lists:seq(0, 14))),
- ?line Test_Func(Bin1 = list_to_binary(lists:seq(0, ?heap_binary_size))),
- ?line Test_Func(Bin2 = list_to_binary(lists:seq(0, ?heap_binary_size+1))),
- ?line Test_Func(Bin3 = list_to_binary(lists:seq(0, 255))),
-
- ?line Test_Func(make_unaligned_sub_binary(Bin0)),
- ?line Test_Func(make_unaligned_sub_binary(Bin1)),
- ?line Test_Func(make_unaligned_sub_binary(Bin2)),
- ?line Test_Func(make_unaligned_sub_binary(Bin3)),
-
- ?line Test_Func(make_sub_binary(lists:seq(42, 43))),
- ?line Test_Func(make_sub_binary([42,43,44])),
- ?line Test_Func(make_sub_binary([42,43,44,45])),
- ?line Test_Func(make_sub_binary([42,43,44,45,46])),
- ?line Test_Func(make_sub_binary([42,43,44,45,46,47])),
- ?line Test_Func(make_sub_binary([42,43,44,45,46,47,48])),
- ?line Test_Func(make_sub_binary(lists:seq(42, 49))),
- ?line Test_Func(make_sub_binary(lists:seq(0, 14))),
- ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size))),
- ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size+1))),
- ?line Test_Func(make_sub_binary(lists:seq(0, 255))),
-
- ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 43))),
- ?line Test_Func(make_unaligned_sub_binary([42,43,44])),
- ?line Test_Func(make_unaligned_sub_binary([42,43,44,45])),
- ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46])),
- ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47])),
- ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47,48])),
- ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 49))),
- ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 14))),
- ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size))),
- ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size+1))),
- ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 255))),
+ Test_Func(Very_Big),
+ Test_Func(-Very_Big+1),
+
+ Test_Func([]),
+ Test_Func("abcdef"),
+ Test_Func([a, b, 1, 2]),
+ Test_Func([a|b]),
+
+ Test_Func({}),
+ Test_Func({1}),
+ Test_Func({a, b}),
+ Test_Func({a, b, c}),
+ Test_Func(list_to_tuple(lists:seq(0, 255))),
+ Test_Func(list_to_tuple(lists:seq(0, 256))),
+
+ Test_Func(make_ref()),
+ Test_Func([make_ref(), make_ref()]),
+
+ Test_Func(make_port()),
+
+ Test_Func(make_pid()),
+
+ Test_Func(Bin0 = list_to_binary(lists:seq(0, 14))),
+ Test_Func(Bin1 = list_to_binary(lists:seq(0, ?heap_binary_size))),
+ Test_Func(Bin2 = list_to_binary(lists:seq(0, ?heap_binary_size+1))),
+ Test_Func(Bin3 = list_to_binary(lists:seq(0, 255))),
+
+ Test_Func(make_unaligned_sub_binary(Bin0)),
+ Test_Func(make_unaligned_sub_binary(Bin1)),
+ Test_Func(make_unaligned_sub_binary(Bin2)),
+ Test_Func(make_unaligned_sub_binary(Bin3)),
+
+ Test_Func(make_sub_binary(lists:seq(42, 43))),
+ Test_Func(make_sub_binary([42,43,44])),
+ Test_Func(make_sub_binary([42,43,44,45])),
+ Test_Func(make_sub_binary([42,43,44,45,46])),
+ Test_Func(make_sub_binary([42,43,44,45,46,47])),
+ Test_Func(make_sub_binary([42,43,44,45,46,47,48])),
+ Test_Func(make_sub_binary(lists:seq(42, 49))),
+ Test_Func(make_sub_binary(lists:seq(0, 14))),
+ Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size))),
+ Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size+1))),
+ Test_Func(make_sub_binary(lists:seq(0, 255))),
+
+ Test_Func(make_unaligned_sub_binary(lists:seq(42, 43))),
+ Test_Func(make_unaligned_sub_binary([42,43,44])),
+ Test_Func(make_unaligned_sub_binary([42,43,44,45])),
+ Test_Func(make_unaligned_sub_binary([42,43,44,45,46])),
+ Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47])),
+ Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47,48])),
+ Test_Func(make_unaligned_sub_binary(lists:seq(42, 49))),
+ Test_Func(make_unaligned_sub_binary(lists:seq(0, 14))),
+ Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size))),
+ Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size+1))),
+ Test_Func(make_unaligned_sub_binary(lists:seq(0, 255))),
%% Bit level binaries.
- ?line Test_Func(<<1:1>>),
- ?line Test_Func(<<2:2>>),
- ?line Test_Func(<<42:10>>),
- ?line Test_Func(list_to_bitstring([<<5:6>>|lists:seq(0, 255)])),
+ Test_Func(<<1:1>>),
+ Test_Func(<<2:2>>),
+ Test_Func(<<42:10>>),
+ Test_Func(list_to_bitstring([<<5:6>>|lists:seq(0, 255)])),
- ?line Test_Func(F = fun(A) -> 42*A end),
- ?line Test_Func(lists:duplicate(32, F)),
+ Test_Func(F = fun(A) -> 42*A end),
+ Test_Func(lists:duplicate(32, F)),
- ?line Test_Func(FF = fun binary_SUITE:all/0),
- ?line Test_Func(lists:duplicate(32, FF)),
+ Test_Func(FF = fun binary_SUITE:all/0),
+ Test_Func(lists:duplicate(32, FF)),
ok.
test_floats(Test_Func) ->
- ?line Test_Func(5.5),
- ?line Test_Func(-15.32),
- ?line Test_Func(1.2435e25),
- ?line Test_Func(1.2333e-20),
- ?line Test_Func(199.0e+15),
+ Test_Func(5.5),
+ Test_Func(-15.32),
+ Test_Func(1.2435e25),
+ Test_Func(1.2333e-20),
+ Test_Func(199.0e+15),
ok.
very_big_num() ->
very_big_num(33, 1).
very_big_num(Left, Result) when Left > 0 ->
- ?line very_big_num(Left-1, Result*256);
+ very_big_num(Left-1, Result*256);
very_big_num(0, Result) ->
- ?line Result.
+ Result.
make_port() ->
- ?line open_port({spawn, efile}, [eof]).
+ open_port({spawn, efile}, [eof]).
make_pid() ->
- ?line spawn_link(?MODULE, sleeper, []).
+ spawn_link(?MODULE, sleeper, []).
sleeper() ->
- ?line receive after infinity -> ok end.
+ receive after infinity -> ok end.
%% Test that binaries are garbage collected properly.
@@ -1218,7 +1205,7 @@ gc_test1(Pid) ->
receive
{Pid,done} -> ok
after 10000 ->
- ?line ?t:fail()
+ ct:fail("timeout")
end.
%% Like split binary, but returns REFC binaries. Only useful for gc_test/1.
@@ -1237,7 +1224,7 @@ gc() ->
gc1() -> ok.
bit_sized_binary_sizes(Config) when is_list(Config) ->
- ?line [bsbs_1(A) || A <- lists:seq(1, 8)],
+ [bsbs_1(A) || A <- lists:seq(1, 8)],
ok.
bsbs_1(A) ->
@@ -1279,13 +1266,13 @@ obsolete_funs(Config) when is_list(Config) ->
X = id({1,2,3}),
Y = id([a,b,c,d]),
Z = id({x,y,z}),
- ?line obsolete_fun(fun() -> ok end),
- ?line obsolete_fun(fun() -> X end),
- ?line obsolete_fun(fun(A) -> {A,X} end),
- ?line obsolete_fun(fun() -> {X,Y} end),
- ?line obsolete_fun(fun() -> {X,Y,Z} end),
+ obsolete_fun(fun() -> ok end),
+ obsolete_fun(fun() -> X end),
+ obsolete_fun(fun(A) -> {A,X} end),
+ obsolete_fun(fun() -> {X,Y} end),
+ obsolete_fun(fun() -> {X,Y,Z} end),
- ?line obsolete_fun(fun ?MODULE:all/1),
+ obsolete_fun(fun ?MODULE:all/1),
erts_debug:set_internal_state(available_internal_state, false),
ok.
@@ -1312,41 +1299,41 @@ no_fun_roundtrip(Term) ->
%% but recognized by binary_to_term/1.
robustness(Config) when is_list(Config) ->
- ?line [] = binary_to_term_stress(<<131,107,0,0>>), %Empty string.
- ?line [] = binary_to_term_stress(<<131,108,0,0,0,0,106>>), %Zero-length list.
+ [] = binary_to_term_stress(<<131,107,0,0>>), %Empty string.
+ [] = binary_to_term_stress(<<131,108,0,0,0,0,106>>), %Zero-length list.
%% {[],a} where [] is a zero-length list.
- ?line {[],a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>),
+ {[],a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>),
%% {42,a} where 42 is a zero-length list with 42 in the tail.
- ?line {42,a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>),
+ {42,a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>),
%% {{x,y},a} where {x,y} is a zero-length list with {x,y} in the tail.
- ?line {{x,y},a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,
+ {{x,y},a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,
104,2,100,0,1,120,100,0,1,
121,100,0,1,97>>),
%% Bignums fitting in 32 bits.
- ?line 16#7FFFFFFF = binary_to_term_stress(<<131,98,127,255,255,255>>),
- ?line -1 = binary_to_term_stress(<<131,98,255,255,255,255>>),
+ 16#7FFFFFFF = binary_to_term_stress(<<131,98,127,255,255,255>>),
+ -1 = binary_to_term_stress(<<131,98,255,255,255,255>>),
ok.
%% OTP-8180: Test several terms that have been known to crash the emulator.
%% (Thanks to Scott Lystig Fritchie.)
otp_8180(Config) when is_list(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line Wc = filename:join(Data, "zzz.*"),
+ Data = proplists:get_value(data_dir, Config),
+ Wc = filename:join(Data, "zzz.*"),
Files = filelib:wildcard(Wc),
[run_otp_8180(F) || F <- Files],
ok.
run_otp_8180(Name) ->
io:format("~s", [Name]),
- ?line {ok,Bins} = file:consult(Name),
+ {ok,Bins} = file:consult(Name),
[begin
io:format("~p\n", [Bin]),
- ?line {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin))
+ {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin))
end || Bin <- Bins],
ok.
@@ -1518,7 +1505,7 @@ cmp_old_impl(Config) when is_list(Config) ->
false ->
{skipped, "No "++Rel++" available"};
true ->
- {ok, Node} = ?t:start_node(list_to_atom(atom_to_list(?MODULE)++"_"++Rel),
+ {ok, Node} = test_server:start_node(list_to_atom(atom_to_list(?MODULE)++"_"++Rel),
peer,
[{args, " -setcookie "++Cookie},
{erl, [{release, Rel}]}]),
@@ -1560,7 +1547,7 @@ cmp_old_impl(Config) when is_list(Config) ->
cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(1000000)))]}),
cmp_node(Node, {erlang, bitstring_to_list, [list_to_bitstring(list2bitstrlist(mk_list(10000000)))]}),
- ?t:stop_node(Node),
+ test_server:stop_node(Node),
ok
end.
@@ -1604,7 +1591,7 @@ bit_sized_binary(Bin0) ->
unaligned_sub_bin(Bin, 0) -> Bin;
unaligned_sub_bin(Bin0, Offs) ->
- F = random:uniform(256),
+ F = rand:uniform(256),
Roffs = 8-Offs,
Bin1 = <<F:Offs,Bin0/binary,F:Roffs>>,
Sz = size(Bin0),
diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl
index dcd13c19df..8836fe40ae 100644
--- a/erts/emulator/test/bs_bincomp_SUITE.erl
+++ b/erts/emulator/test/bs_bincomp_SUITE.erl
@@ -131,7 +131,7 @@ tracing(Config) when is_list(Config) ->
random_binary() ->
Seq = [1,2,3,4,5,6,7,8,9,10],
- << <<($a + random:uniform($z - $a)):8>> || _ <- Seq >>.
+ << <<($a + rand:uniform($z - $a)):8>> || _ <- Seq >>.
random_binaries(N) when N > 0 ->
random_binary(),
diff --git a/erts/emulator/test/bs_bit_binaries_SUITE.erl b/erts/emulator/test/bs_bit_binaries_SUITE.erl
index a07fd7609c..dd056d10af 100644
--- a/erts/emulator/test/bs_bit_binaries_SUITE.erl
+++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl
@@ -30,7 +30,7 @@
big_binary_to_and_from_list/1,send_and_receive/1,
send_and_receive_alot/1,append/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -57,9 +57,9 @@ end_per_group(_GroupName, Config) ->
misc(Config) when is_list(Config) ->
- ?line <<1:100>> = id(<<1:100>>),
- ?line {ok,ok} = {match(7),match(9)},
- ?line {ok,ok} = {match1(15),match1(31)},
+ <<1:100>> = id(<<1:100>>),
+ {ok,ok} = {match(7),match(9)},
+ {ok,ok} = {match1(15),match1(31)},
ok.
@@ -76,70 +76,70 @@ match1(N) ->
ok.
test_bit_size(Config) when is_list(Config) ->
- ?line 101 = bit_size(<<1:101>>),
- ?line 1001 = bit_size(<<1:1001>>),
- ?line 80 = bit_size(<<1:80>>),
- ?line 800 = bit_size(<<1:800>>),
- ?line Bin = <<0:16#1000000>>,
- ?line BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]),
- ?line 16#10000001 = erlang:bit_size(BigBin),
+ 101 = bit_size(<<1:101>>),
+ 1001 = bit_size(<<1:1001>>),
+ 80 = bit_size(<<1:80>>),
+ 800 = bit_size(<<1:800>>),
+ Bin = <<0:16#1000000>>,
+ BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]),
+ 16#10000001 = erlang:bit_size(BigBin),
%% Only run these on computers with lots of memory
%% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]),
%% 16#100000011 = bit_size(HugeBin),
- ?line 0 = bit_size(<<>>),
+ 0 = bit_size(<<>>),
ok.
horrid_match(Config) when is_list(Config) ->
- ?line <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>,
- ?line <<42:24/little>> = B,
+ <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>,
+ <<42:24/little>> = B,
ok.
test_bitstr(Config) when is_list(Config) ->
- ?line <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>,
- ?line <<1:1,6>> = B,
- ?line B = <<1:1,6>>,
+ <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>,
+ <<1:1,6>> = B,
+ B = <<1:1,6>>,
ok.
asymmetric_tests(Config) when is_list(Config) ->
- ?line <<1:12>> = <<0,1:4>>,
- ?line <<0,1:4>> = <<1:12>>,
- ?line <<1:1,X/bitstring>> = <<128,255,0,0:2>>,
- ?line <<1,254,0,0:1>> = X,
- ?line X = <<1,254,0,0:1>>,
- ?line <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>,
- ?line <<1,254,0,0:1>> = X1,
- ?line X1 = <<1,254,0,0:1>>,
+ <<1:12>> = <<0,1:4>>,
+ <<0,1:4>> = <<1:12>>,
+ <<1:1,X/bitstring>> = <<128,255,0,0:2>>,
+ <<1,254,0,0:1>> = X,
+ X = <<1,254,0,0:1>>,
+ <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>,
+ <<1,254,0,0:1>> = X1,
+ X1 = <<1,254,0,0:1>>,
ok.
big_asymmetric_tests(Config) when is_list(Config) ->
- ?line <<1:875,1:12>> = <<1:875,0,1:4>>,
- ?line <<1:875,0,1:4>> = <<1:875,1:12>>,
- ?line <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>,
- ?line <<1,254,0,0:1,1:875>> = X,
- ?line X = <<1,254,0,0:1,1:875>>,
- ?line <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>,
- ?line <<1,254,0,0:1,1:875>> = X1,
- ?line X1 = <<1,254,0,0:1,1:875>>,
+ <<1:875,1:12>> = <<1:875,0,1:4>>,
+ <<1:875,0,1:4>> = <<1:875,1:12>>,
+ <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>,
+ <<1,254,0,0:1,1:875>> = X,
+ X = <<1,254,0,0:1,1:875>>,
+ <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>,
+ <<1,254,0,0:1,1:875>> = X1,
+ X1 = <<1,254,0,0:1,1:875>>,
ok.
binary_to_and_from_list(Config) when is_list(Config) ->
- ?line <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)),
- ?line [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>),
- ?line <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]),
- ?line [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>),
+ <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)),
+ [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>),
+ <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]),
+ [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>),
ok.
big_binary_to_and_from_list(Config) when is_list(Config) ->
- ?line <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)),
- ?line [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>),
- ?line <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]),
+ <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)),
+ [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>),
+ <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]),
ok.
send_and_receive(Config) when is_list(Config) ->
- ?line Bin = <<1,2:7>>,
+ Bin = <<1,2:7>>,
Pid = spawn_link(fun() -> receiver(Bin) end),
- ?line Pid ! {self(),<<1:7,8:5,Bin/bitstring>>},
- ?line receive
+ Pid ! {self(),<<1:7,8:5,Bin/bitstring>>},
+ receive
ok ->
ok
end.
@@ -176,8 +176,8 @@ receiver_alot(Bin) ->
append(Config) when is_list(Config) ->
cs_init(),
- ?line <<(-1):256/signed-unit:8>> = cs(do_append(id(<<>>), 256*8)),
- ?line <<(-1):256/signed-unit:8>> = cs(do_append2(id(<<>>), 256*4)),
+ <<(-1):256/signed-unit:8>> = cs(do_append(id(<<>>), 256*8)),
+ <<(-1):256/signed-unit:8>> = cs(do_append2(id(<<>>), 256*4)),
<<(-1):256/signed-unit:8>> = cs(do_append3(id(<<>>), 256*8)),
cs_end().
diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl
index cadb30e1a4..8deb0c7422 100644
--- a/erts/emulator/test/bs_construct_SUITE.erl
+++ b/erts/emulator/test/bs_construct_SUITE.erl
@@ -22,40 +22,26 @@
-module(bs_construct_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
test1/1, test2/1, test3/1, test4/1, test5/1, testf/1,
not_used/1, in_guard/1,
mem_leak/1, coerce_to_float/1, bjorn/1,
huge_float_field/1, huge_binary/1, system_limit/1, badarg/1,
copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1,
- otp_7422/1, zero_width/1, bad_append/1]).
+ otp_7422/1, zero_width/1, bad_append/1, bs_add_overflow/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 10}}].
all() ->
[test1, test2, test3, test4, test5, testf, not_used,
in_guard, mem_leak, coerce_to_float, bjorn,
huge_float_field, huge_binary, system_limit, badarg,
copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width,
- bad_append].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
+ bad_append, bs_add_overflow].
big(1) ->
57285702734876389752897683.
@@ -68,9 +54,9 @@ r(L) ->
-define(T(B, L), {B, ??B, L}).
-define(N(B), {B, ??B, unknown}).
--define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])).
+-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])).
--define(FAIL_VARS(Expr, Vars), ?line fail_check(catch Expr, ??Expr, Vars)).
+-define(FAIL_VARS(Expr, Vars), fail_check(catch Expr, ??Expr, Vars)).
l(I_13, I_big1) ->
[
@@ -189,7 +175,7 @@ one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) ->
true ->
io:format("ERROR: Compiled: ~p. Expected ~p. Got ~p.~n",
[Str, Bytes, binary_to_list(C_bin)]),
- test_server:fail(comp)
+ ct:fail(comp)
end,
if
E_bin == Bin ->
@@ -197,7 +183,7 @@ one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) ->
true ->
io:format("ERROR: Interpreted: ~p. Expected ~p. Got ~p.~n",
[Str, Bytes, binary_to_list(E_bin)]),
- test_server:fail(comp)
+ ct:fail(comp)
end;
one_test({C_bin, E_bin, Str, Result}) ->
io:format(" ~s ~p~n", [Str, C_bin]),
@@ -218,7 +204,7 @@ one_test({C_bin, E_bin, Str, Result}) ->
io:format("ERROR: Compiled not equal to interpreted:"
"~n ~p, ~p.~n",
[binary_to_list(C_bin), binary_to_list(E_bin)]),
- test_server:fail(comp);
+ ct:fail(comp);
0 ->
ok;
%% For situations where the final bits may not matter, like
@@ -253,23 +239,22 @@ fail_check({'EXIT',{badarg,_}}, Str, Vars) ->
try evaluate(Str, Vars) of
Res ->
io:format("Interpreted result: ~p", [Res]),
- ?t:fail(did_not_fail_in_intepreted_code)
+ ct:fail(did_not_fail_in_intepreted_code)
catch
error:badarg ->
ok
end;
fail_check(Res, _, _) ->
io:format("Compiled result: ~p", [Res]),
- ?t:fail(did_not_fail_in_compiled_code).
+ ct:fail(did_not_fail_in_compiled_code).
%%% Simple working cases
-test1(suite) -> [];
test1(Config) when is_list(Config) ->
- ?line I_13 = i(13),
- ?line I_big1 = big(1),
- ?line Vars = [{'I_13', I_13},
+ I_13 = i(13),
+ I_big1 = big(1),
+ Vars = [{'I_13', I_13},
{'I_big1', I_big1}],
- ?line lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)).
+ lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)).
%%% Misc
@@ -285,10 +270,9 @@ gen(N, S, A) ->
gen_l(N, S, A) ->
[?T(<<A:S/little, A:(N-S)/little>>, comp(N, A, S))].
-test2(suite) -> [];
test2(Config) when is_list(Config) ->
- ?line test2(0, 8, 2#10101010101010101),
- ?line test2(0, 8, 2#1111111111).
+ test2(0, 8, 2#10101010101010101),
+ test2(0, 8, 2#1111111111).
test2(End, End, _) ->
ok;
@@ -313,10 +297,9 @@ t3() ->
?N(<<>>)
].
-test3(suite) -> [];
test3(Config) when is_list(Config) ->
- ?line Vars = [],
- ?line lists:foreach(fun one_test/1, eval_list(t3(), Vars)).
+ Vars = [],
+ lists:foreach(fun one_test/1, eval_list(t3(), Vars)).
gen_u(N, S, A) ->
[?N(<<A:S, A:(N-S)>>)].
@@ -324,10 +307,9 @@ gen_u(N, S, A) ->
gen_u_l(N, S, A) ->
[?N(<<A:S/little, A:(N-S)/little>>)].
-test4(suite) -> [];
test4(Config) when is_list(Config) ->
- ?line test4(0, 16, 2#10101010101010101),
- ?line test4(0, 16, 2#1111111111).
+ test4(0, 16, 2#10101010101010101),
+ test4(0, 16, 2#1111111111).
test4(End, End, _) ->
ok;
@@ -345,11 +327,10 @@ gen_b(N, S, A) ->
[?T(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>,
binary_to_list(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>))].
-test5(suite) -> [];
-test5(doc) -> ["OTP-3995"];
+%% OTP-3995
test5(Config) when is_list(Config) ->
- ?line test5(0, 8, <<73>>),
- ?line test5(0, 8, <<68>>).
+ test5(0, 8, <<73>>),
+ test5(0, 8, <<68>>).
test5(End, End, _) ->
ok;
@@ -363,47 +344,46 @@ test5(S, A) ->
lists:foreach(fun one_test/1, eval_list(gen_b(N, S, A), Vars)).
%%% Failure cases
-testf(suite) -> [];
testf(Config) when is_list(Config) ->
- ?line ?FAIL(<<3.14>>),
- ?line ?FAIL(<<<<1,2>>>>),
+ ?FAIL(<<3.14>>),
+ ?FAIL(<<<<1,2>>>>),
- ?line ?FAIL(<<2.71/binary>>),
- ?line ?FAIL(<<24334/binary>>),
- ?line ?FAIL(<<24334344294788947129487129487219847/binary>>),
+ ?FAIL(<<2.71/binary>>),
+ ?FAIL(<<24334/binary>>),
+ ?FAIL(<<24334344294788947129487129487219847/binary>>),
BigInt = id(24334344294788947129487129487219847),
- ?line ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]),
- ?line ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]),
- ?line ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]),
+ ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]),
+ ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]),
+ ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]),
%% One negative field size, but the sum of field sizes will be 1 byte.
%% Make sure that we reject that properly.
I_minus_777 = id(-777),
I_minus_2047 = id(-2047),
- ?line ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>,
+ ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>,
ordsets:from_list([{'I_minus_777',I_minus_777},
{'I_minus_2047',I_minus_2047}])),
- ?line ?FAIL(<<<<1,2,3>>/float>>),
+ ?FAIL(<<<<1,2,3>>/float>>),
%% Negative field widths.
- ?line testf_1(-8, <<1,2,3,4,5>>),
- ?line ?FAIL(<<0:(-(1 bsl 100))>>),
+ testf_1(-8, <<1,2,3,4,5>>),
+ ?FAIL(<<0:(-(1 bsl 100))>>),
- ?line ?FAIL(<<42:(-16)>>),
- ?line ?FAIL(<<3.14:(-8)/float>>),
- ?line ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>),
- ?line ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>),
- ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>),
- ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>),
+ ?FAIL(<<42:(-16)>>),
+ ?FAIL(<<3.14:(-8)/float>>),
+ ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>),
+ ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>),
+ ?FAIL(<<<<23,56,0,2>>:(anka)>>),
+ ?FAIL(<<<<23,56,0,2>>:(anka)>>),
%% Unit failures.
- ?line ?FAIL(<<<<1:1>>/binary>>),
+ ?FAIL(<<<<1:1>>/binary>>),
Sz = id(1),
- ?line ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]),
- ?line {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>),
- ?line ?FAIL(<<<<7,8,9>>/binary-unit:16>>),
- ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>),
- ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>),
+ ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]),
+ {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>),
+ ?FAIL(<<<<7,8,9>>/binary-unit:16>>),
+ ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>),
+ ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>),
ok.
@@ -413,14 +393,13 @@ testf_1(W, B) ->
?FAIL_VARS(<<3.14:W/float>>, Vars),
?FAIL_VARS(<<B:W/binary>>, [{'B',B}|Vars]).
-not_used(doc) ->
- "Test that constructed binaries that are not used will still give an exception.";
+%% Test that constructed binaries that are not used will still give an exception.
not_used(Config) when is_list(Config) ->
- ?line ok = not_used1(3, <<"dum">>),
- ?line {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")),
- ?line {'EXIT',{badarg,_}} = (catch not_used2(444, -2)),
- ?line {'EXIT',{badarg,_}} = (catch not_used2(444, anka)),
- ?line {'EXIT',{badarg,_}} = (catch not_used3(444)),
+ ok = not_used1(3, <<"dum">>),
+ {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")),
+ {'EXIT',{badarg,_}} = (catch not_used2(444, -2)),
+ {'EXIT',{badarg,_}} = (catch not_used2(444, anka)),
+ {'EXIT',{badarg,_}} = (catch not_used3(444)),
ok.
not_used1(I, BinString) ->
@@ -436,11 +415,11 @@ not_used3(I) ->
ok.
in_guard(Config) when is_list(Config) ->
- ?line 1 = in_guard(<<16#74ad:16>>, 16#e95, 5),
- ?line 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>),
- ?line 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415),
- ?line 3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3),
- ?line 3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226),
+ 1 = in_guard(<<16#74ad:16>>, 16#e95, 5),
+ 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>),
+ 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415),
+ 3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3),
+ 3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226),
nope = in_guard(<<1>>, 42, b),
nope = in_guard(<<1>>, a, b),
nope = in_guard(<<1,2>>, 1, 1),
@@ -454,16 +433,16 @@ in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3;
in_guard(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen;
in_guard(_, _, _) -> nope.
-mem_leak(doc) -> "Make sure that construction has no memory leak";
+%% Make sure that construction has no memory leak
mem_leak(Config) when is_list(Config) ->
- ?line B = make_bin(16, <<0>>),
- ?line mem_leak(1024, B),
+ B = make_bin(16, <<0>>),
+ mem_leak(1024, B),
ok.
mem_leak(0, _) -> ok;
mem_leak(N, B) ->
- ?line big_bin(B, <<23>>),
- ?line {'EXIT',{badarg,_}} = (catch big_bin(B, bad)),
+ big_bin(B, <<23>>),
+ {'EXIT',{badarg,_}} = (catch big_bin(B, bad)),
mem_leak(N-1, B).
big_bin(B1, B2) ->
@@ -477,18 +456,18 @@ make_bin(0, Acc) -> Acc;
make_bin(N, Acc) -> make_bin(N-1, <<Acc/binary,Acc/binary>>).
-define(COF(Int0),
- ?line (fun(Int) ->
+ (fun(Int) ->
true = <<Int:32/float>> =:= <<(float(Int)):32/float>>,
true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
end)(nonliteral(Int0)),
- ?line true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>,
- ?line true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
+ true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>,
+ true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
-define(COF64(Int0),
- ?line (fun(Int) ->
+ (fun(Int) ->
true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
end)(nonliteral(Int0)),
- ?line true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
+ true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
nonliteral(X) -> X.
@@ -507,7 +486,7 @@ coerce_to_float(Config) when is_list(Config) ->
ok.
bjorn(Config) when is_list(Config) ->
- ?line error = bjorn_1(),
+ error = bjorn_1(),
ok.
bjorn_1() ->
@@ -535,32 +514,47 @@ do_something() ->
throw(blurf).
huge_float_field(Config) when is_list(Config) ->
- ?line {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>),
- ?line huge_float_check(catch <<0.0:67108865/float-unit:64>>),
- ?line huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>),
- ?line huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>),
-%% ?line huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>),
- ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>),
-%% ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>),
+ {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>),
+ huge_float_check(catch <<0.0:67108865/float-unit:64>>),
+ huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>),
+ huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>),
+%% huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>),
+ huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>),
+%% huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>),
ok.
huge_float_check({'EXIT',{system_limit,_}}) -> ok;
huge_float_check({'EXIT',{badarg,_}}) -> ok.
huge_binary(Config) when is_list(Config) ->
- ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>),
- ?line garbage_collect(),
+ ct:timetrap({seconds, 30}),
+ 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>),
+ garbage_collect(),
{Shift,Return} = case free_mem() of
- undefined -> {32,ok};
- Mb when Mb > 600 -> {32,ok};
- Mb when Mb > 300 -> {31,"Limit huge binaries to 256 Mb"};
- _ -> {30,"Limit huge binary to 128 Mb"}
+ undefined ->
+ %% This test has to be inlined inside the case to
+ %% use a literal Shift
+ garbage_collect(),
+ id(<<0:((1 bsl 32)-1)>>),
+ {32,ok};
+ Mb when Mb > 600 ->
+ garbage_collect(),
+ id(<<0:((1 bsl 32)-1)>>),
+ {32,ok};
+ Mb when Mb > 300 ->
+ garbage_collect(),
+ id(<<0:((1 bsl 31)-1)>>),
+ {31,"Limit huge binaries to 256 Mb"};
+ _ ->
+ garbage_collect(),
+ id(<<0:((1 bsl 30)-1)>>),
+ {30,"Limit huge binary to 128 Mb"}
end,
- ?line garbage_collect(),
- ?line id(<<0:((1 bsl Shift)-1)>>),
- ?line garbage_collect(),
- ?line id(<<0:(id((1 bsl Shift)-1))>>),
- ?line garbage_collect(),
+ garbage_collect(),
+ id(<<0:((1 bsl Shift)-1)>>),
+ garbage_collect(),
+ id(<<0:(id((1 bsl Shift)-1))>>),
+ garbage_collect(),
case Return of
ok -> ok;
Comment -> {comment, Comment}
@@ -595,16 +589,16 @@ free_mem() ->
system_limit(Config) when is_list(Config) ->
WordSize = erlang:system_info(wordsize),
BitsPerWord = WordSize * 8,
- ?line {'EXIT',{system_limit,_}} =
+ {'EXIT',{system_limit,_}} =
(catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>),
- ?line {'EXIT',{system_limit,_}} =
+ {'EXIT',{system_limit,_}} =
(catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>),
- ?line {'EXIT',{system_limit,_}} =
+ {'EXIT',{system_limit,_}} =
(catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>),
%% Would fail to load.
- ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>),
- ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>),
+ {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>),
+ {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>),
case WordSize of
4 ->
@@ -614,60 +608,59 @@ system_limit(Config) when is_list(Config) ->
end.
system_limit_32() ->
- ?line {'EXIT',{badarg,_}} = (catch <<42:(-1)>>),
- ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>),
- ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>),
- ?line {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>),
- ?line {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>),
- ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>),
- ?line {'EXIT',{system_limit,_}} =
+ {'EXIT',{badarg,_}} = (catch <<42:(-1)>>),
+ {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>),
+ {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>),
+ {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>),
+ {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>),
+ {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>),
+ {'EXIT',{system_limit,_}} =
(catch <<0:(id(8)),42:(id(536870912))/unit:8>>),
%% The size would be silently truncated, resulting in a crash.
- ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>),
- ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>),
+ {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>),
+ {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>),
%% Would fail to load.
- ?line {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>),
- ?line {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>),
+ {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>),
+ {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>),
ok.
badarg(Config) when is_list(Config) ->
- ?line {'EXIT',{badarg,_}} =
+ {'EXIT',{badarg,_}} =
(catch <<0:(id(1 bsl 100)),0:(id(-1))>>),
- ?line {'EXIT',{badarg,_}} =
+ {'EXIT',{badarg,_}} =
(catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>),
- ?line {'EXIT',{badarg,_}} =
+ {'EXIT',{badarg,_}} =
(catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>),
- ?line {'EXIT',{badarg,_}} =
+ {'EXIT',{badarg,_}} =
(catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>),
ok.
copy_writable_binary(Config) when is_list(Config) ->
- ?line [copy_writable_binary_1(I) || I <- lists:seq(0, 256)],
+ [copy_writable_binary_1(I) || I <- lists:seq(0, 256)],
ok.
copy_writable_binary_1(_) ->
- ?line Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>,
- ?line SubBin = make_sub_bin(Bin0),
- ?line id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier.
- ?line Pid = spawn(fun() ->
+ Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>,
+ SubBin = make_sub_bin(Bin0),
+ id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier.
+ Pid = spawn(fun() ->
copy_writable_binary_holder(Bin0, SubBin)
end),
- ?line Tab = ets:new(holder, []),
- ?line ets:insert(Tab, {17,Bin0}),
- ?line ets:insert(Tab, {42,SubBin}),
- ?line id(<<Bin0/binary,0:(64*1024*8)>>),
- ?line Pid ! self(),
- ?line [{17,Bin0}] = ets:lookup(Tab, 17),
- ?line [{42,Bin0}] = ets:lookup(Tab, 42),
+ Tab = ets:new(holder, []),
+ ets:insert(Tab, {17,Bin0}),
+ ets:insert(Tab, {42,SubBin}),
+ id(<<Bin0/binary,0:(64*1024*8)>>),
+ Pid ! self(),
+ [{17,Bin0}] = ets:lookup(Tab, 17),
+ [{42,Bin0}] = ets:lookup(Tab, 42),
receive
{Pid,Bin0,Bin0} -> ok;
Other ->
- io:format("Unexpected message: ~p", [Other]),
- ?line ?t:fail()
+ ct:fail("Unexpected message: ~p", [Other])
end,
ok.
@@ -708,8 +701,8 @@ have_250_terabytes_of_ram() -> false.
%% give the same result.
dynamic(Config) when is_list(Config) ->
- ?line dynamic_1(fun dynamic_big/5),
- ?line dynamic_1(fun dynamic_little/5),
+ dynamic_1(fun dynamic_big/5),
+ dynamic_1(fun dynamic_little/5),
ok.
dynamic_1(Dynamic) ->
@@ -788,32 +781,32 @@ bs_add(Config) when is_list(Config) ->
return],
%% Write assembly file and assemble it.
- ?line PrivDir = ?config(priv_dir, Config),
- ?line RootName = filename:join(PrivDir, atom_to_list(Mod)),
- ?line AsmFile = RootName ++ ".S",
- ?line {ok,Fd} = file:open(AsmFile, [write]),
- ?line [io:format(Fd, "~p. \n", [T]) || T <- Code],
- ?line ok = file:close(Fd),
- ?line {ok,Mod} = compile:file(AsmFile, [from_asm,report,{outdir,PrivDir}]),
- ?line LoadRc = code:load_abs(RootName),
- ?line {module,_Module} = LoadRc,
+ PrivDir = proplists:get_value(priv_dir, Config),
+ RootName = filename:join(PrivDir, atom_to_list(Mod)),
+ AsmFile = RootName ++ ".S",
+ {ok,Fd} = file:open(AsmFile, [write]),
+ [io:format(Fd, "~p. \n", [T]) || T <- Code],
+ ok = file:close(Fd),
+ {ok,Mod} = compile:file(AsmFile, [from_asm,report,{outdir,PrivDir}]),
+ LoadRc = code:load_abs(RootName),
+ {module,_Module} = LoadRc,
%% Find smallest positive bignum.
- ?line SmallestBig = smallest_big(),
- ?line io:format("~p\n", [SmallestBig]),
- ?line Expected = SmallestBig + N,
+ SmallestBig = smallest_big(),
+ io:format("~p\n", [SmallestBig]),
+ Expected = SmallestBig + N,
DoTest = fun() ->
exit(Mod:bs_add(SmallestBig, -SmallestBig))
end,
- ?line {Pid,Mref} = spawn_monitor(DoTest),
+ {Pid,Mref} = spawn_monitor(DoTest),
receive
{'DOWN',Mref,process,Pid,Res} -> ok
end,
- ?line Expected = Res,
+ Expected = Res,
%% Clean up.
- ?line ok = file:delete(AsmFile),
- ?line ok = file:delete(code:which(Mod)),
+ ok = file:delete(AsmFile),
+ ok = file:delete(code:which(Mod)),
ok.
@@ -854,17 +847,17 @@ otp_7422_bin(N) when N < 512 ->
otp_7422_bin(_) -> ok.
zero_width(Config) when is_list(Config) ->
- ?line Z = id(0),
+ Z = id(0),
Small = id(42),
Big = id(1 bsl 128),
- ?line <<>> = <<Small:Z>>,
- ?line <<>> = <<Small:0>>,
- ?line <<>> = <<Big:Z>>,
- ?line <<>> = <<Big:0>>,
+ <<>> = <<Small:Z>>,
+ <<>> = <<Small:0>>,
+ <<>> = <<Big:Z>>,
+ <<>> = <<Big:0>>,
- ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>),
- ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>),
- ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>),
+ {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>),
+ {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>),
+ {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>),
ok.
@@ -911,5 +904,19 @@ append_unit_8(Bin) ->
append_unit_16(Bin) ->
<<Bin/binary-unit:16,0:1>>.
+%% Produce a large result of bs_add that, if cast to signed int, would overflow
+%% into a negative number that fits a smallnum.
+bs_add_overflow(Config) ->
+ case erlang:system_info(wordsize) of
+ 8 ->
+ {skip, "64-bit architecture"};
+ 4 ->
+ Large = <<0:((1 bsl 30)-1)>>,
+ {'EXIT',{system_limit,_}} =
+ (catch <<Large/bits, Large/bits, Large/bits, Large/bits,
+ Large/bits, Large/bits, Large/bits, Large/bits,
+ Large/bits>>),
+ ok
+ end.
id(I) -> I.
diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl
index ba79643e69..6f7abf8c4e 100644
--- a/erts/emulator/test/bs_match_bin_SUITE.erl
+++ b/erts/emulator/test/bs_match_bin_SUITE.erl
@@ -24,7 +24,7 @@
init_per_group/2,end_per_group/2,
byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -47,33 +47,33 @@ end_per_group(_GroupName, Config) ->
Config.
-byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions.";
+%% Tries to split a binary at all byte-aligned positions.
byte_split_binary(Config) when is_list(Config) ->
- ?line L = lists:seq(0, 57),
- ?line B = mkbin(L),
- ?line byte_split(L, B, size(B)),
- ?line Unaligned = make_unaligned_sub_binary(B),
- ?line byte_split(L, Unaligned, size(Unaligned)).
+ L = lists:seq(0, 57),
+ B = mkbin(L),
+ byte_split(L, B, size(B)),
+ Unaligned = make_unaligned_sub_binary(B),
+ byte_split(L, Unaligned, size(Unaligned)).
byte_split(L, B, Pos) when Pos >= 0 ->
- ?line Sz1 = Pos,
- ?line Sz2 = size(B) - Pos,
- ?line <<B1:Sz1/binary,B2:Sz2/binary>> = B,
- ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)),
- ?line B2 = list_to_binary(lists:nthtail(Pos, L)),
- ?line byte_split(L, B, Pos-1);
+ Sz1 = Pos,
+ Sz2 = size(B) - Pos,
+ <<B1:Sz1/binary,B2:Sz2/binary>> = B,
+ B1 = list_to_binary(lists:sublist(L, 1, Pos)),
+ B2 = list_to_binary(lists:nthtail(Pos, L)),
+ byte_split(L, B, Pos-1);
byte_split(_, _, _) -> ok.
-bit_split_binary(doc) -> "Tries to split a binary at all positions.";
+%% Tries to split a binary at all positions.
bit_split_binary(Config) when is_list(Config) ->
Fun = fun(Bin, List, SkipBef, N) ->
- ?line SkipAft = 8*size(Bin) - N - SkipBef,
+ SkipAft = 8*size(Bin) - N - SkipBef,
%%io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]),
- ?line <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin,
- ?line OutBin = make_bin_from_list(List, N)
+ <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin,
+ OutBin = make_bin_from_list(List, N)
end,
- ?line bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)),
- ?line bit_split_binary1(Fun,
+ bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)),
+ bit_split_binary1(Fun,
make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))),
ok.
@@ -119,19 +119,19 @@ make_unaligned_sub_binary(Bin0) ->
id(I) -> I.
match_huge_bin(Config) when is_list(Config) ->
- ?line Bin = <<0:(1 bsl 27),13:8>>,
- ?line skip_huge_bin_1(1 bsl 27, Bin),
- ?line 16777216 = match_huge_bin_1(1 bsl 27, Bin),
+ Bin = <<0:(1 bsl 27),13:8>>,
+ skip_huge_bin_1(1 bsl 27, Bin),
+ 16777216 = match_huge_bin_1(1 bsl 27, Bin),
%% Test overflowing the size of a binary field.
- ?line nomatch = overflow_huge_bin_skip_32(Bin),
- ?line nomatch = overflow_huge_bin_32(Bin),
- ?line nomatch = overflow_huge_bin_skip_64(Bin),
- ?line nomatch = overflow_huge_bin_64(Bin),
+ nomatch = overflow_huge_bin_skip_32(Bin),
+ nomatch = overflow_huge_bin_32(Bin),
+ nomatch = overflow_huge_bin_skip_64(Bin),
+ nomatch = overflow_huge_bin_64(Bin),
%% Size in variable
- ?line ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
- ?line ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+ ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+ ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
ok.
diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl
index 368f71978d..42d692c1ba 100644
--- a/erts/emulator/test/bs_match_int_SUITE.erl
+++ b/erts/emulator/test/bs_match_int_SUITE.erl
@@ -24,7 +24,7 @@
integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1,
match_huge_int/1,bignum/1,unaligned_32_bit/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-import(lists, [seq/2]).
@@ -51,22 +51,22 @@ end_per_group(_GroupName, Config) ->
integer(Config) when is_list(Config) ->
- ?line 0 = get_int(mkbin([])),
- ?line 0 = get_int(mkbin([0])),
- ?line 42 = get_int(mkbin([42])),
- ?line 255 = get_int(mkbin([255])),
- ?line 256 = get_int(mkbin([1,0])),
- ?line 257 = get_int(mkbin([1,1])),
- ?line 258 = get_int(mkbin([1,2])),
- ?line 258 = get_int(mkbin([1,2])),
- ?line 65534 = get_int(mkbin([255,254])),
- ?line 16776455 = get_int(mkbin([255,253,7])),
- ?line 4245492555 = get_int(mkbin([253,13,19,75])),
- ?line 4294967294 = get_int(mkbin([255,255,255,254])),
- ?line 4294967295 = get_int(mkbin([255,255,255,255])),
- ?line Eight = [200,1,19,128,222,42,97,111],
- ?line cmp128(Eight, uint(Eight)),
- ?line fun_clause(catch get_int(mkbin(seq(1,5)))),
+ 0 = get_int(mkbin([])),
+ 0 = get_int(mkbin([0])),
+ 42 = get_int(mkbin([42])),
+ 255 = get_int(mkbin([255])),
+ 256 = get_int(mkbin([1,0])),
+ 257 = get_int(mkbin([1,1])),
+ 258 = get_int(mkbin([1,2])),
+ 258 = get_int(mkbin([1,2])),
+ 65534 = get_int(mkbin([255,254])),
+ 16776455 = get_int(mkbin([255,253,7])),
+ 4245492555 = get_int(mkbin([253,13,19,75])),
+ 4294967294 = get_int(mkbin([255,255,255,254])),
+ 4294967295 = get_int(mkbin([255,255,255,255])),
+ Eight = [200,1,19,128,222,42,97,111],
+ cmp128(Eight, uint(Eight)),
+ fun_clause(catch get_int(mkbin(seq(1,5)))),
ok.
get_int(Bin) ->
@@ -89,13 +89,13 @@ cmp128(<<I:128>>, I) -> equal;
cmp128(_, _) -> not_equal.
signed_integer(Config) when is_list(Config) ->
- ?line {no_match,_} = sint(mkbin([])),
- ?line {no_match,_} = sint(mkbin([1,2,3])),
- ?line 127 = sint(mkbin([127])),
- ?line -1 = sint(mkbin([255])),
- ?line -128 = sint(mkbin([128])),
- ?line 42 = sint(mkbin([42,255])),
- ?line 127 = sint(mkbin([127,255])).
+ {no_match,_} = sint(mkbin([])),
+ {no_match,_} = sint(mkbin([1,2,3])),
+ 127 = sint(mkbin([127])),
+ -1 = sint(mkbin([255])),
+ -128 = sint(mkbin([128])),
+ 42 = sint(mkbin([42,255])),
+ 127 = sint(mkbin([127,255])).
sint(Bin) ->
case Bin of
@@ -130,7 +130,7 @@ dynamic(Bin, S1, S2, A, B) ->
_Other -> erlang:error(badmatch, [Bin,S1,S2,A,B])
end.
-more_dynamic(doc) -> "Extract integers at different alignments and of different sizes.";
+%% Extract integers at different alignments and of different sizes.
more_dynamic(Config) when is_list(Config) ->
% Unsigned big-endian numbers.
@@ -139,7 +139,7 @@ more_dynamic(Config) when is_list(Config) ->
<<_:SkipBef,Int:N,_:SkipAft>> = Bin,
Int = make_int(List, N, 0)
end,
- ?line more_dynamic1(Unsigned, erlang:md5(mkbin([42]))),
+ more_dynamic1(Unsigned, erlang:md5(mkbin([42]))),
%% Signed big-endian numbers.
Signed = fun(Bin, List, SkipBef, N) ->
@@ -151,10 +151,10 @@ more_dynamic(Config) when is_list(Config) ->
io:format("Bin = ~p,", [Bin]),
io:format("SkipBef = ~p, N = ~p", [SkipBef,N]),
io:format("Expected ~p, got ~p", [Int,Other]),
- ?t:fail()
+ ct:fail(signed_big_endian_fail)
end
end,
- ?line more_dynamic1(Signed, erlang:md5(mkbin([43]))),
+ more_dynamic1(Signed, erlang:md5(mkbin([43]))),
%% Unsigned little-endian numbers.
UnsLittle = fun(Bin, List, SkipBef, N) ->
@@ -162,7 +162,7 @@ more_dynamic(Config) when is_list(Config) ->
<<_:SkipBef,Int:N/little,_:SkipAft>> = Bin,
Int = make_int(big_to_little(List, N), N, 0)
end,
- ?line more_dynamic1(UnsLittle, erlang:md5(mkbin([44]))),
+ more_dynamic1(UnsLittle, erlang:md5(mkbin([44]))),
%% Signed little-endian numbers.
SignLittle = fun(Bin, List, SkipBef, N) ->
@@ -171,7 +171,7 @@ more_dynamic(Config) when is_list(Config) ->
Little = big_to_little(List, N),
Int = make_signed_int(Little, N)
end,
- ?line more_dynamic1(SignLittle, erlang:md5(mkbin([45]))),
+ more_dynamic1(SignLittle, erlang:md5(mkbin([45]))),
ok.
@@ -227,23 +227,23 @@ mkbin(L) when is_list(L) -> list_to_binary(L).
mml(Config) when is_list(Config) ->
- ?line single_byte_binary = mml_choose(<<42>>),
- ?line multi_byte_binary = mml_choose(<<42,43>>).
+ single_byte_binary = mml_choose(<<42>>),
+ multi_byte_binary = mml_choose(<<42,43>>).
mml_choose(<<_A:8>>) -> single_byte_binary;
mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary.
match_huge_int(Config) when is_list(Config) ->
Sz = 1 bsl 27,
- ?line Bin = <<0:Sz,13:8>>,
- ?line skip_huge_int_1(Sz, Bin),
- ?line 0 = match_huge_int_1(Sz, Bin),
+ Bin = <<0:Sz,13:8>>,
+ skip_huge_int_1(Sz, Bin),
+ 0 = match_huge_int_1(Sz, Bin),
%% Test overflowing the size of an integer field.
- ?line nomatch = overflow_huge_int_skip_32(Bin),
+ nomatch = overflow_huge_int_skip_32(Bin),
case erlang:system_info(wordsize) of
4 ->
- ?line nomatch = overflow_huge_int_32(Bin);
+ nomatch = overflow_huge_int_32(Bin);
8 ->
%% An attempt will be made to allocate heap space for
%% the bignum (which will probably fail); only if the
@@ -251,15 +251,15 @@ match_huge_int(Config) when is_list(Config) ->
%% the binary is too small.
ok
end,
- ?line nomatch = overflow_huge_int_skip_64(Bin),
- ?line nomatch = overflow_huge_int_64(Bin),
+ nomatch = overflow_huge_int_skip_64(Bin),
+ nomatch = overflow_huge_int_64(Bin),
%% Test overflowing the size of an integer field using variables as sizes.
- ?line Sizes = case erlang:system_info(wordsize) of
+ Sizes = case erlang:system_info(wordsize) of
4 -> lists:seq(25, 32);
8 -> []
end ++ lists:seq(50, 64),
- ?line ok = overflow_huge_int_unit128(Bin, Sizes),
+ ok = overflow_huge_int_unit128(Bin, Sizes),
ok.
@@ -326,19 +326,19 @@ overflow_huge_int_64(<<Int:9223372036854775808/unit:128,0,_/binary>>) -> {8,Int}
overflow_huge_int_64(_) -> nomatch.
bignum(Config) when is_list(Config) ->
- ?line Bin = id(<<42,0:1024/unit:8,43>>),
- ?line <<42:1025/little-integer-unit:8,_:8>> = Bin,
- ?line <<_:8,43:1025/integer-unit:8>> = Bin,
+ Bin = id(<<42,0:1024/unit:8,43>>),
+ <<42:1025/little-integer-unit:8,_:8>> = Bin,
+ <<_:8,43:1025/integer-unit:8>> = Bin,
- ?line BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>),
- ?line <<258254417031933722623:(512+9)/unit:8>> = BignumBin,
+ BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>),
+ <<258254417031933722623:(512+9)/unit:8>> = BignumBin,
erlang:garbage_collect(), %Search for holes in debug-build.
ok.
unaligned_32_bit(Config) when is_list(Config) ->
%% There used to be a risk for heap overflow (fixed in R11B-5).
- ?line L = unaligned_32_bit_1(<<-1:(64*1024)>>),
- ?line unaligned_32_bit_verify(L, 1638).
+ L = unaligned_32_bit_1(<<-1:(64*1024)>>),
+ unaligned_32_bit_verify(L, 1638).
unaligned_32_bit_1(<<1:1,U:32,_:7,T/binary>>) ->
[U|unaligned_32_bit_1(T)];
diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl
index e875dc859c..114d7ecb36 100644
--- a/erts/emulator/test/bs_match_misc_SUITE.erl
+++ b/erts/emulator/test/bs_match_misc_SUITE.erl
@@ -19,17 +19,18 @@
%%
-module(bs_match_misc_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1,
kenneth/1,encode_binary/1,native/1,happi/1,
size_var/1,wiger/1,x0_context/1,huge_float_field/1,
writable_binary_matched/1,otp_7198/1,unordered_bindings/1,
float_middle_endian/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 10}}].
all() ->
[bound_var, bound_tail, t_float, little_float, sean,
@@ -37,39 +38,24 @@ all() ->
x0_context, huge_float_field, writable_binary_matched,
otp_7198, unordered_bindings, float_middle_endian].
-groups() ->
- [].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-bound_var(doc) -> "Test matching of bound variables.";
+%% Test matching of bound variables.
bound_var(Config) when is_list(Config) ->
- ?line ok = bound_var(42, 13, <<42,13>>),
- ?line nope = bound_var(42, 13, <<42,255>>),
- ?line nope = bound_var(42, 13, <<154,255>>),
+ ok = bound_var(42, 13, <<42,13>>),
+ nope = bound_var(42, 13, <<42,255>>),
+ nope = bound_var(42, 13, <<154,255>>),
ok.
bound_var(A, B, <<A:8,B:8>>) -> ok;
bound_var(_, _, _) -> nope.
-bound_tail(doc) -> "Test matching of a bound tail.";
+%% Test matching of a bound tail.
bound_tail(Config) when is_list(Config) ->
- ?line ok = bound_tail(<<>>, <<13,14>>),
- ?line ok = bound_tail(<<2,3>>, <<1,1,2,3>>),
- ?line nope = bound_tail(<<2,3>>, <<1,1,2,7>>),
- ?line nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>),
- ?line nope = bound_tail(<<2,3>>, <<>>),
+ ok = bound_tail(<<>>, <<13,14>>),
+ ok = bound_tail(<<2,3>>, <<1,1,2,3>>),
+ nope = bound_tail(<<2,3>>, <<1,1,2,7>>),
+ nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>),
+ nope = bound_tail(<<2,3>>, <<>>),
ok.
bound_tail(T, <<_:16,T/binary>>) -> ok;
@@ -79,26 +65,26 @@ t_float(Config) when is_list(Config) ->
F = f1(),
G = f_one(),
- ?line G = match_float(<<63,128,0,0>>, 32, 0),
- ?line G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0),
+ G = match_float(<<63,128,0,0>>, 32, 0),
+ G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0),
- ?line fcmp(F, match_float(<<F:32/float>>, 32, 0)),
- ?line fcmp(F, match_float(<<F:64/float>>, 64, 0)),
- ?line fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)),
- ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)),
- ?line fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)),
- ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)),
+ fcmp(F, match_float(<<F:32/float>>, 32, 0)),
+ fcmp(F, match_float(<<F:64/float>>, 64, 0)),
+ fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)),
+ fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)),
+ fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)),
+ fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)),
- ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)),
- ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)),
+ {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)),
+ {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)),
ok.
float_middle_endian(Config) when is_list(Config) ->
F = 9007199254740990.0, % turns to -NaN when word-swapped
- ?line fcmp(F, match_float(<<F:64/float>>, 64, 0)),
- ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)),
- ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)),
+ fcmp(F, match_float(<<F:64/float>>, 64, 0)),
+ fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)),
+ fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)),
ok.
@@ -115,15 +101,15 @@ little_float(Config) when is_list(Config) ->
F = f2(),
G = f_one(),
- ?line G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0),
- ?line G = match_float_little(<<0,0,128,63>>, 32, 0),
+ G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0),
+ G = match_float_little(<<0,0,128,63>>, 32, 0),
- ?line fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)),
- ?line fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)),
- ?line fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)),
- ?line fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)),
- ?line fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)),
- ?line fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)),
+ fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)),
+ fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)),
+ fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)),
+ fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)),
+ fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)),
+ fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)),
ok.
@@ -151,16 +137,16 @@ f_one() ->
1.0.
sean(Config) when is_list(Config) ->
- ?line small = sean1(<<>>),
- ?line small = sean1(<<1>>),
- ?line small = sean1(<<1,2>>),
- ?line small = sean1(<<1,2,3>>),
- ?line large = sean1(<<1,2,3,4>>),
-
- ?line small = sean1(<<4>>),
- ?line small = sean1(<<4,5>>),
- ?line small = sean1(<<4,5,6>>),
- ?line {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)),
+ small = sean1(<<>>),
+ small = sean1(<<1>>),
+ small = sean1(<<1,2>>),
+ small = sean1(<<1,2,3>>),
+ large = sean1(<<1,2,3,4>>),
+
+ small = sean1(<<4>>),
+ small = sean1(<<4,5>>),
+ small = sean1(<<4,5,6>>),
+ {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)),
ok.
sean1(<<B/binary>>) when byte_size(B) < 4 -> small;
@@ -292,28 +278,28 @@ getBase64Char(_Else) ->
-define(M(F), <<F>> = <<F>>).
native(Config) when is_list(Config) ->
- ?line ?M(3.14:64/native-float),
- ?line ?M(333:16/native),
- ?line ?M(38658345:32/native),
+ ?M(3.14:64/native-float),
+ ?M(333:16/native),
+ ?M(38658345:32/native),
case <<1:16/native>> of
<<0,1>> -> native_big();
<<1,0>> -> native_little()
end.
native_big() ->
- ?line <<37.33:64/native-float>> = <<37.33:64/big-float>>,
- ?line <<3974:16/native-integer>> = <<3974:16/big-integer>>,
+ <<37.33:64/native-float>> = <<37.33:64/big-float>>,
+ <<3974:16/native-integer>> = <<3974:16/big-integer>>,
{comment,"Big endian"}.
native_little() ->
- ?line <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>,
- ?line <<7974:16/native-integer>> = <<7974:16/little-integer>>,
+ <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>,
+ <<7974:16/native-integer>> = <<7974:16/little-integer>>,
{comment,"Little endian"}.
happi(Config) when is_list(Config) ->
Bin = <<".123">>,
- ?line <<"123">> = lex_digits1(Bin, 1, []),
- ?line <<"123">> = lex_digits2(Bin, 1, []),
+ <<"123">> = lex_digits1(Bin, 1, []),
+ <<"123">> = lex_digits2(Bin, 1, []),
ok.
lex_digits1(<<$., Rest/binary>>,_Val,_Acc) ->
@@ -334,16 +320,16 @@ dec(A) ->
A-$0.
size_var(Config) when is_list(Config) ->
- ?line {<<45>>,<<>>} = split(<<1:16,45>>),
- ?line {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>),
- ?line {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>),
+ {<<45>>,<<>>} = split(<<1:16,45>>),
+ {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>),
+ {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>),
- ?line {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>),
+ {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>),
- ?line {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>),
- ?line {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)),
+ {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>),
+ {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)),
- ?line <<"cdef">> = skip(<<2:8,"abcdef">>),
+ <<"cdef">> = skip(<<2:8,"abcdef">>),
ok.
@@ -359,11 +345,11 @@ split_2(<<N0:8,N:N0,B:N/binary,T/binary>>) ->
skip(<<N:8,_:N/binary,T/binary>>) -> T.
wiger(Config) when is_list(Config) ->
- ?line ok1 = wcheck(<<3>>),
- ?line ok2 = wcheck(<<1,2,3>>),
- ?line ok3 = wcheck(<<4>>),
- ?line {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>),
- ?line {error,<<>>} = wcheck(<<>>),
+ ok1 = wcheck(<<3>>),
+ ok2 = wcheck(<<1,2,3>>),
+ ok3 = wcheck(<<4>>),
+ {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>),
+ {error,<<>>} = wcheck(<<>>),
ok.
wcheck(<<A>>) when A==3->
@@ -396,24 +382,24 @@ x0_2(_, Bin) ->
x0_3(_, Bin) ->
case Bin of
- <<_:72,7:8,_/binary>> ->
- ?line ?t:fail();
- <<_:64,0:16,_/binary>> ->
- ?line ?t:fail();
- <<_:64,42:16,123456:32,_/binary>> ->
- ok
+ <<_:72,7:8,_/binary>> ->
+ ct:fail(bs_matched_1);
+ <<_:64,0:16,_/binary>> ->
+ ct:fail(bs_matched_2);
+ <<_:64,42:16,123456:32,_/binary>> ->
+ ok
end.
huge_float_field(Config) when is_list(Config) ->
Sz = 1 bsl 27,
- ?line Bin = <<0:Sz>>,
+ Bin = <<0:Sz>>,
- ?line nomatch = overflow_huge_float_skip_32(Bin),
- ?line nomatch = overflow_huge_float_32(Bin),
+ nomatch = overflow_huge_float_skip_32(Bin),
+ nomatch = overflow_huge_float_32(Bin),
- ?line ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
- ?line ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+ ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
+ ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)),
ok.
overflow_huge_float_skip_32(<<_:4294967296/float,0,_/binary>>) -> 1; % 1 bsl 32
@@ -455,15 +441,15 @@ overflow_huge_float(_, []) -> ok.
overflow_huge_float_unit128(Bin, [Sz0|Sizes]) ->
Sz = id(1 bsl Sz0),
case Bin of
- <<_:Sz/float-unit:128,0,_/binary>> ->
- {error,Sz};
- _ ->
- case Bin of
- <<Var:Sz/float-unit:128,0,_/binary>> ->
- {error,Sz,Var};
- _ ->
- overflow_huge_float_unit128(Bin, Sizes)
- end
+ <<_:Sz/float-unit:128,0,_/binary>> ->
+ {error,Sz};
+ _ ->
+ case Bin of
+ <<Var:Sz/float-unit:128,0,_/binary>> ->
+ {error,Sz,Var};
+ _ ->
+ overflow_huge_float_unit128(Bin, Sizes)
+ end
end;
overflow_huge_float_unit128(_, []) -> ok.
@@ -473,25 +459,24 @@ overflow_huge_float_unit128(_, []) -> ok.
%%
writable_binary_matched(Config) when is_list(Config) ->
- ?line WritableBin = create_writeable_binary(),
- ?line writable_binary_matched(WritableBin, WritableBin, 500).
+ WritableBin = create_writeable_binary(),
+ writable_binary_matched(WritableBin, WritableBin, 500).
writable_binary_matched(<<0>>, _, N) ->
- if
- N =:= 0 -> ok;
- true ->
- put(grow_heap, [N|get(grow_heap)]),
- ?line WritableBin = create_writeable_binary(),
- ?line writable_binary_matched(WritableBin, WritableBin, N-1)
+ if N =:= 0 -> ok;
+ true ->
+ put(grow_heap, [N|get(grow_heap)]),
+ WritableBin = create_writeable_binary(),
+ writable_binary_matched(WritableBin, WritableBin, N-1)
end;
writable_binary_matched(<<B:8,T/binary>>, WritableBin0, N) ->
- ?line WritableBin = writable_binary(WritableBin0, B),
+ WritableBin = writable_binary(WritableBin0, B),
writable_binary_matched(T, WritableBin, N).
writable_binary(WritableBin0, B) when is_binary(WritableBin0) ->
%% Heavy append to force the binary to move.
- ?line WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>,
- ?line id(<<(id(0)):128/unit:8>>),
+ WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>,
+ id(<<(id(0)):128/unit:8>>),
WritableBin.
create_writeable_binary() ->
@@ -502,7 +487,7 @@ otp_7198(Config) when is_list(Config) ->
%% increase the number of saved positions, the thing word was not updated
%% to account for the new size. Therefore, if there was a garbage collection,
%% the new slots would be included in the garbage collection.
- ?line [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)],
+ [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)],
ok.
do_otp_7198(FillerSize) ->
@@ -512,8 +497,7 @@ do_otp_7198(FillerSize) ->
{'DOWN',Ref,process,Pid,normal} ->
ok;
{'DOWN',Ref,process,Pid,Reason} ->
- io:format("unexpected: ~p", [Reason]),
- ?line ?t:fail()
+ ct:fail("unexpected: ~p", [Reason])
end.
do_otp_7198_test(_) ->
@@ -540,27 +524,27 @@ otp_7198_scan(<<>>, TokAcc) ->
otp_7198_scan(<<D, Z, Rest/binary>>, TokAcc) when
(D =:= $D orelse D =:= $d) and
((Z =:= $\s) or (Z =:= $() or (Z =:= $))) ->
- otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]);
+ otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]);
otp_7198_scan(<<D>>, TokAcc) when
(D =:= $D) or (D =:= $d) ->
- otp_7198_scan(<<>>, ['AND' | TokAcc]);
+ otp_7198_scan(<<>>, ['AND' | TokAcc]);
otp_7198_scan(<<N, Z, Rest/binary>>, TokAcc) when
(N =:= $N orelse N =:= $n) and
((Z =:= $\s) or (Z =:= $() or (Z =:= $))) ->
- otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]);
+ otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]);
otp_7198_scan(<<C, Rest/binary>>, TokAcc) when
(C >= $A) and (C =< $Z);
(C >= $a) and (C =< $z);
(C >= $0) and (C =< $9) ->
- case Rest of
- <<$:, R/binary>> ->
- otp_7198_scan(R, [{'FIELD', C} | TokAcc]);
- _ ->
- otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc])
- end.
+ case Rest of
+ <<$:, R/binary>> ->
+ otp_7198_scan(R, [{'FIELD', C} | TokAcc]);
+ _ ->
+ otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc])
+ end.
unordered_bindings(Config) when is_list(Config) ->
{<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} =
diff --git a/erts/emulator/test/bs_match_tail_SUITE.erl b/erts/emulator/test/bs_match_tail_SUITE.erl
index 58b0d3fef6..8392a0df47 100644
--- a/erts/emulator/test/bs_match_tail_SUITE.erl
+++ b/erts/emulator/test/bs_match_tail_SUITE.erl
@@ -21,61 +21,46 @@
-module(bs_match_tail_SUITE).
-author('[email protected]').
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,aligned/1,unaligned/1,zero_tail/1]).
+-export([all/0, suite/0,
+ aligned/1,unaligned/1,zero_tail/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[aligned, unaligned, zero_tail].
-groups() ->
- [].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-aligned(doc) -> "Test aligned tails.";
+%% Test aligned tails.
aligned(Config) when is_list(Config) ->
- ?line Tail1 = mkbin([]),
- ?line {258,Tail1} = al_get_tail_used(mkbin([1,2])),
- ?line Tail2 = mkbin(lists:seq(1, 127)),
- ?line {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])),
-
- ?line 64896 = al_get_tail_unused(mkbin([253,128])),
- ?line 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])),
-
- ?line Tail3 = mkbin(lists:seq(0, 19)),
- ?line {0,Tail1} = get_dyn_tail_used(Tail1, 0),
- ?line {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0),
- ?line {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8),
-
- ?line 0 = get_dyn_tail_unused(mkbin([]), 0),
- ?line 233 = get_dyn_tail_unused(mkbin([233]), 8),
- ?line 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8),
+ Tail1 = mkbin([]),
+ {258,Tail1} = al_get_tail_used(mkbin([1,2])),
+ Tail2 = mkbin(lists:seq(1, 127)),
+ {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])),
+
+ 64896 = al_get_tail_unused(mkbin([253,128])),
+ 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])),
+
+ Tail3 = mkbin(lists:seq(0, 19)),
+ {0,Tail1} = get_dyn_tail_used(Tail1, 0),
+ {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0),
+ {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8),
+
+ 0 = get_dyn_tail_unused(mkbin([]), 0),
+ 233 = get_dyn_tail_unused(mkbin([233]), 8),
+ 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8),
ok.
al_get_tail_used(<<A:16,T/binary>>) -> {A,T}.
al_get_tail_unused(<<A:16,_/binary>>) -> A.
-unaligned(doc) -> "Test that an non-aligned tail cannot be matched out.";
+%% Test that an non-aligned tail cannot be matched out.
unaligned(Config) when is_list(Config) ->
- ?line {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))),
- ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)),
- ?line {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))),
- ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)),
+ {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))),
+ {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)),
+ {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))),
+ {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)),
ok.
get_tail_used(<<A:1,T/binary>>) -> {A,T}.
@@ -90,11 +75,11 @@ get_dyn_tail_unused(Bin, Sz) ->
<<A:Sz,_/binary>> = Bin,
A.
-zero_tail(doc) -> "Test that zero tails are tested correctly.";
+%% Test that zero tails are tested correctly.
zero_tail(Config) when is_list(Config) ->
- ?line 7 = (catch test_zero_tail(mkbin([7]))),
- ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))),
- ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))),
+ 7 = (catch test_zero_tail(mkbin([7]))),
+ {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))),
+ {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))),
ok.
test_zero_tail(<<A:8>>) -> A.
@@ -102,7 +87,3 @@ test_zero_tail(<<A:8>>) -> A.
test_zero_tail2(<<_A:4,_B:4>>) -> ok.
mkbin(L) when is_list(L) -> list_to_binary(L).
-
-
-
-
diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl
index 0625c22163..f1c09bfbb0 100644
--- a/erts/emulator/test/bs_utf_SUITE.erl
+++ b/erts/emulator/test/bs_utf_SUITE.erl
@@ -20,52 +20,28 @@
-module(bs_utf_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
+-export([all/0, suite/0,
utf8_roundtrip/1,utf16_roundtrip/1,utf32_roundtrip/1,
utf8_illegal_sequences/1,utf16_illegal_sequences/1,
utf32_illegal_sequences/1,
bad_construction/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])).
+-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])).
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:minutes(6)),
- [{watchdog,Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 6}}].
all() ->
[utf8_roundtrip, utf16_roundtrip, utf32_roundtrip,
utf8_illegal_sequences, utf16_illegal_sequences,
utf32_illegal_sequences, bad_construction].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
utf8_roundtrip(Config) when is_list(Config) ->
- ?line utf8_roundtrip(0, 16#D7FF),
- ?line utf8_roundtrip(16#E000, 16#10FFFF),
+ utf8_roundtrip(0, 16#D7FF),
+ utf8_roundtrip(16#E000, 16#10FFFF),
ok.
utf8_roundtrip(First, Last) when First =< Last ->
@@ -83,10 +59,9 @@ utf16_roundtrip(Config) when is_list(Config) ->
Big = fun utf16_big_roundtrip/1,
Little = fun utf16_little_roundtrip/1,
PidRefs = [spawn_monitor(fun() ->
- do_utf16_roundtrip(Fun)
- end) || Fun <- [Big,Little]],
- [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end ||
- {Pid,Ref} <- PidRefs],
+ do_utf16_roundtrip(Fun)
+ end) || Fun <- [Big,Little]],
+ [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end || {Pid,Ref} <- PidRefs],
ok.
do_utf16_roundtrip(Fun) ->
@@ -154,20 +129,20 @@ utf32_little_roundtrip(Char) ->
ok.
utf8_illegal_sequences(Config) when is_list(Config) ->
- ?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
- ?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
+ fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
+ fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
%% Illegal first character.
- ?line [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)],
+ [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)],
%% Short sequences.
- ?line short_sequences(16#80, 16#10FFFF),
+ short_sequences(16#80, 16#10FFFF),
%% Overlong sequences. (Using more bytes than necessary
%% is not allowed.)
- ?line overlong(0, 127, 2),
- ?line overlong(128, 16#7FF, 3),
- ?line overlong(16#800, 16#FFFF, 4),
+ overlong(0, 127, 2),
+ overlong(128, 16#7FF, 3),
+ overlong(16#800, 16#FFFF, 4),
ok.
fail_range(Char, End) when Char =< End ->
@@ -187,9 +162,9 @@ short_sequences(Char, End) ->
short_sequences_1(Char, Step, End) when Char =< End ->
CharEnd = lists:min([Char+Step-1,End]),
[spawn_monitor(fun() ->
- io:format("~p - ~p\n", [Char,CharEnd]),
- do_short_sequences(Char, CharEnd)
- end)|short_sequences_1(Char+Step, Step, End)];
+ io:format("~p - ~p\n", [Char,CharEnd]),
+ do_short_sequences(Char, CharEnd)
+ end)|short_sequences_1(Char+Step, Step, End)];
short_sequences_1(_, _, _) -> [].
do_short_sequences(Char, End) when Char =< End ->
@@ -228,9 +203,9 @@ overlong(_, _, _) -> ok.
overlong(Char, NumBytes) when NumBytes < 5 ->
case int_to_utf8(Char, NumBytes) of
<<Char/utf8>>=Bin ->
- ?t:fail({illegal_encoding_accepted,Bin,Char});
+ ct:fail({illegal_encoding_accepted,Bin,Char});
<<OtherChar/utf8>>=Bin ->
- ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar});
+ ct:fail({illegal_encoding_accepted,Bin,Char,OtherChar});
_ -> ok
end,
overlong(Char, NumBytes+1);
@@ -241,16 +216,16 @@ fail(Bin) ->
fail_1(make_unaligned(Bin)).
fail_1(<<Char/utf8>>=Bin) ->
- ?t:fail({illegal_encoding_accepted,Bin,Char});
+ ct:fail({illegal_encoding_accepted,Bin,Char});
fail_1(_) -> ok.
utf16_illegal_sequences(Config) when is_list(Config) ->
- ?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
- ?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
+ utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
+ utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
- ?line lonely_hi_surrogate(16#D800, 16#DFFF),
- ?line leading_lo_surrogate(16#DC00, 16#DFFF),
+ lonely_hi_surrogate(16#D800, 16#DFFF),
+ leading_lo_surrogate(16#DC00, 16#DFFF),
ok.
@@ -265,9 +240,9 @@ lonely_hi_surrogate(Char, End) when Char =< End ->
BinLittle = <<Char:16/little>>,
case {BinBig,BinLittle} of
{<<Bad/big-utf16>>,_} ->
- ?t:fail({lonely_hi_surrogate_accepted,Bad});
+ ct:fail({lonely_hi_surrogate_accepted,Bad});
{_,<<Bad/little-utf16>>} ->
- ?t:fail({lonely_hi_surrogate_accepted,Bad});
+ ct:fail({lonely_hi_surrogate_accepted,Bad});
{_,_} ->
ok
end,
@@ -284,9 +259,9 @@ leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End ->
BinLittle = <<HiSurr:16/little,LoSurr:16/little>>,
case {BinBig,BinLittle} of
{<<Bad/big-utf16,_/bits>>,_} ->
- ?t:fail({leading_lo_surrogate_accepted,Bad});
+ ct:fail({leading_lo_surrogate_accepted,Bad});
{_,<<Bad/little-utf16,_/bits>>} ->
- ?t:fail({leading_lo_surrogate_accepted,Bad});
+ ct:fail({leading_lo_surrogate_accepted,Bad});
{_,_} ->
ok
end,
@@ -294,20 +269,20 @@ leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End ->
leading_lo_surrogate(_, _, _) -> ok.
utf32_illegal_sequences(Config) when is_list(Config) ->
- ?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
- ?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
- ?line utf32_fail_range(-100, -1),
+ utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large.
+ utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16.
+ utf32_fail_range(-100, -1),
ok.
utf32_fail_range(Char, End) when Char =< End ->
{'EXIT',_} = (catch <<Char/big-utf32>>),
{'EXIT',_} = (catch <<Char/little-utf32>>),
case {<<Char:32>>,<<Char:32/little>>} of
- {<<Unexpected/utf32>>,_} ->
- ?line ?t:fail(Unexpected);
- {_,<<Unexpected/little-utf32>>} ->
- ?line ?t:fail(Unexpected);
- {_,_} -> ok
+ {<<Unexpected/utf32>>,_} ->
+ ct:fail(Unexpected);
+ {_,<<Unexpected/little-utf32>>} ->
+ ct:fail(Unexpected);
+ {_,_} -> ok
end,
utf32_fail_range(Char+1, End);
utf32_fail_range(_, _) -> ok.
@@ -387,14 +362,14 @@ fail_check({'EXIT',{badarg,_}}, Str, Vars) ->
try evaluate(Str, Vars) of
Res ->
io:format("Interpreted result: ~p", [Res]),
- ?t:fail(did_not_fail_in_intepreted_code)
+ ct:fail(did_not_fail_in_intepreted_code)
catch
error:badarg ->
ok
end;
fail_check(Res, _, _) ->
io:format("Compiled result: ~p", [Res]),
- ?t:fail(did_not_fail_in_compiled_code).
+ ct:fail(did_not_fail_in_compiled_code).
evaluate(Str, Vars) ->
{ok,Tokens,_} =
@@ -406,4 +381,3 @@ evaluate(Str, Vars) ->
end.
id(I) -> I.
-
diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl
index 6a2588aadd..c582f8d77b 100644
--- a/erts/emulator/test/busy_port_SUITE.erl
+++ b/erts/emulator/test/busy_port_SUITE.erl
@@ -20,8 +20,7 @@
-module(busy_port_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,end_per_testcase/2,
+-export([all/0, suite/0, end_per_testcase/2,
io_to_busy/1, message_order/1, send_3/1,
system_monitor/1, no_trap_exit/1,
no_trap_exit_unlinked/1, trap_exit/1, multiple_writers/1,
@@ -29,12 +28,14 @@
-compile(export_all).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Internal exports.
-export([init/2]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
[io_to_busy, message_order, send_3, system_monitor,
@@ -43,21 +44,6 @@ all() ->
scheduling_delay_busy,scheduling_delay_busy_nosuspend,
scheduling_busy_link].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
end_per_testcase(_Case, Config) when is_list(Config) ->
case whereis(busy_drv_server) of
undefined ->
@@ -76,17 +62,14 @@ end_per_testcase(_Case, Config) when is_list(Config) ->
%% Tests I/O operations to a busy port, to make sure a suspended send
%% operation is correctly restarted. This used to crash Beam.
-io_to_busy(suite) -> [];
io_to_busy(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(30)),
+ ct:timetrap({seconds, 30}),
- ?line start_busy_driver(Config),
- ?line process_flag(trap_exit, true),
- ?line Writer = fun_spawn(fun writer/0),
- ?line Generator = fun_spawn(fun() -> generator(100, Writer) end),
- ?line wait_for([Writer, Generator]),
-
- ?line test_server:timetrap_cancel(Dog),
+ start_busy_driver(Config),
+ process_flag(trap_exit, true),
+ Writer = fun_spawn(fun writer/0),
+ Generator = fun_spawn(fun() -> generator(100, Writer) end),
+ wait_for([Writer, Generator]),
ok.
generator(N, Writer) ->
@@ -130,27 +113,24 @@ forget(_) ->
%% Test the interaction of busy ports and message sending.
%% This used to cause the wrong message to be received.
-message_order(suite) -> {req, dynamic_loading};
message_order(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
-
- ?line start_busy_driver(Config),
- ?line Self = self(),
- ?line Busy = fun_spawn(fun () -> send_to_busy_1(Self) end),
- ?line receive after 1000 -> ok end,
- ?line Busy ! first,
- ?line Busy ! second,
- ?line receive after 1 -> ok end,
- ?line unlock_slave(),
- ?line Busy ! third,
- ?line receive
- {Busy, first} ->
- ok;
- Other ->
- test_server:fail({unexpected_message, Other})
- end,
-
- ?line test_server:timetrap_cancel(Dog),
+ ct:timetrap({seconds, 10}),
+
+ start_busy_driver(Config),
+ Self = self(),
+ Busy = fun_spawn(fun () -> send_to_busy_1(Self) end),
+ receive after 1000 -> ok end,
+ Busy ! first,
+ Busy ! second,
+ receive after 1 -> ok end,
+ unlock_slave(),
+ Busy ! third,
+ receive
+ {Busy, first} ->
+ ok;
+ Other ->
+ ct:fail({unexpected_message, Other})
+ end,
ok.
send_to_busy_1(Parent) ->
@@ -164,80 +144,64 @@ send_to_busy_1(Parent) ->
end.
%% Test the bif send/3
-send_3(suite) -> {req,dynamic_loading};
-send_3(doc) -> ["Test the BIF send/3"];
send_3(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ct:timetrap({seconds, 10}),
%%
- ?line start_busy_driver(Config),
- ?line {Owner,Slave} = get_slave(),
- ?line ok = erlang:send(Slave, {Owner,{command,"set busy"}},
- [nosuspend]),
+ start_busy_driver(Config),
+ {Owner,Slave} = get_slave(),
+ ok = erlang:send(Slave, {Owner,{command,"set busy"}}, [nosuspend]),
receive after 100 -> ok end, % ensure command reached port
- ?line nosuspend = erlang:send(Slave, {Owner,{command,"busy"}},
- [nosuspend]),
- ?line unlock_slave(),
- ?line ok = erlang:send(Slave, {Owner,{command,"not busy"}},
- [nosuspend]),
- ?line ok = command(stop),
- %%
- ?line test_server:timetrap_cancel(Dog),
+ nosuspend = erlang:send(Slave, {Owner,{command,"busy"}}, [nosuspend]),
+ unlock_slave(),
+ ok = erlang:send(Slave, {Owner,{command,"not busy"}}, [nosuspend]),
+ ok = command(stop),
ok.
%% Test the erlang:system_monitor(Pid, [busy_port])
-system_monitor(suite) -> {req,dynamic_loading};
-system_monitor(doc) -> ["Test erlang:system_monitor({Pid,[busy_port]})."];
system_monitor(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Self = self(),
+ ct:timetrap({seconds, 10}),
+ Self = self(),
%%
- ?line OldMonitor = erlang:system_monitor(Self, [busy_port]),
- ?line {Self,[busy_port]} = erlang:system_monitor(),
- ?line Void = make_ref(),
- ?line start_busy_driver(Config),
- ?line {Owner,Slave} = get_slave(),
- ?line Master = command(get_master),
- ?line Parent = self(),
- ?line Busy =
- spawn_link(
- fun() ->
- (catch port_command(Slave, "set busy")),
- receive {Parent,alpha} -> ok end,
- (catch port_command(Slave, "busy")),
- (catch port_command(Slave, "free")),
- Parent ! {self(),alpha},
- command(lock),
- receive {Parent,beta} -> ok end,
- command({port_command,"busy"}),
- command({port_command,"free"}),
- Parent ! {self(),beta}
- end),
- ?line Void = rec(Void),
- ?line Busy ! {self(),alpha},
- ?line {monitor,Busy,busy_port,Slave} = rec(Void),
- ?line unlock_slave(),
- ?line {Busy,alpha} = rec(Void),
- ?line Void = rec(Void),
- ?line Busy ! {self(), beta},
- ?line {monitor,Owner,busy_port,Slave} = rec(Void),
- ?line port_command(Master, "u"),
- ?line {Busy,beta} = rec(Void),
- ?line Void = rec(Void),
- ?line _NewMonitor = erlang:system_monitor(OldMonitor),
- ?line OldMonitor = erlang:system_monitor(),
- ?line OldMonitor = erlang:system_monitor(OldMonitor),
- %%
- ?line test_server:timetrap_cancel(Dog),
+ OldMonitor = erlang:system_monitor(Self, [busy_port]),
+ {Self,[busy_port]} = erlang:system_monitor(),
+ Void = make_ref(),
+ start_busy_driver(Config),
+ {Owner,Slave} = get_slave(),
+ Master = command(get_master),
+ Parent = self(),
+ Busy = spawn_link(
+ fun() ->
+ (catch port_command(Slave, "set busy")),
+ receive {Parent,alpha} -> ok end,
+ (catch port_command(Slave, "busy")),
+ (catch port_command(Slave, "free")),
+ Parent ! {self(),alpha},
+ command(lock),
+ receive {Parent,beta} -> ok end,
+ command({port_command,"busy"}),
+ command({port_command,"free"}),
+ Parent ! {self(),beta}
+ end),
+ Void = rec(Void),
+ Busy ! {self(),alpha},
+ {monitor,Busy,busy_port,Slave} = rec(Void),
+ unlock_slave(),
+ {Busy,alpha} = rec(Void),
+ Void = rec(Void),
+ Busy ! {self(), beta},
+ {monitor,Owner,busy_port,Slave} = rec(Void),
+ port_command(Master, "u"),
+ {Busy,beta} = rec(Void),
+ Void = rec(Void),
+ _NewMonitor = erlang:system_monitor(OldMonitor),
+ OldMonitor = erlang:system_monitor(),
+ OldMonitor = erlang:system_monitor(OldMonitor),
ok.
-
-
rec(Tag) ->
receive X -> X after 1000 -> Tag end.
-
-
%% Assuming the following scenario,
%%
%% +---------------+ +-----------+
@@ -248,65 +212,59 @@ rec(Tag) ->
%%
%% tests that the suspended process is killed if the port is killed.
-no_trap_exit(suite) -> [];
no_trap_exit(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line process_flag(trap_exit, true),
- ?line Pid = fun_spawn(fun no_trap_exit_process/3,
- [self(), linked, Config]),
- ?line receive
- {Pid, port_created, Port} ->
- io:format("Process ~w created port ~w", [Pid, Port]),
- ?line exit(Port, die);
- Other1 ->
- test_server:fail({unexpected_message, Other1})
- end,
- ?line receive
- {'EXIT', Pid, die} ->
- ok;
- Other2 ->
- test_server:fail({unexpected_message, Other2})
- end,
-
- ?line test_server:timetrap_cancel(Dog),
+ ct:timetrap({seconds, 10}),
+ process_flag(trap_exit, true),
+ Pid = fun_spawn(fun no_trap_exit_process/3, [self(), linked, Config]),
+ receive
+ {Pid, port_created, Port} ->
+ io:format("Process ~w created port ~w", [Pid, Port]),
+ exit(Port, die);
+ Other1 ->
+ ct:fail({unexpected_message, Other1})
+ end,
+ receive
+ {'EXIT', Pid, die} ->
+ ok;
+ Other2 ->
+ ct:fail({unexpected_message, Other2})
+ end,
ok.
%% The same scenario as above, but the port has been explicitly
%% unlinked from the process.
-no_trap_exit_unlinked(suite) -> [];
no_trap_exit_unlinked(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line process_flag(trap_exit, true),
- ?line Pid = fun_spawn(fun no_trap_exit_process/3,
- [self(), unlink, Config]),
- ?line receive
- {Pid, port_created, Port} ->
- io:format("Process ~w created port ~w", [Pid, Port]),
- ?line exit(Port, die);
- Other1 ->
- test_server:fail({unexpected_message, Other1})
- end,
- ?line receive
- {'EXIT', Pid, normal} ->
- ok;
- Other2 ->
- test_server:fail({unexpected_message, Other2})
- end,
- ?line test_server:timetrap_cancel(Dog),
+ ct:timetrap({seconds, 10}),
+ process_flag(trap_exit, true),
+ Pid = fun_spawn(fun no_trap_exit_process/3,
+ [self(), unlink, Config]),
+ receive
+ {Pid, port_created, Port} ->
+ io:format("Process ~w created port ~w", [Pid, Port]),
+ exit(Port, die);
+ Other1 ->
+ ct:fail({unexpected_message, Other1})
+ end,
+ receive
+ {'EXIT', Pid, normal} ->
+ ok;
+ Other2 ->
+ ct:fail({unexpected_message, Other2})
+ end,
ok.
no_trap_exit_process(ResultTo, Link, Config) ->
- ?line load_busy_driver(Config),
- ?line _Master = open_port({spawn, "busy_drv master"}, [eof]),
- ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]),
- ?line case Link of
- linked -> ok;
- unlink -> unlink(Slave)
- end,
- ?line (catch port_command(Slave, "lock port")),
- ?line ResultTo ! {self(), port_created, Slave},
- ?line (catch port_command(Slave, "suspend me")),
+ load_busy_driver(Config),
+ _Master = open_port({spawn, "busy_drv master"}, [eof]),
+ Slave = open_port({spawn, "busy_drv slave"}, [eof]),
+ case Link of
+ linked -> ok;
+ unlink -> unlink(Slave)
+ end,
+ (catch port_command(Slave, "lock port")),
+ ResultTo ! {self(), port_created, Slave},
+ (catch port_command(Slave, "suspend me")),
ok.
%% Assuming the following scenario,
@@ -320,36 +278,34 @@ no_trap_exit_process(ResultTo, Link, Config) ->
%% tests that the suspended process is scheduled runnable and
%% receives an 'EXIT' message if the port is killed.
-trap_exit(suite) -> [];
trap_exit(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Pid = fun_spawn(fun busy_port_exit_process/2, [self(), Config]),
- ?line receive
+ ct:timetrap({seconds, 10}),
+ Pid = fun_spawn(fun busy_port_exit_process/2, [self(), Config]),
+ receive
{Pid, port_created, Port} ->
io:format("Process ~w created port ~w", [Pid, Port]),
- ?line unlink(Pid),
- ?line {status, suspended} = process_info(Pid, status),
- ?line exit(Port, die);
+ unlink(Pid),
+ {status, suspended} = process_info(Pid, status),
+ exit(Port, die);
Other1 ->
- test_server:fail({unexpected_message, Other1})
+ ct:fail({unexpected_message, Other1})
end,
- ?line receive
+ receive
{Pid, ok} ->
ok;
Other2 ->
- test_server:fail({unexpected_message, Other2})
+ ct:fail({unexpected_message, Other2})
end,
- ?line test_server:timetrap_cancel(Dog),
ok.
busy_port_exit_process(ResultTo, Config) ->
- ?line process_flag(trap_exit, true),
- ?line load_busy_driver(Config),
- ?line _Master = open_port({spawn, "busy_drv master"}, [eof]),
- ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]),
- ?line (catch port_command(Slave, "lock port")),
- ?line ResultTo ! {self(), port_created, Slave},
- ?line (catch port_command(Slave, "suspend me")),
+ process_flag(trap_exit, true),
+ load_busy_driver(Config),
+ _Master = open_port({spawn, "busy_drv master"}, [eof]),
+ Slave = open_port({spawn, "busy_drv slave"}, [eof]),
+ (catch port_command(Slave, "lock port")),
+ ResultTo ! {self(), port_created, Slave},
+ (catch port_command(Slave, "suspend me")),
receive
{'EXIT', Slave, die} ->
ResultTo ! {self(), ok};
@@ -362,19 +318,18 @@ busy_port_exit_process(ResultTo, Config) ->
%% This should work even if some of the processes have terminated
%% in the meantime.
-multiple_writers(suite) -> [];
multiple_writers(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line start_busy_driver(Config),
- ?line process_flag(trap_exit, true),
+ ct:timetrap({seconds, 10}),
+ start_busy_driver(Config),
+ process_flag(trap_exit, true),
%% Start the waiters and make sure they have blocked.
- ?line W1 = fun_spawn(fun quick_writer/0),
- ?line W2 = fun_spawn(fun quick_writer/0),
- ?line W3 = fun_spawn(fun quick_writer/0),
- ?line W4 = fun_spawn(fun quick_writer/0),
- ?line W5 = fun_spawn(fun quick_writer/0),
- ?line test_server:sleep(500), % Make sure writers have blocked.
+ W1 = fun_spawn(fun quick_writer/0),
+ W2 = fun_spawn(fun quick_writer/0),
+ W3 = fun_spawn(fun quick_writer/0),
+ W4 = fun_spawn(fun quick_writer/0),
+ W5 = fun_spawn(fun quick_writer/0),
+ test_server:sleep(500), % Make sure writers have blocked.
%% Kill two of the processes.
exit(W1, kill),
@@ -383,10 +338,8 @@ multiple_writers(Config) when is_list(Config) ->
receive {'EXIT', W3, killed} -> ok end,
%% Unlock the port. The surviving processes should be become runnable.
- ?line unlock_slave(),
- ?line wait_for([W2, W4, W5]),
-
- ?line test_server:timetrap_cancel(Dog),
+ unlock_slave(),
+ wait_for([W2, W4, W5]),
ok.
quick_writer() ->
@@ -402,205 +355,193 @@ soft_busy_driver(Config) when is_list(Config) ->
hs_test(Config, false).
hs_test(Config, HardBusy) when is_list(Config) ->
- ?line DrvName = case HardBusy of
- true -> 'hard_busy_drv';
- false -> 'soft_busy_drv'
- end,
- ?line erl_ddll:start(),
- ?line Path = ?config(data_dir, Config),
+ DrvName = case HardBusy of
+ true -> 'hard_busy_drv';
+ false -> 'soft_busy_drv'
+ end,
+ erl_ddll:start(),
+ Path = proplists:get_value(data_dir, Config),
case erl_ddll:load_driver(Path, DrvName) of
- ok -> ok;
- {error, Error} ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- ?line ?t:fail()
+ ok -> ok;
+ {error, Error} ->
+ ct:fail(erl_ddll:format_error(Error))
end,
- ?line Port = open_port({spawn, DrvName}, []),
-
+ Port = open_port({spawn, DrvName}, []),
+
NotSuspended = fun (Proc) ->
- chk_not_value({status,suspended},
- process_info(Proc, status))
- end,
+ chk_not_value({status,suspended},
+ process_info(Proc, status))
+ end,
NotBusyEnd = fun (Proc, Res, Time) ->
- receive
- {Port, caller, Proc} -> ok
- after
- 500 -> exit(missing_caller_message)
- end,
- chk_value({return, true}, Res),
- chk_range(0, Time, 100)
- end,
+ receive
+ {Port, caller, Proc} -> ok
+ after
+ 500 -> exit(missing_caller_message)
+ end,
+ chk_value({return, true}, Res),
+ chk_range(0, Time, 100)
+ end,
ForceEnd = fun (Proc, Res, Time) ->
- case HardBusy of
- false ->
- NotBusyEnd(Proc, Res, Time);
- true ->
- chk_value({error, notsup}, Res),
- chk_range(0, Time, 100),
- receive
- Msg -> exit({unexpected_msg, Msg})
- after
- 500 -> ok
- end
- end
- end,
+ case HardBusy of
+ false ->
+ NotBusyEnd(Proc, Res, Time);
+ true ->
+ chk_value({error, notsup}, Res),
+ chk_range(0, Time, 100),
+ receive
+ Msg -> exit({unexpected_msg, Msg})
+ after
+ 500 -> ok
+ end
+ end
+ end,
BadArg = fun (_Proc, Res, Time) ->
- chk_value({error, badarg}, Res),
- chk_range(0, Time, 100)
- end,
+ chk_value({error, badarg}, Res),
+ chk_range(0, Time, 100)
+ end,
%% Not busy
%% Not busy; nosuspend option
- ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended, NotBusyEnd),
+ hs_busy_pcmd(Port, [nosuspend], NotSuspended, NotBusyEnd),
%% Not busy; force option
- ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd),
+ hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd),
%% Not busy; force and nosuspend option
- ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd),
+ hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd),
%% Not busy; no option
- ?line hs_busy_pcmd(Port, [], NotSuspended, NotBusyEnd),
+ hs_busy_pcmd(Port, [], NotSuspended, NotBusyEnd),
%% Not busy; bad option
- ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg),
+ hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg),
%% Make busy
- ?line erlang:port_control(Port, $B, []),
+ erlang:port_control(Port, $B, []),
%% Busy; nosuspend option
- ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended,
- fun (_Proc, Res, Time) ->
- chk_value({return, false}, Res),
- chk_range(0, Time, 100),
- receive
- Msg -> exit({unexpected_msg, Msg})
- after
- 500 -> ok
- end
- end),
+ hs_busy_pcmd(Port, [nosuspend], NotSuspended,
+ fun (_Proc, Res, Time) ->
+ chk_value({return, false}, Res),
+ chk_range(0, Time, 100),
+ receive
+ Msg -> exit({unexpected_msg, Msg})
+ after
+ 500 -> ok
+ end
+ end),
%% Busy; force option
- ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd),
+ hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd),
%% Busy; force and nosuspend option
- ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd),
+ hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd),
%% Busy; bad option
- ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg),
+ hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg),
%% no option on busy port
- ?line hs_busy_pcmd(Port, [],
- fun (Proc) ->
- receive after 1000 -> ok end,
- chk_value({status,suspended},
- process_info(Proc, status)),
-
- %% Make not busy
- erlang:port_control(Port, $N, [])
- end,
- fun (_Proc, Res, Time) ->
- chk_value({return, true}, Res),
- chk_range(1000, Time, 2000)
- end),
-
- ?line true = erlang:port_close(Port),
- ?line ok = erl_ddll:unload_driver(DrvName),
- ?line ok = erl_ddll:stop(),
- ?line ok.
+ hs_busy_pcmd(Port, [],
+ fun (Proc) ->
+ receive after 1000 -> ok end,
+ chk_value({status,suspended},
+ process_info(Proc, status)),
+
+ %% Make not busy
+ erlang:port_control(Port, $N, [])
+ end,
+ fun (_Proc, Res, Time) ->
+ chk_value({return, true}, Res),
+ chk_range(1000, Time, 2000)
+ end),
+
+ true = erlang:port_close(Port),
+ ok = erl_ddll:unload_driver(DrvName),
+ ok = erl_ddll:stop(),
+ ok.
hs_busy_pcmd(Prt, Opts, StartFun, EndFun) ->
Tester = self(),
P = spawn_link(fun () ->
- erlang:yield(),
- Tester ! {self(), doing_port_command},
- Start = erlang:monotonic_time(micro_seconds),
- Res = try {return,
- port_command(Prt, [], Opts)}
- catch Exception:Error -> {Exception, Error}
- end,
- End = erlang:monotonic_time(micro_seconds),
- Time = round((End - Start)/1000),
- Tester ! {self(), port_command_result, Res, Time}
- end),
+ erlang:yield(),
+ Tester ! {self(), doing_port_command},
+ Start = erlang:monotonic_time(micro_seconds),
+ Res = try {return,
+ port_command(Prt, [], Opts)}
+ catch Exception:Error -> {Exception, Error}
+ end,
+ End = erlang:monotonic_time(micro_seconds),
+ Time = round((End - Start)/1000),
+ Tester ! {self(), port_command_result, Res, Time}
+ end),
receive
- {P, doing_port_command} ->
- ok
+ {P, doing_port_command} ->
+ ok
end,
StartFun(P),
receive
- {P, port_command_result, Res, Time} ->
- EndFun(P, Res, Time)
+ {P, port_command_result, Res, Time} ->
+ EndFun(P, Res, Time)
end.
scheduling_delay_busy(Config) ->
-
- Scenario =
- [{1,{spawn,[{var,drvname},undefined]}},
- {2,{call,[{var,1},open_port]}},
- {3,{spawn,[{var,2},{var,1}]}},
- {0,{ack,[{var,1},{busy,1,250}]}},
- {0,{cast,[{var,3},{command,2}]}},
- [{0,{cast,[{var,3},{command,I}]}}
- || I <- lists:seq(3,50)],
- {0,{cast,[{var,3},take_control]}},
- {0,{cast,[{var,1},{new_owner,{var,3}}]}},
- {0,{cast,[{var,3},close]}},
- {0,{timer,sleep,[300]}},
- {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}},
- [{0,{cast,[{var,1},{command,I}]}}
- || I <- lists:seq(101,127)]
- ,{10,{call,[{var,3},get_data]}}
- ],
+ Scenario = [{1,{spawn,[{var,drvname},undefined]}},
+ {2,{call,[{var,1},open_port]}},
+ {3,{spawn,[{var,2},{var,1}]}},
+ {0,{ack,[{var,1},{busy,1,250}]}},
+ {0,{cast,[{var,3},{command,2}]}},
+ [{0,{cast,[{var,3},{command,I}]}} || I <- lists:seq(3,50)],
+ {0,{cast,[{var,3},take_control]}},
+ {0,{cast,[{var,1},{new_owner,{var,3}}]}},
+ {0,{cast,[{var,3},close]}},
+ {0,{timer,sleep,[300]}},
+ {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}},
+ [{0,{cast,[{var,1},{command,I}]}} || I <- lists:seq(101,127)],
+ {10,{call,[{var,3},get_data]}}],
Validation = [{seq,10,lists:seq(1,50)}],
- port_scheduling(Scenario,Validation,?config(data_dir,Config)).
+ port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)).
scheduling_delay_busy_nosuspend(Config) ->
-
- Scenario =
- [{1,{spawn,[{var,drvname},undefined]}},
- {2,{call,[{var,1},open_port]}},
- {0,{cast,[{var,1},{command,1,100}]}},
- {0,{cast,[{var,1},{busy,2}]}},
- {0,{timer,sleep,[200]}}, % ensure reached port
- {10,{call,[{var,1},{command,3,[nosuspend]}]}},
- {0,{timer,sleep,[200]}},
- {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}},
- {0,{cast,[{var,1},close]}},
- {20,{call,[{var,1},get_data]}}
- ],
+ Scenario = [{1,{spawn,[{var,drvname},undefined]}},
+ {2,{call,[{var,1},open_port]}},
+ {0,{cast,[{var,1},{command,1,100}]}},
+ {0,{cast,[{var,1},{busy,2}]}},
+ {0,{timer,sleep,[200]}}, % ensure reached port
+ {10,{call,[{var,1},{command,3,[nosuspend]}]}},
+ {0,{timer,sleep,[200]}},
+ {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}},
+ {0,{cast,[{var,1},close]}},
+ {20,{call,[{var,1},get_data]}}],
Validation = [{eq,10,nosuspend},{seq,20,[1,2]}],
- port_scheduling(Scenario,Validation,?config(data_dir,Config)).
+ port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)).
scheduling_busy_link(Config) ->
-
- Scenario =
- [{1,{spawn,[{var,drvname},undefined]}},
- {2,{call,[{var,1},open_port]}},
- {3,{spawn,[{var,2},{var,1}]}},
- {0,{cast,[{var,1},unlink]}},
- {0,{cast,[{var,1},{busy,1}]}},
- {0,{cast,[{var,1},{command,2}]}},
- {0,{cast,[{var,1},link]}},
- {0,{timer,sleep,[1000]}},
- {0,{ack,[{var,3},take_control]}},
- {0,{cast,[{var,1},{new_owner,{var,3}}]}},
- {0,{cast,[{var,3},close]}},
- {10,{call,[{var,3},get_data]}},
- {20,{call,[{var,1},get_exit]}}
- ],
+ Scenario = [{1,{spawn,[{var,drvname},undefined]}},
+ {2,{call,[{var,1},open_port]}},
+ {3,{spawn,[{var,2},{var,1}]}},
+ {0,{cast,[{var,1},unlink]}},
+ {0,{cast,[{var,1},{busy,1}]}},
+ {0,{cast,[{var,1},{command,2}]}},
+ {0,{cast,[{var,1},link]}},
+ {0,{timer,sleep,[1000]}},
+ {0,{ack,[{var,3},take_control]}},
+ {0,{cast,[{var,1},{new_owner,{var,3}}]}},
+ {0,{cast,[{var,3},close]}},
+ {10,{call,[{var,3},get_data]}},
+ {20,{call,[{var,1},get_exit]}}],
Validation = [{seq,10,[1]},
{seq,20,[{'EXIT',noproc}]}],
- port_scheduling(Scenario,Validation,?config(data_dir,Config)).
+ port_scheduling(Scenario,Validation,proplists:get_value(data_dir,Config)).
process_init(DrvName,Owner) ->
process_flag(trap_exit,true),
@@ -699,11 +640,11 @@ handle_msg(close,Port,Owner,_Data) ->
handle_msg(get_data,Port,_Owner,{[],_Exit}) ->
%% Wait for data if it has not arrived yet
receive
- {Port,{data,Data}} ->
- Data
+ {Port,{data,Data}} ->
+ Data
after 2000 ->
- pal("~p",[erlang:process_info(self())]),
- exit(did_not_get_port_data)
+ pal("~p",[erlang:process_info(self())]),
+ exit(did_not_get_port_data)
end;
handle_msg(get_data,_Port,Owner,{Data,Exit}) ->
pal("GetData",[]),
@@ -753,8 +694,7 @@ port_scheduling(Scenario,Validation,Path) ->
case erl_ddll:load_driver(Path, DrvName) of
ok -> ok;
{error, Error} ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- ?line ?t:fail()
+ ct:fail(erl_ddll:format_error(Error))
end,
Data = run_scenario(lists:flatten(Scenario),[{drvname,DrvName}]),
@@ -860,7 +800,7 @@ wait_for(Pids) ->
{'EXIT', Pid, normal} ->
wait_for(lists:delete(Pid, Pids));
Other ->
- test_server:fail({bad_exit, Other})
+ ct:fail({bad_exit, Other})
end.
fun_spawn(Fun) ->
@@ -896,39 +836,38 @@ fun_spawn(Fun, Args) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
load_busy_driver(Config) when is_list(Config) ->
- ?line DataDir = ?config(data_dir, Config),
- ?line erl_ddll:start(),
+ DataDir = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
case erl_ddll:load_driver(DataDir, "busy_drv") of
ok -> ok;
{error, Error} ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- ?line ?t:fail()
+ ct:fail(erl_ddll:format_error(Error))
end.
%%% Interface functions.
start_busy_driver(Config) when is_list(Config) ->
- ?line Pid = spawn_link(?MODULE, init, [Config, self()]),
- ?line receive
+ Pid = spawn_link(?MODULE, init, [Config, self()]),
+ receive
{Pid, started} ->
ok;
Other ->
- test_server:fail({unexpected_message, Other})
+ ct:fail({unexpected_message, Other})
end.
unlock_slave() ->
command(unlock).
get_slave() ->
- ?line command(get_slave).
+ command(get_slave).
%% Internal functions.
command(Msg) ->
- ?line whereis(busy_drv_server) ! {self(), Msg},
- ?line receive
- {busy_drv_reply, Reply} ->
- Reply
+ whereis(busy_drv_server) ! {self(), Msg},
+ receive
+ {busy_drv_reply, Reply} ->
+ Reply
end.
%%% Server.
diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl
index 064404a038..4ec18aa49e 100644
--- a/erts/emulator/test/call_trace_SUITE.erl
+++ b/erts/emulator/test/call_trace_SUITE.erl
@@ -21,66 +21,46 @@
-module(call_trace_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
- hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1,
- return_trace/1,exception_trace/1,on_load/1,deep_exception/1,
- upgrade/1,
- exception_nocatch/1,bit_syntax/1]).
+-export([all/0, suite/0,
+ init_per_testcase/2,end_per_testcase/2,
+ hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1,
+ return_trace/1,exception_trace/1,on_load/1,deep_exception/1,
+ upgrade/1,
+ exception_nocatch/1,bit_syntax/1]).
%% Helper functions.
-export([bar/0,foo/0,foo/1,foo/2,expect/1,worker_foo/1,pam_foo/2,nasty/0,
- id/1,deep/3,deep_1/3,deep_2/2,deep_3/2,deep_4/1,deep_5/1,
- bs_sum_a/2,bs_sum_b/2]).
+ id/1,deep/3,deep_1/3,deep_2/2,deep_3/2,deep_4/1,deep_5/1,
+ bs_sum_a/2,bs_sum_b/2]).
%% Debug
-export([abbr/1,abbr/2]).
-
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(P, 20).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 30}}].
all() ->
Common = [errors, on_load],
NotHipe = [process_specs, basic, flags, pam, change_pam,
- upgrade,
- return_trace, exception_trace, deep_exception,
- exception_nocatch, bit_syntax],
+ upgrade,
+ return_trace, exception_trace, deep_exception,
+ exception_nocatch, bit_syntax],
Hipe = [hipe],
case test_server:is_native(call_trace_SUITE) of
- true -> Hipe ++ Common;
- false -> NotHipe ++ Common
+ true -> Hipe ++ Common;
+ false -> NotHipe ++ Common
end.
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:seconds(30)),
- [{watchdog, Dog}|Config].
+ Config.
end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
-
%% Reloading the module will clear all trace patterns, and
%% in a debug-compiled emulator run assertions of the counters
%% for the number of traced exported functions in this module.
@@ -88,51 +68,49 @@ end_per_testcase(_Func, Config) ->
c:l(?MODULE).
hipe(Config) when is_list(Config) ->
- ?line 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true),
- ?line 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true, [local]),
- ?line AllFuncs = erlang:trace_pattern({'_','_','_'}, true),
+ 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true),
+ 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true, [local]),
+ AllFuncs = erlang:trace_pattern({'_','_','_'}, true),
%% Make sure that a traced, exported function can still be found.
- ?line true = erlang:function_exported(error_handler, undefined_function, 3),
- ?line AllFuncs = erlang:trace_pattern({'_','_','_'}, false),
+ true = erlang:function_exported(error_handler, undefined_function, 3),
+ AllFuncs = erlang:trace_pattern({'_','_','_'}, false),
ok.
-process_specs(doc) ->
- "Tests 'all', 'new', and 'existing' for specifying processes.";
-process_specs(suite) -> [];
+%% Tests 'all', 'new', and 'existing' for specifying processes.
process_specs(Config) when is_list(Config) ->
- ?line Tracer = start_tracer(),
- ?line {flags,[call]} = trace_info(self(), flags),
- ?line {tracer,Tracer} = trace_info(self(), tracer),
- ?line trace_func({?MODULE,worker_foo,1}, []),
+ Tracer = start_tracer(),
+ {flags,[call]} = trace_info(self(), flags),
+ {tracer,Tracer} = trace_info(self(), tracer),
+ trace_func({?MODULE,worker_foo,1}, []),
%% Test the 'new' flag.
- ?line {Work1A,Work1B} = start_and_trace(new, [1,2,3], A1B={3,2,1}),
+ {Work1A,Work1B} = start_and_trace(new, [1,2,3], A1B={3,2,1}),
{flags,[]} = trace_info(Work1A, flags),
{tracer,[]} = trace_info(Work1A, tracer),
{tracer,Tracer} = trace_info(Work1B, tracer),
{flags,[call]} = trace_info(Work1B, flags),
- ?line expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}),
- ?line unlink(Work1B),
- ?line Mref = erlang:monitor(process, Work1B),
- ?line exit(Work1B, kill),
+ expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}),
+ unlink(Work1B),
+ Mref = erlang:monitor(process, Work1B),
+ exit(Work1B, kill),
receive
- {'DOWN',Mref,_,_,_} -> ok
+ {'DOWN',Mref,_,_,_} -> ok
end,
- ?line undefined = trace_info(Work1B, flags),
- ?line {flags,[]} = trace_info(new, flags),
- ?line {tracer,[]} = trace_info(new, tracer),
+ undefined = trace_info(Work1B, flags),
+ {flags,[]} = trace_info(new, flags),
+ {tracer,[]} = trace_info(new, tracer),
%% Test the 'existing' flag.
- ?line {Work2A,_Work2B} = start_and_trace(existing, A2A=[5,6,7], [7,6,5]),
- ?line expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}),
+ {Work2A,_Work2B} = start_and_trace(existing, A2A=[5,6,7], [7,6,5]),
+ expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}),
%% Test the 'all' flag.
- ?line {Work3A,Work3B} = start_and_trace(all, A3A=[12,13], A3B=[13,12]),
- ?line expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}),
- ?line expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}),
-
+ {Work3A,Work3B} = start_and_trace(all, A3A=[12,13], A3B=[13,12]),
+ expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}),
+ expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}),
+
ok.
start_and_trace(Flag, A1, A2) ->
@@ -142,33 +120,33 @@ start_and_trace(Flag, A1, A2) ->
call_worker(W1, A1),
call_worker(W2, A2),
case Flag of
- new ->
- {flags,[call]} = trace_info(new, flags),
- {tracer,_} = trace_info(new, tracer);
- _Other ->
- ok
+ new ->
+ {flags,[call]} = trace_info(new, flags),
+ {tracer,_} = trace_info(new, tracer);
+ _Other ->
+ ok
end,
trace_pid(Flag, false, [call]),
{W1,W2}.
start_worker() ->
- ?line spawn(fun worker_loop/0).
+ spawn(fun worker_loop/0).
call_worker(Pid, Arg) ->
Pid ! {self(),{call,Arg}},
receive
- {result,Res} -> Res
+ {result,Res} -> Res
after 5000 ->
- ?line ?t:fail(no_answer_from_worker)
+ ct:fail(no_answer_from_worker)
end.
worker_loop() ->
receive
- {From,{call,Arg}} ->
- From ! {result,?MODULE:worker_foo(Arg)},
- worker_loop();
- Other ->
- exit({unexpected_message,Other})
+ {From,{call,Arg}} ->
+ From ! {result,?MODULE:worker_foo(Arg)},
+ worker_loop();
+ Other ->
+ exit({unexpected_message,Other})
end.
worker_foo(_Arg) ->
@@ -177,98 +155,98 @@ worker_foo(_Arg) ->
%% Basic test of the call tracing (we trace one process).
basic(_Config) ->
case test_server:is_native(lists) of
- true -> {skip,"lists is native"};
- false -> basic()
+ true -> {skip,"lists is native"};
+ false -> basic()
end.
basic() ->
- ?line start_tracer(),
- ?line trace_info(self(), flags),
- ?line trace_info(self(), tracer),
- ?line 0 = trace_func({?MODULE,no_such_function,0}, []),
- ?line {traced,undefined} =
- trace_info({?MODULE,no_such_function,0}, traced),
- ?line {match_spec, undefined} =
- trace_info({?MODULE,no_such_function,0}, match_spec),
+ start_tracer(),
+ trace_info(self(), flags),
+ trace_info(self(), tracer),
+ 0 = trace_func({?MODULE,no_such_function,0}, []),
+ {traced,undefined} =
+ trace_info({?MODULE,no_such_function,0}, traced),
+ {match_spec, undefined} =
+ trace_info({?MODULE,no_such_function,0}, match_spec),
%% Trace some functions...
- ?line trace_func({lists,'_','_'}, []),
+ trace_func({lists,'_','_'}, []),
%% Make sure that tracing the same functions more than once
%% does not cause any problems.
- ?line 3 = trace_func({?MODULE,foo,'_'}, true),
- ?line 3 = trace_func({?MODULE,foo,'_'}, true),
- ?line 1 = trace_func({?MODULE,bar,0}, true),
- ?line 1 = trace_func({?MODULE,bar,0}, true),
- ?line {traced,global} = trace_info({?MODULE,bar,0}, traced),
- ?line 1 = trace_func({erlang,list_to_integer,1}, true),
- ?line {traced,global} = trace_info({erlang,list_to_integer,1}, traced),
+ 3 = trace_func({?MODULE,foo,'_'}, true),
+ 3 = trace_func({?MODULE,foo,'_'}, true),
+ 1 = trace_func({?MODULE,bar,0}, true),
+ 1 = trace_func({?MODULE,bar,0}, true),
+ {traced,global} = trace_info({?MODULE,bar,0}, traced),
+ 1 = trace_func({erlang,list_to_integer,1}, true),
+ {traced,global} = trace_info({erlang,list_to_integer,1}, traced),
%% ... and call them...
- ?line AList = [x,y,z],
- ?line true = lists:member(y, AList),
- ?line foo0 = ?MODULE:foo(),
- ?line 4 = ?MODULE:foo(3),
- ?line 11 = ?MODULE:foo(7, 4),
- ?line ok = ?MODULE:bar(),
- ?line 42 = list_to_integer(non_literal("42")),
+ AList = [x,y,z],
+ true = lists:member(y, AList),
+ foo0 = ?MODULE:foo(),
+ 4 = ?MODULE:foo(3),
+ 11 = ?MODULE:foo(7, 4),
+ ok = ?MODULE:bar(),
+ 42 = list_to_integer(non_literal("42")),
%% ... make sure the we got trace messages (but not for ?MODULE:expect/1).
- ?line Self = self(),
- ?line ?MODULE:expect({trace,Self,call,{lists,member,[y,AList]}}),
- ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[]}}),
- ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[3]}}),
- ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[7,4]}}),
- ?line ?MODULE:expect({trace,Self,call,{?MODULE,bar,[]}}),
- ?line ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["42"]}}),
+ Self = self(),
+ ?MODULE:expect({trace,Self,call,{lists,member,[y,AList]}}),
+ ?MODULE:expect({trace,Self,call,{?MODULE,foo,[]}}),
+ ?MODULE:expect({trace,Self,call,{?MODULE,foo,[3]}}),
+ ?MODULE:expect({trace,Self,call,{?MODULE,foo,[7,4]}}),
+ ?MODULE:expect({trace,Self,call,{?MODULE,bar,[]}}),
+ ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["42"]}}),
%% Turn off trace for this module and call functions...
- ?line trace_func({?MODULE,'_','_'}, false),
- ?line {traced,false} = trace_info({?MODULE,bar,0}, traced),
- ?line foo0 = ?MODULE:foo(),
- ?line 4 = ?MODULE:foo(3),
- ?line 11 = ?MODULE:foo(7, 4),
- ?line ok = ?MODULE:bar(),
- ?line [1,2,3,4,5,6,7,8,9,10] = lists:seq(1, 10),
- ?line 777 = list_to_integer(non_literal("777")),
+ trace_func({?MODULE,'_','_'}, false),
+ {traced,false} = trace_info({?MODULE,bar,0}, traced),
+ foo0 = ?MODULE:foo(),
+ 4 = ?MODULE:foo(3),
+ 11 = ?MODULE:foo(7, 4),
+ ok = ?MODULE:bar(),
+ [1,2,3,4,5,6,7,8,9,10] = lists:seq(1, 10),
+ 777 = list_to_integer(non_literal("777")),
%% ... turn on all trace messages...
- ?line trace_func({'_','_','_'}, false),
- ?line [b,a] = lists:reverse([a,b]),
+ trace_func({'_','_','_'}, false),
+ [b,a] = lists:reverse([a,b]),
%% Read out the remaing trace messages.
- ?line ?MODULE:expect({trace,Self,call,{lists,seq,[1,10]}}),
- ?line ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["777"]}}),
+ ?MODULE:expect({trace,Self,call,{lists,seq,[1,10]}}),
+ ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["777"]}}),
receive
- Any ->
- ?line ?t:fail({unexpected_message,Any})
+ Any ->
+ ct:fail({unexpected_message,Any})
after 1 ->
- ok
+ ok
end,
%% Turn on and then off tracing on all external functions.
%% This might cause the emulator to crasch later if it doesn't
%% restore all export entries properly.
- ?line AllFuncs = trace_func({'_','_','_'}, true),
+ AllFuncs = trace_func({'_','_','_'}, true),
io:format("AllFuncs = ~p", [AllFuncs]),
%% Make sure that a traced, exported function can still be found.
- ?line true = erlang:function_exported(error_handler, undefined_function, 3),
- ?line AllFuncs = trace_func({'_','_','_'}, false),
- ?line erlang:trace_delivered(all),
+ true = erlang:function_exported(error_handler, undefined_function, 3),
+ AllFuncs = trace_func({'_','_','_'}, false),
+ erlang:trace_delivered(all),
receive
- {trace_delivered,_,_} -> ok
+ {trace_delivered,_,_} -> ok
end,
c:flush(), % Print the traces messages.
c:flush(), % Print the traces messages.
- ?line {traced,false} = trace_info({erlang,list_to_integer,1}, traced),
+ {traced,false} = trace_info({erlang,list_to_integer,1}, traced),
ok.
@@ -287,8 +265,8 @@ foo(X, Y) -> X+Y.
%% This test case was written to verify that we do not change
%% any behaviour with the introduction of "block-free" upgrade in R16.
%% In short: Do not refer to this test case as an authority of how it must work.
-upgrade(doc) ->
- "Test tracing on module being upgraded";
+
+%% Test tracing on module being upgraded
upgrade(Config) when is_list(Config) ->
V1 = compile_version(my_upgrade_test, 1, Config),
V2 = compile_version(my_upgrade_test, 2, Config),
@@ -304,8 +282,8 @@ upgrade_do(V1, V2, TraceLocalVersion) ->
trace_func({my_upgrade_test,'_','_'}, [], [global]),
case TraceLocalVersion of
- true -> trace_func({my_upgrade_test,local_version,0}, [], [local]);
- _ -> ok
+ true -> trace_func({my_upgrade_test,local_version,0}, [], [local]);
+ _ -> ok
end,
1 = my_upgrade_test:version(),
1 = my_upgrade_test:do_local(),
@@ -320,15 +298,15 @@ upgrade_do(V1, V2, TraceLocalVersion) ->
expect({trace,Self,call,{my_upgrade_test,do_local,[]}}),
expect({trace,Self,call,{my_upgrade_test,do_real_local,[]}}),
case TraceLocalVersion of
- true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}});
- _ -> ok
+ true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}});
+ _ -> ok
end,
expect({trace,Self,call,{my_upgrade_test,make_fun_exp,[]}}),
expect({trace,Self,call,{my_upgrade_test,make_fun_local,[]}}),
expect({trace,Self,call,{my_upgrade_test,version,[]}}), % F1_exp
case TraceLocalVersion of
- true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F1_loc
- _ -> ok
+ true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F1_loc
+ _ -> ok
end,
{module,my_upgrade_test} = erlang:load_module(my_upgrade_test, V2),
@@ -350,8 +328,8 @@ upgrade_do(V1, V2, TraceLocalVersion) ->
trace_func({my_upgrade_test,'_','_'}, [], [global]),
case TraceLocalVersion of
- true -> trace_func({my_upgrade_test,local_version,0}, [], [local]);
- _ -> ok
+ true -> trace_func({my_upgrade_test,local_version,0}, [], [local]);
+ _ -> ok
end,
2 = my_upgrade_test:version(),
2 = my_upgrade_test:do_local(),
@@ -363,13 +341,13 @@ upgrade_do(V1, V2, TraceLocalVersion) ->
expect({trace,Self,call,{my_upgrade_test,do_local,[]}}),
expect({trace,Self,call,{my_upgrade_test,do_real_local,[]}}),
case TraceLocalVersion of
- true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}});
- _ -> ok
+ true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}});
+ _ -> ok
end,
expect({trace,Self,call,{my_upgrade_test,version,[]}}), % F2_exp
case TraceLocalVersion of
- true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F2_loc
- _ -> ok
+ true -> expect({trace,Self,call,{my_upgrade_test,local_version,[]}}); % F2_loc
+ _ -> ok
end,
true = erlang:delete_module(my_upgrade_test),
@@ -385,10 +363,10 @@ upgrade_do(V1, V2, TraceLocalVersion) ->
ok.
compile_version(Module, Version, Config) ->
- Data = ?config(data_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
File = filename:join(Data, atom_to_list(Module)),
{ok,Module,Bin} = compile:file(File, [{d,'VERSION',Version},
- binary,report]),
+ binary,report]),
Bin.
@@ -397,162 +375,157 @@ compile_version(Module, Version, Config) ->
%% Also, test the '{tracer,Pid}' option.
flags(_Config) ->
case test_server:is_native(filename) of
- true -> {skip,"filename is native"};
- false -> flags()
+ true -> {skip,"filename is native"};
+ false -> flags()
end.
flags() ->
- ?line Tracer = start_tracer_loop(),
- ?line trace_pid(self(), true, [call,{tracer,Tracer}]),
+ Tracer = start_tracer_loop(),
+ trace_pid(self(), true, [call,{tracer,Tracer}]),
%% Trace some functions...
- ?line trace_func({filename,'_','_'}, true),
+ trace_func({filename,'_','_'}, true),
%% ... and call them...
- ?line Self = self(),
- ?line filename:absname("nisse"),
- ?line ?MODULE:expect({trace,Self,call,{filename,absname,["nisse"]}}),
- ?line trace_pid(Self, true, [call,arity]),
- ?line filename:absname("kalle"),
- ?line filename:absname("kalle", "/root"),
- ?line ?MODULE:expect({trace,Self,call,{filename,absname,1}}),
- ?line ?MODULE:expect({trace,Self,call,{filename,absname,2}}),
- ?line trace_info(Self, flags),
+ Self = self(),
+ filename:absname("nisse"),
+ ?MODULE:expect({trace,Self,call,{filename,absname,["nisse"]}}),
+ trace_pid(Self, true, [call,arity]),
+ filename:absname("kalle"),
+ filename:absname("kalle", "/root"),
+ ?MODULE:expect({trace,Self,call,{filename,absname,1}}),
+ ?MODULE:expect({trace,Self,call,{filename,absname,2}}),
+ trace_info(Self, flags),
%% Timestamp + arity.
flag_test(fun() ->
- ?line trace_pid(Self, true, [timestamp]),
- ?line "dum" = filename:basename("/abcd/dum"),
- ?line Ts = expect({trace_ts,Self,call,{filename,basename,1},ts}),
- ?line trace_info(Self, flags),
- Ts
- end),
+ trace_pid(Self, true, [timestamp]),
+ "dum" = filename:basename("/abcd/dum"),
+ Ts = expect({trace_ts,Self,call,{filename,basename,1},ts}),
+ trace_info(Self, flags),
+ Ts
+ end),
%% Timestamp.
- ?line AnArg = "/abcd/hejsan",
+ AnArg = "/abcd/hejsan",
flag_test(fun() ->
- ?line trace_pid(Self, false, [arity]),
- ?line "hejsan" = filename:basename(AnArg),
- ?line Ts = expect({trace_ts,Self,call,
- {filename,basename,[AnArg]},ts}),
- ?line trace_info(Self, flags),
- Ts
- end),
+ trace_pid(Self, false, [arity]),
+ "hejsan" = filename:basename(AnArg),
+ Ts = expect({trace_ts,Self,call,
+ {filename,basename,[AnArg]},ts}),
+ trace_info(Self, flags),
+ Ts
+ end),
%% All flags turned off.
- ?line trace_pid(Self, false, [timestamp]),
- ?line AnotherArg = filename:join(AnArg, "hoppsan"),
- ?line "hoppsan" = filename:basename(AnotherArg),
- ?line expect({trace,Self,call,{filename,join,[AnArg,"hoppsan"]}}),
- ?line expect({trace,Self,call,{filename,basename,[AnotherArg]}}),
- ?line trace_info(Self, flags),
-
+ trace_pid(Self, false, [timestamp]),
+ AnotherArg = filename:join(AnArg, "hoppsan"),
+ "hoppsan" = filename:basename(AnotherArg),
+ expect({trace,Self,call,{filename,join,[AnArg,"hoppsan"]}}),
+ expect({trace,Self,call,{filename,basename,[AnotherArg]}}),
+ trace_info(Self, flags),
+
ok.
flag_test(Test) ->
Now = now(),
Ts = Test(),
case timer:now_diff(Ts, Now) of
- Time when Time < 5*1000000 ->
- %% Reasonable short time.
- ok;
- _Diff ->
- %% Too large difference.
- io:format("Now = ~p\n", [Now]),
- io:format("Ts = ~p\n", [Ts]),
- ?line ?t:fail()
+ Time when Time < 5*1000000 ->
+ %% Reasonable short time.
+ ok;
+ _Diff ->
+ %% Too large difference.
+ ct:fail("Now = ~p, Ts = ~p", [Now, Ts])
end,
flag_test_cpu_timestamp(Test).
flag_test_cpu_timestamp(Test) ->
try erlang:trace(all, true, [cpu_timestamp]) of
- _ ->
- io:format("CPU timestamps"),
- Ts = Test(),
- erlang:trace(all, false, [cpu_timestamp]),
- Origin = {0,0,0},
- Hour = 3600*1000000,
- case timer:now_diff(Ts, Origin) of
- Diff when Diff < 4*Hour ->
- %% In the worst case, CPU timestamps count from when this
- %% Erlang emulator was started. The above test is a conservative
- %% test that all CPU timestamps should pass.
- ok;
- _Time ->
- io:format("Strange CPU timestamp: ~p", [Ts]),
- ?line ?t:fail()
- end,
- io:format("Turned off CPU timestamps")
+ _ ->
+ io:format("CPU timestamps"),
+ Ts = Test(),
+ erlang:trace(all, false, [cpu_timestamp]),
+ Origin = {0,0,0},
+ Hour = 3600*1000000,
+ case timer:now_diff(Ts, Origin) of
+ Diff when Diff < 4*Hour ->
+ %% In the worst case, CPU timestamps count from when this
+ %% Erlang emulator was started. The above test is a conservative
+ %% test that all CPU timestamps should pass.
+ ok;
+ _Time ->
+ ct:fail("Strange CPU timestamp: ~p", [Ts])
+ end,
+ io:format("Turned off CPU timestamps")
catch
- error:badarg -> ok
+ error:badarg -> ok
end.
-errors(doc) -> "Test bad arguments for trace/3 and trace_pattern/3.";
-errors(suite) -> [];
+%% Test bad arguments for trace/3 and trace_pattern/3.
errors(Config) when is_list(Config) ->
- ?line expect_badarg_pid(aaa, true, []),
- ?line expect_badarg_pid({pid,dum}, false, []),
- ?line expect_badarg_func({'_','_',1}, []),
- ?line expect_badarg_func({'_',gosh,1}, []),
- ?line expect_badarg_func({xxx,'_',2}, []),
- ?line expect_badarg_func({xxx,yyy,b}, glurp),
+ expect_badarg_pid(aaa, true, []),
+ expect_badarg_pid({pid,dum}, false, []),
+ expect_badarg_func({'_','_',1}, []),
+ expect_badarg_func({'_',gosh,1}, []),
+ expect_badarg_func({xxx,'_',2}, []),
+ expect_badarg_func({xxx,yyy,b}, glurp),
ok.
expect_badarg_pid(What, How, Flags) ->
case catch erlang:trace(What, How, Flags) of
- {'EXIT',{badarg,Where}} ->
- io:format("trace(~p, ~p, ~p) ->\n {'EXIT',{badarg,~p}}",
- [What,How,Flags,Where]),
- ok;
- Other ->
- io:format("trace(~p, ~p, ~p) -> ~p",
- [What,How,Flags,Other]),
- ?t:fail({unexpected,Other})
+ {'EXIT',{badarg,Where}} ->
+ io:format("trace(~p, ~p, ~p) ->\n {'EXIT',{badarg,~p}}",
+ [What,How,Flags,Where]),
+ ok;
+ Other ->
+ io:format("trace(~p, ~p, ~p) -> ~p",
+ [What,How,Flags,Other]),
+ ct:fail({unexpected,Other})
end.
expect_badarg_func(MFA, Pattern) ->
case catch erlang:trace_pattern(MFA, Pattern) of
- {'EXIT',{badarg,Where}} ->
- io:format("trace_pattern(~p, ~p) ->\n {'EXIT',{badarg,~p}}",
- [MFA,Pattern,Where]),
- ok;
- Other ->
- io:format("trace_pattern(~p, ~p) -> ~p",
- [MFA, Pattern, Other]),
- ?t:fail({unexpected,Other})
+ {'EXIT',{badarg,Where}} ->
+ io:format("trace_pattern(~p, ~p) ->\n {'EXIT',{badarg,~p}}",
+ [MFA,Pattern,Where]),
+ ok;
+ Other ->
+ io:format("trace_pattern(~p, ~p) -> ~p",
+ [MFA, Pattern, Other]),
+ ct:fail({unexpected,Other})
end.
-pam(doc) -> "Basic test of PAM.";
-pam(suite) -> [];
+%% Basic test of PAM.
pam(Config) when is_list(Config) ->
- ?line start_tracer(),
- ?line Self = self(),
+ start_tracer(),
+ Self = self(),
%% Build the match program.
- ?line Prog1 = {[{a,tuple},'$1'],[],[]},
- ?line Prog2 = {[{a,bigger,tuple},'$1'],[],[{message,'$1'}]},
- ?line MatchProg = [Prog1,Prog2],
- ?line pam_trace(MatchProg),
+ Prog1 = {[{a,tuple},'$1'],[],[]},
+ Prog2 = {[{a,bigger,tuple},'$1'],[],[{message,'$1'}]},
+ MatchProg = [Prog1,Prog2],
+ pam_trace(MatchProg),
%% Do some calls.
- ?line ?MODULE:pam_foo(not_a_tuple, [a,b]),
- ?line ?MODULE:pam_foo({a,tuple}, [a,list]),
- ?line ?MODULE:pam_foo([this,one,will,'not',match], dummy_arg),
- ?line LongList = lists:seq(1,10),
- ?line ?MODULE:pam_foo({a,bigger,tuple}, LongList),
+ ?MODULE:pam_foo(not_a_tuple, [a,b]),
+ ?MODULE:pam_foo({a,tuple}, [a,list]),
+ ?MODULE:pam_foo([this,one,will,'not',match], dummy_arg),
+ LongList = lists:seq(1,10),
+ ?MODULE:pam_foo({a,bigger,tuple}, LongList),
%% Check that we get the correct trace messages.
- ?line expect({trace,Self,call,{?MODULE,pam_foo,[{a,tuple},[a,list]]}}),
- ?line expect({trace,Self,call,
- {?MODULE,pam_foo,[{a,bigger,tuple},LongList]},
- LongList}),
+ expect({trace,Self,call,{?MODULE,pam_foo,[{a,tuple},[a,list]]}}),
+ expect({trace,Self,call,
+ {?MODULE,pam_foo,[{a,bigger,tuple},LongList]},
+ LongList}),
- ?line trace_func({?MODULE,pam_foo,'_'}, false),
+ trace_func({?MODULE,pam_foo,'_'}, false),
ok.
pam_trace(Prog) ->
@@ -567,38 +540,38 @@ pam_foo(A, B) ->
%% Test changing PAM programs for a function.
change_pam(_Config) ->
case test_server:is_native(lists) of
- true -> {skip,"lists is native"};
- false -> change_pam()
+ true -> {skip,"lists is native"};
+ false -> change_pam()
end.
change_pam() ->
- ?line start_tracer(),
- ?line Self = self(),
+ start_tracer(),
+ Self = self(),
%% Install the first match program.
%% Test using timestamp at the same time.
- ?line trace_pid(Self, true, [call,arity,timestamp]),
- ?line Prog1 = [{['$1','$2'],[],[{message,'$1'}]}],
- ?line change_pam_trace(Prog1),
- ?line [x,y] = lists:append(id([x]), id([y])),
- ?line {heap_size,_} = erlang:process_info(Self, heap_size),
- ?line expect({trace_ts,Self,call,{lists,append,2},[x],ts}),
- ?line expect({trace_ts,Self,call,{erlang,process_info,2},Self,ts}),
+ trace_pid(Self, true, [call,arity,timestamp]),
+ Prog1 = [{['$1','$2'],[],[{message,'$1'}]}],
+ change_pam_trace(Prog1),
+ [x,y] = lists:append(id([x]), id([y])),
+ {heap_size,_} = erlang:process_info(Self, heap_size),
+ expect({trace_ts,Self,call,{lists,append,2},[x],ts}),
+ expect({trace_ts,Self,call,{erlang,process_info,2},Self,ts}),
%% Install a new PAM program.
- ?line Prog2 = [{['$1','$2'],[],[{message,'$2'}]}],
- ?line change_pam_trace(Prog2),
- ?line [xx,yy] = lists:append(id([xx]), id([yy])),
- ?line {current_function,_} = erlang:process_info(Self, current_function),
- ?line expect({trace_ts,Self,call,{lists,append,2},[yy],ts}),
- ?line expect({trace_ts,Self,call,{erlang,process_info,2},current_function,ts}),
+ Prog2 = [{['$1','$2'],[],[{message,'$2'}]}],
+ change_pam_trace(Prog2),
+ [xx,yy] = lists:append(id([xx]), id([yy])),
+ {current_function,_} = erlang:process_info(Self, current_function),
+ expect({trace_ts,Self,call,{lists,append,2},[yy],ts}),
+ expect({trace_ts,Self,call,{erlang,process_info,2},current_function,ts}),
- ?line 1 = trace_func({lists,append,2}, false),
- ?line 1 = trace_func({erlang,process_info,2}, false),
- ?line {match_spec,false} = trace_info({lists,append,2}, match_spec),
- ?line {match_spec,false} = trace_info({erlang,process_info,2}, match_spec),
+ 1 = trace_func({lists,append,2}, false),
+ 1 = trace_func({erlang,process_info,2}, false),
+ {match_spec,false} = trace_info({lists,append,2}, match_spec),
+ {match_spec,false} = trace_info({erlang,process_info,2}, match_spec),
ok.
@@ -611,71 +584,71 @@ change_pam_trace(Prog) ->
return_trace(_Config) ->
case test_server:is_native(lists) of
- true -> {skip,"lists is native"};
- false -> return_trace()
+ true -> {skip,"lists is native"};
+ false -> return_trace()
end.
return_trace() ->
X = {save,me},
- ?line start_tracer(),
- ?line Self = self(),
+ start_tracer(),
+ Self = self(),
%% Test call and return trace and timestamp.
- ?line trace_pid(Self, true, [call,timestamp]),
+ trace_pid(Self, true, [call,timestamp]),
Stupid = {pointless,tuple},
- ?line Prog1 = [{['$1','$2'],[],[{return_trace},{message,{Stupid}}]}],
- ?line 1 = trace_func({lists,append,2}, Prog1),
- ?line 1 = trace_func({erlang,process_info,2}, Prog1),
- ?line {match_spec,Prog1} = trace_info({lists,append,2}, match_spec),
- ?line {match_spec,Prog1} = trace_info({erlang,process_info,2}, match_spec),
+ Prog1 = [{['$1','$2'],[],[{return_trace},{message,{Stupid}}]}],
+ 1 = trace_func({lists,append,2}, Prog1),
+ 1 = trace_func({erlang,process_info,2}, Prog1),
+ {match_spec,Prog1} = trace_info({lists,append,2}, match_spec),
+ {match_spec,Prog1} = trace_info({erlang,process_info,2}, match_spec),
- ?line [x,y] = lists:append(id([x]), id([y])),
+ [x,y] = lists:append(id([x]), id([y])),
Current = {current_function,{?MODULE,return_trace,0}},
- ?line Current = erlang:process_info(Self, current_function),
- ?line expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}),
- ?line expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}),
- ?line expect({trace_ts,Self,call,{erlang,process_info,[Self,current_function]},
- Stupid,ts}),
- ?line expect({trace_ts,Self,return_from,{erlang,process_info,2},Current,ts}),
+ Current = erlang:process_info(Self, current_function),
+ expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}),
+ expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}),
+ expect({trace_ts,Self,call,{erlang,process_info,[Self,current_function]},
+ Stupid,ts}),
+ expect({trace_ts,Self,return_from,{erlang,process_info,2},Current,ts}),
%% Try catch/exit.
- ?line 1 = trace_func({?MODULE,nasty,0}, [{[],[],[{return_trace},{message,false}]}]),
- ?line {'EXIT',good_bye} = (catch ?MODULE:nasty()),
- ?line 1 = trace_func({?MODULE,nasty,0}, false),
+ 1 = trace_func({?MODULE,nasty,0}, [{[],[],[{return_trace},{message,false}]}]),
+ {'EXIT',good_bye} = (catch ?MODULE:nasty()),
+ 1 = trace_func({?MODULE,nasty,0}, false),
%% Turn off trace.
- ?line 1 = trace_func({lists,append,2}, false),
- ?line 1 = trace_func({erlang,process_info,2}, false),
- ?line {match_spec,false} = trace_info({lists,append,2}, match_spec),
- ?line {match_spec,false} = trace_info({erlang,process_info,2}, match_spec),
+ 1 = trace_func({lists,append,2}, false),
+ 1 = trace_func({erlang,process_info,2}, false),
+ {match_spec,false} = trace_info({lists,append,2}, match_spec),
+ {match_spec,false} = trace_info({erlang,process_info,2}, match_spec),
%% No timestamp, no trace message for call.
- ?line trace_pid(Self, false, [timestamp]),
- ?line Prog2 = [{['$1','$2'],[],[{return_trace},{message,false}]},
- {['$1'],[],[{return_trace},{message,false}]}],
- ?line 1 = trace_func({lists,seq,2}, Prog2),
- ?line 1 = trace_func({erlang,atom_to_list,1}, Prog2),
- ?line {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec),
- ?line {match_spec,Prog2} = trace_info({erlang,atom_to_list,1}, match_spec),
+ trace_pid(Self, false, [timestamp]),
+ Prog2 = [{['$1','$2'],[],[{return_trace},{message,false}]},
+ {['$1'],[],[{return_trace},{message,false}]}],
+ 1 = trace_func({lists,seq,2}, Prog2),
+ 1 = trace_func({erlang,atom_to_list,1}, Prog2),
+ {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec),
+ {match_spec,Prog2} = trace_info({erlang,atom_to_list,1}, match_spec),
- ?line lists:seq(2, 7),
- ?line _ = atom_to_list(non_literal(nisse)),
- ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}),
- ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}),
+ lists:seq(2, 7),
+ _ = atom_to_list(non_literal(nisse)),
+ expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}),
+ expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}),
%% Turn off trace.
- ?line 1 = trace_func({lists,seq,2}, false),
- ?line 1 = trace_func({erlang,atom_to_list,1}, false),
- ?line {match_spec,false} = trace_info({lists,seq,2}, match_spec),
- ?line {match_spec,false} = trace_info({erlang,atom_to_list,1}, match_spec),
+ 1 = trace_func({lists,seq,2}, false),
+ 1 = trace_func({erlang,atom_to_list,1}, false),
+ {match_spec,false} = trace_info({lists,seq,2}, match_spec),
+ {match_spec,false} = trace_info({erlang,atom_to_list,1}, match_spec),
+
+ {save,me} = X,
- ?line {save,me} = X,
-
ok.
nasty() ->
@@ -683,396 +656,393 @@ nasty() ->
exception_trace(_Config) ->
case test_server:is_native(lists) of
- true -> {skip,"lists is native"};
- false -> exception_trace()
+ true -> {skip,"lists is native"};
+ false -> exception_trace()
end.
exception_trace() ->
X = {save,me},
- ?line start_tracer(),
- ?line Self = self(),
+ start_tracer(),
+ Self = self(),
%% Test call and return trace and timestamp.
- ?line trace_pid(Self, true, [call,timestamp]),
+ trace_pid(Self, true, [call,timestamp]),
Stupid = {pointless,tuple},
- ?line Prog1 = [{['$1','$2'],[],[{exception_trace},{message,{Stupid}}]}],
- ?line 1 = trace_func({lists,append,2}, Prog1),
- ?line 1 = trace_func({erlang,process_info,2}, Prog1),
- ?line {match_spec,Prog1} = trace_info({lists,append,2}, match_spec),
- ?line {match_spec,Prog1} =
- trace_info({erlang,process_info,2}, match_spec),
-
- ?line [x,y] = lists:append(id([x]), id([y])),
+ Prog1 = [{['$1','$2'],[],[{exception_trace},{message,{Stupid}}]}],
+ 1 = trace_func({lists,append,2}, Prog1),
+ 1 = trace_func({erlang,process_info,2}, Prog1),
+ {match_spec,Prog1} = trace_info({lists,append,2}, match_spec),
+ {match_spec,Prog1} =
+ trace_info({erlang,process_info,2}, match_spec),
+
+ [x,y] = lists:append(id([x]), id([y])),
Current = {current_function,{?MODULE,exception_trace,0}},
- ?line Current = erlang:process_info(Self, current_function),
- ?line expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}),
- ?line expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}),
- ?line expect({trace_ts,Self,call,{erlang,process_info,
- [Self,current_function]},
- Stupid,ts}),
- ?line expect({trace_ts,Self,return_from,
- {erlang,process_info,2},Current,ts}),
+ Current = erlang:process_info(Self, current_function),
+ expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}),
+ expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}),
+ expect({trace_ts,Self,call,{erlang,process_info,
+ [Self,current_function]},
+ Stupid,ts}),
+ expect({trace_ts,Self,return_from,
+ {erlang,process_info,2},Current,ts}),
%% Try catch/exit.
- ?line 1 = trace_func({?MODULE,nasty,0},
- [{[],[],[{exception_trace},{message,false}]}]),
- ?line {'EXIT',good_bye} = (catch ?MODULE:nasty()),
- ?line expect({trace_ts,Self,exception_from,
- {?MODULE,nasty,0},{exit,good_bye},ts}),
- ?line 1 = trace_func({?MODULE,nasty,0}, false),
+ 1 = trace_func({?MODULE,nasty,0},
+ [{[],[],[{exception_trace},{message,false}]}]),
+ {'EXIT',good_bye} = (catch ?MODULE:nasty()),
+ expect({trace_ts,Self,exception_from,
+ {?MODULE,nasty,0},{exit,good_bye},ts}),
+ 1 = trace_func({?MODULE,nasty,0}, false),
%% Turn off trace.
- ?line 1 = trace_func({lists,append,2}, false),
- ?line 1 = trace_func({erlang,process_info,2}, false),
- ?line {match_spec,false} = trace_info({lists,append,2}, match_spec),
- ?line {match_spec,false} =
- trace_info({erlang,process_info,2}, match_spec),
+ 1 = trace_func({lists,append,2}, false),
+ 1 = trace_func({erlang,process_info,2}, false),
+ {match_spec,false} = trace_info({lists,append,2}, match_spec),
+ {match_spec,false} =
+ trace_info({erlang,process_info,2}, match_spec),
%% No timestamp, no trace message for call.
- ?line trace_pid(Self, false, [timestamp]),
- ?line Prog2 = [{['$1','$2'],[],[{exception_trace},{message,false}]},
- {['$1'],[],[{exception_trace},{message,false}]}],
- ?line 1 = trace_func({lists,seq,2}, Prog2),
- ?line 1 = trace_func({erlang,atom_to_list,1}, Prog2),
- ?line {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec),
- ?line {match_spec,Prog2} =
- trace_info({erlang,atom_to_list,1}, match_spec),
+ trace_pid(Self, false, [timestamp]),
+ Prog2 = [{['$1','$2'],[],[{exception_trace},{message,false}]},
+ {['$1'],[],[{exception_trace},{message,false}]}],
+ 1 = trace_func({lists,seq,2}, Prog2),
+ 1 = trace_func({erlang,atom_to_list,1}, Prog2),
+ {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec),
+ {match_spec,Prog2} =
+ trace_info({erlang,atom_to_list,1}, match_spec),
- ?line lists:seq(2, 7),
- ?line _ = atom_to_list(non_literal(nisse)),
- ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}),
- ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}),
+ lists:seq(2, 7),
+ _ = atom_to_list(non_literal(nisse)),
+ expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}),
+ expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}),
%% Turn off trace.
- ?line 1 = trace_func({lists,seq,2}, false),
- ?line 1 = trace_func({erlang,atom_to_list,1}, false),
- ?line {match_spec,false} = trace_info({lists,seq,2}, match_spec),
- ?line {match_spec,false} =
- trace_info({erlang,atom_to_list,1}, match_spec),
+ 1 = trace_func({lists,seq,2}, false),
+ 1 = trace_func({erlang,atom_to_list,1}, false),
+ {match_spec,false} = trace_info({lists,seq,2}, match_spec),
+ {match_spec,false} =
+ trace_info({erlang,atom_to_list,1}, match_spec),
- ?line expect(),
- ?line {save,me} = X,
+ expect(),
+ {save,me} = X,
ok.
-on_load(doc) -> "Test the on_load argument for trace_pattern/3.";
-on_load(suite) -> [];
+%% Test the on_load argument for trace_pattern/3.
on_load(Config) when is_list(Config) ->
- ?line 0 = erlang:trace_pattern(on_load, []),
- ?line {traced,global} = erlang:trace_info(on_load, traced),
- ?line {match_spec,[]} = erlang:trace_info(on_load, match_spec),
+ 0 = erlang:trace_pattern(on_load, []),
+ {traced,global} = erlang:trace_info(on_load, traced),
+ {match_spec,[]} = erlang:trace_info(on_load, match_spec),
- ?line 0 = erlang:trace_pattern(on_load, true, [local]),
- ?line {traced,local} = erlang:trace_info(on_load, traced),
- ?line {match_spec,[]} = erlang:trace_info(on_load, match_spec),
+ 0 = erlang:trace_pattern(on_load, true, [local]),
+ {traced,local} = erlang:trace_info(on_load, traced),
+ {match_spec,[]} = erlang:trace_info(on_load, match_spec),
- ?line 0 = erlang:trace_pattern(on_load, false, [local]),
- ?line {traced,false} = erlang:trace_info(on_load, traced),
- ?line {match_spec,false} = erlang:trace_info(on_load, match_spec),
+ 0 = erlang:trace_pattern(on_load, false, [local]),
+ {traced,false} = erlang:trace_info(on_load, traced),
+ {match_spec,false} = erlang:trace_info(on_load, match_spec),
- ?line Pam1 = [{[],[],[{message,false}]}],
- ?line 0 = erlang:trace_pattern(on_load, Pam1),
- ?line {traced,global} = erlang:trace_info(on_load, traced),
- ?line {match_spec,Pam1} = erlang:trace_info(on_load, match_spec),
+ Pam1 = [{[],[],[{message,false}]}],
+ 0 = erlang:trace_pattern(on_load, Pam1),
+ {traced,global} = erlang:trace_info(on_load, traced),
+ {match_spec,Pam1} = erlang:trace_info(on_load, match_spec),
- ?line 0 = erlang:trace_pattern(on_load, true, [local]),
- ?line 0 = erlang:trace_pattern(on_load, false, [local]),
+ 0 = erlang:trace_pattern(on_load, true, [local]),
+ 0 = erlang:trace_pattern(on_load, false, [local]),
ok.
-deep_exception(doc) -> "Test the new exception trace.";
-deep_exception(suite) -> [];
+%% Test the new exception trace.
deep_exception(Config) when is_list(Config) ->
deep_exception().
deep_exception() ->
- ?line start_tracer(),
- ?line Self = self(),
- ?line N = 200000,
- ?line LongImproperList = seq(1, N-1, N),
-
+ start_tracer(),
+ Self = self(),
+ N = 200000,
+ LongImproperList = seq(1, N-1, N),
+
Prog = [{'_',[],[{exception_trace}]}],
-%% ?line 1 = trace_pid(Self, true, [call]),
- ?line 1 = trace_func({?MODULE,deep,'_'}, Prog),
- ?line 1 = trace_func({?MODULE,deep_1,'_'}, Prog),
- ?line 1 = trace_func({?MODULE,deep_2,'_'}, Prog),
- ?line 1 = trace_func({?MODULE,deep_3,'_'}, Prog),
- ?line 1 = trace_func({?MODULE,deep_4,'_'}, Prog),
- ?line 1 = trace_func({?MODULE,deep_5,'_'}, Prog),
- ?line 1 = trace_func({?MODULE,id,'_'}, Prog),
- ?line 1 = trace_func({erlang,'++','_'}, Prog),
- ?line 1 = trace_func({erlang,exit,1}, Prog),
- ?line 1 = trace_func({erlang,throw,1}, Prog),
- ?line 2 = trace_func({erlang,error,'_'}, Prog),
- ?line 1 = trace_func({lists,reverse,2}, Prog),
-
- ?line deep_exception(?LINE, exit, [paprika], 1,
- [{trace,Self,call,{erlang,exit,[paprika]}},
- {trace,Self,exception_from,{erlang,exit,1},
- {exit,paprika}}],
- exception_from, {exit,paprika}),
- ?line deep_exception(?LINE, throw, [3.14], 2,
- [{trace,Self,call,{erlang,throw,[3.14]}},
- {trace,Self,exception_from,{erlang,throw,1},
- {throw,3.14}}],
- exception_from, {throw,3.14}),
- ?line deep_exception(?LINE, error, [{paprika}], 3,
- [{trace,Self,call,{erlang,error,[{paprika}]}},
- {trace,Self,exception_from,{erlang,error,1},
- {error,{paprika}}}],
- exception_from, {error,{paprika}}),
- ?line deep_exception(?LINE, error, ["{paprika}",[]], 3,
- [{trace,Self,call,{erlang,error,["{paprika}",[]]}},
- {trace,Self,exception_from,{erlang,error,2},
- {error,"{paprika}"}}],
- exception_from, {error,"{paprika}"}),
- ?line deep_exception(?LINE, id, [broccoli], 4, [],
- return_from, broccoli),
- ?line deep_exception(
- ?LINE, append, [1,2], 5,
- [{trace,Self,call,{erlang,'++',[1,2]}},
- {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}],
- exception_from, {error,badarg}),
- ?line deep_exception(?LINE, '=', [1,2], 6, [],
- exception_from, {error,{badmatch,2}}),
+ %% 1 = trace_pid(Self, true, [call]),
+ 1 = trace_func({?MODULE,deep,'_'}, Prog),
+ 1 = trace_func({?MODULE,deep_1,'_'}, Prog),
+ 1 = trace_func({?MODULE,deep_2,'_'}, Prog),
+ 1 = trace_func({?MODULE,deep_3,'_'}, Prog),
+ 1 = trace_func({?MODULE,deep_4,'_'}, Prog),
+ 1 = trace_func({?MODULE,deep_5,'_'}, Prog),
+ 1 = trace_func({?MODULE,id,'_'}, Prog),
+ 1 = trace_func({erlang,'++','_'}, Prog),
+ 1 = trace_func({erlang,exit,1}, Prog),
+ 1 = trace_func({erlang,throw,1}, Prog),
+ 2 = trace_func({erlang,error,'_'}, Prog),
+ 1 = trace_func({lists,reverse,2}, Prog),
+
+ deep_exception(?LINE, exit, [paprika], 1,
+ [{trace,Self,call,{erlang,exit,[paprika]}},
+ {trace,Self,exception_from,{erlang,exit,1},
+ {exit,paprika}}],
+ exception_from, {exit,paprika}),
+ deep_exception(?LINE, throw, [3.14], 2,
+ [{trace,Self,call,{erlang,throw,[3.14]}},
+ {trace,Self,exception_from,{erlang,throw,1},
+ {throw,3.14}}],
+ exception_from, {throw,3.14}),
+ deep_exception(?LINE, error, [{paprika}], 3,
+ [{trace,Self,call,{erlang,error,[{paprika}]}},
+ {trace,Self,exception_from,{erlang,error,1},
+ {error,{paprika}}}],
+ exception_from, {error,{paprika}}),
+ deep_exception(?LINE, error, ["{paprika}",[]], 3,
+ [{trace,Self,call,{erlang,error,["{paprika}",[]]}},
+ {trace,Self,exception_from,{erlang,error,2},
+ {error,"{paprika}"}}],
+ exception_from, {error,"{paprika}"}),
+ deep_exception(?LINE, id, [broccoli], 4, [],
+ return_from, broccoli),
+ deep_exception(
+ ?LINE, append, [1,2], 5,
+ [{trace,Self,call,{erlang,'++',[1,2]}},
+ {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}],
+ exception_from, {error,badarg}),
+ deep_exception(?LINE, '=', [1,2], 6, [],
+ exception_from, {error,{badmatch,2}}),
%%
- ?line io:format("== Subtest: ~w", [?LINE]),
- ?line try lists:reverse(LongImproperList, []) of
- R1 -> test_server:fail({returned,abbr(R1)})
- catch error:badarg -> ok
- end,
- ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}})
- when is_list(L1), is_list(L2), S == Self ->
- next;
- ({trace,S,exception_from,
- {lists,reverse,2},{error,badarg}})
- when S == Self ->
- expected;
- ('_') ->
- {trace,Self,exception_from,
- {lists,reverse,2},{error,badarg}};
- (_) ->
- {unexpected,
- {trace,Self,exception_from,
- {lists,reverse,2},{error,badarg}}}
- end),
- ?line deep_exception(?LINE, deep_5, [1,2], 7,
- [{trace,Self,call,{erlang,error,[undef]}},
- {trace,Self,exception_from,{erlang,error,1},
- {error,undef}}],
- exception_from, {error,undef}),
- ?line deep_exception(?LINE, deep_5, [undef], 8,
- [{trace,Self,call,{?MODULE,deep_5,[undef]}},
- {trace,Self,exception_from,{?MODULE,deep_5,1},
- {error,function_clause}}],
- exception_from, {error,function_clause}),
-
+ io:format("== Subtest: ~w", [?LINE]),
+ try lists:reverse(LongImproperList, []) of
+ R1 -> ct:fail({returned,abbr(R1)})
+ catch error:badarg -> ok
+ end,
+ expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}})
+ when is_list(L1), is_list(L2), S == Self ->
+ next;
+ ({trace,S,exception_from,
+ {lists,reverse,2},{error,badarg}})
+ when S == Self ->
+ expected;
+ ('_') ->
+ {trace,Self,exception_from,
+ {lists,reverse,2},{error,badarg}};
+ (_) ->
+ {unexpected,
+ {trace,Self,exception_from,
+ {lists,reverse,2},{error,badarg}}}
+ end),
+ deep_exception(?LINE, deep_5, [1,2], 7,
+ [{trace,Self,call,{erlang,error,[undef]}},
+ {trace,Self,exception_from,{erlang,error,1},
+ {error,undef}}],
+ exception_from, {error,undef}),
+ deep_exception(?LINE, deep_5, [undef], 8,
+ [{trace,Self,call,{?MODULE,deep_5,[undef]}},
+ {trace,Self,exception_from,{?MODULE,deep_5,1},
+ {error,function_clause}}],
+ exception_from, {error,function_clause}),
+
%% Apply
%%
- ?line deep_exception(?LINE, apply, [erlang,error,[[mo|rot]]], 1,
- [{trace,Self,call,{erlang,error,[[mo|rot]]}},
- {trace,Self,exception_from,{erlang,error,1},
- {error,[mo|rot]}}],
- exception_from, {error,[mo|rot]}),
- ?line deep_exception(?LINE, apply, [erlang,error,[[mo|"rot"],[]]], 1,
- [{trace,Self,call,{erlang,error,[[mo|"rot"],[]]}},
- {trace,Self,exception_from,{erlang,error,2},
- {error,[mo|"rot"]}}],
- exception_from, {error,[mo|"rot"]}),
- ?line Morot = make_ref(),
- ?line deep_exception(?LINE, apply, [erlang,throw,[Morot]], 3,
- [{trace,Self,call,{erlang,throw,[Morot]}},
- {trace,Self,exception_from,{erlang,throw,1},
- {throw,Morot}}],
- exception_from, {throw,Morot}),
- ?line deep_exception(?LINE, apply, [erlang,exit,[["morot"|Morot]]], 2,
- [{trace,Self,call,{erlang,exit,[["morot"|Morot]]}},
- {trace,Self,exception_from,{erlang,exit,1},
- {exit,["morot"|Morot]}}],
- exception_from, {exit,["morot"|Morot]}),
- ?line deep_exception(
- ?LINE, apply, [?MODULE,id,[spenat]], 4,
- [{trace,Self,call,{?MODULE,id,[spenat]}},
- {trace,Self,return_from,{?MODULE,id,1},spenat}],
- return_from, spenat),
- ?line deep_exception(
- ?LINE, apply, [erlang,'++',[1,2]], 5,
- [{trace,Self,call,{erlang,'++',[1,2]}},
- {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}],
- exception_from, {error,badarg}),
- ?line io:format("== Subtest: ~w", [?LINE]),
- ?line try apply(lists, reverse, [LongImproperList, []]) of
- R2 -> test_server:fail({returned,abbr(R2)})
- catch error:badarg -> ok
- end,
- ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}})
- when is_list(L1), is_list(L2), S == Self ->
- next;
- ({trace,S,exception_from,
- {lists,reverse,2},{error,badarg}})
- when S == Self ->
- expected;
- ('_') ->
- {trace,Self,exception_from,
- {lists,reverse,2},{error,badarg}};
- (_) ->
- {unexpected,
- {trace,Self,exception_from,
- {lists,reverse,2},{error,badarg}}}
- end),
- ?line deep_exception(?LINE, apply, [?MODULE,deep_5,[1,2]], 7,
- [{trace,Self,call,{erlang,error,[undef]}},
- {trace,Self,exception_from,{erlang,error,1},
- {error,undef}}],
- exception_from, {error,undef}),
- ?line deep_exception(?LINE, apply, [?MODULE,deep_5,[undef]], 8,
- [{trace,Self,call,{?MODULE,deep_5,[undef]}},
- {trace,Self,exception_from,{?MODULE,deep_5,1},
- {error,function_clause}}],
- exception_from, {error,function_clause}),
+ deep_exception(?LINE, apply, [erlang,error,[[mo|rot]]], 1,
+ [{trace,Self,call,{erlang,error,[[mo|rot]]}},
+ {trace,Self,exception_from,{erlang,error,1},
+ {error,[mo|rot]}}],
+ exception_from, {error,[mo|rot]}),
+ deep_exception(?LINE, apply, [erlang,error,[[mo|"rot"],[]]], 1,
+ [{trace,Self,call,{erlang,error,[[mo|"rot"],[]]}},
+ {trace,Self,exception_from,{erlang,error,2},
+ {error,[mo|"rot"]}}],
+ exception_from, {error,[mo|"rot"]}),
+ Morot = make_ref(),
+ deep_exception(?LINE, apply, [erlang,throw,[Morot]], 3,
+ [{trace,Self,call,{erlang,throw,[Morot]}},
+ {trace,Self,exception_from,{erlang,throw,1},
+ {throw,Morot}}],
+ exception_from, {throw,Morot}),
+ deep_exception(?LINE, apply, [erlang,exit,[["morot"|Morot]]], 2,
+ [{trace,Self,call,{erlang,exit,[["morot"|Morot]]}},
+ {trace,Self,exception_from,{erlang,exit,1},
+ {exit,["morot"|Morot]}}],
+ exception_from, {exit,["morot"|Morot]}),
+ deep_exception(
+ ?LINE, apply, [?MODULE,id,[spenat]], 4,
+ [{trace,Self,call,{?MODULE,id,[spenat]}},
+ {trace,Self,return_from,{?MODULE,id,1},spenat}],
+ return_from, spenat),
+ deep_exception(
+ ?LINE, apply, [erlang,'++',[1,2]], 5,
+ [{trace,Self,call,{erlang,'++',[1,2]}},
+ {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}],
+ exception_from, {error,badarg}),
+ io:format("== Subtest: ~w", [?LINE]),
+ try apply(lists, reverse, [LongImproperList, []]) of
+ R2 -> ct:fail({returned,abbr(R2)})
+ catch error:badarg -> ok
+ end,
+ expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}})
+ when is_list(L1), is_list(L2), S == Self ->
+ next;
+ ({trace,S,exception_from,
+ {lists,reverse,2},{error,badarg}})
+ when S == Self ->
+ expected;
+ ('_') ->
+ {trace,Self,exception_from,
+ {lists,reverse,2},{error,badarg}};
+ (_) ->
+ {unexpected,
+ {trace,Self,exception_from,
+ {lists,reverse,2},{error,badarg}}}
+ end),
+ deep_exception(?LINE, apply, [?MODULE,deep_5,[1,2]], 7,
+ [{trace,Self,call,{erlang,error,[undef]}},
+ {trace,Self,exception_from,{erlang,error,1},
+ {error,undef}}],
+ exception_from, {error,undef}),
+ deep_exception(?LINE, apply, [?MODULE,deep_5,[undef]], 8,
+ [{trace,Self,call,{?MODULE,deep_5,[undef]}},
+ {trace,Self,exception_from,{?MODULE,deep_5,1},
+ {error,function_clause}}],
+ exception_from, {error,function_clause}),
%% Apply of fun
%%
- ?line deep_exception(?LINE, apply,
- [fun () ->
- erlang:error([{"palsternacka",3.14},17])
- end, []], 1,
- [{trace,Self,call,
- {erlang,error,[[{"palsternacka",3.14},17]]}},
- {trace,Self,exception_from,{erlang,error,1},
- {error,[{"palsternacka",3.14},17]}}],
- exception_from, {error,[{"palsternacka",3.14},17]}),
- ?line deep_exception(?LINE, apply,
- [fun () ->
- erlang:error(["palsternacka",17], [])
- end, []], 1,
- [{trace,Self,call,
- {erlang,error,[["palsternacka",17],[]]}},
- {trace,Self,exception_from,{erlang,error,2},
- {error,["palsternacka",17]}}],
- exception_from, {error,["palsternacka",17]}),
- ?line deep_exception(?LINE, apply,
- [fun () -> erlang:throw(Self) end, []], 2,
- [{trace,Self,call,{erlang,throw,[Self]}},
- {trace,Self,exception_from,{erlang,throw,1},
- {throw,Self}}],
- exception_from, {throw,Self}),
- ?line deep_exception(?LINE, apply,
- [fun () ->
- erlang:exit({1,2,3,4,[5,palsternacka]})
- end, []], 3,
- [{trace,Self,call,
- {erlang,exit,[{1,2,3,4,[5,palsternacka]}]}},
- {trace,Self,exception_from,{erlang,exit,1},
- {exit,{1,2,3,4,[5,palsternacka]}}}],
- exception_from, {exit,{1,2,3,4,[5,palsternacka]}}),
- ?line deep_exception(?LINE, apply,
- [fun () -> ?MODULE:id(bladsallad) end, []], 4,
- [{trace,Self,call,{?MODULE,id,[bladsallad]}},
- {trace,Self,return_from,{?MODULE,id,1},bladsallad}],
- return_from, bladsallad),
- ?line deep_exception(?LINE, apply,
- [fun (A, B) -> A ++ B end, [1,2]], 5,
- [{trace,Self,call,{erlang,'++',[1,2]}},
- {trace,Self,exception_from,
- {erlang,'++',2},{error,badarg}}],
- exception_from, {error,badarg}),
- ?line deep_exception(?LINE, apply, [fun (A, B) -> A = B end, [1,2]], 6,
- [],
- exception_from, {error,{badmatch,2}}),
- ?line io:format("== Subtest: ~w", [?LINE]),
- ?line try apply(fun() -> lists:reverse(LongImproperList, []) end, []) of
- R3 -> test_server:fail({returned,abbr(R3)})
- catch error:badarg -> ok
- end,
- ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}})
- when is_list(L1), is_list(L2), S == Self ->
- next;
- ({trace,S,exception_from,
- {lists,reverse,2},{error,badarg}})
- when S == Self ->
- expected;
- ('_') ->
- {trace,Self,exception_from,
- {lists,reverse,2},{error,badarg}};
- (_) ->
- {unexpected,
- {trace,Self,exception_from,
- {lists,reverse,2},{error,badarg}}}
- end),
- ?line deep_exception(?LINE, apply,
- [fun () -> ?MODULE:deep_5(1,2) end, []], 7,
- [{trace,Self,call,{erlang,error,[undef]}},
- {trace,Self,exception_from,{erlang,error,1},
- {error,undef}}],
- exception_from, {error,undef}),
- ?line deep_exception(?LINE, apply,
- [fun () -> ?MODULE:deep_5(undef) end, []], 8,
- [{trace,Self,call,{?MODULE,deep_5,[undef]}},
- {trace,Self,exception_from,{?MODULE,deep_5,1},
- {error,function_clause}}],
- exception_from, {error,function_clause}),
-
- ?line trace_func({?MODULE,'_','_'}, false),
- ?line trace_func({erlang,'_','_'}, false),
- ?line trace_func({lists,'_','_'}, false),
- ?line expect(),
- ?line ok.
+ deep_exception(?LINE, apply,
+ [fun () ->
+ erlang:error([{"palsternacka",3.14},17])
+ end, []], 1,
+ [{trace,Self,call,
+ {erlang,error,[[{"palsternacka",3.14},17]]}},
+ {trace,Self,exception_from,{erlang,error,1},
+ {error,[{"palsternacka",3.14},17]}}],
+ exception_from, {error,[{"palsternacka",3.14},17]}),
+ deep_exception(?LINE, apply,
+ [fun () ->
+ erlang:error(["palsternacka",17], [])
+ end, []], 1,
+ [{trace,Self,call,
+ {erlang,error,[["palsternacka",17],[]]}},
+ {trace,Self,exception_from,{erlang,error,2},
+ {error,["palsternacka",17]}}],
+ exception_from, {error,["palsternacka",17]}),
+ deep_exception(?LINE, apply,
+ [fun () -> erlang:throw(Self) end, []], 2,
+ [{trace,Self,call,{erlang,throw,[Self]}},
+ {trace,Self,exception_from,{erlang,throw,1},
+ {throw,Self}}],
+ exception_from, {throw,Self}),
+ deep_exception(?LINE, apply,
+ [fun () ->
+ erlang:exit({1,2,3,4,[5,palsternacka]})
+ end, []], 3,
+ [{trace,Self,call,
+ {erlang,exit,[{1,2,3,4,[5,palsternacka]}]}},
+ {trace,Self,exception_from,{erlang,exit,1},
+ {exit,{1,2,3,4,[5,palsternacka]}}}],
+ exception_from, {exit,{1,2,3,4,[5,palsternacka]}}),
+ deep_exception(?LINE, apply,
+ [fun () -> ?MODULE:id(bladsallad) end, []], 4,
+ [{trace,Self,call,{?MODULE,id,[bladsallad]}},
+ {trace,Self,return_from,{?MODULE,id,1},bladsallad}],
+ return_from, bladsallad),
+ deep_exception(?LINE, apply,
+ [fun (A, B) -> A ++ B end, [1,2]], 5,
+ [{trace,Self,call,{erlang,'++',[1,2]}},
+ {trace,Self,exception_from,
+ {erlang,'++',2},{error,badarg}}],
+ exception_from, {error,badarg}),
+ deep_exception(?LINE, apply, [fun (A, B) -> A = B end, [1,2]], 6,
+ [],
+ exception_from, {error,{badmatch,2}}),
+ io:format("== Subtest: ~w", [?LINE]),
+ try apply(fun() -> lists:reverse(LongImproperList, []) end, []) of
+ R3 -> ct:fail({returned,abbr(R3)})
+ catch error:badarg -> ok
+ end,
+ expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}})
+ when is_list(L1), is_list(L2), S == Self ->
+ next;
+ ({trace,S,exception_from,
+ {lists,reverse,2},{error,badarg}})
+ when S == Self ->
+ expected;
+ ('_') ->
+ {trace,Self,exception_from,
+ {lists,reverse,2},{error,badarg}};
+ (_) ->
+ {unexpected,
+ {trace,Self,exception_from,
+ {lists,reverse,2},{error,badarg}}}
+ end),
+ deep_exception(?LINE, apply,
+ [fun () -> ?MODULE:deep_5(1,2) end, []], 7,
+ [{trace,Self,call,{erlang,error,[undef]}},
+ {trace,Self,exception_from,{erlang,error,1},
+ {error,undef}}],
+ exception_from, {error,undef}),
+ deep_exception(?LINE, apply,
+ [fun () -> ?MODULE:deep_5(undef) end, []], 8,
+ [{trace,Self,call,{?MODULE,deep_5,[undef]}},
+ {trace,Self,exception_from,{?MODULE,deep_5,1},
+ {error,function_clause}}],
+ exception_from, {error,function_clause}),
+
+ trace_func({?MODULE,'_','_'}, false),
+ trace_func({erlang,'_','_'}, false),
+ trace_func({lists,'_','_'}, false),
+ expect(),
+ ok.
deep_exception(Line, B, Q, N, Extra, Tag, R) ->
- ?line Self = self(),
- ?line io:format("== Subtest: ~w", [Line]),
- ?line Result = ?MODULE:deep(N, B, Q),
- ?line Result = deep_expect(Self, B, Q, N, Extra, Tag, R).
+ Self = self(),
+ io:format("== Subtest: ~w", [Line]),
+ Result = ?MODULE:deep(N, B, Q),
+ Result = deep_expect(Self, B, Q, N, Extra, Tag, R).
deep_expect(Self, B, Q, N, Extra, Tag, R) ->
- ?line expect({trace,Self,call,{?MODULE,deep,[N,B,Q]}}),
- ?line Result = deep_expect_N(Self, B, Q, N, Extra, Tag, R),
- ?line expect({trace,Self,return_from,{?MODULE,deep,3},Result}),
- ?line Result.
+ expect({trace,Self,call,{?MODULE,deep,[N,B,Q]}}),
+ Result = deep_expect_N(Self, B, Q, N, Extra, Tag, R),
+ expect({trace,Self,return_from,{?MODULE,deep,3},Result}),
+ Result.
deep_expect_N(Self, B, Q, N, Extra, Tag, R) ->
deep_expect_N(Self, B, Q, N, Extra, Tag, R, N).
deep_expect_N(Self, B, Q, N, Extra, Tag, R, J) when J > 0 ->
- ?line expect({trace,Self,call,{?MODULE,deep_1,[J,B,Q]}}),
- ?line deep_expect_N(Self, B, Q, N, Extra, Tag, R, J-1);
+ expect({trace,Self,call,{?MODULE,deep_1,[J,B,Q]}}),
+ deep_expect_N(Self, B, Q, N, Extra, Tag, R, J-1);
deep_expect_N(Self, B, Q, N, Extra, Tag, R, 0) ->
- ?line expect({trace,Self,call,{?MODULE,deep_2,[B,Q]}}),
- ?line expect({trace,Self,call,{?MODULE,deep_3,[B,Q]}}),
- ?line expect({trace,Self,return_from,{?MODULE,deep_3,2},{B,Q}}),
- ?line expect({trace,Self,call,{?MODULE,deep_4,[{B,Q}]}}),
- ?line expect({trace,Self,call,{?MODULE,id,[{B,Q}]}}),
- ?line expect({trace,Self,return_from,{?MODULE,id,1},{B,Q}}),
- ?line deep_expect_Extra(Self, N, Extra, Tag, R),
- ?line expect({trace,Self,Tag,{?MODULE,deep_4,1},R}),
- ?line expect({trace,Self,Tag,{?MODULE,deep_2,2},R}),
- ?line deep_expect_N(Self, N, Tag, R).
+ expect({trace,Self,call,{?MODULE,deep_2,[B,Q]}}),
+ expect({trace,Self,call,{?MODULE,deep_3,[B,Q]}}),
+ expect({trace,Self,return_from,{?MODULE,deep_3,2},{B,Q}}),
+ expect({trace,Self,call,{?MODULE,deep_4,[{B,Q}]}}),
+ expect({trace,Self,call,{?MODULE,id,[{B,Q}]}}),
+ expect({trace,Self,return_from,{?MODULE,id,1},{B,Q}}),
+ deep_expect_Extra(Self, N, Extra, Tag, R),
+ expect({trace,Self,Tag,{?MODULE,deep_4,1},R}),
+ expect({trace,Self,Tag,{?MODULE,deep_2,2},R}),
+ deep_expect_N(Self, N, Tag, R).
deep_expect_Extra(Self, N, [E|Es], Tag, R) ->
- ?line expect(E),
- ?line deep_expect_Extra(Self, N, Es, Tag, R);
+ expect(E),
+ deep_expect_Extra(Self, N, Es, Tag, R);
deep_expect_Extra(_Self, _N, [], _Tag, _R) ->
- ?line ok.
+ ok.
deep_expect_N(Self, N, Tag, R) when N > 0 ->
- ?line expect({trace,Self,Tag,{?MODULE,deep_1,3},R}),
- ?line deep_expect_N(Self, N-1, Tag, R);
+ expect({trace,Self,Tag,{?MODULE,deep_1,3},R}),
+ deep_expect_N(Self, N-1, Tag, R);
deep_expect_N(_Self, 0, return_from, R) ->
- ?line {value,R};
+ {value,R};
deep_expect_N(_Self, 0, exception_from, R) ->
- ?line R.
+ R.
-exception_nocatch(doc) -> "Test the new exception trace.";
-exception_nocatch(suite) -> [];
+%% Test the new exception trace.
exception_nocatch(Config) when is_list(Config) ->
exception_nocatch().
@@ -1082,78 +1052,78 @@ exception_nocatch() ->
Deep4LocBadmatch = get_deep_4_loc({'=',[a,b]}),
Prog = [{'_',[],[{exception_trace}]}],
- ?line 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog),
- ?line 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog),
- ?line 1 = erlang:trace_pattern({?MODULE,deep_3,'_'}, Prog),
- ?line 1 = erlang:trace_pattern({?MODULE,deep_4,'_'}, Prog),
- ?line 1 = erlang:trace_pattern({?MODULE,deep_5,'_'}, Prog),
- ?line 1 = erlang:trace_pattern({?MODULE,id,'_'}, Prog),
- ?line 1 = erlang:trace_pattern({erlang,exit,1}, Prog),
- ?line 1 = erlang:trace_pattern({erlang,throw,1}, Prog),
- ?line 2 = erlang:trace_pattern({erlang,error,'_'}, Prog),
- ?line Q1 = {make_ref(),Prog},
- ?line T1 =
- exception_nocatch(?LINE, exit, [Q1], 3,
- [{trace,t1,call,{erlang,exit,[Q1]}},
- {trace,t1,exception_from,{erlang,exit,1},
- {exit,Q1}}],
- exception_from, {exit,Q1}),
- ?line expect({trace,T1,exit,Q1}),
- ?line Q2 = {cake,14.125},
- ?line T2 =
- exception_nocatch(?LINE, throw, [Q2], 2,
- [{trace,t2,call,{erlang,throw,[Q2]}},
- {trace,t2,exception_from,{erlang,throw,1},
- {error,{nocatch,Q2}}}],
- exception_from, {error,{nocatch,Q2}}),
- ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]},
- {?MODULE,deep_4,1,
- Deep4LocThrow}]}}),
- ?line Q3 = {dump,[dump,{dump}]},
- ?line T3 =
- exception_nocatch(?LINE, error, [Q3], 4,
- [{trace,t3,call,{erlang,error,[Q3]}},
- {trace,t3,exception_from,{erlang,error,1},
- {error,Q3}}],
- exception_from, {error,Q3}),
- ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]},
- {?MODULE,deep_4,1,Deep4LocError}]}}),
- ?line T4 =
- exception_nocatch(?LINE, '=', [17,4711], 5, [],
- exception_from, {error,{badmatch,4711}}),
- ?line expect({trace,T4,exit,{{badmatch,4711},
- [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}),
+ 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog),
+ 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog),
+ 1 = erlang:trace_pattern({?MODULE,deep_3,'_'}, Prog),
+ 1 = erlang:trace_pattern({?MODULE,deep_4,'_'}, Prog),
+ 1 = erlang:trace_pattern({?MODULE,deep_5,'_'}, Prog),
+ 1 = erlang:trace_pattern({?MODULE,id,'_'}, Prog),
+ 1 = erlang:trace_pattern({erlang,exit,1}, Prog),
+ 1 = erlang:trace_pattern({erlang,throw,1}, Prog),
+ 2 = erlang:trace_pattern({erlang,error,'_'}, Prog),
+ Q1 = {make_ref(),Prog},
+ T1 =
+ exception_nocatch(?LINE, exit, [Q1], 3,
+ [{trace,t1,call,{erlang,exit,[Q1]}},
+ {trace,t1,exception_from,{erlang,exit,1},
+ {exit,Q1}}],
+ exception_from, {exit,Q1}),
+ expect({trace,T1,exit,Q1}),
+ Q2 = {cake,14.125},
+ T2 =
+ exception_nocatch(?LINE, throw, [Q2], 2,
+ [{trace,t2,call,{erlang,throw,[Q2]}},
+ {trace,t2,exception_from,{erlang,throw,1},
+ {error,{nocatch,Q2}}}],
+ exception_from, {error,{nocatch,Q2}}),
+ expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2],[]},
+ {?MODULE,deep_4,1,
+ Deep4LocThrow}]}}),
+ Q3 = {dump,[dump,{dump}]},
+ T3 =
+ exception_nocatch(?LINE, error, [Q3], 4,
+ [{trace,t3,call,{erlang,error,[Q3]}},
+ {trace,t3,exception_from,{erlang,error,1},
+ {error,Q3}}],
+ exception_from, {error,Q3}),
+ expect({trace,T3,exit,{Q3,[{erlang,error,[Q3],[]},
+ {?MODULE,deep_4,1,Deep4LocError}]}}),
+ T4 =
+ exception_nocatch(?LINE, '=', [17,4711], 5, [],
+ exception_from, {error,{badmatch,4711}}),
+ expect({trace,T4,exit,{{badmatch,4711},
+ [{?MODULE,deep_4,1,Deep4LocBadmatch}]}}),
%%
- ?line erlang:trace_pattern({?MODULE,'_','_'}, false),
- ?line erlang:trace_pattern({erlang,'_','_'}, false),
- ?line expect(),
- ?line ok.
+ erlang:trace_pattern({?MODULE,'_','_'}, false),
+ erlang:trace_pattern({erlang,'_','_'}, false),
+ expect(),
+ ok.
get_deep_4_loc(Arg) ->
try
- deep_4(Arg),
- ?t:fail(should_not_return_to_here)
+ deep_4(Arg),
+ ct:fail(should_not_return_to_here)
catch
- _:_ ->
- [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(),
- Loc0
+ _:_ ->
+ [{?MODULE,deep_4,1,Loc0}|_] = erlang:get_stacktrace(),
+ Loc0
end.
exception_nocatch(Line, B, Q, N, Extra, Tag, R) ->
- ?line io:format("== Subtest: ~w", [Line]),
- ?line Go = make_ref(),
- ?line Tracee =
- spawn(fun () ->
- receive
- Go ->
- deep_1(N, B, Q)
- end
- end),
- ?line 1 = erlang:trace(Tracee, true, [call,return_to,procs]),
- ?line Tracee ! Go,
- ?line deep_expect_N(Tracee, B, Q, N-1,
- [setelement(2, T, Tracee) || T <- Extra], Tag, R),
- ?line Tracee.
+ io:format("== Subtest: ~w", [Line]),
+ Go = make_ref(),
+ Tracee =
+ spawn(fun () ->
+ receive
+ Go ->
+ deep_1(N, B, Q)
+ end
+ end),
+ 1 = erlang:trace(Tracee, true, [call,return_to,procs]),
+ Tracee ! Go,
+ deep_expect_N(Tracee, B, Q, N-1,
+ [setelement(2, T, Tracee) || T <- Extra], Tag, R),
+ Tracee.
%% Make sure that code that uses the optimized bit syntax matching
%% can be traced without crashing the emulator. (Actually, it seems
@@ -1161,22 +1131,22 @@ exception_nocatch(Line, B, Q, N, Extra, Tag, R) ->
%% will keep the test case anyway.)
bit_syntax(Config) when is_list(Config) ->
- ?line start_tracer(),
- ?line 1 = trace_func({?MODULE,bs_sum_a,'_'}, []),
- ?line 1 = trace_func({?MODULE,bs_sum_b,'_'}, []),
+ start_tracer(),
+ 1 = trace_func({?MODULE,bs_sum_a,'_'}, []),
+ 1 = trace_func({?MODULE,bs_sum_b,'_'}, []),
- ?line 6 = call_bs_sum_a(<<1,2,3>>),
- ?line 10 = call_bs_sum_b(<<1,2,3,4>>),
+ 6 = call_bs_sum_a(<<1,2,3>>),
+ 10 = call_bs_sum_b(<<1,2,3,4>>),
- ?line trace_func({?MODULE,'_','_'}, false),
- ?line erlang:trace_delivered(all),
+ trace_func({?MODULE,'_','_'}, false),
+ erlang:trace_delivered(all),
receive
- {trace_delivered,_,_} -> ok
+ {trace_delivered,_,_} -> ok
end,
-
+
Self = self(),
- ?line expect({trace,Self,call,{?MODULE,bs_sum_a,[<<2,3>>,1]}}),
- ?line expect({trace,Self,call,{?MODULE,bs_sum_b,[1,<<2,3,4>>]}}),
+ expect({trace,Self,call,{?MODULE,bs_sum_a,[<<2,3>>,1]}}),
+ expect({trace,Self,call,{?MODULE,bs_sum_b,[1,<<2,3,4>>]}}),
ok.
@@ -1191,7 +1161,7 @@ bs_sum_a(<<>>, Acc) -> Acc.
bs_sum_b(Acc, <<H,T/binary>>) -> bs_sum_b(H+Acc, T);
bs_sum_b(Acc, <<>>) -> Acc.
-
+
@@ -1199,98 +1169,98 @@ bs_sum_b(Acc, <<>>) -> Acc.
expect() ->
case flush() of
- [] -> ok;
- Msgs ->
- test_server:fail({unexpected,abbr(Msgs)})
+ [] -> ok;
+ Msgs ->
+ ct:fail({unexpected,abbr(Msgs)})
end.
expect({trace_ts,Pid,Type,MFA,Term,ts}=Message) ->
receive
- M ->
- case M of
- {trace_ts,Pid,Type,MFA,Term,Ts}=MessageTs ->
- ok = io:format("Expected and got ~p", [abbr(MessageTs)]),
- Ts;
- _ ->
- io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]),
- test_server:fail({unexpected,abbr([M|flush()])})
- end
+ M ->
+ case M of
+ {trace_ts,Pid,Type,MFA,Term,Ts}=MessageTs ->
+ ok = io:format("Expected and got ~p", [abbr(MessageTs)]),
+ Ts;
+ _ ->
+ io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]),
+ ct:fail({unexpected,abbr([M|flush()])})
+ end
after 5000 ->
- io:format("Expected ~p; got nothing", [abbr(Message)]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [abbr(Message)]),
+ ct:fail(no_trace_message)
end;
expect({trace_ts,Pid,Type,MFA,ts}=Message) ->
receive
- M ->
- case M of
- {trace_ts,Pid,Type,MFA,Ts} ->
- ok = io:format("Expected and got ~p", [abbr(M)]),
- Ts;
- _ ->
- io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]),
- test_server:fail({unexpected,abbr([M|flush()])})
- end
+ M ->
+ case M of
+ {trace_ts,Pid,Type,MFA,Ts} ->
+ ok = io:format("Expected and got ~p", [abbr(M)]),
+ Ts;
+ _ ->
+ io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]),
+ ct:fail({unexpected,abbr([M|flush()])})
+ end
after 5000 ->
- io:format("Expected ~p; got nothing", [abbr(Message)]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [abbr(Message)]),
+ ct:fail(no_trace_message)
end;
expect(Validator) when is_function(Validator) ->
receive
- M ->
- case Validator(M) of
- expected ->
- ok = io:format("Expected and got ~p", [abbr(M)]);
- next ->
- ok = io:format("Expected and got ~p", [abbr(M)]),
- expect(Validator);
- {unexpected,Message} ->
- io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]),
- test_server:fail({unexpected,abbr([M|flush()])})
- end
+ M ->
+ case Validator(M) of
+ expected ->
+ ok = io:format("Expected and got ~p", [abbr(M)]);
+ next ->
+ ok = io:format("Expected and got ~p", [abbr(M)]),
+ expect(Validator);
+ {unexpected,Message} ->
+ io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]),
+ ct:fail({unexpected,abbr([M|flush()])})
+ end
after 5000 ->
- io:format("Expected ~p; got nothing", [abbr(Validator('_'))]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [abbr(Validator('_'))]),
+ ct:fail(no_trace_message)
end;
expect(Message) ->
receive
- M ->
- case M of
- Message ->
- ok = io:format("Expected and got ~p", [abbr(Message)]);
- Other ->
- io:format("Expected ~p; got ~p",
- [abbr(Message),abbr(Other)]),
- test_server:fail({unexpected,abbr([Other|flush()])})
- end
+ M ->
+ case M of
+ Message ->
+ ok = io:format("Expected and got ~p", [abbr(Message)]);
+ Other ->
+ io:format("Expected ~p; got ~p",
+ [abbr(Message),abbr(Other)]),
+ ct:fail({unexpected,abbr([Other|flush()])})
+ end
after 5000 ->
- io:format("Expected ~p; got nothing", [abbr(Message)]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [abbr(Message)]),
+ ct:fail(no_trace_message)
end.
trace_info(What, Key) ->
get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}},
Res = receive
- {apply_result,Result} -> Result
- end,
+ {apply_result,Result} -> Result
+ end,
ok = io:format("erlang:trace_info(~p, ~p) -> ~p",
- [What,Key,Res]),
+ [What,Key,Res]),
Res.
-
+
trace_func(MFA, MatchSpec) ->
trace_func(MFA, MatchSpec, []).
trace_func(MFA, MatchSpec, Flags) ->
get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA, MatchSpec, Flags]}},
Res = receive
- {apply_result,Result} -> Result
- end,
+ {apply_result,Result} -> Result
+ end,
ok = io:format("trace_pattern(~p, ~p, ~p) -> ~p", [MFA,MatchSpec,Flags,Res]),
Res.
trace_pid(Pid, On, Flags) ->
get(tracer) ! {apply,self(),{erlang,trace,[Pid,On,Flags]}},
Res = receive
- {apply_result,Result} -> Result
- end,
+ {apply_result,Result} -> Result
+ end,
ok = io:format("trace(~p, ~p, ~p) -> ~p", [Pid,On,Flags,Res]),
Res.
@@ -1310,19 +1280,19 @@ tracer(RelayTo) ->
tracer_loop(RelayTo) ->
receive
- {apply,From,{M,F,A}} ->
- From ! {apply_result,apply(M, F, A)},
- tracer_loop(RelayTo);
- Msg ->
- RelayTo ! Msg,
- tracer_loop(RelayTo)
+ {apply,From,{M,F,A}} ->
+ From ! {apply_result,apply(M, F, A)},
+ tracer_loop(RelayTo);
+ Msg ->
+ RelayTo ! Msg,
+ tracer_loop(RelayTo)
end.
id(I) -> I.
deep(N, Class, Reason) ->
try ?MODULE:deep_1(N, Class, Reason) of
- Value -> {value,Value}
+ Value -> {value,Value}
catch C:R -> {C,R}
end.
@@ -1339,30 +1309,30 @@ deep_3(Class, Reason) ->
deep_4(CR) ->
case ?MODULE:id(CR) of
- {exit,[Reason]} ->
- erlang:exit(Reason);
- {throw,[Reason]} ->
- erlang:throw(Reason);
- {error,[Reason,Arglist]} ->
- erlang:error(Reason, Arglist);
- {error,[Reason]} ->
- erlang:error(Reason);
- {id,[Reason]} ->
- Reason;
- {reverse,[A,B]} ->
- lists:reverse(A, B);
- {append,[A,B]} ->
- A ++ B;
- {apply,[Fun,Args]} ->
- erlang:apply(Fun, Args);
- {apply,[M,F,Args]} ->
- erlang:apply(M, F, Args);
- {deep_5,[A,B]} ->
- ?MODULE:deep_5(A, B);
- {deep_5,[A]} ->
- ?MODULE:deep_5(A);
- {'=',[A,B]} ->
- A = B
+ {exit,[Reason]} ->
+ erlang:exit(Reason);
+ {throw,[Reason]} ->
+ erlang:throw(Reason);
+ {error,[Reason,Arglist]} ->
+ erlang:error(Reason, Arglist);
+ {error,[Reason]} ->
+ erlang:error(Reason);
+ {id,[Reason]} ->
+ Reason;
+ {reverse,[A,B]} ->
+ lists:reverse(A, B);
+ {append,[A,B]} ->
+ A ++ B;
+ {apply,[Fun,Args]} ->
+ erlang:apply(Fun, Args);
+ {apply,[M,F,Args]} ->
+ erlang:apply(M, F, Args);
+ {deep_5,[A,B]} ->
+ ?MODULE:deep_5(A, B);
+ {deep_5,[A]} ->
+ ?MODULE:deep_5(A);
+ {'=',[A,B]} ->
+ A = B
end.
deep_5(A) when is_integer(A) ->
@@ -1370,9 +1340,9 @@ deep_5(A) when is_integer(A) ->
flush() ->
receive X ->
- [X|flush()]
+ [X|flush()]
after 1000 ->
- []
+ []
end.
%% Abbreviate large complex terms
@@ -1395,10 +1365,10 @@ abbr_tuple(_, _, _, R) ->
%%
abbr_list(_, 0, R) ->
case io_lib:printable_list(R) of
- true ->
- reverse(R, "...");
- false ->
- reverse(R, '...')
+ true ->
+ reverse(R, "...");
+ false ->
+ reverse(R, '...')
end;
abbr_list([H|T], N, R) ->
M = N-1,
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 9f318a38be..db285a3977 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -19,17 +19,17 @@
%%
-module(code_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- versions/1,new_binary_types/1,
- t_check_process_code/1,t_check_old_code/1,
- t_check_process_code_ets/1,
- external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
- make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1,
- false_dependency/1,coverage/1,fun_confusion/1]).
+-export([all/0, suite/0, init_per_suite/1, end_per_suite/1,
+ versions/1,new_binary_types/1,
+ t_check_process_code/1,t_check_old_code/1,
+ t_check_process_code_ets/1,
+ external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
+ make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1,
+ false_dependency/1,coverage/1,fun_confusion/1,
+ t_copy_literals/1]).
-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -38,10 +38,7 @@ all() ->
t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
module_md5, make_stub, make_stub_many_funs,
constant_pools, constant_refc_binaries, false_dependency,
- coverage, fun_confusion].
-
-groups() ->
- [].
+ coverage, fun_confusion, t_copy_literals].
init_per_suite(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
@@ -51,12 +48,6 @@ end_per_suite(_Config) ->
catch erts_debug:set_internal_state(available_internal_state, false),
ok.
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
%% Make sure that only two versions of a module can be loaded.
versions(Config) when is_list(Config) ->
V1 = compile_version(1, Config),
@@ -77,10 +68,10 @@ versions(Config) when is_list(Config) ->
_ = monitor(process, P1),
_ = monitor(process, P2),
receive
- {'DOWN',_,process,P1,normal} -> ok
+ {'DOWN',_,process,P1,normal} -> ok
end,
receive
- {'DOWN',_,process,P2,normal} -> ok
+ {'DOWN',_,process,P2,normal} -> ok
end,
true = erlang:purge_module(versions),
true = erlang:delete_module(versions),
@@ -88,84 +79,84 @@ versions(Config) when is_list(Config) ->
ok.
compile_version(Version, Config) ->
- Data = ?config(data_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
File = filename:join(Data, "versions"),
{ok,versions,Bin} = compile:file(File, [{d,'VERSION',Version},
- binary,report]),
+ binary,report]),
Bin.
load_version(Code, Ver) ->
case erlang:load_module(versions, Code) of
- {module,versions} ->
- Pid = spawn_link(versions, loop, []),
- Ver = versions:version(),
- Ver = check_version(Pid),
- {ok,Pid,Ver};
- Error ->
- Error
+ {module,versions} ->
+ Pid = spawn_link(versions, loop, []),
+ Ver = versions:version(),
+ Ver = check_version(Pid),
+ {ok,Pid,Ver};
+ Error ->
+ Error
end.
check_version(Pid) ->
Pid ! {self(),version},
receive
- {Pid,version,Version} ->
- Version
+ {Pid,version,Version} ->
+ Version
end.
new_binary_types(Config) when is_list(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "my_code_test"),
- ?line {ok,my_code_test,Bin} = compile:file(File, [binary]),
- ?line {module,my_code_test} = erlang:load_module(my_code_test,
- make_sub_binary(Bin)),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
-
- ?line {module,my_code_test} = erlang:load_module(my_code_test,
- make_unaligned_sub_binary(Bin)),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "my_code_test"),
+ {ok,my_code_test,Bin} = compile:file(File, [binary]),
+ {module,my_code_test} = erlang:load_module(my_code_test,
+ make_sub_binary(Bin)),
+ true = erlang:delete_module(my_code_test),
+ true = erlang:purge_module(my_code_test),
+
+ {module,my_code_test} = erlang:load_module(my_code_test,
+ make_unaligned_sub_binary(Bin)),
+ true = erlang:delete_module(my_code_test),
+ true = erlang:purge_module(my_code_test),
%% Try heap binaries and bad binaries.
- ?line {error,badfile} = erlang:load_module(my_code_test, <<1,2>>),
- ?line {error,badfile} = erlang:load_module(my_code_test,
- make_sub_binary(<<1,2>>)),
- ?line {error,badfile} = erlang:load_module(my_code_test,
- make_unaligned_sub_binary(<<1,2>>)),
- ?line {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test,
- bit_sized_binary(Bin))),
+ {error,badfile} = erlang:load_module(my_code_test, <<1,2>>),
+ {error,badfile} = erlang:load_module(my_code_test,
+ make_sub_binary(<<1,2>>)),
+ {error,badfile} = erlang:load_module(my_code_test,
+ make_unaligned_sub_binary(<<1,2>>)),
+ {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test,
+ bit_sized_binary(Bin))),
ok.
t_check_process_code(Config) when is_list(Config) ->
- ?line Priv = ?config(priv_dir, Config),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "my_code_test"),
- ?line Code = filename:join(Priv, "my_code_test"),
+ Priv = proplists:get_value(priv_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "my_code_test"),
+ Code = filename:join(Priv, "my_code_test"),
- ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]),
+ {ok,my_code_test} = c:c(File, [{outdir,Priv}]),
- ?line MyFun = fun(X, Y) -> X + Y end, %Confuse things.
- ?line F = my_code_test:make_fun(42),
- ?line 2 = fun_refc(F),
- ?line MyFun2 = fun(X, Y) -> X * Y end, %Confuse things.
- ?line 44 = F(2),
+ MyFun = fun(X, Y) -> X + Y end, %Confuse things.
+ F = my_code_test:make_fun(42),
+ 2 = fun_refc(F),
+ MyFun2 = fun(X, Y) -> X * Y end, %Confuse things.
+ 44 = F(2),
%% Delete the module and call the fun again.
- ?line true = erlang:delete_module(my_code_test),
- ?line 2 = fun_refc(F),
- ?line 45 = F(3),
- ?line {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)),
+ true = erlang:delete_module(my_code_test),
+ 2 = fun_refc(F),
+ 45 = F(3),
+ {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)),
%% The fun should still be there, preventing purge.
- ?line true = erlang:check_process_code(self(), my_code_test),
+ true = erlang:check_process_code(self(), my_code_test),
gc(),
gc(), %Place funs on the old heap.
- ?line true = erlang:check_process_code(self(), my_code_test),
+ true = erlang:check_process_code(self(), my_code_test),
%% Using the funs here guarantees that they will not be prematurely garbed.
- ?line 48 = F(6),
- ?line 3 = MyFun(1, 2),
- ?line 12 = MyFun2(3, 4),
+ 48 = F(6),
+ 3 = MyFun(1, 2),
+ 12 = MyFun2(3, 4),
%% Kill all funs.
t_check_process_code1(Code, []).
@@ -173,64 +164,64 @@ t_check_process_code(Config) when is_list(Config) ->
%% The real fun was killed, but we have some fakes which look similar.
t_check_process_code1(Code, Fakes) ->
- ?line MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things.
- ?line false = erlang:check_process_code(self(), my_code_test),
- ?line 4 = MyFun(1, 2),
+ MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things.
+ false = erlang:check_process_code(self(), my_code_test),
+ 4 = MyFun(1, 2),
t_check_process_code2(Code, Fakes).
t_check_process_code2(Code, _) ->
- ?line false = erlang:check_process_code(self(), my_code_test),
- ?line true = erlang:purge_module(my_code_test),
+ false = erlang:check_process_code(self(), my_code_test),
+ true = erlang:purge_module(my_code_test),
%% In the next test we will load the same module twice.
- ?line {module,my_code_test} = code:load_abs(Code),
- ?line F = my_code_test:make_fun(37),
- ?line 2 = fun_refc(F),
- ?line false = erlang:check_process_code(self(), my_code_test),
- ?line {module,my_code_test} = code:load_abs(Code),
- ?line 2 = fun_refc(F),
+ {module,my_code_test} = code:load_abs(Code),
+ F = my_code_test:make_fun(37),
+ 2 = fun_refc(F),
+ false = erlang:check_process_code(self(), my_code_test),
+ {module,my_code_test} = code:load_abs(Code),
+ 2 = fun_refc(F),
%% Still false because the fun with the same identify is found
%% in the current code.
- ?line false = erlang:check_process_code(self(), my_code_test),
-
+ false = erlang:check_process_code(self(), my_code_test),
+
%% Some fake funs in the same module should not do any difference.
- ?line false = erlang:check_process_code(self(), my_code_test),
+ false = erlang:check_process_code(self(), my_code_test),
38 = F(1),
t_check_process_code3(Code, F, []).
t_check_process_code3(Code, F, Fakes) ->
Pid = spawn_link(fun() -> body(F, Fakes) end),
- ?line true = erlang:purge_module(my_code_test),
- ?line false = erlang:check_process_code(self(), my_code_test),
- ?line false = erlang:check_process_code(Pid, my_code_test),
+ true = erlang:purge_module(my_code_test),
+ false = erlang:check_process_code(self(), my_code_test),
+ false = erlang:check_process_code(Pid, my_code_test),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:check_process_code(self(), my_code_test),
- ?line true = erlang:check_process_code(Pid, my_code_test),
+ true = erlang:delete_module(my_code_test),
+ true = erlang:check_process_code(self(), my_code_test),
+ true = erlang:check_process_code(Pid, my_code_test),
39 = F(2),
t_check_process_code4(Code, Pid).
t_check_process_code4(_Code, Pid) ->
Pid ! drop_funs,
receive after 1 -> ok end,
- ?line false = erlang:check_process_code(Pid, my_code_test),
+ false = erlang:check_process_code(Pid, my_code_test),
ok.
body(F, Fakes) ->
receive
- jog ->
- 40 = F(3),
- erlang:garbage_collect(),
- body(F, Fakes);
- drop_funs ->
- dropped_body()
+ jog ->
+ 40 = F(3),
+ erlang:garbage_collect(),
+ body(F, Fakes);
+ drop_funs ->
+ dropped_body()
end.
dropped_body() ->
receive
- X -> exit(X)
+ X -> exit(X)
end.
gc() ->
@@ -238,61 +229,60 @@ gc() ->
gc1().
gc1() -> ok.
-t_check_process_code_ets(doc) ->
- "Test check_process_code/2 in combination with a fun obtained from an ets table.";
+%% Test check_process_code/2 in combination with a fun obtained from an ets table.
t_check_process_code_ets(Config) when is_list(Config) ->
case test_server:is_native(?MODULE) of
- true ->
- {skip,"Native code"};
- false ->
- do_check_process_code_ets(Config)
+ true ->
+ {skip,"Native code"};
+ false ->
+ do_check_process_code_ets(Config)
end.
do_check_process_code_ets(Config) ->
- ?line Priv = ?config(priv_dir, Config),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "my_code_test"),
-
- ?line erlang:purge_module(my_code_test),
- ?line erlang:delete_module(my_code_test),
- ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]),
-
- ?line T = ets:new(my_code_test, []),
- ?line ets:insert(T, {7,my_code_test:make_fun(107)}),
- ?line ets:insert(T, {8,my_code_test:make_fun(108)}),
- ?line erlang:delete_module(my_code_test),
- ?line false = erlang:check_process_code(self(), my_code_test),
+ Priv = proplists:get_value(priv_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "my_code_test"),
+
+ erlang:purge_module(my_code_test),
+ erlang:delete_module(my_code_test),
+ {ok,my_code_test} = c:c(File, [{outdir,Priv}]),
+
+ T = ets:new(my_code_test, []),
+ ets:insert(T, {7,my_code_test:make_fun(107)}),
+ ets:insert(T, {8,my_code_test:make_fun(108)}),
+ erlang:delete_module(my_code_test),
+ false = erlang:check_process_code(self(), my_code_test),
Body = fun() ->
- [{7,F1}] = ets:lookup(T, 7),
- [{8,F2}] = ets:lookup(T, 8),
- IdleLoop = fun() -> receive _X -> ok end end,
- RecLoop = fun(Again) ->
- receive
- call -> 110 = F1(3),
- 100 = F2(-8),
- Again(Again);
- {drop_funs,To} ->
- To ! funs_dropped,
- IdleLoop()
- end
- end,
- true = erlang:check_process_code(self(), my_code_test),
- RecLoop(RecLoop)
- end,
- ?line Pid = spawn_link(Body),
+ [{7,F1}] = ets:lookup(T, 7),
+ [{8,F2}] = ets:lookup(T, 8),
+ IdleLoop = fun() -> receive _X -> ok end end,
+ RecLoop = fun(Again) ->
+ receive
+ call -> 110 = F1(3),
+ 100 = F2(-8),
+ Again(Again);
+ {drop_funs,To} ->
+ To ! funs_dropped,
+ IdleLoop()
+ end
+ end,
+ true = erlang:check_process_code(self(), my_code_test),
+ RecLoop(RecLoop)
+ end,
+ Pid = spawn_link(Body),
receive after 1 -> ok end,
- ?line true = erlang:check_process_code(Pid, my_code_test),
+ true = erlang:check_process_code(Pid, my_code_test),
Pid ! call,
Pid ! {drop_funs,self()},
receive
- funs_dropped -> ok;
- Other -> ?t:fail({unexpected,Other})
+ funs_dropped -> ok;
+ Other -> ct:fail({unexpected,Other})
after 10000 ->
- ?line ?t:fail(no_funs_dropped_answer)
+ ct:fail(no_funs_dropped_answer)
end,
- ?line false = erlang:check_process_code(Pid, my_code_test),
+ false = erlang:check_process_code(Pid, my_code_test),
ok.
fun_refc(F) ->
@@ -302,89 +292,89 @@ fun_refc(F) ->
%% Test the erlang:check_old_code/1 BIF.
t_check_old_code(Config) when is_list(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "my_code_test"),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "my_code_test"),
- ?line erlang:purge_module(my_code_test),
- ?line erlang:delete_module(my_code_test),
- ?line catch erlang:purge_module(my_code_test),
+ erlang:purge_module(my_code_test),
+ erlang:delete_module(my_code_test),
+ catch erlang:purge_module(my_code_test),
+
+ false = erlang:check_old_code(my_code_test),
+
+ {ok,my_code_test,Code} = compile:file(File, [binary]),
+ {module,my_code_test} = code:load_binary(my_code_test, File, Code),
- ?line false = erlang:check_old_code(my_code_test),
+ false = erlang:check_old_code(my_code_test),
+ {module,my_code_test} = code:load_binary(my_code_test, File, Code),
+ true = erlang:check_old_code(my_code_test),
- ?line {ok,my_code_test,Code} = compile:file(File, [binary]),
- ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code),
-
- ?line false = erlang:check_old_code(my_code_test),
- ?line {module,my_code_test} = code:load_binary(my_code_test, File, Code),
- ?line true = erlang:check_old_code(my_code_test),
+ true = erlang:purge_module(my_code_test),
+ true = erlang:delete_module(my_code_test),
+ true = erlang:purge_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
+ {'EXIT',_} = (catch erlang:check_old_code([])),
- ?line {'EXIT',_} = (catch erlang:check_old_code([])),
-
ok.
external_fun(Config) when is_list(Config) ->
- ?line false = erlang:function_exported(another_code_test, x, 1),
+ false = erlang:function_exported(another_code_test, x, 1),
AnotherCodeTest = id(another_code_test),
ExtFun = fun AnotherCodeTest:x/1,
- ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)),
- ?line false = erlang:function_exported(another_code_test, x, 1),
- ?line false = lists:member(another_code_test, erlang:loaded()),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "another_code_test"),
- ?line {ok,another_code_test,Code} = compile:file(File, [binary,report]),
- ?line {module,another_code_test} = erlang:load_module(another_code_test, Code),
- ?line 42 = ExtFun(answer),
+ {'EXIT',{undef,_}} = (catch ExtFun(answer)),
+ false = erlang:function_exported(another_code_test, x, 1),
+ false = lists:member(another_code_test, erlang:loaded()),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "another_code_test"),
+ {ok,another_code_test,Code} = compile:file(File, [binary,report]),
+ {module,another_code_test} = erlang:load_module(another_code_test, Code),
+ 42 = ExtFun(answer),
ok.
get_chunk(Config) when is_list(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "my_code_test"),
- ?line {ok,my_code_test,Code} = compile:file(File, [binary]),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "my_code_test"),
+ {ok,my_code_test,Code} = compile:file(File, [binary]),
%% Should work.
- ?line Chunk = get_chunk_ok("Atom", Code),
- ?line Chunk = get_chunk_ok("Atom", make_sub_binary(Code)),
- ?line Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)),
+ Chunk = get_chunk_ok("Atom", Code),
+ Chunk = get_chunk_ok("Atom", make_sub_binary(Code)),
+ Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)),
%% Should fail.
- ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")),
- ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")),
+ {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")),
+ {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")),
%% Invalid beam code or missing chunk should return 'undefined'.
- ?line undefined = code:get_chunk(<<"not a beam module">>, "Atom"),
- ?line undefined = code:get_chunk(Code, "XXXX"),
+ undefined = code:get_chunk(<<"not a beam module">>, "Atom"),
+ undefined = code:get_chunk(Code, "XXXX"),
ok.
get_chunk_ok(Chunk, Code) ->
case code:get_chunk(Code, Chunk) of
- Bin when is_binary(Bin) -> Bin
+ Bin when is_binary(Bin) -> Bin
end.
module_md5(Config) when is_list(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "my_code_test"),
- ?line {ok,my_code_test,Code} = compile:file(File, [binary]),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "my_code_test"),
+ {ok,my_code_test,Code} = compile:file(File, [binary]),
%% Should work.
- ?line Chunk = module_md5_ok(Code),
- ?line Chunk = module_md5_ok(make_sub_binary(Code)),
- ?line Chunk = module_md5_ok(make_unaligned_sub_binary(Code)),
+ Chunk = module_md5_ok(Code),
+ Chunk = module_md5_ok(make_sub_binary(Code)),
+ Chunk = module_md5_ok(make_unaligned_sub_binary(Code)),
%% Should fail.
- ?line {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))),
+ {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))),
%% Invalid beam code should return 'undefined'.
- ?line undefined = code:module_md5(<<"not a beam module">>),
+ undefined = code:module_md5(<<"not a beam module">>),
ok.
-
+
module_md5_ok(Code) ->
case code:module_md5(Code) of
- Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin
+ Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin
end.
@@ -392,106 +382,106 @@ make_stub(Config) when is_list(Config) ->
catch erlang:purge_module(my_code_test),
MD5 = erlang:md5(<<>>),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "my_code_test"),
- ?line {ok,my_code_test,Code} = compile:file(File, [binary]),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "my_code_test"),
+ {ok,my_code_test,Code} = compile:file(File, [binary]),
- ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[],MD5}),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
+ my_code_test = code:make_stub_module(my_code_test, Code, {[],[],MD5}),
+ true = erlang:delete_module(my_code_test),
+ true = erlang:purge_module(my_code_test),
- ?line my_code_test = code:make_stub_module(my_code_test,
- make_unaligned_sub_binary(Code),
- {[],[],MD5}),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
+ my_code_test = code:make_stub_module(my_code_test,
+ make_unaligned_sub_binary(Code),
+ {[],[],MD5}),
+ true = erlang:delete_module(my_code_test),
+ true = erlang:purge_module(my_code_test),
- ?line my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code),
- {[],[],MD5}),
- ?line true = erlang:delete_module(my_code_test),
- ?line true = erlang:purge_module(my_code_test),
+ my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code),
+ {[],[],MD5}),
+ true = erlang:delete_module(my_code_test),
+ true = erlang:purge_module(my_code_test),
%% Should fail.
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[],MD5})),
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(my_code_test,
- bit_sized_binary(Code),
- {[],[],MD5})),
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(my_code_test_with_wrong_name,
- Code, {[],[],MD5})),
+ {'EXIT',{badarg,_}} =
+ (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[],MD5})),
+ {'EXIT',{badarg,_}} =
+ (catch code:make_stub_module(my_code_test,
+ bit_sized_binary(Code),
+ {[],[],MD5})),
+ {'EXIT',{badarg,_}} =
+ (catch code:make_stub_module(my_code_test_with_wrong_name,
+ Code, {[],[],MD5})),
ok.
make_stub_many_funs(Config) when is_list(Config) ->
catch erlang:purge_module(many_funs),
MD5 = erlang:md5(<<>>),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "many_funs"),
- ?line {ok,many_funs,Code} = compile:file(File, [binary]),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "many_funs"),
+ {ok,many_funs,Code} = compile:file(File, [binary]),
- ?line many_funs = code:make_stub_module(many_funs, Code, {[],[],MD5}),
- ?line true = erlang:delete_module(many_funs),
- ?line true = erlang:purge_module(many_funs),
- ?line many_funs = code:make_stub_module(many_funs,
- make_unaligned_sub_binary(Code),
- {[],[],MD5}),
- ?line true = erlang:delete_module(many_funs),
- ?line true = erlang:purge_module(many_funs),
+ many_funs = code:make_stub_module(many_funs, Code, {[],[],MD5}),
+ true = erlang:delete_module(many_funs),
+ true = erlang:purge_module(many_funs),
+ many_funs = code:make_stub_module(many_funs,
+ make_unaligned_sub_binary(Code),
+ {[],[],MD5}),
+ true = erlang:delete_module(many_funs),
+ true = erlang:purge_module(many_funs),
%% Should fail.
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})),
- ?line {'EXIT',{badarg,_}} =
- (catch code:make_stub_module(many_funs,
- bit_sized_binary(Code),
- {[],[],MD5})),
+ {'EXIT',{badarg,_}} =
+ (catch code:make_stub_module(many_funs, <<"bad">>, {[],[],MD5})),
+ {'EXIT',{badarg,_}} =
+ (catch code:make_stub_module(many_funs,
+ bit_sized_binary(Code),
+ {[],[],MD5})),
ok.
constant_pools(Config) when is_list(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "literals"),
- ?line {ok,literals,Code} = compile:file(File, [report,binary]),
- ?line {module,literals} = erlang:load_module(literals,
- make_sub_binary(Code)),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "literals"),
+ {ok,literals,Code} = compile:file(File, [report,binary]),
+ {module,literals} = erlang:load_module(literals,
+ make_sub_binary(Code)),
%% Initialize.
- ?line A = literals:a(),
- ?line B = literals:b(),
- ?line C = literals:huge_bignum(),
- ?line process_flag(trap_exit, true),
+ A = literals:a(),
+ B = literals:b(),
+ C = literals:huge_bignum(),
+ process_flag(trap_exit, true),
Self = self(),
%% Have a process WITHOUT old heap that references the literals
%% in the 'literals' module.
- ?line NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end),
+ NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end),
receive go -> ok end,
- ?line true = erlang:delete_module(literals),
- ?line false = erlang:check_process_code(NoOldHeap, literals),
- ?line erlang:check_process_code(self(), literals),
- ?line true = erlang:purge_module(literals),
- ?line NoOldHeap ! done,
- ?line receive
- {'EXIT',NoOldHeap,{A,B,C}} ->
- ok;
- Other ->
- ?line ?t:fail({unexpected,Other})
- end,
- ?line {module,literals} = erlang:load_module(literals, Code),
+ true = erlang:delete_module(literals),
+ false = erlang:check_process_code(NoOldHeap, literals),
+ erlang:check_process_code(self(), literals),
+ true = erlang:purge_module(literals),
+ NoOldHeap ! done,
+ receive
+ {'EXIT',NoOldHeap,{A,B,C}} ->
+ ok;
+ Other ->
+ ct:fail({unexpected,Other})
+ end,
+ {module,literals} = erlang:load_module(literals, Code),
%% Have a process WITH an old heap that references the literals
%% in the 'literals' module.
- ?line OldHeap = spawn_link(fun() -> old_heap(Self) end),
+ OldHeap = spawn_link(fun() -> old_heap(Self) end),
receive go -> ok end,
- ?line true = erlang:delete_module(literals),
- ?line false = erlang:check_process_code(OldHeap, literals),
- ?line erlang:check_process_code(self(), literals),
- ?line erlang:purge_module(literals),
- ?line OldHeap ! done,
+ true = erlang:delete_module(literals),
+ false = erlang:check_process_code(OldHeap, literals),
+ erlang:check_process_code(self(), literals),
+ erlang:purge_module(literals),
+ OldHeap ! done,
receive
- {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 ->
- ok
+ {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 ->
+ ok
end.
no_old_heap(Parent) ->
@@ -500,8 +490,8 @@ no_old_heap(Parent) ->
Res = {A,B,literals:huge_bignum()},
Parent ! go,
receive
- done ->
- exit(Res)
+ done ->
+ exit(Res)
end.
old_heap(Parent) ->
@@ -511,16 +501,16 @@ old_heap(Parent) ->
create_old_heap(),
Parent ! go,
receive
- done ->
- exit(Res)
+ done ->
+ exit(Res)
end.
create_old_heap() ->
case process_info(self(), [heap_size,total_heap_size]) of
- [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total ->
- ok;
- _ ->
- create_old_heap()
+ [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total ->
+ ok;
+ _ ->
+ create_old_heap()
end.
constant_refc_binaries(Config) when is_list(Config) ->
@@ -529,7 +519,7 @@ constant_refc_binaries(Config) when is_list(Config) ->
io:format("Binary data (bytes) before test: ~p\n", [Bef]),
%% Compile the the literals module.
- Data = ?config(data_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
File = filename:join(Data, "literals"),
{ok,literals,Code} = compile:file(File, [report,binary]),
@@ -554,29 +544,29 @@ constant_refc_binaries(Config) when is_list(Config) ->
io:format("Binary data (bytes) after test: ~p", [Aft]),
Diff = Aft - Bef,
if
- Diff < 0 ->
- io:format("~p less bytes", [abs(Diff)]);
- Diff > 0 ->
- io:format("~p more bytes", [Diff]);
- true ->
- ok
+ Diff < 0 ->
+ io:format("~p less bytes", [abs(Diff)]);
+ Diff > 0 ->
+ io:format("~p more bytes", [Diff]);
+ true ->
+ ok
end,
%% Test for leaks. We must accept some natural variations in
%% the size of allocated binaries.
if
- Diff > 64*1024 ->
- ?t:fail(binary_leak);
- true ->
- ok
+ Diff > 64*1024 ->
+ ct:fail(binary_leak);
+ true ->
+ ok
end.
memory_binary() ->
try
- erlang:memory(binary)
+ erlang:memory(binary)
catch
- error:notsup ->
- 0
+ error:notsup ->
+ 0
end.
provoke_mem_leak(0, _, _) -> ok;
@@ -586,19 +576,19 @@ provoke_mem_leak(N, Code, Check) ->
%% Create several processes with references to the literal binary.
Self = self(),
Pids = [spawn_link(fun() ->
- create_binaries(Self, NumRefs, Check)
- end) || NumRefs <- lists:seq(1, 10)],
+ create_binaries(Self, NumRefs, Check)
+ end) || NumRefs <- lists:seq(1, 10)],
[receive {started,Pid} -> ok end || Pid <- Pids],
%% Make the code old and remove references to the constant pool
%% in all processes.
true = erlang:delete_module(literals),
Ms = [spawn_monitor(fun() ->
- false = erlang:check_process_code(Pid, literals)
- end) || Pid <- Pids],
+ false = erlang:check_process_code(Pid, literals)
+ end) || Pid <- Pids],
[receive
- {'DOWN',R,process,P,normal} ->
- ok
+ {'DOWN',R,process,P,normal} ->
+ ok
end || {P,R} <- Ms],
%% Purge the code.
@@ -606,14 +596,14 @@ provoke_mem_leak(N, Code, Check) ->
%% Tell the processes that the code has been purged.
[begin
- monitor(process, Pid),
- Pid ! purged
+ monitor(process, Pid),
+ Pid ! purged
end || Pid <- Pids],
%% Wait for all processes to terminate.
[receive
- {'DOWN',_,process,Pid,normal} ->
- ok
+ {'DOWN',_,process,Pid,normal} ->
+ ok
end || Pid <- Pids],
%% We now expect that the binary has been deallocated.
@@ -625,112 +615,112 @@ create_binaries(Parent, NumRefs, Check) ->
{bits,Bits} = literals:bits(),
Parent ! {started,self()},
receive
- purged ->
- %% The code has been purged. Now make sure that
- %% the binaries haven't been corrupted.
- Check = erlang:md5(Bin),
- [Bin = B || B <- Bins],
- <<42:13,Bin/binary>> = Bits,
-
- %% Remove all references to the binaries
- %% Doing it explicitly like this ensures that
- %% the binaries are gone when the parent process
- %% receives the 'DOWN' message.
- erlang:garbage_collect()
+ purged ->
+ %% The code has been purged. Now make sure that
+ %% the binaries haven't been corrupted.
+ Check = erlang:md5(Bin),
+ [Bin = B || B <- Bins],
+ <<42:13,Bin/binary>> = Bits,
+
+ %% Remove all references to the binaries
+ %% Doing it explicitly like this ensures that
+ %% the binaries are gone when the parent process
+ %% receives the 'DOWN' message.
+ erlang:garbage_collect()
end.
wait_for_memory_deallocations() ->
try
- erts_debug:set_internal_state(wait, deallocations)
+ erts_debug:set_internal_state(wait, deallocations)
catch
- error:undef ->
- erts_debug:set_internal_state(available_internal_state, true),
- wait_for_memory_deallocations()
+ error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ wait_for_memory_deallocations()
end.
%% OTP-7559: c_p->cp could contain garbage and create a false dependency
%% to a module in a process. (Thanks to Richard Carlsson.)
false_dependency(Config) when is_list(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "cpbugx"),
- ?line {ok,cpbugx,Code} = compile:file(File, [binary,report]),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "cpbugx"),
+ {ok,cpbugx,Code} = compile:file(File, [binary,report]),
do_false_dependency(fun cpbugx:before/0, Code),
do_false_dependency(fun cpbugx:before2/0, Code),
do_false_dependency(fun cpbugx:before3/0, Code),
-%% %% Spawn process. Make sure it has called cpbugx:before/0 and returned.
-%% Parent = self(),
-%% ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent) end),
-%% ?line receive initialized -> ok end,
+ %% %% Spawn process. Make sure it has called cpbugx:before/0 and returned.
+ %% Parent = self(),
+ %% Pid = spawn_link(fun() -> false_dependency_loop(Parent) end),
+ %% receive initialized -> ok end,
+
+ %% %% Reload the module. Make sure the process is still alive.
+ %% {module,cpbugx} = erlang:load_module(cpbugx, Bin),
+ %% io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))),
+ %% true = is_process_alive(Pid),
-%% %% Reload the module. Make sure the process is still alive.
-%% ?line {module,cpbugx} = erlang:load_module(cpbugx, Bin),
-%% ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))),
-%% ?line true = is_process_alive(Pid),
+ %% %% There should not be any dependency to cpbugx.
+ %% false = erlang:check_process_code(Pid, cpbugx),
-%% %% There should not be any dependency to cpbugx.
-%% ?line false = erlang:check_process_code(Pid, cpbugx),
-
-%% %% Kill the process.
-%% ?line unlink(Pid), exit(Pid, kill),
+ %% %% Kill the process.
+ %% unlink(Pid), exit(Pid, kill),
ok.
do_false_dependency(Init, Code) ->
- ?line {module,cpbugx} = erlang:load_module(cpbugx, Code),
+ {module,cpbugx} = erlang:load_module(cpbugx, Code),
%% Spawn process. Make sure it has the appropriate init function
%% and returned. CP should not contain garbage after the return.
Parent = self(),
- ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end),
- ?line receive initialized -> ok end,
+ Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end),
+ receive initialized -> ok end,
%% Reload the module. Make sure the process is still alive.
- ?line {module,cpbugx} = erlang:load_module(cpbugx, Code),
- ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))),
- ?line true = is_process_alive(Pid),
+ {module,cpbugx} = erlang:load_module(cpbugx, Code),
+ io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))),
+ true = is_process_alive(Pid),
%% There should not be any dependency to cpbugx.
- ?line false = erlang:check_process_code(Pid, cpbugx),
+ false = erlang:check_process_code(Pid, cpbugx),
%% Kill the process and completely unload the code.
- ?line unlink(Pid), exit(Pid, kill),
- ?line true = erlang:purge_module(cpbugx),
- ?line true = erlang:delete_module(cpbugx),
- ?line code:is_module_native(cpbugx), % test is_module_native on deleted code
- ?line true = erlang:purge_module(cpbugx),
- ?line code:is_module_native(cpbugx), % test is_module_native on purged code
+ unlink(Pid), exit(Pid, kill),
+ true = erlang:purge_module(cpbugx),
+ true = erlang:delete_module(cpbugx),
+ code:is_module_native(cpbugx), % test is_module_native on deleted code
+ true = erlang:purge_module(cpbugx),
+ code:is_module_native(cpbugx), % test is_module_native on purged code
ok.
-
+
false_dependency_loop(Parent, Init, SendInitAck) ->
Init(),
case SendInitAck of
- true -> Parent ! initialized;
- false -> void
- %% Just send one init-ack. I guess the point of this test
- %% wasn't to fill parents msg-queue (?). Seen to cause
- %% out-of-mem (on halfword-vm for some reason) by
- %% 91 million msg in queue. /sverker
+ true -> Parent ! initialized;
+ false -> void
+ %% Just send one init-ack. I guess the point of this test
+ %% wasn't to fill parents msg-queue (?). Seen to cause
+ %% out-of-mem (on halfword-vm for some reason) by
+ %% 91 million msg in queue. /sverker
end,
receive
- _ -> false_dependency_loop(Parent, Init, false)
+ _ -> false_dependency_loop(Parent, Init, false)
end.
coverage(Config) when is_list(Config) ->
- ?line code:is_module_native(?MODULE),
- ?line {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})),
- ?line {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})),
- ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)),
- ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])),
- ?line {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])),
- ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)),
+ code:is_module_native(?MODULE),
+ {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})),
+ {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})),
+ {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)),
+ {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])),
+ {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])),
+ {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)),
ok.
fun_confusion(Config) when is_list(Config) ->
- Data = ?config(data_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
Src = filename:join(Data, "fun_confusion"),
Mod = fun_confusion,
@@ -753,6 +743,80 @@ compile_load(Mod, Src, Ver) ->
{module,Mod} = code:load_binary(Mod, "fun_confusion.beam", Code1),
ok.
+
+t_copy_literals(Config) when is_list(Config) ->
+ %% Compile the the literals module.
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "literals"),
+ {ok,literals,Code} = compile:file(File, [report,binary]),
+ {module,literals} = erlang:load_module(literals, Code),
+
+ N = 30,
+ Me = self(),
+ %% reload literals code every 567 ms
+ Rel = spawn_link(fun() -> reloader(literals,Code,567) end),
+ %% add new literal msgs to the loop every 789 ms
+ Sat = spawn_link(fun() -> saturate(Me,789) end),
+ %% run for 10s
+ _ = spawn_link(fun() -> receive after 10000 -> Me ! done end end),
+ ok = chase_msg(N, Me),
+ %% cleanup
+ Rel ! done,
+ Sat ! done,
+ ok = flush(),
+ ok.
+
+
+chase_msg(0, Pid) ->
+ chase_loop(Pid);
+chase_msg(N, Master) ->
+ Pid = spawn_link(fun() -> chase_msg(N - 1,Master) end),
+ chase_loop(Pid).
+
+chase_loop(Pid) ->
+ receive
+ done ->
+ Pid ! done,
+ ok;
+ {_From,Msg} ->
+ Pid ! {self(), Msg},
+ ok = traverse(Msg),
+ chase_loop(Pid)
+ end.
+
+saturate(Pid,Time) ->
+ Es = [msg1,msg2,msg3,msg4,msg5],
+ Msg = [literals:E()||E <- Es],
+ Pid ! {self(), Msg},
+ receive
+ done -> ok
+ after Time ->
+ saturate(Pid,Time)
+ end.
+
+traverse([]) -> ok;
+traverse([H|T]) ->
+ ok = traverse(H),
+ traverse(T);
+traverse(T) when is_tuple(T) -> ok;
+traverse(B) when is_binary(B) -> ok;
+traverse(I) when is_integer(I) -> ok;
+traverse(#{ 1 := V1, b := V2 }) ->
+ ok = traverse(V1),
+ ok = traverse(V2),
+ ok.
+
+
+reloader(Mod,Code,Time) ->
+ receive
+ done -> ok
+ after Time ->
+ code:purge(Mod),
+ {module,Mod} = erlang:load_module(Mod, Code),
+ reloader(Mod,Code,Time)
+ end.
+
+
%% Utilities.
make_sub_binary(Bin) when is_binary(Bin) ->
@@ -775,4 +839,7 @@ bit_sized_binary(Bin0) ->
BitSize = 8*size(Bin) + 1,
Bin.
+flush() ->
+ receive _ -> flush() after 0 -> ok end.
+
id(I) -> I.
diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl
index 9802d9d3f9..a36bfe09dd 100644
--- a/erts/emulator/test/code_SUITE_data/literals.erl
+++ b/erts/emulator/test/code_SUITE_data/literals.erl
@@ -20,6 +20,7 @@
-module(literals).
-export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]).
+-export([msg1/0,msg2/0,msg3/0,msg4/0,msg5/0]).
a() ->
{a,42.0,[7,38877938333399637266518333334747]}.
@@ -101,3 +102,9 @@ unused_binaries() ->
bits() ->
{bits,<<42:13,?MB_1>>}.
+
+msg1() -> "halloj".
+msg2() -> {"hello","world"}.
+msg3() -> <<"halloj">>.
+msg4() -> #{ 1=> "hello", b => "world"}.
+msg5() -> {1,2,3,4,5,6}.
diff --git a/erts/emulator/test/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl
index b7ac0420cd..e9e7000434 100644
--- a/erts/emulator/test/code_parallel_load_SUITE.erl
+++ b/erts/emulator/test/code_parallel_load_SUITE.erl
@@ -19,49 +19,34 @@
%%
-module(code_parallel_load_SUITE).
--export([
- all/0,
- suite/0,
- init_per_suite/1,
- end_per_suite/1,
- init_per_testcase/2,
- end_per_testcase/2
- ]).
-
--export([
- multiple_load_check_purge_repeat/1,
- many_load_distributed_only_once/1
- ]).
+-export([all/0,
+ suite/0,
+ init_per_testcase/2,
+ end_per_testcase/2]).
+
+-export([multiple_load_check_purge_repeat/1,
+ many_load_distributed_only_once/1]).
-define(model, code_parallel_load_SUITE_model).
-define(interval, 50).
-define(number_of_processes, 160).
-define(passes, 4).
+-include_lib("common_test/include/ct.hrl").
--include_lib("test_server/include/test_server.hrl").
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
- [
- multiple_load_check_purge_repeat,
- many_load_distributed_only_once
- ].
-
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
+ [ multiple_load_check_purge_repeat,
+ many_load_distributed_only_once ].
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(3)),
- [{watchdog, Dog}|Config].
+ Config.
end_per_testcase(_Func, Config) ->
- SConf = ?config(save_config, Config),
+ SConf = proplists:get_value(save_config, Config),
Pids = proplists:get_value(purge_pids, SConf),
case check_old_code(?model) of
@@ -72,9 +57,7 @@ end_per_testcase(_Func, Config) ->
true -> check_and_purge_processes_code(Pids, ?model);
_ -> ok
end,
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
+ ok.
multiple_load_check_purge_repeat(_Conf) ->
Ts = [v1,v2,v3,v4,v5,v6],
diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl
index 3622592586..6212997272 100644
--- a/erts/emulator/test/crypto_SUITE.erl
+++ b/erts/emulator/test/crypto_SUITE.erl
@@ -20,65 +20,44 @@
-module(crypto_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1,
- misc_errors/1]).
+-export([all/0, suite/0,
+ t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1,
+ misc_errors/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
all() ->
[t_md5, t_md5_update, error, unaligned_context,
random_lists, misc_errors].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-
-misc_errors(doc) ->
- ["Test crc32, adler32 and md5 error cases not covered by other tests"];
-misc_errors(suite) ->
- [];
+%% Test crc32, adler32 and md5 error cases not covered by other tests"
misc_errors(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(2)),
- ?line 1 = erlang:adler32([]),
- ?line L = lists:duplicate(600,3),
- ?line 1135871753 = erlang:adler32(L),
- ?line L2 = lists:duplicate(22000,3),
- ?line 1100939744 = erlang:adler32(L2),
- ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(L++[a])),
- ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(L++[a])),
- ?line {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|<<25:7>>])),
- ?line {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|4])),
- ?line Big = 111111111111111111111111111111,
- ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(Big,<<"hej">>)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(25,[1,2,3|4])),
- ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(Big,3,3)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,Big,3)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,3,Big)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(Big,<<"hej">>)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(25,[1,2,3|4])),
- ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(Big,3,3)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,Big,3)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,3,Big)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:md5_update(<<"hej">>,<<"hej">>)),
- ?line {'EXIT', {badarg,_}} = (catch erlang:md5_final(<<"hej">>)),
- ?line test_server:timetrap_cancel(Dog),
+ ct:timetrap({minutes, 2}),
+ 1 = erlang:adler32([]),
+ L = lists:duplicate(600,3),
+ 1135871753 = erlang:adler32(L),
+ L2 = lists:duplicate(22000,3),
+ 1100939744 = erlang:adler32(L2),
+ {'EXIT', {badarg,_}} = (catch erlang:adler32(L++[a])),
+ {'EXIT', {badarg,_}} = (catch erlang:crc32(L++[a])),
+ {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|<<25:7>>])),
+ {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|4])),
+ Big = 111111111111111111111111111111,
+ {'EXIT', {badarg,_}} = (catch erlang:crc32(Big,<<"hej">>)),
+ {'EXIT', {badarg,_}} = (catch erlang:crc32(25,[1,2,3|4])),
+ {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(Big,3,3)),
+ {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,Big,3)),
+ {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,3,Big)),
+ {'EXIT', {badarg,_}} = (catch erlang:adler32(Big,<<"hej">>)),
+ {'EXIT', {badarg,_}} = (catch erlang:adler32(25,[1,2,3|4])),
+ {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(Big,3,3)),
+ {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,Big,3)),
+ {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,3,Big)),
+ {'EXIT', {badarg,_}} = (catch erlang:md5_update(<<"hej">>,<<"hej">>)),
+ {'EXIT', {badarg,_}} = (catch erlang:md5_final(<<"hej">>)),
ok.
@@ -93,7 +72,7 @@ nicesplit(N,L) ->
nicesplit(0,Tail,Acc) ->
{lists:reverse(Acc),Tail};
nicesplit(_,[],Acc) ->
- {lists:reverse(Acc),[]};
+ {lists:reverse(Acc),[]};
nicesplit(N,[H|Tail],Acc) ->
nicesplit(N-1,Tail,[H|Acc]).
@@ -102,17 +81,17 @@ run_in_para([],_) ->
run_in_para(FunList,Schedulers) ->
{ThisTime,NextTime} = nicesplit(Schedulers,FunList),
case length(ThisTime) of
- 1 ->
- [{L,Fun}] = ThisTime,
- try
- Fun()
+ 1 ->
+ [{L,Fun}] = ThisTime,
+ try
+ Fun()
catch
- _:Reason ->
- exit({error_at_line,L,Reason})
- end;
+ _:Reason ->
+ exit({error_at_line,L,Reason})
+ end;
_ ->
- These = [ {L,erlang:spawn_monitor(F)} || {L,F} <- ThisTime ],
- collect_workers(These)
+ These = [ {L,erlang:spawn_monitor(F)} || {L,F} <- ThisTime ],
+ collect_workers(These)
end,
run_in_para(NextTime,Schedulers).
@@ -120,159 +99,147 @@ collect_workers([]) ->
ok;
collect_workers([{L,{Pid,Ref}}|T]) ->
receive
- {'DOWN',Ref,process,Pid,normal} ->
- collect_workers(T);
- {'DOWN',Ref,process,Pid,Other} ->
- exit({error_at_line,L,Other})
+ {'DOWN',Ref,process,Pid,normal} ->
+ collect_workers(T);
+ {'DOWN',Ref,process,Pid,Other} ->
+ exit({error_at_line,L,Other})
end.
-random_lists(doc) ->
- ["Test crc32, adler32 and md5 on a number of pseudo-randomly generated "
- "lists."];
-random_lists(suite) ->
- [];
+%% Test crc32, adler32 and md5 on a number of pseudo-randomly generated lists.
random_lists(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(5)),
- ?line Num = erlang:system_info(schedulers_online),
- ?line B = list_to_binary(
- lists:duplicate(
- (erlang:system_info(context_reductions)*10) - 50,$!)),
- ?line CRC32_1 = fun(L) -> erlang:crc32(L) end,
- ?line CRC32_2 = fun(L) -> ?REF:crc32(L) end,
- ?line ADLER32_1 = fun(L) -> erlang:adler32(L) end,
- ?line ADLER32_2 = fun(L) -> ?REF:adler32(L) end,
- ?line MD5_1 = fun(L) -> erlang:md5(L) end,
- ?line MD5_2 = fun(L) -> ?REF:md5_final(
- ?REF:md5_update(?REF:md5_init(),L)) end,
- ?line MD5_3 = fun(L) -> erlang:md5_final(
- erlang:md5_update(erlang:md5_init(),L)) end,
- ?line CRC32_1_L = fun(L) -> erlang:crc32([B|L]) end,
- ?line CRC32_2_L = fun(L) -> ?REF:crc32([B|L]) end,
- ?line ADLER32_1_L = fun(L) -> erlang:adler32([B|L]) end,
- ?line ADLER32_2_L = fun(L) -> ?REF:adler32([B|L]) end,
- ?line MD5_1_L = fun(L) -> erlang:md5([B|L]) end,
- ?line MD5_2_L = fun(L) -> ?REF:md5_final(
- ?REF:md5_update(?REF:md5_init(),[B|L])) end,
- ?line MD5_3_L = fun(L) -> erlang:md5_final(
- erlang:md5_update(
- erlang:md5_init(),[B|L])) end,
- ?line Wlist0 =
- [{?LINE, fun() -> random_iolist:run(150, CRC32_1, CRC32_2) end},
- {?LINE, fun() -> random_iolist:run(150, ADLER32_1, ADLER32_2) end},
- {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_2) end},
- {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_3) end},
- {?LINE, fun() -> random_iolist:run(150, CRC32_1_L, CRC32_2_L) end},
- {?LINE,
- fun() -> random_iolist:run(150, ADLER32_1_L, ADLER32_2_L) end},
- {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_2_L) end},
- {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_3_L) end}],
- ?line run_in_para(Wlist0,Num),
- ?line CRC32_1_2 = fun(L1,L2) -> erlang:crc32([L1,L2]) end,
- ?line CRC32_2_2 = fun(L1,L2) -> erlang:crc32(erlang:crc32(L1),L2) end,
- ?line CRC32_3_2 = fun(L1,L2) -> erlang:crc32_combine(
- erlang:crc32(L1),
- erlang:crc32(L2),
- erlang:iolist_size(L2))
- end,
- ?line ADLER32_1_2 = fun(L1,L2) -> erlang:adler32([L1,L2]) end,
- ?line ADLER32_2_2 = fun(L1,L2) -> erlang:adler32(
- erlang:adler32(L1),L2) end,
- ?line ADLER32_3_2 = fun(L1,L2) -> erlang:adler32_combine(
- erlang:adler32(L1),
- erlang:adler32(L2),
- erlang:iolist_size(L2))
- end,
- ?line MD5_1_2 = fun(L1,L2) -> erlang:md5([L1,L2]) end,
- ?line MD5_2_2 = fun(L1,L2) ->
- erlang:md5_final(
- erlang:md5_update(
- erlang:md5_update(
- erlang:md5_init(),
- L1),
- L2))
- end,
- ?line CRC32_1_L_2 = fun(L1,L2) -> erlang:crc32([[B|L1],[B|L2]]) end,
- ?line CRC32_2_L_2 = fun(L1,L2) -> erlang:crc32(
- erlang:crc32([B|L1]),[B|L2]) end,
- ?line CRC32_3_L_2 = fun(L1,L2) -> erlang:crc32_combine(
- erlang:crc32([B|L1]),
- erlang:crc32([B|L2]),
- erlang:iolist_size([B|L2]))
- end,
- ?line ADLER32_1_L_2 = fun(L1,L2) -> erlang:adler32([[B|L1],[B|L2]]) end,
- ?line ADLER32_2_L_2 = fun(L1,L2) -> erlang:adler32(
- erlang:adler32([B|L1]),
- [B|L2])
- end,
- ?line ADLER32_3_L_2 = fun(L1,L2) -> erlang:adler32_combine(
- erlang:adler32([B|L1]),
- erlang:adler32([B|L2]),
- erlang:iolist_size([B|L2]))
- end,
- ?line MD5_1_L_2 = fun(L1,L2) -> erlang:md5([[B|L1],[B|L2]]) end,
- ?line MD5_2_L_2 = fun(L1,L2) ->
- erlang:md5_final(
- erlang:md5_update(
- erlang:md5_update(
- erlang:md5_init(),
- [B|L1]),
- [B|L2]))
- end,
- ?line Wlist1 =
- [{?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_2_2) end},
- {?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_3_2) end},
- {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_2_2) end},
- {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_3_2) end},
- {?LINE, fun() -> random_iolist:run2(150,MD5_1_2,MD5_2_2) end},
- {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_2_L_2) end},
- {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_3_L_2) end},
- {?LINE,
- fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_2_L_2) end},
- {?LINE,
- fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_3_L_2) end},
- {?LINE, fun() -> random_iolist:run2(150,MD5_1_L_2,MD5_2_L_2) end}],
- ?line run_in_para(Wlist1,Num),
- ?line test_server:timetrap_cancel(Dog),
+ ct:timetrap({minutes, 5}),
+ Num = erlang:system_info(schedulers_online),
+ B = list_to_binary(
+ lists:duplicate(
+ (erlang:system_info(context_reductions)*10) - 50,$!)),
+ CRC32_1 = fun(L) -> erlang:crc32(L) end,
+ CRC32_2 = fun(L) -> ?REF:crc32(L) end,
+ ADLER32_1 = fun(L) -> erlang:adler32(L) end,
+ ADLER32_2 = fun(L) -> ?REF:adler32(L) end,
+ MD5_1 = fun(L) -> erlang:md5(L) end,
+ MD5_2 = fun(L) -> ?REF:md5_final(
+ ?REF:md5_update(?REF:md5_init(),L)) end,
+ MD5_3 = fun(L) -> erlang:md5_final(
+ erlang:md5_update(erlang:md5_init(),L)) end,
+ CRC32_1_L = fun(L) -> erlang:crc32([B|L]) end,
+ CRC32_2_L = fun(L) -> ?REF:crc32([B|L]) end,
+ ADLER32_1_L = fun(L) -> erlang:adler32([B|L]) end,
+ ADLER32_2_L = fun(L) -> ?REF:adler32([B|L]) end,
+ MD5_1_L = fun(L) -> erlang:md5([B|L]) end,
+ MD5_2_L = fun(L) -> ?REF:md5_final(
+ ?REF:md5_update(?REF:md5_init(),[B|L])) end,
+ MD5_3_L = fun(L) -> erlang:md5_final(
+ erlang:md5_update(
+ erlang:md5_init(),[B|L])) end,
+ Wlist0 =
+ [{?LINE, fun() -> random_iolist:run(150, CRC32_1, CRC32_2) end},
+ {?LINE, fun() -> random_iolist:run(150, ADLER32_1, ADLER32_2) end},
+ {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_2) end},
+ {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_3) end},
+ {?LINE, fun() -> random_iolist:run(150, CRC32_1_L, CRC32_2_L) end},
+ {?LINE,
+ fun() -> random_iolist:run(150, ADLER32_1_L, ADLER32_2_L) end},
+ {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_2_L) end},
+ {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_3_L) end}],
+ run_in_para(Wlist0,Num),
+ CRC32_1_2 = fun(L1,L2) -> erlang:crc32([L1,L2]) end,
+ CRC32_2_2 = fun(L1,L2) -> erlang:crc32(erlang:crc32(L1),L2) end,
+ CRC32_3_2 = fun(L1,L2) -> erlang:crc32_combine(
+ erlang:crc32(L1),
+ erlang:crc32(L2),
+ erlang:iolist_size(L2))
+ end,
+ ADLER32_1_2 = fun(L1,L2) -> erlang:adler32([L1,L2]) end,
+ ADLER32_2_2 = fun(L1,L2) -> erlang:adler32(
+ erlang:adler32(L1),L2) end,
+ ADLER32_3_2 = fun(L1,L2) -> erlang:adler32_combine(
+ erlang:adler32(L1),
+ erlang:adler32(L2),
+ erlang:iolist_size(L2))
+ end,
+ MD5_1_2 = fun(L1,L2) -> erlang:md5([L1,L2]) end,
+ MD5_2_2 = fun(L1,L2) ->
+ erlang:md5_final(
+ erlang:md5_update(
+ erlang:md5_update(
+ erlang:md5_init(),
+ L1),
+ L2))
+ end,
+ CRC32_1_L_2 = fun(L1,L2) -> erlang:crc32([[B|L1],[B|L2]]) end,
+ CRC32_2_L_2 = fun(L1,L2) -> erlang:crc32(
+ erlang:crc32([B|L1]),[B|L2]) end,
+ CRC32_3_L_2 = fun(L1,L2) -> erlang:crc32_combine(
+ erlang:crc32([B|L1]),
+ erlang:crc32([B|L2]),
+ erlang:iolist_size([B|L2]))
+ end,
+ ADLER32_1_L_2 = fun(L1,L2) -> erlang:adler32([[B|L1],[B|L2]]) end,
+ ADLER32_2_L_2 = fun(L1,L2) -> erlang:adler32(
+ erlang:adler32([B|L1]),
+ [B|L2])
+ end,
+ ADLER32_3_L_2 = fun(L1,L2) -> erlang:adler32_combine(
+ erlang:adler32([B|L1]),
+ erlang:adler32([B|L2]),
+ erlang:iolist_size([B|L2]))
+ end,
+ MD5_1_L_2 = fun(L1,L2) -> erlang:md5([[B|L1],[B|L2]]) end,
+ MD5_2_L_2 = fun(L1,L2) ->
+ erlang:md5_final(
+ erlang:md5_update(
+ erlang:md5_update(
+ erlang:md5_init(),
+ [B|L1]),
+ [B|L2]))
+ end,
+ Wlist1 =
+ [{?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_2_2) end},
+ {?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_3_2) end},
+ {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_2_2) end},
+ {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_3_2) end},
+ {?LINE, fun() -> random_iolist:run2(150,MD5_1_2,MD5_2_2) end},
+ {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_2_L_2) end},
+ {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_3_L_2) end},
+ {?LINE,
+ fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_2_L_2) end},
+ {?LINE,
+ fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_3_L_2) end},
+ {?LINE, fun() -> random_iolist:run2(150,MD5_1_L_2,MD5_2_L_2) end}],
+ run_in_para(Wlist1,Num),
ok.
-%%
-%%
-t_md5(doc) ->
- ["Generate MD5 message digests and check the result. Examples are "
- "from RFC-1321."];
+%% Generate MD5 message digests and check the result. Examples are from RFC-1321.
t_md5(Config) when is_list(Config) ->
- ?line t_md5_test("", "d41d8cd98f00b204e9800998ecf8427e"),
- ?line t_md5_test("a", "0cc175b9c0f1b6a831c399e269772661"),
- ?line t_md5_test("abc", "900150983cd24fb0d6963f7d28e17f72"),
- ?line t_md5_test(["message ","digest"], "f96b697d7cb7938d525a2f31aaf161d0"),
- ?line t_md5_test(["message ",unaligned_sub_bin(<<"digest">>)],
- "f96b697d7cb7938d525a2f31aaf161d0"),
- ?line t_md5_test("abcdefghijklmnopqrstuvwxyz",
- "c3fcd3d76192e4007dfb496cca67e13b"),
- ?line t_md5_test("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
- "0123456789",
- "d174ab98d277d9f5a5611c2c9f419d9f"),
- ?line t_md5_test("12345678901234567890123456789012345678901234567890"
- "123456789012345678901234567890",
- "57edf4a22be3c955ac49da2e2107b67a"),
+ t_md5_test("", "d41d8cd98f00b204e9800998ecf8427e"),
+ t_md5_test("a", "0cc175b9c0f1b6a831c399e269772661"),
+ t_md5_test("abc", "900150983cd24fb0d6963f7d28e17f72"),
+ t_md5_test(["message ","digest"], "f96b697d7cb7938d525a2f31aaf161d0"),
+ t_md5_test(["message ",unaligned_sub_bin(<<"digest">>)],
+ "f96b697d7cb7938d525a2f31aaf161d0"),
+ t_md5_test("abcdefghijklmnopqrstuvwxyz",
+ "c3fcd3d76192e4007dfb496cca67e13b"),
+ t_md5_test("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
+ "0123456789",
+ "d174ab98d277d9f5a5611c2c9f419d9f"),
+ t_md5_test("12345678901234567890123456789012345678901234567890"
+ "123456789012345678901234567890",
+ "57edf4a22be3c955ac49da2e2107b67a"),
ok.
-%%
-%%
-t_md5_update(doc) ->
- ["Generate MD5 message using md5_init, md5_update, and md5_final, and"
- "check the result. Examples are from RFC-1321."];
+%% Generate MD5 message using md5_init, md5_update, and md5_final, and
+%% check the result. Examples are from RFC-1321.
t_md5_update(Config) when is_list(Config) ->
- ?line t_md5_update_1(fun(Str) -> Str end),
- ?line t_md5_update_1(fun(Str) -> list_to_binary(Str) end),
- ?line t_md5_update_1(fun(Str) -> unaligned_sub_bin(list_to_binary(Str)) end),
+ t_md5_update_1(fun(Str) -> Str end),
+ t_md5_update_1(fun(Str) -> list_to_binary(Str) end),
+ t_md5_update_1(fun(Str) -> unaligned_sub_bin(list_to_binary(Str)) end),
ok.
t_md5_update_1(Tr) when is_function(Tr, 1) ->
Ctx = erlang:md5_init(),
Ctx1 = erlang:md5_update(Ctx, Tr("ABCDEFGHIJKLMNOPQRSTUVWXYZ")),
Ctx2 = erlang:md5_update(Ctx1, Tr("abcdefghijklmnopqrstuvwxyz"
- "0123456789")),
+ "0123456789")),
m(erlang:md5_final(Ctx2),
hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")),
ok.
@@ -280,28 +247,28 @@ t_md5_update_1(Tr) when is_function(Tr, 1) ->
%%
%%
error(Config) when is_list(Config) ->
- ?line {'EXIT',{badarg,_}} = (catch erlang:md5(bit_sized_binary(<<"abc">>))),
- ?line Ctx0 = erlang:md5_init(),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:md5_update(Ctx0, bit_sized_binary(<<"abcfjldjd">>))),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:md5_update(Ctx0, ["something",bit_sized_binary(<<"abcfjldjd">>)])),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:md5_update(bit_sized_binary(Ctx0), "something")),
- ?line {'EXIT',{badarg,_}} = (catch erlang:md5_final(bit_sized_binary(Ctx0))),
- ?line m(erlang:md5_final(Ctx0), hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")),
+ {'EXIT',{badarg,_}} = (catch erlang:md5(bit_sized_binary(<<"abc">>))),
+ Ctx0 = erlang:md5_init(),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:md5_update(Ctx0, bit_sized_binary(<<"abcfjldjd">>))),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:md5_update(Ctx0, ["something",bit_sized_binary(<<"abcfjldjd">>)])),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:md5_update(bit_sized_binary(Ctx0), "something")),
+ {'EXIT',{badarg,_}} = (catch erlang:md5_final(bit_sized_binary(Ctx0))),
+ m(erlang:md5_final(Ctx0), hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")),
ok.
%%
%%
unaligned_context(Config) when is_list(Config) ->
- ?line Ctx0 = erlang:md5_init(),
- ?line Ctx1 = erlang:md5_update(unaligned_sub_bin(Ctx0), "ABCDEFGHIJKLMNOPQRSTUVWXYZ"),
- ?line Ctx = erlang:md5_update(unaligned_sub_bin(Ctx1),
- "abcdefghijklmnopqrstuvwxyz0123456789"),
- ?line m(erlang:md5_final(unaligned_sub_bin(Ctx)),
- hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")),
+ Ctx0 = erlang:md5_init(),
+ Ctx1 = erlang:md5_update(unaligned_sub_bin(Ctx0), "ABCDEFGHIJKLMNOPQRSTUVWXYZ"),
+ Ctx = erlang:md5_update(unaligned_sub_bin(Ctx1),
+ "abcdefghijklmnopqrstuvwxyz0123456789"),
+ m(erlang:md5_final(unaligned_sub_bin(Ctx)),
+ hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")),
ok.
%%
@@ -347,5 +314,3 @@ bit_sized_binary(Bin0) ->
Bin.
id(I) -> I.
-
-
diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl
index cabd6472d4..6982178827 100644
--- a/erts/emulator/test/ddll_SUITE.erl
+++ b/erts/emulator/test/ddll_SUITE.erl
@@ -31,30 +31,31 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, ddll_test/1, errors/1,
- reference_count/1,
- kill_port/1, dont_kill_port/1]).
+-export([all/0, suite/0,
+ ddll_test/1, errors/1, reference_count/1,
+ kill_port/1, dont_kill_port/1]).
-export([unload_on_process_exit/1, delayed_unload_with_ports/1,
- unload_due_to_process_exit/1,
- no_unload_due_to_process_exit/1, no_unload_due_to_process_exit_2/1,
- unload_reload_thingie/1, unload_reload_thingie_2/1,
- unload_reload_thingie_3/1, reload_pending/1, reload_pending_kill/1,
- load_fail_init/1,
- reload_pending_fail_init/1,
- more_error_codes/1, forced_port_killing/1,
- no_trap_exit_and_kill_ports/1,
- monitor_demonitor/1, monitor_demonitor_load/1, new_interface/1,
- lock_driver/1]).
+ unload_due_to_process_exit/1,
+ no_unload_due_to_process_exit/1, no_unload_due_to_process_exit_2/1,
+ unload_reload_thingie/1, unload_reload_thingie_2/1,
+ unload_reload_thingie_3/1, reload_pending/1, reload_pending_kill/1,
+ load_fail_init/1,
+ reload_pending_fail_init/1,
+ more_error_codes/1, forced_port_killing/1,
+ no_trap_exit_and_kill_ports/1,
+ monitor_demonitor/1, monitor_demonitor_load/1, new_interface/1,
+ lock_driver/1]).
% Private exports
-export([echo_loader/2, nice_echo_loader/2 ,properties/1, load_and_unload/1]).
-import(ordsets, [subtract/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 10}}].
all() ->
[ddll_test, errors, reference_count, kill_port,
@@ -70,1057 +71,931 @@ all() ->
no_trap_exit_and_kill_ports, monitor_demonitor,
monitor_demonitor_load, new_interface, lock_driver].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-unload_on_process_exit(suite) ->
- [];
-unload_on_process_exit(doc) ->
- ["Check that the driver is unloaded on process exit"];
+%% Check that the driver is unloaded on process exit
unload_on_process_exit(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())),
+ Path = proplists:get_value(data_dir, Config),
+ false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())),
Parent = self(),
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- erl_ddll:try_load(Path, echo_drv, []),
- Parent ! gone,
- receive go -> ok end,
- erl_ddll:loaded_drivers(),
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
- ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())),
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ erl_ddll:try_load(Path, echo_drv, []),
+ Parent ! gone,
+ receive go -> ok end,
+ erl_ddll:loaded_drivers(),
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
+ false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())),
Pid ! go,
- ?line receive
- gone -> ok
+ receive
+ gone -> ok
end,
- ?line true = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())),
+ true = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())),
Pid ! go,
- ?line receive
- {'DOWN', Ref, process, Pid, banan} ->
- ok
+ receive
+ {'DOWN', Ref, process, Pid, banan} ->
+ ok
end,
receive after 500 -> ok end,
- ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())),
- ?line test_server:timetrap_cancel(Dog),
+ false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())),
ok.
-delayed_unload_with_ports(suite) ->
- [];
-delayed_unload_with_ports(doc) ->
- ["Check that the driver is unloaded when the last port is closed"];
+%% Check that the driver is unloaded when the last port is closed
delayed_unload_with_ports(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line erl_ddll:try_load(Path, echo_drv, []),
- ?line erl_ddll:try_load(Path, echo_drv, []),
- ?line Port = open_port({spawn, echo_drv}, [eof]),
- ?line 1 = erl_ddll:info(echo_drv, port_count),
- ?line Port2 = open_port({spawn, echo_drv}, [eof]),
- ?line 2 = erl_ddll:info(echo_drv, port_count),
- ?line {ok,pending_process} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]),
- ?line {ok,pending_driver,Ref} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]),
- ?line ok = receive _ -> false after 0 -> ok end,
- ?line Port ! {self(), close},
- ?line ok = receive {Port,closed} -> ok after 1000 -> false end,
- ?line 1 = erl_ddll:info(echo_drv, port_count),
- ?line Port2 ! {self(), close},
- ?line ok = receive {Port2,closed} -> ok after 1000 -> false end,
- ?line ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 1000 -> false end,
- ?line test_server:timetrap_cancel(Dog),
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:try_load(Path, echo_drv, []),
+ erl_ddll:try_load(Path, echo_drv, []),
+ Port = open_port({spawn, echo_drv}, [eof]),
+ 1 = erl_ddll:info(echo_drv, port_count),
+ Port2 = open_port({spawn, echo_drv}, [eof]),
+ 2 = erl_ddll:info(echo_drv, port_count),
+ {ok,pending_process} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]),
+ {ok,pending_driver,Ref} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]),
+ ok = receive _ -> false after 0 -> ok end,
+ Port ! {self(), close},
+ ok = receive {Port,closed} -> ok after 1000 -> false end,
+ 1 = erl_ddll:info(echo_drv, port_count),
+ Port2 ! {self(), close},
+ ok = receive {Port2,closed} -> ok after 1000 -> false end,
+ ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 1000 -> false end,
ok.
-unload_due_to_process_exit(suite) ->
- [];
-unload_due_to_process_exit(doc) ->
- ["Check that the driver with ports is unloaded on process exit"];
+%% Check that the driver with ports is unloaded on process exit
unload_due_to_process_exit(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- spawn(F3),
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- _Port2 = open_port({spawn, echo_drv}, [eof]),
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ spawn(F3),
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ _Port2 = open_port({spawn, echo_drv}, [eof]),
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
ok.
-no_unload_due_to_process_exit(suite) ->
- [];
-no_unload_due_to_process_exit(doc) ->
- ["Check that a driver with driver loaded in another process is not unloaded on process exit"];
+%% Check that a driver with driver loaded in another process is not unloaded on process exit
no_unload_due_to_process_exit(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- spawn(F3),
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- _Port2 = open_port({spawn, echo_drv}, [eof]),
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ spawn(F3),
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ _Port2 = open_port({spawn, echo_drv}, [eof]),
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive X -> {error, X} after 300 -> ok end,
- ?line ok = unload_expect_fast(echo_drv,[]),
- ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive X -> {error, X} after 300 -> ok end,
+ ok = unload_expect_fast(echo_drv,[]),
+ ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
ok.
-no_unload_due_to_process_exit_2(suite) ->
- [];
-no_unload_due_to_process_exit_2(doc) ->
- ["Check that a driver with open ports in another process is not unloaded on process exit"];
+%% Check that a driver with open ports in another process is not unloaded on process exit
no_unload_due_to_process_exit_2(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- spawn(F3),
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- _Port2 = open_port({spawn, echo_drv}, [eof]),
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ spawn(F3),
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ _Port2 = open_port({spawn, echo_drv}, [eof]),
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line Port = open_port({spawn, echo_drv}, [eof]),
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ Port = open_port({spawn, echo_drv}, [eof]),
Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive X -> {error, X} after 300 -> ok end,
- ?line erlang:port_close(Port),
- ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive X -> {error, X} after 300 -> ok end,
+ erlang:port_close(Port),
+ ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
ok.
-unload_reload_thingie(suite) ->
- [];
-unload_reload_thingie(doc) ->
- ["Check delayed unload and reload"];
+%% Check delayed unload and reload
unload_reload_thingie(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- spawn(F3),
- receive go -> ok end,
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ spawn(F3),
+ receive go -> ok end,
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
+ Pid ! go,
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ {ok,pending_driver,Ref3} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]),
+ Ref4 = erl_ddll:monitor(driver,{echo_drv,loaded}),
+ ok = receive {'DOWN',Ref4, driver,echo_drv,load_cancelled} -> ok after 1000 -> false end,
+ {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ ok = receive {'UP',Ref3, driver,echo_drv,unload_cancelled} -> ok after 1000 -> false end,
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line {ok,pending_driver,Ref3} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]),
- ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,loaded}),
- ?line ok = receive {'DOWN',Ref4, driver,echo_drv,load_cancelled} -> ok after 1000 -> false end,
- ?line {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line ok = receive {'UP',Ref3, driver,echo_drv,unload_cancelled} -> ok after 1000 -> false end,
- ?line Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line [{Parent,1}] = erl_ddll:info(echo_drv, processes),
- ?line 0 = erl_ddll:info(echo_drv, port_count),
- ?line ok = unload_expect_fast(echo_drv,[{monitor,pending}]),
- ?line ok = receive
- {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok
- after 300 -> error
- end,
- ?line ok = receive X -> {error, X} after 300 -> ok end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ [{Parent,1}] = erl_ddll:info(echo_drv, processes),
+ 0 = erl_ddll:info(echo_drv, port_count),
+ ok = unload_expect_fast(echo_drv,[{monitor,pending}]),
+ ok = receive
+ {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok
+ after 300 -> error
+ end,
+ ok = receive X -> {error, X} after 300 -> ok end,
ok.
-unload_reload_thingie_2(suite) ->
- [];
-unload_reload_thingie_2(doc) ->
- ["Check delayed unload and reload"];
+%% Check delayed unload and reload
unload_reload_thingie_2(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- spawn(F3),
- receive go -> ok end,
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ spawn(F3),
+ receive go -> ok end,
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
+ Pid ! go,
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ {ok,pending_driver,Ref3} = erl_ddll:try_load(Path, echo_drv,
+ [{monitor,pending_driver},{reload,pending_driver}]),
+ Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line {ok,pending_driver,Ref3} = erl_ddll:try_load(Path,echo_drv,[{monitor,pending_driver},{reload,pending_driver}]),
- ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}),
- ?line Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive {'DOWN',Ref4, driver,echo_drv,unloaded} -> ok after 1000 -> false end,
- ?line ok = receive {'UP',Ref3, driver,echo_drv,loaded} -> ok after 1000 -> false end,
- ?line [{Parent,1}] = erl_ddll:info(echo_drv, processes),
- ?line 0 = erl_ddll:info(echo_drv, port_count),
- ?line ok = receive
- {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok
- after 300 -> error
- end,
- ?line ok = unload_expect_fast(echo_drv,[{monitor,pending}]),
- ?line ok = receive X -> {error, X} after 300 -> ok end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive {'DOWN',Ref4, driver,echo_drv,unloaded} -> ok after 1000 -> false end,
+ ok = receive {'UP',Ref3, driver,echo_drv,loaded} -> ok after 1000 -> false end,
+ [{Parent,1}] = erl_ddll:info(echo_drv, processes),
+ 0 = erl_ddll:info(echo_drv, port_count),
+ ok = receive
+ {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok
+ after 300 -> error
+ end,
+ ok = unload_expect_fast(echo_drv,[{monitor,pending}]),
+ ok = receive X -> {error, X} after 300 -> ok end,
ok.
-unload_reload_thingie_3(suite) ->
- [];
-unload_reload_thingie_3(doc) ->
- ["Check delayed unload and reload failure"];
+%% Check delayed unload and reload failure
unload_reload_thingie_3(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- spawn(F3),
- receive go -> ok end,
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ spawn(F3),
+ receive go -> ok end,
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
+ Pid ! go,
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ {ok,pending_driver,Ref3} = erl_ddll:try_load(filename:join([Path,"skrumpf"]), echo_drv,
+ [{monitor,pending_driver},{reload,pending_driver}]),
+ Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line {ok,pending_driver,Ref3} = erl_ddll:try_load(filename:join([Path,"skrumpf"]),echo_drv,[{monitor,pending_driver},{reload,pending_driver}]),
- ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}),
- ?line Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive
- {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok
- after 300 -> error
- end,
- ?line ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> false end,
- ?line ok = receive
- {'DOWN',Ref3, driver,echo_drv,{load_failure,_}} -> ok
- after 1000 -> false
- end,
- ?line {'EXIT',_} = (catch erl_ddll:info(echo_drv, port_count)),
- ?line {error, not_loaded} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]),
- ?line ok = receive X -> {error, X} after 300 -> ok end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive
+ {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok
+ after 300 -> error
+ end,
+ ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> false end,
+ ok = receive
+ {'DOWN',Ref3, driver,echo_drv,{load_failure,_}} -> ok
+ after 1000 -> false
+ end,
+ {'EXIT',_} = (catch erl_ddll:info(echo_drv, port_count)),
+ {error, not_loaded} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]),
+ ok = receive X -> {error, X} after 300 -> ok end,
ok.
-reload_pending(suite) -> [];
-reload_pending(doc) -> ["Reload a driver that is pending on a user"];
+%% Reload a driver that is pending on a user
reload_pending(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- spawn(F3),
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- _Port2 = open_port({spawn, echo_drv}, [eof]),
- Parent ! opened,
- receive go -> ok end,
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ spawn(F3),
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ _Port2 = open_port({spawn, echo_drv}, [eof]),
+ Parent ! opened,
+ receive go -> ok end,
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line Port = open_port({spawn, echo_drv}, [eof]),
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ Port = open_port({spawn, echo_drv}, [eof]),
Pid ! go,
- ?line receive opened -> ok end,
- ?line {error, pending_process} =
- erl_ddll:try_load(Path, echo_drv,
- [{reload,pending_driver},
- {monitor,pending_driver}]),
- ?line {ok, pending_process, Ref3} =
- erl_ddll:try_load(Path, echo_drv,
- [{reload,pending},
- {monitor,pending}]),
- ?line ok = receive X -> {error, X} after 300 -> ok end,
+ receive opened -> ok end,
+ {error, pending_process} =
+ erl_ddll:try_load(Path, echo_drv,
+ [{reload,pending_driver},
+ {monitor,pending_driver}]),
+ {ok, pending_process, Ref3} =
+ erl_ddll:try_load(Path, echo_drv,
+ [{reload,pending},
+ {monitor,pending}]),
+ ok = receive X -> {error, X} after 300 -> ok end,
Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive Y -> {error, Y} after 300 -> ok end,
- ?line erlang:port_close(Port),
- ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
- ?line ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end,
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive Y -> {error, Y} after 300 -> ok end,
+ erlang:port_close(Port),
+ ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
+ ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end,
[{Parent,1}] = erl_ddll:info(echo_drv,processes),
- ?line ok = receive Z -> {error, Z} after 300 -> ok end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive Z -> {error, Z} after 300 -> ok end,
ok.
-load_fail_init(suite) -> [];
-load_fail_init(doc) -> ["Tests failure in the init in driver struct."];
+%% Tests failure in the init in driver struct.
load_fail_init(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line PathFailing = ?config(priv_dir, Config),
- ?line [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path),
- ?line lists:foreach(fun(Name) ->
- Src = filename:join([Path,Name]),
- Ext = filename:extension(Name),
- Dst =filename:join([PathFailing,"echo_drv"++Ext]),
- file:delete(Dst),
- {ok,_} = file:copy(Src,Dst)
- end,
- AllFailInits),
- ?line [_|_] = filelib:wildcard("echo_drv.*",PathFailing),
- ?line {error, driver_init_failed} = erl_ddll:try_load(PathFailing,
- echo_drv,
- [{monitor,pending}]),
- ?line ok = receive XX ->
- {unexpected,XX}
- after 300 ->
- ok
- end,
- ?line test_server:timetrap_cancel(Dog),
+ Path = proplists:get_value(data_dir, Config),
+ PathFailing = proplists:get_value(priv_dir, Config),
+ [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path),
+ lists:foreach(fun(Name) ->
+ Src = filename:join([Path,Name]),
+ Ext = filename:extension(Name),
+ Dst =filename:join([PathFailing,"echo_drv"++Ext]),
+ file:delete(Dst),
+ {ok,_} = file:copy(Src,Dst)
+ end,
+ AllFailInits),
+ [_|_] = filelib:wildcard("echo_drv.*",PathFailing),
+ {error, driver_init_failed} = erl_ddll:try_load(PathFailing,
+ echo_drv,
+ [{monitor,pending}]),
+ ok = receive XX ->
+ {unexpected,XX}
+ after 300 ->
+ ok
+ end,
ok.
-reload_pending_fail_init(suite) -> [];
-reload_pending_fail_init(doc) -> ["Reload a driver that is pending but init fails"];
+%% Reload a driver that is pending but init fails
reload_pending_fail_init(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line PathFailing = ?config(priv_dir, Config),
- ?line [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path),
- ?line lists:foreach(fun(Name) ->
- Src = filename:join([Path,Name]),
- Ext = filename:extension(Name),
- Dst =filename:join([PathFailing,"echo_drv"++Ext]),
- file:delete(Dst),
- {ok,_} = file:copy(Src,Dst)
- end,
- AllFailInits),
- ?line [_|_] = filelib:wildcard("echo_drv.*",PathFailing),
- ?line Parent = self(),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- receive go -> ok end,
- {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- spawn(F3),
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- _Port2 = open_port({spawn, echo_drv}, [eof]),
- Parent ! opened,
- receive go -> ok end,
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ PathFailing = proplists:get_value(priv_dir, Config),
+ [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path),
+ lists:foreach(fun(Name) ->
+ Src = filename:join([Path,Name]),
+ Ext = filename:extension(Name),
+ Dst =filename:join([PathFailing,"echo_drv"++Ext]),
+ file:delete(Dst),
+ {ok,_} = file:copy(Src,Dst)
+ end,
+ AllFailInits),
+ [_|_] = filelib:wildcard("echo_drv.*",PathFailing),
+ Parent = self(),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ spawn(F3),
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ _Port2 = open_port({spawn, echo_drv}, [eof]),
+ Parent ! opened,
+ receive go -> ok end,
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line Port = open_port({spawn, echo_drv}, [eof]),
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ Port = open_port({spawn, echo_drv}, [eof]),
Pid ! go,
- ?line receive opened -> ok end,
- ?line {ok, pending_process, Ref3} =
- erl_ddll:try_load(PathFailing, echo_drv,
- [{reload,pending},
- {monitor,pending}]),
- ?line ok = receive X -> {error, X} after 300 -> ok end,
+ receive opened -> ok end,
+ {ok, pending_process, Ref3} =
+ erl_ddll:try_load(PathFailing, echo_drv,
+ [{reload,pending},
+ {monitor,pending}]),
+ ok = receive X -> {error, X} after 300 -> ok end,
Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive Y -> {error, Y} after 300 -> ok end,
- ?line erlang:port_close(Port),
- ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
- ?line ok = receive {'DOWN', Ref3, driver, echo_drv, {load_failure,driver_init_failed}} -> ok after 300 -> error end,
- ?line {'EXIT',{badarg,_}} = (catch erl_ddll:info(echo_drv,processes)),
-
- ?line ok = receive Z -> {error, Z} after 300 -> ok end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive Y -> {error, Y} after 300 -> ok end,
+ erlang:port_close(Port),
+ ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
+ ok = receive {'DOWN', Ref3, driver, echo_drv, {load_failure,driver_init_failed}} -> ok after 300 -> error end,
+ {'EXIT',{badarg,_}} = (catch erl_ddll:info(echo_drv,processes)),
+
+ ok = receive Z -> {error, Z} after 300 -> ok end,
ok.
-reload_pending_kill(suite) -> [];
-reload_pending_kill(doc) -> ["Reload a driver with kill_ports option "
- "that is pending on a user"];
+%% Reload a driver with kill_ports option that is pending on a user
reload_pending_kill(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line OldFlag = process_flag(trap_exit,true),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- process_flag(trap_exit,true),
- receive go -> ok end,
- {ok, loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]),
- spawn(F3),
- receive go -> ok end,
- Port = open_port({spawn, echo_drv}, [eof]),
- Port2 = open_port({spawn, echo_drv}, [eof]),
- Parent ! opened,
- receive go -> ok end,
- receive
- {'EXIT', Port2, driver_unloaded} ->
- Parent ! first_exit
- end,
- receive
- {'EXIT', Port, driver_unloaded} ->
- Parent ! second_exit
- end,
- receive go -> ok end,
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ OldFlag = process_flag(trap_exit,true),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ process_flag(trap_exit,true),
+ receive go -> ok end,
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]),
+ spawn(F3),
+ receive go -> ok end,
+ Port = open_port({spawn, echo_drv}, [eof]),
+ Port2 = open_port({spawn, echo_drv}, [eof]),
+ Parent ! opened,
+ receive go -> ok end,
+ receive
+ {'EXIT', Port2, driver_unloaded} ->
+ Parent ! first_exit
+ end,
+ receive
+ {'EXIT', Port, driver_unloaded} ->
+ Parent ! second_exit
+ end,
+ receive go -> ok end,
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]),
- ?line {error,inconsistent} = erl_ddll:try_load(Path, echo_drv, []),
- ?line Port = open_port({spawn, echo_drv}, [eof]),
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]),
+ {error,inconsistent} = erl_ddll:try_load(Path, echo_drv, []),
+ Port = open_port({spawn, echo_drv}, [eof]),
Pid ! go,
- ?line receive opened -> ok end,
- ?line {error, pending_process} =
- erl_ddll:try_load(Path, echo_drv,
- [{driver_options,[kill_ports]},
- {reload,pending_driver},
- {monitor,pending_driver}]),
- ?line {ok, pending_process, Ref3} =
- erl_ddll:try_load(Path, echo_drv,
- [{driver_options,[kill_ports]},
- {reload,pending},
- {monitor,pending}]),
- ?line ok = receive
- {'EXIT', Port, driver_unloaded} ->
- ok
- after 300 -> error
- end,
+ receive opened -> ok end,
+ {error, pending_process} =
+ erl_ddll:try_load(Path, echo_drv,
+ [{driver_options,[kill_ports]},
+ {reload,pending_driver},
+ {monitor,pending_driver}]),
+ {ok, pending_process, Ref3} =
+ erl_ddll:try_load(Path, echo_drv,
+ [{driver_options,[kill_ports]},
+ {reload,pending},
+ {monitor,pending}]),
+ ok = receive
+ {'EXIT', Port, driver_unloaded} ->
+ ok
+ after 300 -> error
+ end,
Pid ! go,
- ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
- ?line ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end,
- ?line [_,_] = erl_ddll:info(echo_drv,processes),
- ?line ok = receive first_exit -> ok after 300 -> error end,
- ?line ok = receive second_exit -> ok after 300 -> error end,
- ?line 0 = erl_ddll:info(echo_drv,port_count),
- ?line ok = receive X -> {error, X} after 300 -> ok end,
+ ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
+ ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end,
+ [_,_] = erl_ddll:info(echo_drv,processes),
+ ok = receive first_exit -> ok after 300 -> error end,
+ ok = receive second_exit -> ok after 300 -> error end,
+ 0 = erl_ddll:info(echo_drv,port_count),
+ ok = receive X -> {error, X} after 300 -> ok end,
Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive Y -> {error, Y} after 300 -> ok end,
- ?line Port2 = open_port({spawn, echo_drv}, [eof]),
- ?line true = is_port(Port2),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive Y -> {error, Y} after 300 -> ok end,
+ Port2 = open_port({spawn, echo_drv}, [eof]),
+ true = is_port(Port2),
[{Parent,1}] = erl_ddll:info(echo_drv,processes),
- ?line 1 = erl_ddll:info(echo_drv,port_count),
- ?line erlang:port_close(Port2),
- ?line ok = receive {'EXIT', Port2, normal} -> ok after 300 -> error end,
- ?line 0 = erl_ddll:info(echo_drv,port_count),
- ?line [{Parent,1}] = erl_ddll:info(echo_drv,processes),
- ?line Port3 = open_port({spawn, echo_drv}, [eof]),
- ?line {ok, pending_driver, Ref4} =
- erl_ddll:try_unload(echo_drv,[{monitor,pending_driver}]),
- ?line ok = receive
- {'EXIT', Port3, driver_unloaded} ->
- ok
- after 300 -> error
- end,
- ?line ok = receive {'DOWN', Ref4, driver, echo_drv, unloaded} -> ok after 300 -> error end,
+ 1 = erl_ddll:info(echo_drv,port_count),
+ erlang:port_close(Port2),
+ ok = receive {'EXIT', Port2, normal} -> ok after 300 -> error end,
+ 0 = erl_ddll:info(echo_drv,port_count),
+ [{Parent,1}] = erl_ddll:info(echo_drv,processes),
+ Port3 = open_port({spawn, echo_drv}, [eof]),
+ {ok, pending_driver, Ref4} =
+ erl_ddll:try_unload(echo_drv,[{monitor,pending_driver}]),
+ ok = receive
+ {'EXIT', Port3, driver_unloaded} ->
+ ok
+ after 300 -> error
+ end,
+ ok = receive {'DOWN', Ref4, driver, echo_drv, unloaded} -> ok after 300 -> error end,
io:format("Port = ~w, Port2 = ~w, Port3 = ~w~n",[Port,Port2,Port3]),
- ?line ok = receive Z -> {error, Z} after 300 -> ok end,
- ?line process_flag(trap_exit,OldFlag),
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive Z -> {error, Z} after 300 -> ok end,
+ process_flag(trap_exit,OldFlag),
ok.
-more_error_codes(suite) ->
- [];
-more_error_codes(doc) ->
- ["Some more error code checking"];
+%% Some more error code checking
more_error_codes(Config) when is_list(Config) ->
- ?line {error,Err} = erl_ddll:try_load("./echo_dr",echo_dr,[]),
- ?line true = is_list(erl_ddll:format_error(Err)),
- ?line true = is_list(erl_ddll:format_error(not_loaded)),
+ {error,Err} = erl_ddll:try_load("./echo_dr",echo_dr,[]),
+ true = is_list(erl_ddll:format_error(Err)),
+ true = is_list(erl_ddll:format_error(not_loaded)),
ok.
-forced_port_killing(suite) ->
- [];
-forced_port_killing(doc) ->
- ["Check kill_ports option to try_unload "];
+%% Check kill_ports option to try_unload
forced_port_killing(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line OldFlag=process_flag(trap_exit,true),
- ?line Parent = self(),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line spawn(F3),
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line Port = open_port({spawn, echo_drv}, [eof]),
- ?line Port2 = open_port({spawn, echo_drv}, [eof]),
- ?line {ok, pending_driver, Ref1} =
- erl_ddll:try_unload(echo_drv,[{monitor,pending_driver},kill_ports]),
- ?line ok = receive
- {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok
- after 300 -> error
- end,
- ?line ok = receive {'EXIT',Port,driver_unloaded} -> ok after 300 -> false end,
- ?line ok = receive {'EXIT',Port2,driver_unloaded} -> ok after 300 -> false end,
- ?line ok = receive {'DOWN',Ref1, driver, echo_drv, unloaded} -> ok after 300 -> false end,
- ?line process_flag(trap_exit,OldFlag),
- ?line ok = receive X -> {error, X} after 300 -> ok end,
- ?line test_server:timetrap_cancel(Dog),
+ Path = proplists:get_value(data_dir, Config),
+ OldFlag=process_flag(trap_exit,true),
+ Parent = self(),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ spawn(F3),
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ Port = open_port({spawn, echo_drv}, [eof]),
+ Port2 = open_port({spawn, echo_drv}, [eof]),
+ {ok, pending_driver, Ref1} =
+ erl_ddll:try_unload(echo_drv,[{monitor,pending_driver},kill_ports]),
+ ok = receive
+ {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok
+ after 300 -> error
+ end,
+ ok = receive {'EXIT',Port,driver_unloaded} -> ok after 300 -> false end,
+ ok = receive {'EXIT',Port2,driver_unloaded} -> ok after 300 -> false end,
+ ok = receive {'DOWN',Ref1, driver, echo_drv, unloaded} -> ok after 300 -> false end,
+ process_flag(trap_exit,OldFlag),
+ ok = receive X -> {error, X} after 300 -> ok end,
ok.
-no_trap_exit_and_kill_ports(suite) ->
- [];
-no_trap_exit_and_kill_ports(doc) ->
- ["Check delayed unload and reload with no trap_exit"];
+%% Check delayed unload and reload with no trap_exit
no_trap_exit_and_kill_ports(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line Parent = self(),
- ?line OldFlag=process_flag(trap_exit,true),
- ?line F3 = fun() ->
- Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
- receive X -> Parent ! {got,X} end
- end,
- ?line Pid = spawn(fun() ->
- process_flag(trap_exit,false),
- receive go -> ok end,
- {ok, loaded} = erl_ddll:try_load(Path, echo_drv,
- [{driver_options,[kill_ports]}]),
- spawn(F3),
- receive go -> ok end,
- _Port = open_port({spawn, echo_drv}, [eof]),
- _Port2 = open_port({spawn, echo_drv}, [eof]),
- exit(banan)
- end),
- ?line Ref = erlang:monitor(process,Pid),
+ Path = proplists:get_value(data_dir, Config),
+ Parent = self(),
+ OldFlag=process_flag(trap_exit,true),
+ F3 = fun() ->
+ Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ receive X -> Parent ! {got,X} end
+ end,
+ Pid = spawn(fun() ->
+ process_flag(trap_exit,false),
+ receive go -> ok end,
+ {ok, loaded} = erl_ddll:try_load(Path, echo_drv,
+ [{driver_options,[kill_ports]}]),
+ spawn(F3),
+ receive go -> ok end,
+ _Port = open_port({spawn, echo_drv}, [eof]),
+ _Port2 = open_port({spawn, echo_drv}, [eof]),
+ exit(banan)
+ end),
+ Ref = erlang:monitor(process,Pid),
Pid ! go,
- ?line {ok,Ref2} = receive
- R when is_reference(R) -> {ok,R};
- Other -> {error, Other}
- after 500 -> {error, timeout}
- end,
- ?line {error, inconsistent} = erl_ddll:try_load(Path, echo_drv, []),
- ?line MyPort = open_port({spawn, echo_drv}, [eof]),
+ {ok,Ref2} = receive
+ R when is_reference(R) -> {ok,R};
+ Other -> {error, Other}
+ after 500 -> {error, timeout}
+ end,
+ {error, inconsistent} = erl_ddll:try_load(Path, echo_drv, []),
+ MyPort = open_port({spawn, echo_drv}, [eof]),
Pid ! go,
- ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
- ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
- ?line ok = receive {'EXIT',MyPort,driver_unloaded} -> ok after 300 -> error end,
- ?line process_flag(trap_exit,OldFlag),
- ?line test_server:timetrap_cancel(Dog),
+ ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end,
+ ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end,
+ ok = receive {'EXIT',MyPort,driver_unloaded} -> ok after 300 -> error end,
+ process_flag(trap_exit,OldFlag),
ok.
-monitor_demonitor(suite) ->
- [];
-monitor_demonitor(doc) ->
- ["Check monitor and demonitor of drivers"];
+%% Check monitor and demonitor of drivers
monitor_demonitor(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line erl_ddll:try_load(Path, echo_drv, []),
- ?line Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}),
- ?line Self = self(),
- ?line [{Self,1}] = erl_ddll:info(echo_drv,awaiting_unload),
- ?line true = erl_ddll:demonitor(Ref),
- ?line [] = erl_ddll:info(echo_drv,awaiting_unload),
- ?line erl_ddll:try_unload(echo_drv,[]),
- ?line ok = receive _ -> error after 300 -> ok end,
- ?line test_server:timetrap_cancel(Dog),
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:try_load(Path, echo_drv, []),
+ Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ Self = self(),
+ [{Self,1}] = erl_ddll:info(echo_drv,awaiting_unload),
+ true = erl_ddll:demonitor(Ref),
+ [] = erl_ddll:info(echo_drv,awaiting_unload),
+ erl_ddll:try_unload(echo_drv,[]),
+ ok = receive _ -> error after 300 -> ok end,
ok.
-monitor_demonitor_load(suite) ->
- [];
-monitor_demonitor_load(doc) ->
- ["Check monitor/demonitor of driver loading"];
+%% Check monitor/demonitor of driver loading
monitor_demonitor_load(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line {ok,loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line Port = open_port({spawn, echo_drv}, [eof]),
- ?line Ref = erl_ddll:monitor(driver,{echo_drv,loaded}),
- ?line ok = receive {'UP',Ref,driver,echo_drv,loaded} -> ok after 500 -> error end,
- ?line {ok, pending_driver} = erl_ddll:try_unload(echo_drv,[]),
- ?line Ref2 = erl_ddll:monitor(driver,{echo_drv,loaded}),
- ?line ok = receive {'DOWN',Ref2,driver,echo_drv,load_cancelled} -> ok after 0 -> error end,
- ?line {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
- ?line {ok, pending_driver} =
- erl_ddll:try_load(Path, echo_drv, [{reload,pending_driver}]),
- ?line Ref3 = erl_ddll:monitor(driver,{echo_drv,loaded}),
- ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}),
- ?line ok = receive _ -> error after 300 -> ok end,
- ?line Self = self(),
- ?line [{Self,1}] = erl_ddll:info(echo_drv,awaiting_load),
- ?line true = erl_ddll:demonitor(Ref3),
- ?line [] = erl_ddll:info(echo_drv,awaiting_load),
- ?line erlang:port_close(Port),
- ?line ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> error end,
- ?line ok = receive _ -> error after 300 -> ok end,
- ?line ok = unload_expect_fast(echo_drv,[]),
- ?line test_server:timetrap_cancel(Dog),
+ Path = proplists:get_value(data_dir, Config),
+ {ok,loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ Port = open_port({spawn, echo_drv}, [eof]),
+ Ref = erl_ddll:monitor(driver,{echo_drv,loaded}),
+ ok = receive {'UP',Ref,driver,echo_drv,loaded} -> ok after 500 -> error end,
+ {ok, pending_driver} = erl_ddll:try_unload(echo_drv,[]),
+ Ref2 = erl_ddll:monitor(driver,{echo_drv,loaded}),
+ ok = receive {'DOWN',Ref2,driver,echo_drv,load_cancelled} -> ok after 0 -> error end,
+ {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []),
+ {ok, pending_driver} =
+ erl_ddll:try_load(Path, echo_drv, [{reload,pending_driver}]),
+ Ref3 = erl_ddll:monitor(driver,{echo_drv,loaded}),
+ Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ ok = receive _ -> error after 300 -> ok end,
+ Self = self(),
+ [{Self,1}] = erl_ddll:info(echo_drv,awaiting_load),
+ true = erl_ddll:demonitor(Ref3),
+ [] = erl_ddll:info(echo_drv,awaiting_load),
+ erlang:port_close(Port),
+ ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> error end,
+ ok = receive _ -> error after 300 -> ok end,
+ ok = unload_expect_fast(echo_drv,[]),
ok.
-new_interface(suite) ->
- [];
-new_interface(doc) ->
- ["Test the new load/unload/reload interface"];
+%% Test the new load/unload/reload interface
new_interface(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
% Typical scenario
- ?line ok = erl_ddll:load(Path, echo_drv),
- ?line Port = open_port({spawn, echo_drv}, [eof]),
- ?line ok = erl_ddll:unload(echo_drv),
- ?line Port ! {self(), {command, "text"}},
- ?line ok = receive
- {Port, {data, "text"}} -> ok;
- _ -> error
- after
- 1000 -> error
- end,
- ?line Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}),
- ?line ok = receive X -> {error, X} after 300 -> ok end,
- ?line erlang:port_close(Port),
- ?line ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 300 -> error end,
+ ok = erl_ddll:load(Path, echo_drv),
+ Port = open_port({spawn, echo_drv}, [eof]),
+ ok = erl_ddll:unload(echo_drv),
+ Port ! {self(), {command, "text"}},
+ ok = receive
+ {Port, {data, "text"}} -> ok;
+ _ -> error
+ after
+ 1000 -> error
+ end,
+ Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ ok = receive X -> {error, X} after 300 -> ok end,
+ erlang:port_close(Port),
+ ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 300 -> error end,
% More than one user
- ?line ok = erl_ddll:load(Path, echo_drv),
- ?line Ref2 = erl_ddll:monitor(driver,{echo_drv,unloaded}),
- ?line ok = erl_ddll:load(Path, echo_drv),
- ?line ok = erl_ddll:load(Path, echo_drv),
- ?line Port2 = open_port({spawn, echo_drv}, [eof]),
- ?line ok = erl_ddll:unload(echo_drv),
- ?line Port2 ! {self(), {command, "text"}},
- ?line ok = receive
- {Port2, {data, "text"}} -> ok;
- _ -> error
- after
- 1000 -> error
- end,
- ?line ok = erl_ddll:unload(echo_drv),
- ?line Port2 ! {self(), {command, "text"}},
- ?line ok = receive
- {Port2, {data, "text"}} -> ok;
- _ -> error
- after
- 1000 -> error
- end,
- ?line ok = erl_ddll:unload(echo_drv),
- ?line Port2 ! {self(), {command, "text"}},
- ?line ok = receive
- {Port2, {data, "text"}} -> ok;
- _ -> error
- after
- 1000 -> error
- end,
- ?line ok = receive X2 -> {error, X2} after 300 -> ok end,
- ?line ok = erl_ddll:load(Path, echo_drv),
- ?line ok = receive {'UP', Ref2, driver, echo_drv, unload_cancelled} -> ok after 300 -> error end,
- ?line Ref3 = erl_ddll:monitor(driver,{echo_drv,unloaded_only}),
- ?line erlang:port_close(Port2),
- ?line ok = receive X3 -> {error, X3} after 300 -> ok end,
- ?line ok = erl_ddll:unload(echo_drv),
- ?line ok = receive {'DOWN', Ref3, driver, echo_drv, unloaded} -> ok after 300 -> error end,
- ?line test_server:timetrap_cancel(Dog),
+ ok = erl_ddll:load(Path, echo_drv),
+ Ref2 = erl_ddll:monitor(driver,{echo_drv,unloaded}),
+ ok = erl_ddll:load(Path, echo_drv),
+ ok = erl_ddll:load(Path, echo_drv),
+ Port2 = open_port({spawn, echo_drv}, [eof]),
+ ok = erl_ddll:unload(echo_drv),
+ Port2 ! {self(), {command, "text"}},
+ ok = receive
+ {Port2, {data, "text"}} -> ok;
+ _ -> error
+ after
+ 1000 -> error
+ end,
+ ok = erl_ddll:unload(echo_drv),
+ Port2 ! {self(), {command, "text"}},
+ ok = receive
+ {Port2, {data, "text"}} -> ok;
+ _ -> error
+ after
+ 1000 -> error
+ end,
+ ok = erl_ddll:unload(echo_drv),
+ Port2 ! {self(), {command, "text"}},
+ ok = receive
+ {Port2, {data, "text"}} -> ok;
+ _ -> error
+ after
+ 1000 -> error
+ end,
+ ok = receive X2 -> {error, X2} after 300 -> ok end,
+ ok = erl_ddll:load(Path, echo_drv),
+ ok = receive {'UP', Ref2, driver, echo_drv, unload_cancelled} -> ok after 300 -> error end,
+ Ref3 = erl_ddll:monitor(driver,{echo_drv,unloaded_only}),
+ erlang:port_close(Port2),
+ ok = receive X3 -> {error, X3} after 300 -> ok end,
+ ok = erl_ddll:unload(echo_drv),
+ ok = receive {'DOWN', Ref3, driver, echo_drv, unloaded} -> ok after 300 -> error end,
ok.
-
-
+
+
ddll_test(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
- %?line {error,{already_started,ErlDdllPid}} = erl_ddll:start(),
- %?line ErlDdllPid = whereis(ddll_server),
+ %{error,{already_started,ErlDdllPid}} = erl_ddll:start(),
+ %ErlDdllPid = whereis(ddll_server),
%% Load the echo driver and verify that it was loaded.
{ok,L1,L2}=load_echo_driver(Path),
%% Verify that the driver works.
- ?line Port = open_port({spawn, echo_drv}, [eof]),
- ?line {hej, "hopp",4711,123445567436543653} =
- erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}),
- ?line {hej, "hopp",4711,123445567436543653} =
- erlang:port_call(Port,47,{hej, "hopp",4711,123445567436543653}),
- ?line Port ! {self(), {command, "text"}},
- ?line 1 = receive
- {Port, {data, "text"}} -> 1;
- _Other -> 2
- after
- 1000 -> 2
- end,
- ?line Port ! {self(), close},
- ?line receive {Port, closed} -> ok end,
-
-%% %% Unload the driver and verify that it was unloaded.
- ok = unload_echo_driver(L1,L2),
-
-%% %?line {error, {already_started, _}} = erl_ddll:start(),
-
- ?line test_server:timetrap_cancel(Dog),
+ Port = open_port({spawn, echo_drv}, [eof]),
+ {hej, "hopp",4711,123445567436543653} =
+ erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}),
+ {hej, "hopp",4711,123445567436543653} =
+ erlang:port_call(Port,47,{hej, "hopp",4711,123445567436543653}),
+ Port ! {self(), {command, "text"}},
+ 1 = receive
+ {Port, {data, "text"}} -> 1;
+ _Other -> 2
+ after
+ 1000 -> 2
+ end,
+ Port ! {self(), close},
+ receive {Port, closed} -> ok end,
+
+ %% %% Unload the driver and verify that it was unloaded.
+ ok = unload_echo_driver(L1,L2),
+
+ %% %{error, {already_started, _}} = erl_ddll:start(),
ok.
%% Tests errors having to do with bad drivers.
errors(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
- ?line {ok, L1} = erl_ddll:loaded_drivers(),
+ {ok, L1} = erl_ddll:loaded_drivers(),
- ?line {error, {open_error, _}} = erl_ddll:load_driver(Path, bad_name),
- ?line {error, driver_init_failed} = erl_ddll:load_driver(Path, initfail_drv),
- ?line {error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv),
+ {error, {open_error, _}} = erl_ddll:load_driver(Path, bad_name),
+ {error, driver_init_failed} = erl_ddll:load_driver(Path, initfail_drv),
+ {error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv),
%% We assume that there is a statically linked driver named "ddll":
- ?line {error, linked_in_driver} = erl_ddll:unload_driver(efile),
- ?line {error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"),
-
+ {error, linked_in_driver} = erl_ddll:unload_driver(efile),
+ {error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"),
+
case os:type() of
- {unix, _} ->
- ?line {error, no_driver_init} =
- erl_ddll:load_driver(Path, noinit_drv);
- _ ->
- ok
+ {unix, _} ->
+ {error, no_driver_init} =
+ erl_ddll:load_driver(Path, noinit_drv);
+ _ ->
+ ok
end,
- ?line {ok, L1} = erl_ddll:loaded_drivers(),
-
- ?line test_server:timetrap_cancel(Dog),
+ {ok, L1} = erl_ddll:loaded_drivers(),
ok.
-reference_count(doc) ->
- ["Check that drivers are unloaded when their reference count ",
- "reaches zero, and that they cannot be unloaded while ",
- "they are still referenced."];
+%% Check that drivers are unloaded when their reference count
+%% reaches zero, and that they cannot be unloaded while
+%% they are still referenced.
reference_count(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
%% Spawn a process that loads the driver (and holds a reference
%% to it).
Pid1=spawn_link(?MODULE, echo_loader, [Path, self()]),
receive
- {Pid1, echo_loaded} -> ok
- after 2000 -> test_server:fail("echo_loader failed to start.")
+ {Pid1, echo_loaded} -> ok
+ after 2000 -> ct:fail("echo_loader failed to start.")
end,
Pid1 ! {self(), die},
- ?line test_server:sleep(200), % Give time to unload.
+ test_server:sleep(200), % Give time to unload.
% Verify that the driver was automaticly unloaded when the
% process died.
- ?line {error, not_loaded}=erl_ddll:unload_driver(echo_drv),
-
- ?line test_server:timetrap_cancel(Dog),
+ {error, not_loaded}=erl_ddll:unload_driver(echo_drv),
ok.
% Loads the echo driver, send msg to started, sits and waits to
% get a signal to die, then unloads the driver and terminates.
echo_loader(Path, Starter) ->
- ?line {ok, L1, L2}=load_echo_driver(Path),
- ?line Starter ! {self(), echo_loaded},
+ {ok, L1, L2}=load_echo_driver(Path),
+ Starter ! {self(), echo_loaded},
receive
- {Starter, die} ->
- ?line unload_echo_driver(L1,L2)
+ {Starter, die} ->
+ unload_echo_driver(L1,L2)
end.
% Loads the echo driver, send msg to started, sits and waits to
% get a signal to die, then unloads the driver and terminates.
nice_echo_loader(Path, Starter) ->
- ?line {ok, L1, L2}=load_nice_echo_driver(Path),
- ?line Starter ! {self(), echo_loaded},
+ {ok, L1, L2}=load_nice_echo_driver(Path),
+ Starter ! {self(), echo_loaded},
receive
- {Starter, die} ->
- ?line unload_echo_driver(L1,L2)
+ {Starter, die} ->
+ unload_echo_driver(L1,L2)
end.
-kill_port(doc) ->
- ["Test that a port that uses a driver is killed when the ",
- "process that loaded the driver dies."];
+%% Test that a port that uses a driver is killed when the
+%% process that loaded the driver dies.
kill_port(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
%% Spawn a process that loads the driver (and holds a reference
%% to it).
- ?line Pid1=spawn(?MODULE, echo_loader, [Path, self()]),
- ?line receive
- {Pid1, echo_loaded} ->
- ok
- after 3000 ->
- ?line exit(Pid1, kill),
- ?line test_server:fail("echo_loader failed to start.")
- end,
+ Pid1=spawn(?MODULE, echo_loader, [Path, self()]),
+ receive
+ {Pid1, echo_loaded} ->
+ ok
+ after 3000 ->
+ exit(Pid1, kill),
+ ct:fail("echo_loader failed to start.")
+ end,
% Spawn off a port that uses the driver.
- ?line Port = open_port({spawn, echo_drv}, [eof]),
+ Port = open_port({spawn, echo_drv}, [eof]),
% Kill the process / unload the driver.
- ?line process_flag(trap_exit, true),
- ?line exit(Pid1, kill),
- ?line test_server:sleep(200), % Give some time to unload.
- ?line {error, not_loaded} = erl_ddll:unload_driver(echo_drv),
+ process_flag(trap_exit, true),
+ exit(Pid1, kill),
+ test_server:sleep(200), % Give some time to unload.
+ {error, not_loaded} = erl_ddll:unload_driver(echo_drv),
% See if the port is killed.
receive
- {'EXIT', Port, Reason} ->
- io:format("Port exited with reason ~w", [Reason])
+ {'EXIT', Port, Reason} ->
+ io:format("Port exited with reason ~w", [Reason])
after 5000 ->
- ?line test_server:fail("Echo port did not terminate.")
+ ct:fail("Echo port did not terminate.")
end,
-
- %% Cleanup and exit.
- ?line test_server:timetrap_cancel(Dog),
ok.
-dont_kill_port(doc) ->
- ["Test that a port that uses a driver is not killed when the ",
- "process that loaded the driver dies and it's nicely opened."];
+%% Test that a port that uses a driver is not killed when the
+%% process that loaded the driver dies and it's nicely opened.
dont_kill_port(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
%% Spawn a process that loads the driver (and holds a reference
%% to it).
- ?line Pid1=spawn(?MODULE, nice_echo_loader, [Path, self()]),
- ?line receive
- {Pid1, echo_loaded} ->
- ok
- after 3000 ->
- ?line exit(Pid1, kill),
- ?line test_server:fail("echo_loader failed to start.")
- end,
+ Pid1=spawn(?MODULE, nice_echo_loader, [Path, self()]),
+ receive
+ {Pid1, echo_loaded} ->
+ ok
+ after 3000 ->
+ exit(Pid1, kill),
+ ct:fail("echo_loader failed to start.")
+ end,
% Spawn off a port that uses the driver.
- ?line Port = open_port({spawn, echo_drv}, [eof]),
+ Port = open_port({spawn, echo_drv}, [eof]),
% Kill the process / unload the driver.
- ?line process_flag(trap_exit, true),
- ?line exit(Pid1, kill),
- ?line test_server:sleep(200), % Give some time to unload.
- ?line {hej, "hopp",4711,123445567436543653} =
- erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}),
- ?line [] = erl_ddll:info(echo_drv,processes),
+ process_flag(trap_exit, true),
+ exit(Pid1, kill),
+ test_server:sleep(200), % Give some time to unload.
+ {hej, "hopp",4711,123445567436543653} =
+ erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}),
+ [] = erl_ddll:info(echo_drv,processes),
%% unload should work with no owner
- ?line ok = erl_ddll:unload_driver(echo_drv), %Kill ports while at it
+ ok = erl_ddll:unload_driver(echo_drv), %Kill ports while at it
% See if the port is killed.
receive
- {'EXIT', Port, Reason} ->
- io:format("Port exited with reason ~w", [Reason])
+ {'EXIT', Port, Reason} ->
+ io:format("Port exited with reason ~w", [Reason])
after 5000 ->
- ?line test_server:fail("Echo port did not terminate.")
+ ct:fail("Echo port did not terminate.")
end,
-
- %% Cleanup and exit.
- ?line test_server:timetrap_cancel(Dog),
ok.
-properties(doc) -> ["Test that a process that loaded a driver ",
- "is the only process that can unload it."];
+%% Test that a process that loaded a driver
+%% is the only process that can unload it.
properties(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
% Let another process load the echo driver.
Pid=spawn_link(?MODULE, echo_loader, [Path, self()]),
receive
- {Pid, echo_loaded} -> ok
- after 2000 -> test_server:fail("echo_loader failed to start.")
+ {Pid, echo_loaded} -> ok
+ after 2000 -> ct:fail("echo_loader failed to start.")
end,
% Try to unload the driver from this process (the wrong one).
- ?line {error, _} = erl_ddll:unload_driver(echo_drv),
- ?line {ok, Drivers} = erl_ddll:loaded_drivers(),
- ?line case lists:member("echo_drv", Drivers) of
- true ->
- ok;
- false ->
- test_server:fail("Unload from wrong process "
- "succeeded.")
- end,
+ {error, _} = erl_ddll:unload_driver(echo_drv),
+ {ok, Drivers} = erl_ddll:loaded_drivers(),
+ case lists:member("echo_drv", Drivers) of
+ true ->
+ ok;
+ false ->
+ ct:fail("Unload from wrong process succeeded.")
+ end,
% Unload the driver and terminate dummy process.
- ?line Pid ! {self(), die},
- ?line test_server:sleep(200), % Give time to unload.
- ?line test_server:timetrap_cancel(Dog),
+ Pid ! {self(), die},
+ test_server:sleep(200), % Give time to unload.
ok.
-load_and_unload(doc) -> ["Load two drivers and unload them in load order."];
+%% Load two drivers and unload them in load order.
load_and_unload(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(60)),
- ?line Path = ?config(data_dir, Config),
- ?line {ok, Loaded_drivers1} = erl_ddll:loaded_drivers(),
- ?line ok = erl_ddll:load_driver(Path, echo_drv),
- ?line ok = erl_ddll:load_driver(Path, dummy_drv),
- ?line ok = erl_ddll:unload_driver(echo_drv),
- ?line ok = erl_ddll:unload_driver(dummy_drv),
- ?line {ok, Loaded_drivers2} = erl_ddll:loaded_drivers(),
- ?line Set1 = ordsets:from_list(Loaded_drivers1),
- ?line Set2 = ordsets:from_list(Loaded_drivers2),
- ?line io:format("~p == ~p\n", [Loaded_drivers1, Loaded_drivers2]),
- ?line [] = ordsets:to_list(ordsets:subtract(Set2, Set1)),
-
- ?line test_server:timetrap_cancel(Dog),
+ Path = proplists:get_value(data_dir, Config),
+ {ok, Loaded_drivers1} = erl_ddll:loaded_drivers(),
+ ok = erl_ddll:load_driver(Path, echo_drv),
+ ok = erl_ddll:load_driver(Path, dummy_drv),
+ ok = erl_ddll:unload_driver(echo_drv),
+ ok = erl_ddll:unload_driver(dummy_drv),
+ {ok, Loaded_drivers2} = erl_ddll:loaded_drivers(),
+ Set1 = ordsets:from_list(Loaded_drivers1),
+ Set2 = ordsets:from_list(Loaded_drivers2),
+ io:format("~p == ~p\n", [Loaded_drivers1, Loaded_drivers2]),
+ [] = ordsets:to_list(ordsets:subtract(Set2, Set1)),
ok.
-lock_driver(suite) ->
- [];
-lock_driver(doc) ->
- ["Check multiple calls to driver_lock_driver"];
+%% Check multiple calls to driver_lock_driver
lock_driver(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line {ok, _} = erl_ddll:try_load(Path, lock_drv, []),
- ?line Port1 = open_port({spawn, lock_drv}, [eof]),
- ?line Port2 = open_port({spawn, lock_drv}, [eof]),
- ?line true = erl_ddll:info(lock_drv,permanent),
- ?line erlang:port_close(Port1),
- ?line erlang:port_close(Port2),
- ?line test_server:timetrap_cancel(Dog),
+ Path = proplists:get_value(data_dir, Config),
+ {ok, _} = erl_ddll:try_load(Path, lock_drv, []),
+ Port1 = open_port({spawn, lock_drv}, [eof]),
+ Port2 = open_port({spawn, lock_drv}, [eof]),
+ true = erl_ddll:info(lock_drv,permanent),
+ erlang:port_close(Port1),
+ erlang:port_close(Port2),
ok.
-
+
% Load and unload the echo_drv driver.
% Make sure that the driver doesn't exist before we load it,
% and that it exists before we unload it.
load_echo_driver(Path) ->
- ?line {ok, L1} = erl_ddll:loaded_drivers(),
- ?line ok = erl_ddll:load_driver(Path, echo_drv),
- ?line {ok, L2} = erl_ddll:loaded_drivers(),
- ?line ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2),
- ordsets:from_list(L1))),
+ {ok, L1} = erl_ddll:loaded_drivers(),
+ ok = erl_ddll:load_driver(Path, echo_drv),
+ {ok, L2} = erl_ddll:loaded_drivers(),
+ ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2),
+ ordsets:from_list(L1))),
{ok,L1,L2}.
load_nice_echo_driver(Path) ->
- ?line {ok, L1} = erl_ddll:loaded_drivers(),
- ?line ok = erl_ddll:load(Path, echo_drv),
- ?line {ok, L2} = erl_ddll:loaded_drivers(),
- ?line ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2),
- ordsets:from_list(L1))),
+ {ok, L1} = erl_ddll:loaded_drivers(),
+ ok = erl_ddll:load(Path, echo_drv),
+ {ok, L2} = erl_ddll:loaded_drivers(),
+ ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2),
+ ordsets:from_list(L1))),
{ok,L1,L2}.
unload_echo_driver(L1,L2) ->
- ?line {ok, L2} = erl_ddll:loaded_drivers(),
- ?line ok = erl_ddll:unload_driver(echo_drv),
- ?line {ok, L3} = erl_ddll:loaded_drivers(),
- ?line [] = ordsets:to_list(subtract(ordsets:from_list(L3),
- ordsets:from_list(L1))),
+ {ok, L2} = erl_ddll:loaded_drivers(),
+ ok = erl_ddll:unload_driver(echo_drv),
+ {ok, L3} = erl_ddll:loaded_drivers(),
+ [] = ordsets:to_list(subtract(ordsets:from_list(L3),
+ ordsets:from_list(L1))),
ok.
unload_expect_fast(Driver,XFlags) ->
{ok, pending_driver, Ref} =
- erl_ddll:try_unload(Driver,
- [{monitor,pending_driver}]++XFlags),
+ erl_ddll:try_unload(Driver,
+ [{monitor,pending_driver}]++XFlags),
receive
- {'DOWN', Ref, driver, Driver, unloaded} ->
- case lists:member(atom_to_list(Driver),element(2,erl_ddll:loaded_drivers())) of
- true ->
- {error, {still_there, Driver}};
- false ->
- ok
- end
+ {'DOWN', Ref, driver, Driver, unloaded} ->
+ case lists:member(atom_to_list(Driver),element(2,erl_ddll:loaded_drivers())) of
+ true ->
+ {error, {still_there, Driver}};
+ false ->
+ ok
+ end
after 1000 ->
- {error,{unable_to_unload, Driver}}
+ {error,{unable_to_unload, Driver}}
end.
diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl
index 6a5ca20ac3..ad592f7147 100644
--- a/erts/emulator/test/decode_packet_SUITE.erl
+++ b/erts/emulator/test/decode_packet_SUITE.erl
@@ -22,15 +22,16 @@
-module(decode_packet_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
- basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1,
+-export([all/0, suite/0,groups/0,
+ init_per_testcase/2,end_per_testcase/2,
+ basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1, otp_8536/1,
otp_9389/1, otp_9389_line/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
all() ->
[basic, packet_size, neg, http, line, ssl, otp_8536,
@@ -39,69 +40,49 @@ all() ->
groups() ->
[].
-init_per_suite(Config) ->
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ rand:seed(exsplus),
+ io:format("*** SEED: ~p ***\n", [rand:export_seed()]),
Config.
-end_per_suite(_Config) ->
+end_per_testcase(_Func, _Config) ->
ok.
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Seed = {S1,S2,S3} = {erlang:monotonic_time(),
- erlang:time_offset(),
- erlang:unique_integer()},
- random:seed(S1,S2,S3),
- io:format("*** SEED: ~p ***\n", [Seed]),
- Dog=?t:timetrap(?t:minutes(1)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-basic(doc) -> [];
-basic(suite) -> [];
basic(Config) when is_list(Config) ->
- ?line Packet = <<101,22,203,54,175>>,
- ?line Rest = <<123,34,0,250>>,
- ?line Bin = <<Packet/binary,Rest/binary>>,
- ?line {ok, Bin, <<>>} = decode_pkt(raw,Bin),
+ Packet = <<101,22,203,54,175>>,
+ Rest = <<123,34,0,250>>,
+ Bin = <<Packet/binary,Rest/binary>>,
+ {ok, Bin, <<>>} = decode_pkt(raw,Bin),
- ?line {more, 5+1} = decode_pkt(1,<<5,1,2,3,4>>),
- ?line {more, 5+2} = decode_pkt(2,<<0,5,1,2,3,4>>),
- ?line {more, 5+4} = decode_pkt(4,<<0,0,0,5,1,2,3,4>>),
+ {more, 5+1} = decode_pkt(1,<<5,1,2,3,4>>),
+ {more, 5+2} = decode_pkt(2,<<0,5,1,2,3,4>>),
+ {more, 5+4} = decode_pkt(4,<<0,0,0,5,1,2,3,4>>),
- ?line {more, undefined} = decode_pkt(1,<<>>),
- ?line {more, undefined} = decode_pkt(2,<<0>>),
- ?line {more, undefined} = decode_pkt(4,<<0,0,0>>),
+ {more, undefined} = decode_pkt(1,<<>>),
+ {more, undefined} = decode_pkt(2,<<0>>),
+ {more, undefined} = decode_pkt(4,<<0,0,0>>),
Types = [1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls],
%% Run tests for different header types and bit offsets.
lists:foreach(fun({Type,Bits})->basic_pack(Type,Packet,Rest,Bits),
- more_length(Type,Packet,Bits) end,
- [{T,B} || T<-Types, B<-lists:seq(0,32)]),
+ more_length(Type,Packet,Bits) end,
+ [{T,B} || T<-Types, B<-lists:seq(0,32)]),
ok.
basic_pack(Type,Body,Rest,BitOffs) ->
- ?line {Bin,Unpacked,_} = pack(Type,Body,Rest,BitOffs),
- ?line {ok, Unpacked, Rest} = decode_pkt(Type,Bin),
+ {Bin,Unpacked,_} = pack(Type,Body,Rest,BitOffs),
+ {ok, Unpacked, Rest} = decode_pkt(Type,Bin),
case Rest of
- <<>> -> ok;
- _ ->
- ?line <<_:1,NRest/bits>> = Rest,
- basic_pack(Type,Body,NRest,BitOffs)
+ <<>> -> ok;
+ _ ->
+ <<_:1,NRest/bits>> = Rest,
+ basic_pack(Type,Body,NRest,BitOffs)
end.
more_length(Type,Body,BitOffs) ->
- ?line {Bin,_,_} = pack(Type,Body,<<>>,BitOffs),
+ {Bin,_,_} = pack(Type,Body,<<>>,BitOffs),
HdrSize = byte_size(Bin) - byte_size(Body),
more_length_do(Type,HdrSize,Bin,byte_size(Bin)).
@@ -110,17 +91,17 @@ more_length_do(_,_,_,0) ->
more_length_do(Type,HdrSize,Bin,Size) ->
TrySize = (Size*3) div 4,
NSize = if TrySize < HdrSize -> Size - 1;
- true -> TrySize
- end,
+ true -> TrySize
+ end,
{B1,_} = split_binary(Bin,NSize),
- ?line {more, Length} = decode_pkt(Type,B1),
+ {more, Length} = decode_pkt(Type,B1),
case Length of
- L when L=:=byte_size(Bin) -> ok;
- undefined when NSize<HdrSize -> ok
+ L when L=:=byte_size(Bin) -> ok;
+ undefined when NSize<HdrSize -> ok
end,
more_length_do(Type,HdrSize,Bin,NSize).
-
+
pack(Type,Packet,Rest) ->
{Bin,Unpacked} = pack(Type,Packet),
@@ -136,7 +117,7 @@ pack(Type,Body,Rest,BitOffs) ->
{Packet,Unpacked} = pack(Type,Body),
%% Make Bin a sub-bin with an arbitrary bitoffset within Orig
- Prefix = random:uniform(1 bsl BitOffs) - 1,
+ Prefix = rand:uniform(1 bsl BitOffs) - 1,
Orig = <<Prefix:BitOffs,Packet/binary,Rest/bits>>,
<<_:BitOffs,Bin/bits>> = Orig,
{Bin,Unpacked,Orig}.
@@ -151,212 +132,206 @@ pack(4,Bin) ->
Psz = byte_size(Bin),
{<<Psz:32,Bin/binary>>, Bin};
pack(asn1,Bin) ->
- Ident = case random:uniform(3) of
- 1 -> <<17>>;
- 2 -> <<16#1f,16#81,17>>;
- 3 -> <<16#1f,16#81,16#80,16#80,17>>
- end,
+ Ident = case rand:uniform(3) of
+ 1 -> <<17>>;
+ 2 -> <<16#1f,16#81,17>>;
+ 3 -> <<16#1f,16#81,16#80,16#80,17>>
+ end,
Psz = byte_size(Bin),
- Length = case random:uniform(4) of
- 1 when Psz < 128 ->
- <<Psz:8>>;
- R when R=<2 andalso Psz < 16#10000 ->
- <<16#82,Psz:16>>;
- R when R=<3 andalso Psz < 16#1000000 ->
- <<16#83,Psz:24>>;
- _ when Psz < 16#100000000 ->
- <<16#84,Psz:32>>
- end,
+ Length = case rand:uniform(4) of
+ 1 when Psz < 128 ->
+ <<Psz:8>>;
+ R when R=<2 andalso Psz < 16#10000 ->
+ <<16#82,Psz:16>>;
+ R when R=<3 andalso Psz < 16#1000000 ->
+ <<16#83,Psz:24>>;
+ _ when Psz < 16#100000000 ->
+ <<16#84,Psz:32>>
+ end,
Res = <<Ident/binary,Length/binary,Bin/binary>>,
{Res,Res};
pack(sunrm,Bin) ->
Psz = byte_size(Bin),
Res = if Psz < 16#80000000 ->
- <<Psz:32,Bin/binary>>
- end,
+ <<Psz:32,Bin/binary>>
+ end,
{Res,Res};
pack(cdr,Bin) ->
GIOP = <<"GIOP">>,
- Major = random:uniform(256) - 1,
- Minor = random:uniform(256) - 1,
- MType = random:uniform(256) - 1,
+ Major = rand:uniform(256) - 1,
+ Minor = rand:uniform(256) - 1,
+ MType = rand:uniform(256) - 1,
Psz = byte_size(Bin),
- Res = case random:uniform(2) of
- 1 -> <<GIOP/binary,Major:8,Minor:8,0:8,MType:8,Psz:32/big,Bin/binary>>;
- 2 -> <<GIOP/binary,Major:8,Minor:8,1:8,MType:8,Psz:32/little,Bin/binary>>
- end,
+ Res = case rand:uniform(2) of
+ 1 -> <<GIOP/binary,Major:8,Minor:8,0:8,MType:8,Psz:32/big,Bin/binary>>;
+ 2 -> <<GIOP/binary,Major:8,Minor:8,1:8,MType:8,Psz:32/little,Bin/binary>>
+ end,
{Res,Res};
pack(fcgi,Bin) ->
Ver = 1,
- Type = random:uniform(256) - 1,
- Id = random:uniform(65536) - 1,
- PaddSz = random:uniform(16) - 1,
+ Type = rand:uniform(256) - 1,
+ Id = rand:uniform(65536) - 1,
+ PaddSz = rand:uniform(16) - 1,
Psz = byte_size(Bin),
- Reserv = random:uniform(256) - 1,
+ Reserv = rand:uniform(256) - 1,
Padd = case PaddSz of
- 0 -> <<>>;
- _ -> list_to_binary([random:uniform(256)-1
- || _<- lists:seq(1,PaddSz)])
- end,
+ 0 -> <<>>;
+ _ -> list_to_binary([rand:uniform(256)-1
+ || _<- lists:seq(1,PaddSz)])
+ end,
Res = <<Ver:8,Type:8,Id:16,Psz:16/big,PaddSz:8,Reserv:8,Bin/binary>>,
{<<Res/binary,Padd/binary>>, Res};
pack(tpkt,Bin) ->
Ver = 3,
- Reserv = random:uniform(256) - 1,
+ Reserv = rand:uniform(256) - 1,
Size = byte_size(Bin) + 4,
Res = <<Ver:8,Reserv:8,Size:16,Bin/binary>>,
{Res, Res};
pack(ssl_tls,Bin) ->
- Content = case (random:uniform(256) - 1) of
- C when C<128 -> C;
- _ -> v2hello
- end,
- Major = random:uniform(256) - 1,
- Minor = random:uniform(256) - 1,
+ Content = case (rand:uniform(256) - 1) of
+ C when C<128 -> C;
+ _ -> v2hello
+ end,
+ Major = rand:uniform(256) - 1,
+ Minor = rand:uniform(256) - 1,
pack_ssl(Content,Major,Minor,Bin).
pack_ssl(Content, Major, Minor, Body) ->
case Content of
- v2hello ->
- Size = byte_size(Body),
- Res = <<1:1,(Size+3):15, 1:8, Major:8, Minor:8, Body/binary>>,
- C = 22,
- Data = <<1:8, (Size+2):24, Major:8, Minor:8, Body/binary>>;
- C when is_integer(C) ->
- Size = byte_size(Body),
- Res = <<Content:8, Major:8, Minor:8, Size:16, Body/binary>>,
- Data = Body
+ v2hello ->
+ Size = byte_size(Body),
+ Res = <<1:1,(Size+3):15, 1:8, Major:8, Minor:8, Body/binary>>,
+ C = 22,
+ Data = <<1:8, (Size+2):24, Major:8, Minor:8, Body/binary>>;
+ C when is_integer(C) ->
+ Size = byte_size(Body),
+ Res = <<Content:8, Major:8, Minor:8, Size:16, Body/binary>>,
+ Data = Body
end,
{Res, {ssl_tls,[],C,{Major,Minor}, Data}}.
-packet_size(doc) -> [];
-packet_size(suite) -> [];
packet_size(Config) when is_list(Config) ->
- ?line Packet = <<101,22,203,54,175>>,
- ?line Rest = <<123,34,0,250>>,
+ Packet = <<101,22,203,54,175>>,
+ Rest = <<123,34,0,250>>,
F = fun({Type,Max})->
- ?line {Bin,Unpacked} = pack(Type,Packet,Rest),
- ?line case decode_pkt(Type,Bin,[{packet_size,Max}]) of
- {ok,Unpacked,Rest} when Max=:=0; Max>=byte_size(Packet) ->
- ok;
- {error,_} when Max<byte_size(Packet), Max=/=0 ->
- ok;
- {error,_} when Type=:=fcgi, Max=/=0 ->
- %% packet includes random amount of padding
- ok
- end
- end,
- ?line lists:foreach(F, [{T,D} || T<-[1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls],
- D<-lists:seq(0, byte_size(Packet)*2)]),
+ {Bin,Unpacked} = pack(Type,Packet,Rest),
+ case decode_pkt(Type,Bin,[{packet_size,Max}]) of
+ {ok,Unpacked,Rest} when Max=:=0; Max>=byte_size(Packet) ->
+ ok;
+ {error,_} when Max<byte_size(Packet), Max=/=0 ->
+ ok;
+ {error,_} when Type=:=fcgi, Max=/=0 ->
+ %% packet includes random amount of padding
+ ok
+ end
+ end,
+ lists:foreach(F, [{T,D} || T<-[1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls],
+ D<-lists:seq(0, byte_size(Packet)*2)]),
%% Test OTP-8102, "negative" 4-byte sizes.
lists:foreach(fun(Size) ->
- ?line {error,_} = decode_pkt(4,<<Size:32,Packet/binary>>)
- end,
- lists:seq(-10,-1)),
+ {error,_} = decode_pkt(4,<<Size:32,Packet/binary>>)
+ end,
+ lists:seq(-10,-1)),
%% Test OTP-9389, long HTTP header lines.
Opts = [{packet_size, 128}],
Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /",
string:chars($Y, 64), "\r\n\r\n"]),
<<Pkt1:50/binary, Pkt2/binary>> = Pkt,
- ?line {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} =
- erlang:decode_packet(http, Pkt1, Opts),
- ?line {ok, {http_header,_,'Host',_,"localhost"}, Rest2} =
- erlang:decode_packet(httph, Rest1, Opts),
- ?line {more, undefined} = erlang:decode_packet(httph, Rest2, Opts),
- ?line {ok, {http_header,_,"Link",_,_}, _} =
- erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts),
+ {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} =
+ erlang:decode_packet(http, Pkt1, Opts),
+ {ok, {http_header,_,'Host',_,"localhost"}, Rest2} =
+ erlang:decode_packet(httph, Rest1, Opts),
+ {more, undefined} = erlang:decode_packet(httph, Rest2, Opts),
+ {ok, {http_header,_,"Link",_,_}, _} =
+ erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts),
Pkt3 = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /",
string:chars($Y, 129), "\r\n\r\n"]),
- ?line {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} =
- erlang:decode_packet(http, Pkt3, Opts),
- ?line {ok, {http_header,_,'Host',_,"localhost"}, Rest4} =
- erlang:decode_packet(httph, Rest3, Opts),
- ?line {error, invalid} = erlang:decode_packet(httph, Rest4, Opts),
+ {ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest3} =
+ erlang:decode_packet(http, Pkt3, Opts),
+ {ok, {http_header,_,'Host',_,"localhost"}, Rest4} =
+ erlang:decode_packet(httph, Rest3, Opts),
+ {error, invalid} = erlang:decode_packet(httph, Rest4, Opts),
ok.
-neg(doc) -> [];
-neg(suite) -> [];
neg(Config) when is_list(Config) ->
- ?line Bin = <<"dummy">>,
+ Bin = <<"dummy">>,
Fun = fun()->dummy end,
-
+
BadargF = fun(T,B,Opts)-> {'EXIT',{badarg,_}} = (catch decode_pkt(T,B,Opts)) end,
%% Invalid Type args
lists:foreach(fun(T)-> BadargF(T,Bin,[]) end,
- [3,-1,5,2.0,{2},unknown,[],"line",Bin,Fun,self()]),
+ [3,-1,5,2.0,{2},unknown,[],"line",Bin,Fun,self()]),
%% Invalid Bin args
lists:foreach(fun(B)-> BadargF(0,B,[]) end,
- [3,2.0,unknown,[],"Bin",[Bin],{Bin},Fun,self()]),
+ [3,2.0,unknown,[],"Bin",[Bin],{Bin},Fun,self()]),
%% Invalid options
InvOpts = [2,false,self(),Bin,"Options",Fun,
- packet_size,{packet_size},{packet_size,0,false},
- {packet_size,-1},{packet_size,100.0},{packet_size,false},
- {line_length,-1},{line_length,100.0},{line_length,false}],
+ packet_size,{packet_size},{packet_size,0,false},
+ {packet_size,-1},{packet_size,100.0},{packet_size,false},
+ {line_length,-1},{line_length,100.0},{line_length,false}],
lists:foreach(fun(Opt)-> BadargF(0,Bin,Opt),
- BadargF(0,Bin,[Opt]),
- BadargF(0,Bin,[Opt,{packet_size,1000}]),
- BadargF(0,Bin,[{packet_size,1000},Opt]) end,
- InvOpts),
+ BadargF(0,Bin,[Opt]),
+ BadargF(0,Bin,[Opt,{packet_size,1000}]),
+ BadargF(0,Bin,[{packet_size,1000},Opt]) end,
+ InvOpts),
ok.
-http(doc) -> [];
-http(suite) -> [];
http(Config) when is_list(Config) ->
- ?line <<"foo">> = http_do(http_request("foo")),
- ?line <<" bar">> = http_do(http_request(" bar")),
- ?line <<"Hello!">> = http_do(http_response("Hello!")),
+ <<"foo">> = http_do(http_request("foo")),
+ <<" bar">> = http_do(http_request(" bar")),
+ <<"Hello!">> = http_do(http_response("Hello!")),
%% Test all known header atoms
Val = "dummy value",
ValB = list_to_binary(Val),
Rest = <<"Rest">>,
HdrF = fun(Str,N) ->
- ?line StrA = list_to_atom(Str),
- ?line StrB = list_to_binary(Str),
- ?line Bin = <<StrB/binary,": ",ValB/binary,"\r\n",Rest/binary>>,
- ?line {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin),
- ?line {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin),
- ?line N + 1
- end,
- ?line lists:foldl(HdrF, 1, http_hdr_strings()),
+ StrA = list_to_atom(Str),
+ StrB = list_to_binary(Str),
+ Bin = <<StrB/binary,": ",ValB/binary,"\r\n",Rest/binary>>,
+ {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin),
+ {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin),
+ N + 1
+ end,
+ lists:foldl(HdrF, 1, http_hdr_strings()),
%% Test all known method atoms
MethF = fun(Meth) ->
- ?line MethA = list_to_atom(Meth),
- ?line MethB = list_to_binary(Meth),
- ?line Bin = <<MethB/binary," /invalid/url HTTP/1.0\r\n",Rest/binary>>,
- ?line {ok, {http_request,MethA,{abs_path,"/invalid/url"},{1,0}},
- Rest} = decode_pkt(http,Bin),
- ?line {ok, {http_request,MethA,{abs_path,<<"/invalid/url">>},{1,0}},
- Rest} = decode_pkt(http_bin,Bin)
- end,
- ?line lists:foreach(MethF, http_meth_strings()),
+ MethA = list_to_atom(Meth),
+ MethB = list_to_binary(Meth),
+ Bin = <<MethB/binary," /invalid/url HTTP/1.0\r\n",Rest/binary>>,
+ {ok, {http_request,MethA,{abs_path,"/invalid/url"},{1,0}},
+ Rest} = decode_pkt(http,Bin),
+ {ok, {http_request,MethA,{abs_path,<<"/invalid/url">>},{1,0}},
+ Rest} = decode_pkt(http_bin,Bin)
+ end,
+ lists:foreach(MethF, http_meth_strings()),
%% Test all uri variants
UriF = fun({Str,ResL,ResB}) ->
- Bin = <<"GET ",(list_to_binary(Str))/binary," HTTP/1.1\r\n",Rest/binary>>,
- {ok, {http_request, 'GET', ResL, {1,1}}, Rest} = decode_pkt(http,Bin),
- {ok, {http_request, 'GET', ResB, {1,1}}, Rest} = decode_pkt(http_bin,Bin)
- end,
+ Bin = <<"GET ",(list_to_binary(Str))/binary," HTTP/1.1\r\n",Rest/binary>>,
+ {ok, {http_request, 'GET', ResL, {1,1}}, Rest} = decode_pkt(http,Bin),
+ {ok, {http_request, 'GET', ResB, {1,1}}, Rest} = decode_pkt(http_bin,Bin)
+ end,
lists:foreach(UriF, http_uri_variants()),
%% Response with empty phrase
- ?line {ok,{http_response,{1,1},200,[]},<<>>} = decode_pkt(http, <<"HTTP/1.1 200\r\n">>, []),
- ?line {ok,{http_response,{1,1},200,<<>>},<<>>} = decode_pkt(http_bin, <<"HTTP/1.1 200\r\n">>, []),
+ {ok,{http_response,{1,1},200,[]},<<>>} = decode_pkt(http, <<"HTTP/1.1 200\r\n">>, []),
+ {ok,{http_response,{1,1},200,<<>>},<<>>} = decode_pkt(http_bin, <<"HTTP/1.1 200\r\n">>, []),
ok.
-
+
http_with_bin(http) ->
http_bin;
http_with_bin(httph) ->
@@ -367,88 +342,88 @@ http_do(Tup) ->
http_do({Bin, []}, _) ->
Bin;
http_do({Bin,[{_Line,PL,PB}|Tail]}, Type) ->
- ?line {ok, PL, Rest} = decode_pkt(Type,Bin),
- ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin),
+ {ok, PL, Rest} = decode_pkt(Type,Bin),
+ {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin),
%% Same tests again but as SubBin
- PreLen = random:uniform(64),
- Prefix = random:uniform(1 bsl PreLen) - 1,
- SufLen = random:uniform(64),
- Suffix = random:uniform(1 bsl SufLen) - 1,
+ PreLen = rand:uniform(64),
+ Prefix = rand:uniform(1 bsl PreLen) - 1,
+ SufLen = rand:uniform(64),
+ Suffix = rand:uniform(1 bsl SufLen) - 1,
Orig = <<Prefix:PreLen, Bin/bits, Suffix:SufLen>>,
BinLen = bit_size(Bin),
<<_:PreLen, SubBin:BinLen/bits, _/bits>> = Orig, % Make SubBin
- ?line SubBin = Bin, % just to make sure
+ SubBin = Bin, % just to make sure
- ?line {ok, PL, Rest} = decode_pkt(Type,SubBin),
- ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),SubBin),
+ {ok, PL, Rest} = decode_pkt(Type,SubBin),
+ {ok, PB, Rest} = decode_pkt(http_with_bin(Type),SubBin),
http_do({Rest, Tail}, httph).
http_request(Msg) ->
QnA = [{"POST /invalid/url HTTP/1.1\r\n",
- {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}},
- {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}},
- {"Connection: close\r\n",
- {http_header,2,'Connection',undefined, "close"},
- {http_header,2,'Connection',undefined,<<"close">>}},
- {"Host\t : localhost:8000\r\n", % white space before :
- {http_header,14,'Host',undefined, "localhost:8000"},
- {http_header,14,'Host',undefined,<<"localhost:8000">>}},
- {"User-Agent: perl post\r\n",
- {http_header,24,'User-Agent',undefined, "perl post"},
- {http_header,24,'User-Agent',undefined,<<"perl post">>}},
- {"Content-Length: 4\r\n",
- {http_header,38,'Content-Length',undefined, "4"},
- {http_header,38,'Content-Length',undefined,<<"4">>}},
- {"Content-Type: text/xml; charset=utf-8\r\n",
- {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"},
- {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}},
- {"Other-Field: with some text\r\n",
- {http_header,0, "Other-Field" ,undefined, "with some text"},
- {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}},
- {"Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY: with some text\r\n",
- {http_header,0, "Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely" ,undefined, "with some text"},
- {http_header,0,<<"Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely">>,undefined,<<"with some text">>}},
- {"Multi-Line: Once upon a time in a land far far away,\r\n"
- " there lived a princess imprisoned in the highest tower\r\n"
- " of the most haunted castle.\r\n",
- {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."},
- {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}},
- {"\r\n",
- http_eoh,
- http_eoh}],
+ {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}},
+ {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}},
+ {"Connection: close\r\n",
+ {http_header,2,'Connection',undefined, "close"},
+ {http_header,2,'Connection',undefined,<<"close">>}},
+ {"Host\t : localhost:8000\r\n", % white space before :
+ {http_header,14,'Host',undefined, "localhost:8000"},
+ {http_header,14,'Host',undefined,<<"localhost:8000">>}},
+ {"User-Agent: perl post\r\n",
+ {http_header,24,'User-Agent',undefined, "perl post"},
+ {http_header,24,'User-Agent',undefined,<<"perl post">>}},
+ {"Content-Length: 4\r\n",
+ {http_header,38,'Content-Length',undefined, "4"},
+ {http_header,38,'Content-Length',undefined,<<"4">>}},
+ {"Content-Type: text/xml; charset=utf-8\r\n",
+ {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"},
+ {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}},
+ {"Other-Field: with some text\r\n",
+ {http_header,0, "Other-Field" ,undefined, "with some text"},
+ {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}},
+ {"Make-sure-a-LONG-HEaDer-fIeLd-is-fORMATTED-NicelY: with some text\r\n",
+ {http_header,0, "Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely" ,undefined, "with some text"},
+ {http_header,0,<<"Make-Sure-A-Long-Header-Field-Is-Formatted-Nicely">>,undefined,<<"with some text">>}},
+ {"Multi-Line: Once upon a time in a land far far away,\r\n"
+ " there lived a princess imprisoned in the highest tower\r\n"
+ " of the most haunted castle.\r\n",
+ {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."},
+ {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}},
+ {"\r\n",
+ http_eoh,
+ http_eoh}],
Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line),
- <<Acc/binary,LineBin/binary>> end,
- <<"">>, QnA),
+ <<Acc/binary,LineBin/binary>> end,
+ <<"">>, QnA),
MsgBin = list_to_binary(Msg),
{<<Bin/binary,MsgBin/binary>>, QnA}.
http_response(Msg) ->
QnA = [{"HTTP/1.0 404 Object Not Found\r\n",
- {http_response, {1,0}, 404, "Object Not Found"},
- {http_response, {1,0}, 404, <<"Object Not Found">>}},
- {"Server: inets/4.7.16\r\n",
- {http_header, 30, 'Server', undefined, "inets/4.7.16"},
- {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}},
- {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n",
- {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"},
- {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}},
- {"Content-Type: text/html\r\n",
- {http_header, 42, 'Content-Type', undefined, "text/html"},
- {http_header, 42, 'Content-Type', undefined, <<"text/html">>}},
- {"Content-Length: 207\r\n",
- {http_header, 38, 'Content-Length', undefined, "207"},
- {http_header, 38, 'Content-Length', undefined, <<"207">>}},
- {"\r\n",
- http_eoh,
- http_eoh}],
+ {http_response, {1,0}, 404, "Object Not Found"},
+ {http_response, {1,0}, 404, <<"Object Not Found">>}},
+ {"Server: inets/4.7.16\r\n",
+ {http_header, 30, 'Server', undefined, "inets/4.7.16"},
+ {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}},
+ {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n",
+ {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"},
+ {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}},
+ {"Content-Type: text/html\r\n",
+ {http_header, 42, 'Content-Type', undefined, "text/html"},
+ {http_header, 42, 'Content-Type', undefined, <<"text/html">>}},
+ {"Content-Length: 207\r\n",
+ {http_header, 38, 'Content-Length', undefined, "207"},
+ {http_header, 38, 'Content-Length', undefined, <<"207">>}},
+ {"\r\n",
+ http_eoh,
+ http_eoh}],
Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line),
- <<Acc/binary,LineBin/binary>> end,
- <<"">>, QnA),
+ <<Acc/binary,LineBin/binary>> end,
+ <<"">>, QnA),
MsgBin = list_to_binary(Msg),
{<<Bin/binary,MsgBin/binary>>, QnA}.
@@ -489,60 +464,56 @@ http_uri_variants() ->
{"something_else", "something_else", <<"something_else">>}].
-line(doc) -> [];
-line(suite) -> [];
line(Config) when is_list(Config) ->
Text = <<"POST /invalid/url HTTP/1.1\r\n"
- "Connection: close\r\n"
- "Host\t : localhost:8000\r\n"
- "User-Agent: perl post\r\n"
- "Content-Length: 4\r\n"
- "Content-Type: text/xml; charset=utf-8\r\n"
- "Other-Field: with some text\r\n"
- "Multi-Line: Once upon a time in a land far far away,\r\n"
- " there lived a princess imprisoned in the highest tower\r\n"
- " of the most haunted castle.\r\n"
- "\r\nThe residue">>,
+ "Connection: close\r\n"
+ "Host\t : localhost:8000\r\n"
+ "User-Agent: perl post\r\n"
+ "Content-Length: 4\r\n"
+ "Content-Type: text/xml; charset=utf-8\r\n"
+ "Other-Field: with some text\r\n"
+ "Multi-Line: Once upon a time in a land far far away,\r\n"
+ " there lived a princess imprisoned in the highest tower\r\n"
+ " of the most haunted castle.\r\n"
+ "\r\nThe residue">>,
lists:foreach(fun(MaxLen) -> line_do(Text,MaxLen) end,
- [0,7,19,29,37]),
+ [0,7,19,29,37]),
ok.
line_do(Bin,MaxLen) ->
Res = decode_pkt(line,Bin,[{line_length,MaxLen}]),
MyRes = decode_line(Bin,MaxLen),
- ?line MyRes = Res,
+ MyRes = Res,
case Res of
- {ok,_,Rest} ->
- line_do(Rest,MaxLen);
- {more,undefined} ->
- ok
+ {ok,_,Rest} ->
+ line_do(Rest,MaxLen);
+ {more,undefined} ->
+ ok
end.
-
+
% Emulates decode_packet(line,Bin,[{line_length,MaxLen}])
decode_line(Bin,MaxLen) ->
- ?line case find_in_binary($\n,Bin) of
- notfound when MaxLen>0 andalso byte_size(Bin) >= MaxLen ->
- {LineB,Rest} = split_binary(Bin,MaxLen),
- {ok,LineB,Rest};
- notfound ->
- {more,undefined};
- Pos when MaxLen>0 andalso Pos > MaxLen ->
- {LineB,Rest} = split_binary(Bin,MaxLen),
- {ok,LineB,Rest};
- Pos ->
- {LineB,Rest} = split_binary(Bin,Pos),
- {ok,LineB,Rest}
+ case find_in_binary($\n,Bin) of
+ notfound when MaxLen>0 andalso byte_size(Bin) >= MaxLen ->
+ {LineB,Rest} = split_binary(Bin,MaxLen),
+ {ok,LineB,Rest};
+ notfound ->
+ {more,undefined};
+ Pos when MaxLen>0 andalso Pos > MaxLen ->
+ {LineB,Rest} = split_binary(Bin,MaxLen),
+ {ok,LineB,Rest};
+ Pos ->
+ {LineB,Rest} = split_binary(Bin,Pos),
+ {ok,LineB,Rest}
end.
find_in_binary(Byte, Bin) ->
case string:chr(binary_to_list(Bin),Byte) of
- 0 -> notfound;
- P -> P
+ 0 -> notfound;
+ P -> P
end.
-ssl(doc) -> [];
-ssl(suite) -> [];
ssl(Config) when is_list(Config) ->
Major = 34,
Minor = 17,
@@ -550,15 +521,15 @@ ssl(Config) when is_list(Config) ->
Rest = <<23,123,203,12,234>>,
F = fun(Content) ->
- {Packet,Unpacked} = pack_ssl(Content, Major, Minor, Body),
- Bin = <<Packet/binary,Rest/binary>>,
- ?line {ok, Unpacked, Rest} = decode_pkt(ssl_tls, Bin)
- end,
+ {Packet,Unpacked} = pack_ssl(Content, Major, Minor, Body),
+ Bin = <<Packet/binary,Rest/binary>>,
+ {ok, Unpacked, Rest} = decode_pkt(ssl_tls, Bin)
+ end,
F(25),
F(v2hello),
ok.
-otp_8536(doc) -> ["Corrupt sub-binary-strings from httph_bin"];
+%% Corrupt sub-binary-strings from httph_bin
otp_8536(Config) when is_list(Config) ->
lists:foreach(fun otp_8536_do/1, lists:seq(1,50)),
ok.
@@ -571,7 +542,7 @@ otp_8536_do(N) ->
Bin = <<Hdr/binary, ": ", Data/binary, "\r\n\r\n">>,
io:format("Bin='~p'\n",[Bin]),
- ?line {ok,{http_header,0,Hdr2,undefined,Data2},<<"\r\n">>} = decode_pkt(httph_bin, Bin, []),
+ {ok,{http_header,0,Hdr2,undefined,Data2},<<"\r\n">>} = decode_pkt(httph_bin, Bin, []),
%% Do something to trash the C-stack, how about another decode_packet:
decode_pkt(httph_bin,<<Letters/binary, ": ", Data/binary, "\r\n\r\n">>, []),
@@ -587,8 +558,7 @@ decode_pkt(Type,Bin,Opts) ->
%%io:format(" -> ~p\n",[Res]),
Res.
-otp_9389(doc) -> ["Verify line_length works correctly for HTTP headers"];
-otp_9389(suite) -> [];
+%% Verify line_length works correctly for HTTP headers
otp_9389(Config) when is_list(Config) ->
Opts = [{packet_size, 16384}, {line_length, 3000}],
Pkt = list_to_binary(["GET / HTTP/1.1\r\nHost: localhost\r\nLink: /",
@@ -596,26 +566,25 @@ otp_9389(Config) when is_list(Config) ->
"\r\nContent-Length: 0\r\n\r\n"]),
<<Pkt1:5000/binary, Pkt2/binary>> = Pkt,
{ok, {http_request,'GET',{abs_path,"/"},{1,1}}, Rest1} =
- erlang:decode_packet(http, Pkt1, Opts),
+ erlang:decode_packet(http, Pkt1, Opts),
{ok, {http_header,_,'Host',_,"localhost"}, Rest2} =
- erlang:decode_packet(httph, Rest1, Opts),
+ erlang:decode_packet(httph, Rest1, Opts),
{more, undefined} = erlang:decode_packet(httph, Rest2, Opts),
{ok, {http_header,_,"Link",_,Link}, Rest3} =
- erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts),
+ erlang:decode_packet(httph, list_to_binary([Rest2, Pkt2]), Opts),
true = (length(Link) > 8000),
{ok, {http_header,_,'Content-Length',_,"0"}, <<"\r\n">>} =
- erlang:decode_packet(httph, Rest3, Opts),
+ erlang:decode_packet(httph, Rest3, Opts),
ok.
-otp_9389_line(doc) -> ["Verify packet_size works correctly for line mode"];
-otp_9389_line(suite) -> [];
+%% Verify packet_size works correctly for line mode
otp_9389_line(Config) when is_list(Config) ->
Opts = [{packet_size, 20}],
Line1 = <<"0123456789012345678\n">>,
Line2 = <<"0123456789\n">>,
Line3 = <<"01234567890123456789\n">>,
Pkt = list_to_binary([Line1, Line2, Line3]),
- ?line {ok, Line1, Rest1} = erlang:decode_packet(line, Pkt, Opts),
- ?line {ok, Line2, Rest2} = erlang:decode_packet(line, Rest1, Opts),
- ?line {error, invalid} = erlang:decode_packet(line, Rest2, Opts),
+ {ok, Line1, Rest1} = erlang:decode_packet(line, Pkt, Opts),
+ {ok, Line2, Rest2} = erlang:decode_packet(line, Rest1, Opts),
+ {error, invalid} = erlang:decode_packet(line, Rest2, Opts),
ok.
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index d71cedbdc5..f116ec979b 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -33,41 +33,40 @@
%% Tests distribution and the tcp driver.
--include_lib("test_server/include/test_server.hrl").
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- ping/1, bulk_send_small/1,
- bulk_send_big/1, bulk_send_bigbig/1,
- local_send_small/1, local_send_big/1,
- local_send_legal/1, link_to_busy/1, exit_to_busy/1,
- lost_exit/1, link_to_dead/1, link_to_dead_new_node/1,
- applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1,
- trap_bif_1/1, trap_bif_2/1, trap_bif_3/1,
- stop_dist/1,
- dist_auto_connect_never/1, dist_auto_connect_once/1,
- dist_parallel_send/1,
- atom_roundtrip/1,
- unicode_atom_roundtrip/1,
- atom_roundtrip_r15b/1,
- contended_atom_cache_entry/1,
- contended_unicode_atom_cache_entry/1,
- bad_dist_structure/1,
- bad_dist_ext_receive/1,
- bad_dist_ext_process_info/1,
- bad_dist_ext_control/1,
- bad_dist_ext_connection_id/1]).
-
--export([init_per_testcase/2, end_per_testcase/2]).
+-include_lib("common_test/include/ct.hrl").
+
+-export([all/0, suite/0, groups/0,
+ ping/1, bulk_send_small/1,
+ bulk_send_big/1, bulk_send_bigbig/1,
+ local_send_small/1, local_send_big/1,
+ local_send_legal/1, link_to_busy/1, exit_to_busy/1,
+ lost_exit/1, link_to_dead/1, link_to_dead_new_node/1,
+ applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1,
+ trap_bif_1/1, trap_bif_2/1, trap_bif_3/1,
+ stop_dist/1,
+ dist_auto_connect_never/1, dist_auto_connect_once/1,
+ dist_parallel_send/1,
+ atom_roundtrip/1,
+ unicode_atom_roundtrip/1,
+ atom_roundtrip_r15b/1,
+ contended_atom_cache_entry/1,
+ contended_unicode_atom_cache_entry/1,
+ bad_dist_structure/1,
+ bad_dist_ext_receive/1,
+ bad_dist_ext_process_info/1,
+ bad_dist_ext_control/1,
+ bad_dist_ext_connection_id/1]).
%% Internal exports.
-export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0,
- roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1,
- dist_parallel_sender/3, dist_parallel_receiver/0,
- dist_evil_parallel_receiver/0,
+ roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1,
+ dist_parallel_sender/3, dist_parallel_receiver/0,
+ dist_evil_parallel_receiver/0,
sendersender/4, sendersender2/4]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
[ping, {group, bulk_send}, {group, local_send},
@@ -90,81 +89,55 @@ groups() ->
[bad_dist_ext_receive, bad_dist_ext_process_info,
bad_dist_ext_control, bad_dist_ext_connection_id]}].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
--define(DEFAULT_TIMETRAP, 4*60*1000).
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?DEFAULT_TIMETRAP),
- [{watchdog, Dog},{testcase, Func}|Config].
-
-end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-ping(doc) ->
- ["Tests pinging a node in different ways."];
+%% Tests pinging a node in different ways.
ping(Config) when is_list(Config) ->
Times = 1024,
%% Ping a non-existing node many times. This used to crash the emulator
%% on Windows.
- ?line Host = hostname(),
- ?line BadName = list_to_atom("__pucko__@" ++ Host),
- ?line io:format("Pinging ~s (assumed to not exist)", [BadName]),
- ?line test_server:do_times(Times, fun() -> pang = net_adm:ping(BadName)
- end),
+ Host = hostname(),
+ BadName = list_to_atom("__pucko__@" ++ Host),
+ io:format("Pinging ~s (assumed to not exist)", [BadName]),
+ test_server:do_times(Times, fun() -> pang = net_adm:ping(BadName)
+ end),
%% Pings another node.
- ?line {ok, OtherNode} = start_node(distribution_SUITE_other),
- ?line io:format("Pinging ~s (assumed to exist)", [OtherNode]),
- ?line test_server:do_times(Times, fun() -> pong = net_adm:ping(OtherNode) end),
- ?line stop_node(OtherNode),
+ {ok, OtherNode} = start_node(distribution_SUITE_other),
+ io:format("Pinging ~s (assumed to exist)", [OtherNode]),
+ test_server:do_times(Times, fun() -> pong = net_adm:ping(OtherNode) end),
+ stop_node(OtherNode),
%% Pings our own node many times.
- ?line Node = node(),
- ?line io:format("Pinging ~s (the same node)", [Node]),
- ?line test_server:do_times(Times, fun() -> pong = net_adm:ping(Node) end),
+ Node = node(),
+ io:format("Pinging ~s (the same node)", [Node]),
+ test_server:do_times(Times, fun() -> pong = net_adm:ping(Node) end),
ok.
bulk_send_small(Config) when is_list(Config) ->
- ?line bulk_send(64, 32).
+ bulk_send(64, 32).
bulk_send_big(Config) when is_list(Config) ->
- ?line bulk_send(32, 64).
+ bulk_send(32, 64).
bulk_send_bigbig(Config) when is_list(Config) ->
- ?line bulk_sendsend(32*5, 4).
+ bulk_sendsend(32*5, 4).
bulk_send(Terms, BinSize) ->
- ?line Dog = test_server:timetrap(test_server:seconds(30)),
-
- ?line io:format("Sending ~w binaries, each of size ~w K",
- [Terms, BinSize]),
- ?line {ok, Node} = start_node(bulk_receiver),
- ?line Recv = spawn(Node, erlang, apply, [fun receiver/2, [0, 0]]),
- ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)),
- ?line Size = Terms*size(Bin),
- ?line {Elapsed, {Terms, Size}} = test_server:timecall(?MODULE, sender,
- [Recv, Bin, Terms]),
- ?line stop_node(Node),
-
- ?line test_server:timetrap_cancel(Dog),
- {comment, integer_to_list(trunc(Size/1024/Elapsed+0.5)) ++ " K/s"}.
+ ct:timetrap({seconds, 30}),
+
+ io:format("Sending ~w binaries, each of size ~w K", [Terms, BinSize]),
+ {ok, Node} = start_node(bulk_receiver),
+ Recv = spawn(Node, erlang, apply, [fun receiver/2, [0, 0]]),
+ Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)),
+ Size = Terms*size(Bin),
+ {Elapsed, {Terms, Size}} = test_server:timecall(?MODULE, sender,
+ [Recv, Bin, Terms]),
+ stop_node(Node),
+ {comment, integer_to_list(trunc(Size/1024/max(1,Elapsed)+0.5)) ++ " K/s"}.
bulk_sendsend(Terms, BinSize) ->
{Rate1, MonitorCount1} = bulk_sendsend2(Terms, BinSize, 5),
@@ -173,29 +146,29 @@ bulk_sendsend(Terms, BinSize) ->
true -> MonitorCount1 / MonitorCount2
end,
Comment = integer_to_list(Rate1) ++ " K/s, " ++
- integer_to_list(Rate2) ++ " K/s, " ++
- integer_to_list(MonitorCount1) ++ " monitor msgs, " ++
- integer_to_list(MonitorCount2) ++ " monitor msgs, " ++
- float_to_list(Ratio) ++ " monitor ratio",
+ integer_to_list(Rate2) ++ " K/s, " ++
+ integer_to_list(MonitorCount1) ++ " monitor msgs, " ++
+ integer_to_list(MonitorCount2) ++ " monitor msgs, " ++
+ float_to_list(Ratio) ++ " monitor ratio",
if
- %% A somewhat arbitrary ratio, but hopefully one that will
- %% accommodate a wide range of CPU speeds.
- Ratio > 8.0 ->
- {comment,Comment};
- true ->
- io:put_chars(Comment),
- ?line ?t:fail(ratio_too_low)
+ %% A somewhat arbitrary ratio, but hopefully one that will
+ %% accommodate a wide range of CPU speeds.
+ Ratio > 8.0 ->
+ {comment,Comment};
+ true ->
+ io:put_chars(Comment),
+ ct:fail(ratio_too_low)
end.
bulk_sendsend2(Terms, BinSize, BusyBufSize) ->
- ?line Dog = test_server:timetrap(test_server:seconds(30)),
+ ct:timetrap({seconds, 30}),
- ?line io:format("Sending ~w binaries, each of size ~w K",
- [Terms, BinSize]),
- ?line {ok, NodeRecv} = start_node(bulk_receiver),
- ?line Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]),
- ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)),
- %%?line Size = Terms*size(Bin),
+ io:format("Sending ~w binaries, each of size ~w K",
+ [Terms, BinSize]),
+ {ok, NodeRecv} = start_node(bulk_receiver),
+ Recv = spawn(NodeRecv, erlang, apply, [fun receiver/2, [0, 0]]),
+ Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)),
+ %%Size = Terms*size(Bin),
%% SLF LEFT OFF HERE.
%% When the caller uses small hunks, like 4k via
@@ -206,23 +179,21 @@ bulk_sendsend2(Terms, BinSize, BusyBufSize) ->
%% default busy size and "+zdbbl 5", and if the 5 case gets
%% "many many more" monitor messages, then we know we're working.
- ?line {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)),
- ?line _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]),
- ?line {Elapsed, {_TermsN, SizeN}, MonitorCount} =
- receive {sendersender, BigRes} ->
+ {ok, NodeSend} = start_node(bulk_sender, "+zdbbl " ++ integer_to_list(BusyBufSize)),
+ _Send = spawn(NodeSend, erlang, apply, [fun sendersender/4, [self(), Recv, Bin, Terms]]),
+ {Elapsed, {_TermsN, SizeN}, MonitorCount} =
+ receive {sendersender, BigRes} ->
BigRes
- end,
- ?line stop_node(NodeRecv),
- ?line stop_node(NodeSend),
-
- ?line test_server:timetrap_cancel(Dog),
+ end,
+ stop_node(NodeRecv),
+ stop_node(NodeSend),
{trunc(SizeN/1024/Elapsed+0.5), MonitorCount}.
sender(To, _Bin, 0) ->
To ! {done, self()},
receive
- Any ->
- Any
+ Any ->
+ Any
end;
sender(To, Bin, Left) ->
To ! {term, Bin},
@@ -233,9 +204,9 @@ sender(To, Bin, Left) ->
sendersender(Parent, To, Bin, Left) ->
erlang:system_monitor(self(), [busy_dist_port]),
[spawn(fun() -> sendersender2(To, Bin, Left, false) end) ||
- _ <- lists:seq(1,1)],
+ _ <- lists:seq(1,1)],
{USec, {Res, MonitorCount}} =
- timer:tc(?MODULE, sendersender2, [To, Bin, Left, true]),
+ timer:tc(?MODULE, sendersender2, [To, Bin, Left, true]),
Parent ! {sendersender, {USec/1000000, Res, MonitorCount}}.
sendersender2(To, Bin, Left, SendDone) ->
@@ -243,22 +214,22 @@ sendersender2(To, Bin, Left, SendDone) ->
sendersender3(To, _Bin, 0, SendDone, MonitorCount) ->
if SendDone ->
- To ! {done, self()};
+ To ! {done, self()};
true ->
- ok
+ ok
end,
receive
{monitor, _Pid, _Type, _Info} ->
sendersender3(To, _Bin, 0, SendDone, MonitorCount + 1)
after 0 ->
- if SendDone ->
- receive
- Any when is_tuple(Any), size(Any) == 2 ->
- {Any, MonitorCount}
- end;
- true ->
- exit(normal)
- end
+ if SendDone ->
+ receive
+ Any when is_tuple(Any), size(Any) == 2 ->
+ {Any, MonitorCount}
+ end;
+ true ->
+ exit(normal)
+ end
end;
sendersender3(To, Bin, Left, SendDone, MonitorCount) ->
To ! {term, Bin},
@@ -269,80 +240,74 @@ sendersender3(To, Bin, Left, SendDone, MonitorCount) ->
receiver(Terms, Size) ->
receive
- {term, Bin} ->
- receiver(Terms+1, Size+size(Bin));
- {done, ReplyTo} ->
- ReplyTo ! {Terms, Size}
+ {term, Bin} ->
+ receiver(Terms+1, Size+size(Bin));
+ {done, ReplyTo} ->
+ ReplyTo ! {Terms, Size}
end.
-local_send_big(doc) ->
- ["Sends several big message to an non-registered process on ",
- "the local node."];
+%% Sends several big message to an non-registered process on the local node.
local_send_big(Config) when is_list(Config) ->
- Data0=local_send_big(doc)++
- ["Tests sending small and big messages to a non-existing ",
- "local registered process."],
+ Data0= ["Tests sending small and big messages to a non-existing ",
+ "local registered process."],
Data1=[Data0,[Data0, Data0, [Data0], Data0],Data0],
Data2=Data0++lists:flatten(Data1)++
- list_to_binary(lists:flatten(Data1)),
+ list_to_binary(lists:flatten(Data1)),
Func=fun() -> Data2= {arbitrary_name, node()} ! Data2 end,
- ?line test_server:do_times(4096, Func),
+ test_server:do_times(4096, Func),
ok.
-local_send_small(doc) ->
- ["Sends a small message to an non-registered process on the ",
- "local node."];
+%% Sends a small message to an non-registered process on the local node.
local_send_small(Config) when is_list(Config) ->
Data={some_stupid, "arbitrary", 'Data'},
Func=fun() -> Data= {unregistered_name, node()} ! Data end,
- ?line test_server:do_times(4096, Func),
+ test_server:do_times(4096, Func),
ok.
-local_send_legal(doc) ->
- ["Sends data to a registered process on the local node, ",
- "as if it was on another node."];
+%% Sends data to a registered process on the local node, as if it was on another node.
local_send_legal(Config) when is_list(Config) ->
Times=16384,
- Data={local_send_legal(doc), local_send_legal(doc)},
+ Txt = "Some Not so random Data",
+ Data={[Txt,Txt,Txt], [Txt,Txt,Txt]},
Pid=spawn(?MODULE,receiver2, [0, 0]) ,
- ?line true=register(registered_process, Pid),
+ true=register(registered_process, Pid),
Func=fun() -> Data={registered_process, node()} ! Data end,
TotalSize=size(Data)*Times,
- ?line test_server:do_times(Times, Func),
+ test_server:do_times(Times, Func),
% Check that all msgs really came through.
Me=self(),
- ?line {done, Me}=
- {registered_process, node()} ! {done, Me},
+ {done, Me}=
+ {registered_process, node()} ! {done, Me},
receive
- {Times, TotalSize} ->
- ok;
- _ ->
- test_server:fail("Wrong number of msgs received.")
+ {Times, TotalSize} ->
+ ok;
+ _ ->
+ ct:fail("Wrong number of msgs received.")
end,
ok.
receiver2(Num, TotSize) ->
receive
- {done, ReplyTo} ->
- ReplyTo ! {Num, TotSize};
- Stuff ->
- receiver2(Num+1, TotSize+size(Stuff))
+ {done, ReplyTo} ->
+ ReplyTo ! {Num, TotSize};
+ Stuff ->
+ receiver2(Num+1, TotSize+size(Stuff))
end.
-link_to_busy(doc) -> "Test that link/1 to a busy distribution port works.";
+%% Test that link/1 to a busy distribution port works.
link_to_busy(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(60)),
- ?line {ok, Node} = start_node(link_to_busy),
- ?line Recv = spawn(Node, erlang, apply, [fun sink/1, [link_to_busy_sink]]),
+ ct:timetrap({seconds, 60}),
+ {ok, Node} = start_node(link_to_busy),
+ Recv = spawn(Node, erlang, apply, [fun sink/1, [link_to_busy_sink]]),
Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of
- "true" -> start_busy_dist_port_tracer();
- _ -> false
- end,
+ "true" -> start_busy_dist_port_tracer();
+ _ -> false
+ end,
%% We will spawn off a process which will try to link to the other
%% node. The linker process will not actually run until this
@@ -351,20 +316,19 @@ link_to_busy(Config) when is_list(Config) ->
%% process will block, too, because of the because busy port,
%% and will later be restarted.
- ?line do_busy_test(Node, fun () -> linker(Recv) end),
+ do_busy_test(Node, fun () -> linker(Recv) end),
%% Same thing, but we apply link/1 instead of calling it directly.
- ?line do_busy_test(Node, fun () -> applied_linker(Recv) end),
+ do_busy_test(Node, fun () -> applied_linker(Recv) end),
%% Same thing again, but we apply link/1 in the tail of a function.
- ?line do_busy_test(Node, fun () -> tail_applied_linker(Recv) end),
+ do_busy_test(Node, fun () -> tail_applied_linker(Recv) end),
%% Done.
- ?line stop_node(Node),
- ?line stop_busy_dist_port_tracer(Tracer),
- ?line test_server:timetrap_cancel(Dog),
+ stop_node(Node),
+ stop_busy_dist_port_tracer(Tracer),
ok.
linker(Pid) ->
@@ -379,16 +343,16 @@ applied_linker(Pid) ->
tail_applied_linker(Pid) ->
apply(erlang, link, [Pid]).
-
-exit_to_busy(doc) -> "Test that exit/2 to a busy distribution port works.";
+
+%% Test that exit/2 to a busy distribution port works.
exit_to_busy(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(60)),
- ?line {ok, Node} = start_node(exit_to_busy),
+ ct:timetrap({seconds, 60}),
+ {ok, Node} = start_node(exit_to_busy),
Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of
- "true" -> start_busy_dist_port_tracer();
- _ -> false
- end,
+ "true" -> start_busy_dist_port_tracer();
+ _ -> false
+ end,
%% We will spawn off a process which will try to exit a process on
%% the other node. That process will not actually run until this
@@ -397,59 +361,58 @@ exit_to_busy(Config) when is_list(Config) ->
%% too, because of the busy distribution port, and will be allowed
%% to continue when the port becomes non-busy.
- ?line Recv1 = spawn(Node, fun () -> sink(exit_to_busy_sink) end),
- ?line M1 = erlang:monitor(process, Recv1),
- ?line do_busy_test(Node, fun () -> joey_killer(Recv1) end),
- ?line receive
- {'DOWN', M1, process, Recv1, R1} ->
- ?line joey_said_die = R1
- end,
+ Recv1 = spawn(Node, fun () -> sink(exit_to_busy_sink) end),
+ M1 = erlang:monitor(process, Recv1),
+ do_busy_test(Node, fun () -> joey_killer(Recv1) end),
+ receive
+ {'DOWN', M1, process, Recv1, R1} ->
+ joey_said_die = R1
+ end,
%% Same thing, but tail call to exit/2.
- ?line Recv2 = spawn(Node, fun () -> sink(exit_to_busy_sink) end),
- ?line M2 = erlang:monitor(process, Recv2),
- ?line do_busy_test(Node, fun () -> tail_joey_killer(Recv2) end),
- ?line receive
- {'DOWN', M2, process, Recv2, R2} ->
- ?line joey_said_die = R2
- end,
+ Recv2 = spawn(Node, fun () -> sink(exit_to_busy_sink) end),
+ M2 = erlang:monitor(process, Recv2),
+ do_busy_test(Node, fun () -> tail_joey_killer(Recv2) end),
+ receive
+ {'DOWN', M2, process, Recv2, R2} ->
+ joey_said_die = R2
+ end,
%% Same thing, but we apply exit/2 instead of calling it directly.
- ?line Recv3 = spawn(Node, fun () -> sink(exit_to_busy_sink) end),
- ?line M3 = erlang:monitor(process, Recv3),
- ?line do_busy_test(Node, fun () -> applied_joey_killer(Recv3) end),
- ?line receive
- {'DOWN', M3, process, Recv3, R3} ->
- ?line joey_said_die = R3
- end,
+ Recv3 = spawn(Node, fun () -> sink(exit_to_busy_sink) end),
+ M3 = erlang:monitor(process, Recv3),
+ do_busy_test(Node, fun () -> applied_joey_killer(Recv3) end),
+ receive
+ {'DOWN', M3, process, Recv3, R3} ->
+ joey_said_die = R3
+ end,
%% Same thing again, but we apply exit/2 in the tail of a function.
- ?line Recv4 = spawn(Node, fun () -> sink(exit_to_busy_sink) end),
- ?line M4 = erlang:monitor(process, Recv4),
- ?line do_busy_test(Node, fun () -> tail_applied_joey_killer(Recv4) end),
- ?line receive
- {'DOWN', M4, process, Recv4, R4} ->
- ?line joey_said_die = R4
- end,
-
+ Recv4 = spawn(Node, fun () -> sink(exit_to_busy_sink) end),
+ M4 = erlang:monitor(process, Recv4),
+ do_busy_test(Node, fun () -> tail_applied_joey_killer(Recv4) end),
+ receive
+ {'DOWN', M4, process, Recv4, R4} ->
+ joey_said_die = R4
+ end,
+
%% Done.
- ?line stop_node(Node),
- ?line stop_busy_dist_port_tracer(Tracer),
- ?line test_server:timetrap_cancel(Dog),
+ stop_node(Node),
+ stop_busy_dist_port_tracer(Tracer),
ok.
make_busy_data() ->
Size = 1024*1024,
Key = '__busy__port__data__',
case get(Key) of
- undefined ->
- Data = list_to_binary(lists:duplicate(Size, 253)),
- put(Key, Data),
- Data;
- Data ->
- true = is_binary(Data),
- true = size(Data) == Size,
- Data
+ undefined ->
+ Data = list_to_binary(lists:duplicate(Size, 253)),
+ put(Key, Data),
+ Data;
+ Data ->
+ true = is_binary(Data),
+ true = size(Data) == Size,
+ Data
end.
make_busy(Node, Time) when is_integer(Time) ->
@@ -458,27 +421,27 @@ make_busy(Node, Time) when is_integer(Time) ->
Data = make_busy_data(),
%% first make port busy
Pid = spawn_link(fun () ->
- forever(fun () ->
- dport_reg_send(Node,
- '__noone__',
- Data)
- end)
- end),
+ forever(fun () ->
+ dport_reg_send(Node,
+ '__noone__',
+ Data)
+ end)
+ end),
receive after Own -> ok end,
until(fun () ->
- case process_info(Pid, status) of
- {status, suspended} -> true;
- _ -> false
- end
- end),
+ case process_info(Pid, status) of
+ {status, suspended} -> true;
+ _ -> false
+ end
+ end),
%% then dist entry
make_busy(Node, [nosuspend], Data),
Pid.
make_busy(Node, Opts, Data) ->
case erlang:send({'__noone__', Node}, Data, Opts) of
- nosuspend -> nosuspend;
- _ -> make_busy(Node, Opts, Data)
+ nosuspend -> nosuspend;
+ _ -> make_busy(Node, Opts, Data)
end.
unmake_busy(Pid) ->
@@ -491,29 +454,29 @@ do_busy_test(Node, Fun) ->
receive after 100 -> ok end,
Pinfo = process_info(P, [status, current_function]),
unmake_busy(Busy),
- ?t:format("~p : ~p~n", [P, Pinfo]),
+ io:format("~p : ~p~n", [P, Pinfo]),
case Pinfo of
- undefined ->
- receive
- {'DOWN', M, process, P, Reason} ->
- ?t:format("~p died with exit reason ~p~n", [P, Reason])
- end,
- ?t:fail(premature_death);
- _ ->
- %% Don't match arity; it is different in debug and
- %% optimized emulator
- [{status, suspended},
- {current_function, {erlang, bif_return_trap, _}}] = Pinfo,
- receive
- {'DOWN', M, process, P, Reason} ->
- ?t:format("~p died with exit reason ~p~n", [P, Reason]),
- normal = Reason
- end
+ undefined ->
+ receive
+ {'DOWN', M, process, P, Reason} ->
+ io:format("~p died with exit reason ~p~n", [P, Reason])
+ end,
+ ct:fail(premature_death);
+ _ ->
+ %% Don't match arity; it is different in debug and
+ %% optimized emulator
+ [{status, suspended},
+ {current_function, {erlang, bif_return_trap, _}}] = Pinfo,
+ receive
+ {'DOWN', M, process, P, Reason} ->
+ io:format("~p died with exit reason ~p~n", [P, Reason]),
+ normal = Reason
+ end
end.
remote_is_process_alive(Pid) ->
rpc:call(node(Pid), erlang, is_process_alive,
- [Pid]).
+ [Pid]).
joey_killer(Pid) ->
exit(Pid, joey_said_die),
@@ -535,234 +498,227 @@ sink(Name) ->
sink1() ->
receive
- _Any -> sink1()
+ _Any -> sink1()
end.
-lost_exit(doc) ->
- "Test that EXIT and DOWN messages send to another node are not lost if "
- "the distribution port is busy.";
+%% Test that EXIT and DOWN messages send to another node are not lost if
+%% the distribution port is busy.
lost_exit(Config) when is_list(Config) ->
- ?line {ok, Node} = start_node(lost_exit),
+ {ok, Node} = start_node(lost_exit),
Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of
- "true" -> start_busy_dist_port_tracer();
- _ -> false
- end,
+ "true" -> start_busy_dist_port_tracer();
+ _ -> false
+ end,
Self = self(),
Die = make_ref(),
- ?line R1 = spawn(fun () -> receive after infinity -> ok end end),
- ?line MR1 = erlang:monitor(process, R1),
-
- ?line {L1, ML1} = spawn_monitor(fun() ->
- link(R1),
- Self ! {self(), linked},
- receive
- Die ->
- exit(controlled_suicide)
- end
- end),
-
- ?line R2 = spawn(fun () ->
- M = erlang:monitor(process, L1),
- receive
- {'DOWN', M, process, L1, R} ->
- Self ! {self(), got_down_message, L1, R}
- end
- end),
-
- ?line receive {L1, linked} -> ok end,
-
+ R1 = spawn(fun () -> receive after infinity -> ok end end),
+ MR1 = erlang:monitor(process, R1),
+
+ {L1, ML1} = spawn_monitor(fun() ->
+ link(R1),
+ Self ! {self(), linked},
+ receive
+ Die ->
+ exit(controlled_suicide)
+ end
+ end),
+
+ R2 = spawn(fun () ->
+ M = erlang:monitor(process, L1),
+ receive
+ {'DOWN', M, process, L1, R} ->
+ Self ! {self(), got_down_message, L1, R}
+ end
+ end),
+
+ receive {L1, linked} -> ok end,
+
Busy = make_busy(Node, 2000),
receive after 100 -> ok end,
L1 ! Die,
- ?line receive
- {'DOWN', ML1, process, L1, RL1} ->
- ?line controlled_suicide = RL1
- end,
+ receive
+ {'DOWN', ML1, process, L1, RL1} ->
+ controlled_suicide = RL1
+ end,
receive after 500 -> ok end,
unmake_busy(Busy),
- ?line receive
- {'DOWN', MR1, process, R1, RR1} ->
- ?line controlled_suicide = RR1
- end,
-
- ?line receive
- {R2, got_down_message, L1, RR2} ->
- ?line controlled_suicide = RR2
- end,
+ receive
+ {'DOWN', MR1, process, R1, RR1} ->
+ controlled_suicide = RR1
+ end,
+
+ receive
+ {R2, got_down_message, L1, RR2} ->
+ controlled_suicide = RR2
+ end,
%% Done.
- ?line stop_busy_dist_port_tracer(Tracer),
- ?line stop_node(Node),
+ stop_busy_dist_port_tracer(Tracer),
+ stop_node(Node),
ok.
dummy_waiter() ->
receive
after infinity ->
- ok
+ ok
end.
-link_to_dead(doc) ->
- ["Test that linking to a dead remote process gives an EXIT message ",
- "AND that the link is teared down."];
+%% Test that linking to a dead remote process gives an EXIT message
+%% AND that the link is teared down.
link_to_dead(Config) when is_list(Config) ->
- ?line process_flag(trap_exit, true),
- ?line {ok, Node} = start_node(link_to_dead),
-% ?line monitor_node(Node, true),
- ?line net_adm:ping(Node), %% Ts_cross_server workaround.
- ?line Pid = spawn(Node, ?MODULE, dead_process, []),
+ process_flag(trap_exit, true),
+ {ok, Node} = start_node(link_to_dead),
+ % monitor_node(Node, true),
+ net_adm:ping(Node), %% Ts_cross_server workaround.
+ Pid = spawn(Node, ?MODULE, dead_process, []),
receive
after 5000 -> ok
end,
- ?line link(Pid),
- ?line receive
- {'EXIT', Pid, noproc} ->
- ok;
- Other ->
- ?line test_server:fail({unexpected_message, Other})
- after 5000 ->
- ?line test_server:fail(nothing_received)
- end,
- ?line {links, Links} = process_info(self(), links),
- ?line io:format("Pid=~p, links=~p", [Pid, Links]),
- ?line false = lists:member(Pid, Links),
- ?line stop_node(Node),
- ?line receive
- Message ->
- ?line test_server:fail({unexpected_message, Message})
- after 3000 ->
- ok
- end,
+ link(Pid),
+ receive
+ {'EXIT', Pid, noproc} ->
+ ok;
+ Other ->
+ ct:fail({unexpected_message, Other})
+ after 5000 ->
+ ct:fail(nothing_received)
+ end,
+ {links, Links} = process_info(self(), links),
+ io:format("Pid=~p, links=~p", [Pid, Links]),
+ false = lists:member(Pid, Links),
+ stop_node(Node),
+ receive
+ Message ->
+ ct:fail({unexpected_message, Message})
+ after 3000 ->
+ ok
+ end,
ok.
-
+
dead_process() ->
erlang:error(die).
-link_to_dead_new_node(doc) ->
- ["Test that linking to a pid on node that has gone and restarted gives ",
- "the correct EXIT message (OTP-2304)."];
+%% Test that linking to a pid on node that has gone and restarted gives
+%% the correct EXIT message (OTP-2304).
link_to_dead_new_node(Config) when is_list(Config) ->
- ?line process_flag(trap_exit, true),
+ process_flag(trap_exit, true),
%% Start the node, get a Pid and stop the node again.
- ?line {ok, Node} = start_node(link_to_dead_new_node),
- ?line Pid = spawn(Node, ?MODULE, dead_process, []),
- ?line stop_node(Node),
+ {ok, Node} = start_node(link_to_dead_new_node),
+ Pid = spawn(Node, ?MODULE, dead_process, []),
+ stop_node(Node),
%% Start a new node with the same name.
- ?line {ok, Node} = start_node(link_to_dead_new_node),
- ?line link(Pid),
- ?line receive
- {'EXIT', Pid, noproc} ->
- ok;
- Other ->
- ?line test_server:fail({unexpected_message, Other})
- after 5000 ->
- ?line test_server:fail(nothing_received)
- end,
+ {ok, Node} = start_node(link_to_dead_new_node),
+ link(Pid),
+ receive
+ {'EXIT', Pid, noproc} ->
+ ok;
+ Other ->
+ ct:fail({unexpected_message, Other})
+ after 5000 ->
+ ct:fail(nothing_received)
+ end,
%% Make sure that the link wasn't created.
- ?line {links, Links} = process_info(self(), links),
- ?line io:format("Pid=~p, links=~p", [Pid, Links]),
- ?line false = lists:member(Pid, Links),
- ?line stop_node(Node),
- ?line receive
- Message ->
- ?line test_server:fail({unexpected_message, Message})
- after 3000 ->
- ok
- end,
+ {links, Links} = process_info(self(), links),
+ io:format("Pid=~p, links=~p", [Pid, Links]),
+ false = lists:member(Pid, Links),
+ stop_node(Node),
+ receive
+ Message ->
+ ct:fail({unexpected_message, Message})
+ after 3000 ->
+ ok
+ end,
ok.
-applied_monitor_node(doc) ->
- "Test that monitor_node/2 works when applied.";
+%% Test that monitor_node/2 works when applied.
applied_monitor_node(Config) when is_list(Config) ->
- ?line NonExisting = list_to_atom("__non_existing__@" ++ hostname()),
+ NonExisting = list_to_atom("__non_existing__@" ++ hostname()),
%% Tail-recursive call to apply (since the node is non-existing,
%% there will be a trap).
- ?line true = tail_apply(erlang, monitor_node, [NonExisting, true]),
- ?line [{nodedown, NonExisting}] = test_server:messages_get(),
+ true = tail_apply(erlang, monitor_node, [NonExisting, true]),
+ [{nodedown, NonExisting}] = test_server:messages_get(),
%% Ordinary call (with trap).
- ?line true = apply(erlang, monitor_node, [NonExisting, true]),
- ?line [{nodedown, NonExisting}] = test_server:messages_get(),
-
+ true = apply(erlang, monitor_node, [NonExisting, true]),
+ [{nodedown, NonExisting}] = test_server:messages_get(),
+
ok.
tail_apply(M, F, A) ->
apply(M, F, A).
-ref_port_roundtrip(doc) ->
- "Test that sending a port or reference to another node and back again "
- "doesn't correct them in any way.";
+%% Test that sending a port or reference to another node and back again
+%% doesn't correct them in any way.
ref_port_roundtrip(Config) when is_list(Config) ->
- ?line process_flag(trap_exit, true),
- ?line Port = open_port({spawn, efile}, []),
- ?line Ref = make_ref(),
- ?line {ok, Node} = start_node(ref_port_roundtrip),
- ?line net_adm:ping(Node),
- ?line Term = {Port, Ref},
- ?line io:format("Term before: ~p", [show_term(Term)]),
- ?line Pid = spawn_link(Node, ?MODULE, roundtrip, [Term]),
- ?line receive after 5000 -> ok end,
- ?line stop_node(Node),
- ?line receive
- {'EXIT', Pid, {Port, Ref}} ->
- ?line io:format("Term after: ~p", [show_term(Term)]),
- ok;
- Other ->
- ?line io:format("Term after: ~p", [show_term(Term)]),
- ?line test_server:fail({unexpected, Other})
- after 10000 ->
- ?line test_server:fail(timeout)
- end,
+ process_flag(trap_exit, true),
+ Port = open_port({spawn, efile}, []),
+ Ref = make_ref(),
+ {ok, Node} = start_node(ref_port_roundtrip),
+ net_adm:ping(Node),
+ Term = {Port, Ref},
+ io:format("Term before: ~p", [show_term(Term)]),
+ Pid = spawn_link(Node, ?MODULE, roundtrip, [Term]),
+ receive after 5000 -> ok end,
+ stop_node(Node),
+ receive
+ {'EXIT', Pid, {Port, Ref}} ->
+ io:format("Term after: ~p", [show_term(Term)]),
+ ok;
+ Other ->
+ io:format("Term after: ~p", [show_term(Term)]),
+ ct:fail({unexpected, Other})
+ after 10000 ->
+ ct:fail(timeout)
+ end,
ok.
roundtrip(Term) ->
exit(Term).
-nil_roundtrip(doc) ->
- "Test that the smallest external term [] aka NIL can be sent to "
- "another node node and back again.";
+%% Test that the smallest external term [] aka NIL can be sent to
+%% another node node and back again.
nil_roundtrip(Config) when is_list(Config) ->
- ?line process_flag(trap_exit, true),
- ?line {ok, Node} = start_node(nil_roundtrip),
- ?line net_adm:ping(Node),
- ?line Pid = spawn_link(Node, ?MODULE, bounce, [self()]),
- ?line Pid ! [],
- ?line receive
- [] ->
- ?line receive
- {'EXIT', Pid, []} ->
- ?line stop_node(Node),
- ok
- end
- end.
+ process_flag(trap_exit, true),
+ {ok, Node} = start_node(nil_roundtrip),
+ net_adm:ping(Node),
+ Pid = spawn_link(Node, ?MODULE, bounce, [self()]),
+ Pid ! [],
+ receive
+ [] ->
+ receive
+ {'EXIT', Pid, []} ->
+ stop_node(Node),
+ ok
+ end
+ end.
bounce(Dest) ->
receive Msg ->
- Dest ! Msg,
- exit(Msg)
+ Dest ! Msg,
+ exit(Msg)
end.
show_term(Term) ->
binary_to_list(term_to_binary(Term)).
-stop_dist(doc) ->
- ["Tests behaviour after net_kernel:stop (OTP-2586)."];
+%% Tests behaviour after net_kernel:stop (OTP-2586).
stop_dist(Config) when is_list(Config) ->
- ?line Str = os:cmd(atom_to_list(lib:progname())
- ++ " -noshell -pa "
- ++ ?config(data_dir, Config)
- ++ " -s run"),
+ Str = os:cmd(atom_to_list(lib:progname())
+ ++ " -noshell -pa "
+ ++ proplists:get_value(data_dir, Config)
+ ++ " -s run"),
%% The "true" may be followed by an error report, so ignore anything that
%% follows it.
- ?line "true\n"++_ = Str,
+ "true\n"++_ = Str,
%% "May fail on FreeBSD due to differently configured name lookup - ask Arndt",
%% if you can find him.
@@ -770,37 +726,31 @@ stop_dist(Config) when is_list(Config) ->
ok.
-trap_bif_1(doc) ->
- [""];
trap_bif_1(Config) when is_list(Config) ->
- ?line {true} = tr1(),
+ {true} = tr1(),
ok.
-trap_bif_2(doc) ->
- [""];
trap_bif_2(Config) when is_list(Config) ->
- ?line {true} = tr2(),
+ {true} = tr2(),
ok.
-trap_bif_3(doc) ->
- [""];
trap_bif_3(Config) when is_list(Config) ->
- ?line {hoo} = tr3(),
+ {hoo} = tr3(),
ok.
tr1() ->
- ?line NonExisting = 'abc@boromir',
- ?line X = erlang:monitor_node(NonExisting, true),
+ NonExisting = 'abc@boromir',
+ X = erlang:monitor_node(NonExisting, true),
{X}.
tr2() ->
- ?line NonExisting = 'abc@boromir',
- ?line X = apply(erlang, monitor_node, [NonExisting, true]),
+ NonExisting = 'abc@boromir',
+ X = apply(erlang, monitor_node, [NonExisting, true]),
{X}.
tr3() ->
- ?line NonExisting = 'abc@boromir',
- ?line X = {NonExisting, glirp} ! hoo,
+ NonExisting = 'abc@boromir',
+ X = {NonExisting, glirp} ! hoo,
{X}.
@@ -821,60 +771,61 @@ tr3() ->
% * n2 gets pang when pinging n1
% * n2 forces connection by using net_kernel:connect_node (ovverrides)
% * n2 gets pong when pinging n1.
-dist_auto_connect_once(doc) -> "Test the dist_auto_connect once kernel parameter";
+
+%% Test the dist_auto_connect once kernel parameter
dist_auto_connect_once(Config) when is_list(Config) ->
- ?line Sock = start_relay_node(dist_auto_connect_relay_node,[]),
- ?line NN = inet_rpc_nodename(Sock),
- ?line Sock2 = start_relay_node(dist_auto_connect_once_node,
- "-kernel dist_auto_connect once"),
- ?line NN2 = inet_rpc_nodename(Sock2),
- ?line {ok,[]} = do_inet_rpc(Sock,erlang,nodes,[]),
- ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
- ?line {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]),
- ?line {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]),
- ?line [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"),
- ?line [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"),
+ Sock = start_relay_node(dist_auto_connect_relay_node,[]),
+ NN = inet_rpc_nodename(Sock),
+ Sock2 = start_relay_node(dist_auto_connect_once_node,
+ "-kernel dist_auto_connect once"),
+ NN2 = inet_rpc_nodename(Sock2),
+ {ok,[]} = do_inet_rpc(Sock,erlang,nodes,[]),
+ {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
+ {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]),
+ {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]),
+ [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"),
+ [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"),
% Give net_kernel a chance to change the state of the node to up to.
- ?line receive after 1000 -> ok end,
+ receive after 1000 -> ok end,
case HostPartPeer of
- MyHostPart ->
- ?line ok = stop_relay_node(Sock),
- ?line {ok,pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]);
- _ ->
- ?line {ok, true} = do_inet_rpc(Sock,net_kernel,disconnect,[NN2]),
- receive
- after 500 -> ok
- end
+ MyHostPart ->
+ ok = stop_relay_node(Sock),
+ {ok,pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]);
+ _ ->
+ {ok, true} = do_inet_rpc(Sock,net_kernel,disconnect,[NN2]),
+ receive
+ after 500 -> ok
+ end
end,
- ?line {ok, []} = do_inet_rpc(Sock2,erlang,nodes,[]),
+ {ok, []} = do_inet_rpc(Sock2,erlang,nodes,[]),
Sock3 = case HostPartPeer of
- MyHostPart ->
- ?line start_relay_node(dist_auto_connect_relay_node,[]);
- _ ->
- Sock
- end,
- ?line TS1 = timestamp(),
- ?line {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
- ?line TS2 = timestamp(),
+ MyHostPart ->
+ start_relay_node(dist_auto_connect_relay_node,[]);
+ _ ->
+ Sock
+ end,
+ TS1 = timestamp(),
+ {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
+ TS2 = timestamp(),
RefT = net_kernel:connecttime() - 1000,
- ?line true = ((TS2 - TS1) < RefT),
- ?line TS3 = timestamp(),
- ?line {ok, true} = do_inet_rpc(Sock2,erlang,monitor_node,
- [NN,true,[allow_passive_connect]]),
- ?line TS4 = timestamp(),
- ?line true = ((TS4 - TS3) > RefT),
- ?line {ok, pong} = do_inet_rpc(Sock3,net_adm,ping,[NN2]),
- ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
- ?line {ok, true} = do_inet_rpc(Sock3,net_kernel,disconnect,[NN2]),
+ true = ((TS2 - TS1) < RefT),
+ TS3 = timestamp(),
+ {ok, true} = do_inet_rpc(Sock2,erlang,monitor_node,
+ [NN,true,[allow_passive_connect]]),
+ TS4 = timestamp(),
+ true = ((TS4 - TS3) > RefT),
+ {ok, pong} = do_inet_rpc(Sock3,net_adm,ping,[NN2]),
+ {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
+ {ok, true} = do_inet_rpc(Sock3,net_kernel,disconnect,[NN2]),
receive
after 500 -> ok
end,
- ?line {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
- ?line {ok, true} = do_inet_rpc(Sock2,net_kernel,connect_node,[NN]),
- ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
- ?line stop_relay_node(Sock3),
- ?line stop_relay_node(Sock2).
-
+ {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
+ {ok, true} = do_inet_rpc(Sock2,net_kernel,connect_node,[NN]),
+ {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]),
+ stop_relay_node(Sock3),
+ stop_relay_node(Sock2).
+
%% Start a relay node and a lonely (dist_auto_connect never) node.
@@ -883,51 +834,51 @@ dist_auto_connect_once(Config) when is_list(Config) ->
%% Result is sent here through relay node.
dist_auto_connect_never(Config) when is_list(Config) ->
Self = self(),
- ?line {ok, RelayNode} =
- start_node(dist_auto_connect_relay),
- ?line spawn(RelayNode,
- fun() ->
- register(dist_auto_connect_relay, self()),
- dist_auto_connect_relay(Self)
- end),
- ?line {ok, Handle} = dist_auto_connect_start(dist_auto_connect, never),
- ?line Result =
- receive
- {do_dist_auto_connect, ok} ->
- ok;
- {do_dist_auto_connect, Error} ->
- {error, Error};
- Other ->
- {error, Other}
- after 32000 ->
- timeout
- end,
- ?line stop_node(RelayNode),
- ?line Stopped = dist_auto_connect_stop(Handle),
- ?line Junk =
- receive
- {do_dist_auto_connect, _} = J ->
- J
- after 0 ->
- ok
- end,
- ?line {ok, ok, ok} = {Result, Stopped, Junk},
+ {ok, RelayNode} =
+ start_node(dist_auto_connect_relay),
+ spawn(RelayNode,
+ fun() ->
+ register(dist_auto_connect_relay, self()),
+ dist_auto_connect_relay(Self)
+ end),
+ {ok, Handle} = dist_auto_connect_start(dist_auto_connect, never),
+ Result =
+ receive
+ {do_dist_auto_connect, ok} ->
+ ok;
+ {do_dist_auto_connect, Error} ->
+ {error, Error};
+ Other ->
+ {error, Other}
+ after 32000 ->
+ timeout
+ end,
+ stop_node(RelayNode),
+ Stopped = dist_auto_connect_stop(Handle),
+ Junk =
+ receive
+ {do_dist_auto_connect, _} = J ->
+ J
+ after 0 ->
+ ok
+ end,
+ {ok, ok, ok} = {Result, Stopped, Junk},
ok.
do_dist_auto_connect([never]) ->
Node = list_to_atom("dist_auto_connect_relay@" ++ hostname()),
io:format("~p:do_dist_auto_connect([false]) Node=~p~n",
- [?MODULE, Node]),
+ [?MODULE, Node]),
Ping = net_adm:ping(Node),
io:format("~p:do_dist_auto_connect([false]) Ping=~p~n",
- [?MODULE, Ping]),
+ [?MODULE, Ping]),
Result = case Ping of
- pang -> ok;
- _ -> {error, Ping}
- end,
+ pang -> ok;
+ _ -> {error, Ping}
+ end,
io:format("~p:do_dist_auto_connect([false]) Result=~p~n",
- [?MODULE, Result]),
+ [?MODULE, Result]),
net_kernel:connect_node(Node),
catch {dist_auto_connect_relay, Node} ! {do_dist_auto_connect, Result};
% receive after 1000 -> ok end,
@@ -935,10 +886,10 @@ do_dist_auto_connect([never]) ->
do_dist_auto_connect(Arg) ->
io:format("~p:do_dist_auto_connect(~p)~n",
- [?MODULE, Arg]),
+ [?MODULE, Arg]),
receive after 10000 -> ok end,
halt().
-
+
dist_auto_connect_start(Name, Value) when is_atom(Name) ->
dist_auto_connect_start(atom_to_list(Name), Value);
@@ -948,16 +899,16 @@ dist_auto_connect_start(Name, Value) when is_list(Name), is_atom(Value) ->
ValueStr = atom_to_list(Value),
Cookie = atom_to_list(erlang:get_cookie()),
Cmd = lists:concat(
- [%"xterm -e ",
- atom_to_list(lib:progname()),
-% " -noinput ",
- " -detached ",
- long_or_short(), " ", Name,
- " -setcookie ", Cookie,
- " -pa ", ModuleDir,
- " -s ", atom_to_list(?MODULE),
- " do_dist_auto_connect ", ValueStr,
- " -kernel dist_auto_connect ", ValueStr]),
+ [%"xterm -e ",
+ atom_to_list(lib:progname()),
+ % " -noinput ",
+ " -detached ",
+ long_or_short(), " ", Name,
+ " -setcookie ", Cookie,
+ " -pa ", ModuleDir,
+ " -s ", atom_to_list(?MODULE),
+ " do_dist_auto_connect ", ValueStr,
+ " -kernel dist_auto_connect ", ValueStr]),
io:format("~p:dist_auto_connect_start() cmd: ~p~n", [?MODULE, Cmd]),
Port = open_port({spawn, Cmd}, [stream]),
{ok, {Port, Node}}.
@@ -975,102 +926,83 @@ dist_auto_connect_stop(Port, _Node, Pid, N) when is_integer(N), N =< 0 ->
Result;
dist_auto_connect_stop(Port, Node, Pid, N) when is_integer(N) ->
case net_adm:ping(Node) of
- pong ->
- receive after 100 -> ok end,
- dist_auto_connect_stop(Port, Node, Pid, N-100);
- pang ->
- exit(Pid, normal),
- catch erlang:port_close(Port),
- io:format("~p:dist_auto_connect_stop() ok~n", [?MODULE]),
- ok
+ pong ->
+ receive after 100 -> ok end,
+ dist_auto_connect_stop(Port, Node, Pid, N-100);
+ pang ->
+ exit(Pid, normal),
+ catch erlang:port_close(Port),
+ io:format("~p:dist_auto_connect_stop() ok~n", [?MODULE]),
+ ok
end.
dist_auto_connect_relay(Parent) ->
receive X ->
- catch Parent ! X
+ catch Parent ! X
end,
dist_auto_connect_relay(Parent).
-dist_parallel_send(doc) ->
- [];
-dist_parallel_send(suite) ->
- [];
dist_parallel_send(Config) when is_list(Config) ->
- ?line {ok, RNode} = start_node(dist_parallel_receiver),
- ?line {ok, SNode} = start_node(dist_parallel_sender),
- ?line WatchDog = spawn_link(
- fun () ->
- TRef = erlang:start_timer((?DEFAULT_TIMETRAP
- div 2),
- self(),
- oops),
- receive
- {timeout, TRef, _ } ->
- spawn(SNode,
- fun () ->
- abort(timeout)
- end),
- spawn(RNode,
- fun () ->
- abort(timeout)
- end)
-%% rpc:cast(SNode, erlang, halt,
-%% ["Timetrap (sender)"]),
-%% rpc:cast(RNode, erlang, halt,
-%% ["Timetrap (receiver)"])
- end
- end),
- ?line MkSndrs = fun (Receiver) ->
- lists:map(fun (_) ->
- spawn_link(SNode,
- ?MODULE,
- dist_parallel_sender,
- [self(),
- Receiver,
- 1000])
- end,
- lists:seq(1, 64))
- end,
- ?line SndrsStart = fun (Sndrs) ->
- Parent = self(),
- spawn_link(
- SNode,
- fun () ->
- lists:foreach(fun (P) ->
- P ! {go, Parent}
- end,
- Sndrs)
- end)
- end,
- ?line SndrsWait = fun (Sndrs) ->
- lists:foreach(fun (P) ->
- receive {P, done} -> ok end
- end,
- Sndrs)
- end,
- ?line DPR = spawn_link(RNode, ?MODULE, dist_parallel_receiver, []),
- ?line Sndrs1 = MkSndrs(DPR),
- ?line SndrsStart(Sndrs1),
- ?line SndrsWait(Sndrs1),
- ?line unlink(DPR),
- ?line exit(DPR, bang),
-
- ?line DEPR = spawn_link(RNode, ?MODULE, dist_evil_parallel_receiver, []),
- ?line Sndrs2 = MkSndrs(DEPR),
- ?line SndrsStart(Sndrs2),
- ?line SndrsWait(Sndrs2),
- ?line unlink(DEPR),
- ?line exit(DEPR, bang),
-
- ?line unlink(WatchDog),
- ?line exit(WatchDog, bang),
-
- ?line stop_node(RNode),
- ?line stop_node(SNode),
-
- ?line ok.
+ {ok, RNode} = start_node(dist_parallel_receiver),
+ {ok, SNode} = start_node(dist_parallel_sender),
+ WatchDog = spawn_link(
+ fun () ->
+ TRef = erlang:start_timer((2*60*1000), self(), oops),
+ receive
+ {timeout, TRef, _ } ->
+ spawn(SNode, fun () -> abort(timeout) end),
+ spawn(RNode, fun () -> abort(timeout) end)
+ %% rpc:cast(SNode, erlang, halt,
+ %% ["Timetrap (sender)"]),
+ %% rpc:cast(RNode, erlang, halt,
+ %% ["Timetrap (receiver)"])
+ end
+ end),
+ MkSndrs = fun (Receiver) ->
+ lists:map(fun (_) ->
+ spawn_link(SNode,
+ ?MODULE,
+ dist_parallel_sender,
+ [self(), Receiver, 1000])
+ end, lists:seq(1, 64))
+ end,
+ SndrsStart = fun (Sndrs) ->
+ Parent = self(),
+ spawn_link(SNode,
+ fun () ->
+ lists:foreach(fun (P) ->
+ P ! {go, Parent}
+ end, Sndrs)
+ end)
+ end,
+ SndrsWait = fun (Sndrs) ->
+ lists:foreach(fun (P) ->
+ receive {P, done} -> ok end
+ end, Sndrs)
+ end,
+ DPR = spawn_link(RNode, ?MODULE, dist_parallel_receiver, []),
+ Sndrs1 = MkSndrs(DPR),
+ SndrsStart(Sndrs1),
+ SndrsWait(Sndrs1),
+ unlink(DPR),
+ exit(DPR, bang),
+
+ DEPR = spawn_link(RNode, ?MODULE, dist_evil_parallel_receiver, []),
+ Sndrs2 = MkSndrs(DEPR),
+ SndrsStart(Sndrs2),
+ SndrsWait(Sndrs2),
+ unlink(DEPR),
+ exit(DEPR, bang),
+
+ unlink(WatchDog),
+ exit(WatchDog, bang),
+
+ stop_node(RNode),
+ stop_node(SNode),
+
+ ok.
do_dist_parallel_sender(Parent, _Receiver, 0) ->
Parent ! {self(), done};
@@ -1092,71 +1024,71 @@ dist_evil_parallel_receiver() ->
dist_evil_parallel_receiver().
atom_roundtrip(Config) when is_list(Config) ->
- ?line AtomData = atom_data(),
- ?line verify_atom_data(AtomData),
- ?line {ok, Node} = start_node(Config),
- ?line do_atom_roundtrip(Node, AtomData),
- ?line stop_node(Node),
- ?line ok.
+ AtomData = atom_data(),
+ verify_atom_data(AtomData),
+ {ok, Node} = start_node(Config),
+ do_atom_roundtrip(Node, AtomData),
+ stop_node(Node),
+ ok.
atom_roundtrip_r15b(Config) when is_list(Config) ->
- case ?t:is_release_available("r15b") of
- true ->
- ?line AtomData = atom_data(),
- ?line verify_atom_data(AtomData),
- ?line {ok, Node} = start_node(Config, [], "r15b"),
- ?line do_atom_roundtrip(Node, AtomData),
- ?line stop_node(Node),
- ?line ok;
- false ->
- ?line {skip,"No OTP R15B available"}
+ case test_server:is_release_available("r15b") of
+ true ->
+ AtomData = atom_data(),
+ verify_atom_data(AtomData),
+ {ok, Node} = start_node(Config, [], "r15b"),
+ do_atom_roundtrip(Node, AtomData),
+ stop_node(Node),
+ ok;
+ false ->
+ {skip,"No OTP R15B available"}
end.
unicode_atom_roundtrip(Config) when is_list(Config) ->
- ?line AtomData = unicode_atom_data(),
- ?line verify_atom_data(AtomData),
- ?line {ok, Node} = start_node(Config),
- ?line do_atom_roundtrip(Node, AtomData),
- ?line stop_node(Node),
- ?line ok.
+ AtomData = unicode_atom_data(),
+ verify_atom_data(AtomData),
+ {ok, Node} = start_node(Config),
+ do_atom_roundtrip(Node, AtomData),
+ stop_node(Node),
+ ok.
do_atom_roundtrip(Node, AtomData) ->
- ?line Parent = self(),
- ?line Proc = spawn_link(Node, fun () -> verify_atom_data_loop(Parent) end),
- ?line Proc ! {self(), AtomData},
- ?line receive {Proc, AD1} -> AtomData = AD1 end,
- ?line Proc ! {self(), AtomData},
- ?line receive {Proc, AD2} -> AtomData = AD2 end,
- ?line RevAtomData = lists:reverse(AtomData),
- ?line Proc ! {self(), RevAtomData},
- ?line receive {Proc, RAD1} -> RevAtomData = RAD1 end,
- ?line unlink(Proc),
- ?line exit(Proc, bang),
- ?line ok.
+ Parent = self(),
+ Proc = spawn_link(Node, fun () -> verify_atom_data_loop(Parent) end),
+ Proc ! {self(), AtomData},
+ receive {Proc, AD1} -> AtomData = AD1 end,
+ Proc ! {self(), AtomData},
+ receive {Proc, AD2} -> AtomData = AD2 end,
+ RevAtomData = lists:reverse(AtomData),
+ Proc ! {self(), RevAtomData},
+ receive {Proc, RAD1} -> RevAtomData = RAD1 end,
+ unlink(Proc),
+ exit(Proc, bang),
+ ok.
verify_atom_data_loop(From) ->
receive
- {From, AtomData} ->
- verify_atom_data(AtomData),
- From ! {self(), AtomData},
- verify_atom_data_loop(From)
+ {From, AtomData} ->
+ verify_atom_data(AtomData),
+ From ! {self(), AtomData},
+ verify_atom_data_loop(From)
end.
atom_data() ->
lists:map(fun (N) ->
- ATxt = "a"++integer_to_list(N),
- {list_to_atom(ATxt), ATxt}
- end,
- lists:seq(1, 2000)).
+ ATxt = "a"++integer_to_list(N),
+ {list_to_atom(ATxt), ATxt}
+ end,
+ lists:seq(1, 2000)).
verify_atom_data(AtomData) ->
lists:foreach(fun ({Atom, AtomTxt}) when is_atom(Atom) ->
- AtomTxt = atom_to_list(Atom);
- ({PPR, AtomTxt}) ->
- % Pid, Port, or Ref
- AtomTxt = atom_to_list(node(PPR))
- end,
- AtomData).
+ AtomTxt = atom_to_list(Atom);
+ ({PPR, AtomTxt}) ->
+ % Pid, Port, or Ref
+ AtomTxt = atom_to_list(node(PPR))
+ end,
+ AtomData).
uc_atom_tup(ATxt) ->
Atom = string_to_atom(ATxt),
@@ -1209,9 +1141,8 @@ unicode_atom_data() ->
uc_atom_tup(lists:seq(65500, 65754)),
uc_atom_tup(lists:seq(65500, 65563))
| lists:map(fun (N) ->
- uc_atom_tup(lists:seq(64000+N, 64254+N))
- end,
- lists:seq(1, 2000))].
+ uc_atom_tup(lists:seq(64000+N, 64254+N))
+ end, lists:seq(1, 2000))].
contended_atom_cache_entry(Config) when is_list(Config) ->
contended_atom_cache_entry_test(Config, latin1).
@@ -1220,79 +1151,77 @@ contended_unicode_atom_cache_entry(Config) when is_list(Config) ->
contended_atom_cache_entry_test(Config, unicode).
contended_atom_cache_entry_test(Config, Type) ->
- ?line TestServer = self(),
- ?line ProcessPairs = 10,
- ?line Msgs = 100000,
- ?line {ok, SNode} = start_node(Config),
- ?line {ok, RNode} = start_node(Config),
- ?line Success = make_ref(),
- ?line spawn_link(
- SNode,
- fun () ->
- erts_debug:set_internal_state(available_internal_state,
- true),
- Master = self(),
- CIX = get_cix(),
- TestAtoms = case Type of
- latin1 ->
- get_conflicting_atoms(CIX,
- ProcessPairs);
- unicode ->
- get_conflicting_unicode_atoms(CIX,
- ProcessPairs)
- end,
- io:format("Testing with the following atoms all using "
- "cache index ~p:~n ~w~n",
- [CIX, TestAtoms]),
- Ps = lists:map(
- fun (A) ->
- Ref = make_ref(),
- R = spawn_link(
- RNode,
- fun () ->
- Atom = receive
- {Ref, txt, ATxt} ->
- case Type of
- latin1 ->
- list_to_atom(ATxt);
- unicode ->
- string_to_atom(ATxt)
- end
- end,
- receive_ref_atom(Ref,
- Atom,
- Msgs),
- Master ! {self(), success}
- end),
- S = spawn_link(
- SNode,
- fun () ->
- receive go -> ok end,
- R ! {Ref,
- txt,
- atom_to_list(A)},
- send_ref_atom(R, Ref, A, Msgs)
- end),
- {S, R}
- end,
- TestAtoms),
- lists:foreach(fun ({S, _}) ->
- S ! go
- end,
- Ps),
- lists:foreach(fun ({_, R}) ->
- receive {R, success} -> ok end
- end,
- Ps),
- TestServer ! Success
- end),
- ?line receive
- Success ->
- ok
- end,
- ?line stop_node(SNode),
- ?line stop_node(RNode),
- ?line ok.
+ TestServer = self(),
+ ProcessPairs = 10,
+ Msgs = 100000,
+ {ok, SNode} = start_node(Config),
+ {ok, RNode} = start_node(Config),
+ Success = make_ref(),
+ spawn_link(
+ SNode,
+ fun () ->
+ erts_debug:set_internal_state(available_internal_state,
+ true),
+ Master = self(),
+ CIX = get_cix(),
+ TestAtoms = case Type of
+ latin1 ->
+ get_conflicting_atoms(CIX,
+ ProcessPairs);
+ unicode ->
+ get_conflicting_unicode_atoms(CIX,
+ ProcessPairs)
+ end,
+ io:format("Testing with the following atoms all using "
+ "cache index ~p:~n ~w~n",
+ [CIX, TestAtoms]),
+ Ps = lists:map(
+ fun (A) ->
+ Ref = make_ref(),
+ R = spawn_link(RNode,
+ fun () ->
+ Atom = receive
+ {Ref, txt, ATxt} ->
+ case Type of
+ latin1 ->
+ list_to_atom(ATxt);
+ unicode ->
+ string_to_atom(ATxt)
+ end
+ end,
+ receive_ref_atom(Ref,
+ Atom,
+ Msgs),
+ Master ! {self(), success}
+ end),
+ S = spawn_link(SNode,
+ fun () ->
+ receive go -> ok end,
+ R ! {Ref,
+ txt,
+ atom_to_list(A)},
+ send_ref_atom(R, Ref, A, Msgs)
+ end),
+ {S, R}
+ end,
+ TestAtoms),
+ lists:foreach(fun ({S, _}) ->
+ S ! go
+ end,
+ Ps),
+ lists:foreach(fun ({_, R}) ->
+ receive {R, success} -> ok end
+ end,
+ Ps),
+ TestServer ! Success
+ end),
+ receive
+ Success ->
+ ok
+ end,
+ stop_node(SNode),
+ stop_node(RNode),
+ ok.
send_ref_atom(_To, _Ref, _Atom, 0) ->
ok;
@@ -1304,11 +1233,11 @@ receive_ref_atom(_Ref, _Atom, 0) ->
ok;
receive_ref_atom(Ref, Atom, N) ->
receive
- {Ref, Value} ->
- Atom = Value
+ {Ref, Value} ->
+ Atom = Value
end,
receive_ref_atom(Ref, Atom, N-1).
-
+
get_cix() ->
get_cix(1000).
@@ -1316,34 +1245,34 @@ get_cix(CIX) when is_integer(CIX), CIX < 0 ->
get_cix(0);
get_cix(CIX) when is_integer(CIX) ->
get_cix(CIX,
- unwanted_cixs(),
- erts_debug:get_internal_state(max_atom_out_cache_index)).
+ unwanted_cixs(),
+ erts_debug:get_internal_state(max_atom_out_cache_index)).
get_cix(CIX, Unwanted, MaxCIX) when CIX > MaxCIX ->
get_cix(0, Unwanted, MaxCIX);
get_cix(CIX, Unwanted, MaxCIX) ->
case lists:member(CIX, Unwanted) of
- true -> get_cix(CIX+1, Unwanted, MaxCIX);
- false -> CIX
+ true -> get_cix(CIX+1, Unwanted, MaxCIX);
+ false -> CIX
end.
unwanted_cixs() ->
lists:map(fun (Node) ->
- erts_debug:get_internal_state({atom_out_cache_index,
- Node})
- end,
- nodes()).
-
-
+ erts_debug:get_internal_state({atom_out_cache_index,
+ Node})
+ end,
+ nodes()).
+
+
get_conflicting_atoms(_CIX, 0) ->
[];
get_conflicting_atoms(CIX, N) ->
Atom = list_to_atom("atom" ++ integer_to_list(erlang:unique_integer([positive]))),
case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of
- CIX ->
- [Atom|get_conflicting_atoms(CIX, N-1)];
- _ ->
- get_conflicting_atoms(CIX, N)
+ CIX ->
+ [Atom|get_conflicting_atoms(CIX, N-1)];
+ _ ->
+ get_conflicting_atoms(CIX, N)
end.
get_conflicting_unicode_atoms(_CIX, 0) ->
@@ -1351,10 +1280,10 @@ get_conflicting_unicode_atoms(_CIX, 0) ->
get_conflicting_unicode_atoms(CIX, N) ->
Atom = string_to_atom([16#1f608] ++ "atom" ++ integer_to_list(erlang:unique_integer([positive]))),
case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of
- CIX ->
- [Atom|get_conflicting_unicode_atoms(CIX, N-1)];
- _ ->
- get_conflicting_unicode_atoms(CIX, N)
+ CIX ->
+ [Atom|get_conflicting_unicode_atoms(CIX, N-1)];
+ _ ->
+ get_conflicting_unicode_atoms(CIX, N)
end.
-define(COOKIE, '').
@@ -1376,482 +1305,474 @@ get_conflicting_unicode_atoms(CIX, N) ->
-define(DOP_MONITOR_P_EXIT, 21).
start_monitor(Offender,P) ->
- ?line Parent = self(),
- ?line Q = spawn(Offender,
- fun () ->
- Ref = erlang:monitor(process,P),
- Parent ! {self(),ref,Ref},
- receive
- just_stay_alive -> ok
- end
- end),
- ?line Ref = receive
- {Q,ref,R} ->
- R
- after 5000 ->
- error
- end,
+ Parent = self(),
+ Q = spawn(Offender,
+ fun () ->
+ Ref = erlang:monitor(process,P),
+ Parent ! {self(),ref,Ref},
+ receive
+ just_stay_alive -> ok
+ end
+ end),
+ Ref = receive
+ {Q,ref,R} ->
+ R
+ after 5000 ->
+ error
+ end,
io:format("Ref is ~p~n",[Ref]),
ok.
start_link(Offender,P) ->
- ?line Parent = self(),
- ?line Q = spawn(Offender,
- fun () ->
- process_flag(trap_exit,true),
- link(P),
- Parent ! {self(),ref,P},
- receive
- just_stay_alive -> ok
- end
- end),
- ?line Ref = receive
- {Q,ref,R} ->
- R
- after 5000 ->
- error
- end,
+ Parent = self(),
+ Q = spawn(Offender,
+ fun () ->
+ process_flag(trap_exit,true),
+ link(P),
+ Parent ! {self(),ref,P},
+ receive
+ just_stay_alive -> ok
+ end
+ end),
+ Ref = receive
+ {Q,ref,R} ->
+ R
+ after 5000 ->
+ error
+ end,
io:format("Ref is ~p~n",[Ref]),
ok.
-bad_dist_structure(suite) ->
- [];
-bad_dist_structure(doc) ->
- ["Test dist messages with valid structure (binary to term ok) but malformed"
- "control content"];
+%% Test dist messages with valid structure (binary to term ok) but malformed control content
bad_dist_structure(Config) when is_list(Config) ->
- %process_flag(trap_exit,true),
- ODog = ?config(watchdog, Config),
- ?t:timetrap_cancel(ODog),
- Dog = ?t:timetrap(?t:seconds(15)),
-
- ?line {ok, Offender} = start_node(bad_dist_structure_offender),
- ?line {ok, Victim} = start_node(bad_dist_structure_victim),
- ?line start_node_monitors([Offender,Victim]),
- ?line Parent = self(),
- ?line P = spawn(Victim,
- fun () ->
- process_flag(trap_exit,true),
- Parent ! {self(), started},
- receive check_msgs -> ok end,
- bad_dist_struct_check_msgs([one,
- two]),
- Parent ! {self(), messages_checked},
- receive done -> ok end
- end),
- ?line receive {P, started} -> ok end,
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line verify_up(Offender, Victim),
- ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
- ?line start_monitor(Offender,P),
- ?line P ! one,
- ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_monitor(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_link(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_LINK},0),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_link(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_link(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_link(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_link(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_monitor(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_monitor(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_monitor(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line start_monitor(Offender,P),
- ?line send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line P ! two,
- ?line P ! check_msgs,
- ?line receive
- {P, messages_checked} -> ok
- after 5000 ->
- exit(victim_is_dead)
- end,
-
- ?line {message_queue_len, 0}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
-
- ?line unlink(P),
- ?line P ! done,
- ?line stop_node(Offender),
- ?line stop_node(Victim),
- ?t:timetrap_cancel(Dog),
+ ct:timetrap({seconds, 15}),
+
+ {ok, Offender} = start_node(bad_dist_structure_offender),
+ {ok, Victim} = start_node(bad_dist_structure_victim),
+ start_node_monitors([Offender,Victim]),
+ Parent = self(),
+ P = spawn(Victim,
+ fun () ->
+ process_flag(trap_exit,true),
+ Parent ! {self(), started},
+ receive check_msgs -> ok end,
+ bad_dist_struct_check_msgs([one,
+ two]),
+ Parent ! {self(), messages_checked},
+ receive done -> ok end
+ end),
+ receive {P, started} -> ok end,
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ verify_up(Offender, Victim),
+ true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
+ start_monitor(Offender,P),
+ P ! one,
+ send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_monitor(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_link(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_LINK},0),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_link(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_link(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_link(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_link(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_monitor(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_monitor(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_monitor(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ start_monitor(Offender,P),
+ send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ P ! two,
+ P ! check_msgs,
+ receive
+ {P, messages_checked} -> ok
+ after 5000 ->
+ exit(victim_is_dead)
+ end,
+
+ {message_queue_len, 0}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+
+ unlink(P),
+ P ! done,
+ stop_node(Offender),
+ stop_node(Victim),
ok.
bad_dist_ext_receive(Config) when is_list(Config) ->
- ?line {ok, Offender} = start_node(bad_dist_ext_receive_offender),
- ?line {ok, Victim} = start_node(bad_dist_ext_receive_victim),
- ?line start_node_monitors([Offender,Victim]),
-
- ?line Parent = self(),
-
- ?line P = spawn_link(Victim,
- fun () ->
- Parent ! {self(), started},
- receive check_msgs -> ok end,
- bad_dist_ext_check_msgs([one,
- two,
- three]),
- Parent ! {self(), messages_checked},
- receive done -> ok end
- end),
-
- ?line receive {P, started} -> ok end,
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line verify_up(Offender, Victim),
- ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
- ?line P ! one,
- ?line send_bad_msg(Offender, P),
- ?line P ! two,
- ?line verify_down(Offender, connection_closed, Victim, killed),
- ?line {message_queue_len, 2}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
-
- ?line Suspended = make_ref(),
- ?line S = spawn(Victim,
- fun () ->
- erlang:suspend_process(P),
- Parent ! Suspended,
- receive after infinity -> ok end
- end),
- ?line MS = erlang:monitor(process, S),
- ?line receive Suspended -> ok end,
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line verify_up(Offender, Victim),
- ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
- ?line send_bad_msgs(Offender, P, 5),
- ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
- ?line P ! three,
- ?line send_bad_msgs(Offender, P, 5),
+ {ok, Offender} = start_node(bad_dist_ext_receive_offender),
+ {ok, Victim} = start_node(bad_dist_ext_receive_victim),
+ start_node_monitors([Offender,Victim]),
+
+ Parent = self(),
+
+ P = spawn_link(Victim,
+ fun () ->
+ Parent ! {self(), started},
+ receive check_msgs -> ok end,
+ bad_dist_ext_check_msgs([one,
+ two,
+ three]),
+ Parent ! {self(), messages_checked},
+ receive done -> ok end
+ end),
+
+ receive {P, started} -> ok end,
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ verify_up(Offender, Victim),
+ true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
+ P ! one,
+ send_bad_msg(Offender, P),
+ P ! two,
+ verify_down(Offender, connection_closed, Victim, killed),
+ {message_queue_len, 2}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+
+ Suspended = make_ref(),
+ S = spawn(Victim,
+ fun () ->
+ erlang:suspend_process(P),
+ Parent ! Suspended,
+ receive after infinity -> ok end
+ end),
+ MS = erlang:monitor(process, S),
+ receive Suspended -> ok end,
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ verify_up(Offender, Victim),
+ true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
+ send_bad_msgs(Offender, P, 5),
+ true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
+ P ! three,
+ send_bad_msgs(Offender, P, 5),
%% Make sure bad msgs has reached Victim
- ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]),
-
- ?line verify_still_up(Offender, Victim),
- ?line {message_queue_len, 13}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
-
- ?line exit(S, bang),
- ?line receive {'DOWN', MS, process, S, bang} -> ok end,
- ?line verify_down(Offender, connection_closed, Victim, killed),
- ?line {message_queue_len, 3}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
-
- ?line P ! check_msgs,
- ?line receive {P, messages_checked} -> ok end,
-
- ?line {message_queue_len, 0}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
-
- ?line P ! done,
- ?line unlink(P),
- ?line verify_no_down(Offender, Victim),
- ?line stop_node(Offender),
- ?line stop_node(Victim).
+ rpc:call(Offender, rpc, call, [Victim, erlang, node, []]),
+
+ verify_still_up(Offender, Victim),
+ {message_queue_len, 13}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+
+ exit(S, bang),
+ receive {'DOWN', MS, process, S, bang} -> ok end,
+ verify_down(Offender, connection_closed, Victim, killed),
+ {message_queue_len, 3}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+
+ P ! check_msgs,
+ receive {P, messages_checked} -> ok end,
+
+ {message_queue_len, 0}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+
+ P ! done,
+ unlink(P),
+ verify_no_down(Offender, Victim),
+ stop_node(Offender),
+ stop_node(Victim).
bad_dist_ext_process_info(Config) when is_list(Config) ->
- ?line {ok, Offender} = start_node(bad_dist_ext_process_info_offender),
- ?line {ok, Victim} = start_node(bad_dist_ext_process_info_victim),
- ?line start_node_monitors([Offender,Victim]),
-
- ?line Parent = self(),
- ?line P = spawn_link(Victim,
- fun () ->
- Parent ! {self(), started},
- receive check_msgs -> ok end,
- bad_dist_ext_check_msgs([one, two]),
- Parent ! {self(), messages_checked},
- receive done -> ok end
- end),
-
- ?line receive {P, started} -> ok end,
- ?line P ! one,
-
- ?line Suspended = make_ref(),
- ?line S = spawn(Victim,
- fun () ->
- erlang:suspend_process(P),
- Parent ! Suspended,
- receive after infinity -> ok end
- end),
-
- ?line receive Suspended -> ok end,
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line verify_up(Offender, Victim),
- ?line send_bad_msgs(Offender, P, 5),
-
- ?line P ! two,
- ?line send_bad_msgs(Offender, P, 5),
+ {ok, Offender} = start_node(bad_dist_ext_process_info_offender),
+ {ok, Victim} = start_node(bad_dist_ext_process_info_victim),
+ start_node_monitors([Offender,Victim]),
+
+ Parent = self(),
+ P = spawn_link(Victim,
+ fun () ->
+ Parent ! {self(), started},
+ receive check_msgs -> ok end,
+ bad_dist_ext_check_msgs([one, two]),
+ Parent ! {self(), messages_checked},
+ receive done -> ok end
+ end),
+
+ receive {P, started} -> ok end,
+ P ! one,
+
+ Suspended = make_ref(),
+ S = spawn(Victim,
+ fun () ->
+ erlang:suspend_process(P),
+ Parent ! Suspended,
+ receive after infinity -> ok end
+ end),
+
+ receive Suspended -> ok end,
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ verify_up(Offender, Victim),
+ send_bad_msgs(Offender, P, 5),
+
+ P ! two,
+ send_bad_msgs(Offender, P, 5),
%% Make sure bad msgs has reached Victim
- ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]),
-
- ?line verify_still_up(Offender, Victim),
- ?line {message_queue_len, 12}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
- ?line verify_still_up(Offender, Victim),
- ?line [{message_queue_len, 2},
- {messages, [one, two]}]
- = rpc:call(Victim, erlang, process_info, [P, [message_queue_len,
- messages]]),
- ?line verify_down(Offender, connection_closed, Victim, killed),
-
- ?line P ! check_msgs,
- ?line exit(S, bang),
- ?line receive {P, messages_checked} -> ok end,
-
- ?line {message_queue_len, 0}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
-
- ?line P ! done,
- ?line unlink(P),
- ?line verify_no_down(Offender, Victim),
- ?line stop_node(Offender),
- ?line stop_node(Victim).
+ rpc:call(Offender, rpc, call, [Victim, erlang, node, []]),
+
+ verify_still_up(Offender, Victim),
+ {message_queue_len, 12}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+ verify_still_up(Offender, Victim),
+ [{message_queue_len, 2},
+ {messages, [one, two]}]
+ = rpc:call(Victim, erlang, process_info, [P, [message_queue_len,
+ messages]]),
+ verify_down(Offender, connection_closed, Victim, killed),
+
+ P ! check_msgs,
+ exit(S, bang),
+ receive {P, messages_checked} -> ok end,
+
+ {message_queue_len, 0}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+
+ P ! done,
+ unlink(P),
+ verify_no_down(Offender, Victim),
+ stop_node(Offender),
+ stop_node(Victim).
bad_dist_ext_control(Config) when is_list(Config) ->
- ?line {ok, Offender} = start_node(bad_dist_ext_control_offender),
- ?line {ok, Victim} = start_node(bad_dist_ext_control_victim),
- ?line start_node_monitors([Offender,Victim]),
+ {ok, Offender} = start_node(bad_dist_ext_control_offender),
+ {ok, Victim} = start_node(bad_dist_ext_control_victim),
+ start_node_monitors([Offender,Victim]),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line verify_up(Offender, Victim),
- ?line send_bad_dhdr(Offender, Victim),
- ?line verify_down(Offender, connection_closed, Victim, killed),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ verify_up(Offender, Victim),
+ send_bad_dhdr(Offender, Victim),
+ verify_down(Offender, connection_closed, Victim, killed),
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line verify_up(Offender, Victim),
- ?line send_bad_ctl(Offender, Victim),
- ?line verify_down(Offender, connection_closed, Victim, killed),
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ verify_up(Offender, Victim),
+ send_bad_ctl(Offender, Victim),
+ verify_down(Offender, connection_closed, Victim, killed),
- ?line verify_no_down(Offender, Victim),
- ?line stop_node(Offender),
- ?line stop_node(Victim).
+ verify_no_down(Offender, Victim),
+ stop_node(Offender),
+ stop_node(Victim).
bad_dist_ext_connection_id(Config) when is_list(Config) ->
- ?line {ok, Offender} = start_node(bad_dist_ext_connection_id_offender),
- ?line {ok, Victim} = start_node(bad_dist_ext_connection_id_victim),
- ?line start_node_monitors([Offender,Victim]),
-
- ?line Parent = self(),
- ?line P = spawn_link(Victim,
- fun () ->
- Parent ! {self(), started},
- receive check_msgs -> ok end,
- bad_dist_ext_check_msgs([]),
- Parent ! {self(), messages_checked},
- receive done -> ok end
- end),
-
- ?line receive {P, started} -> ok end,
- ?line Suspended = make_ref(),
- ?line S = spawn(Victim,
- fun () ->
- erlang:suspend_process(P),
- Parent ! Suspended,
- receive after infinity -> ok end
- end),
- ?line MS = erlang:monitor(process, S),
- ?line receive Suspended -> ok end,
- ?line pong = rpc:call(Victim, net_adm, ping, [Offender]),
- ?line verify_up(Offender, Victim),
- ?line send_bad_msg(Offender, P),
+ {ok, Offender} = start_node(bad_dist_ext_connection_id_offender),
+ {ok, Victim} = start_node(bad_dist_ext_connection_id_victim),
+ start_node_monitors([Offender,Victim]),
+
+ Parent = self(),
+ P = spawn_link(Victim,
+ fun () ->
+ Parent ! {self(), started},
+ receive check_msgs -> ok end,
+ bad_dist_ext_check_msgs([]),
+ Parent ! {self(), messages_checked},
+ receive done -> ok end
+ end),
+
+ receive {P, started} -> ok end,
+ Suspended = make_ref(),
+ S = spawn(Victim,
+ fun () ->
+ erlang:suspend_process(P),
+ Parent ! Suspended,
+ receive after infinity -> ok end
+ end),
+ MS = erlang:monitor(process, S),
+ receive Suspended -> ok end,
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ verify_up(Offender, Victim),
+ send_bad_msg(Offender, P),
%% Make sure bad msg has reached Victim
- ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]),
+ rpc:call(Offender, rpc, call, [Victim, erlang, node, []]),
- ?line {message_queue_len, 1}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+ {message_queue_len, 1}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
- ?line true = rpc:call(Offender, net_kernel, disconnect, [Victim]),
- ?line verify_down(Offender, disconnect, Victim, connection_closed),
- ?line pong = rpc:call(Offender, net_adm, ping, [Victim]),
+ true = rpc:call(Offender, net_kernel, disconnect, [Victim]),
+ verify_down(Offender, disconnect, Victim, connection_closed),
+ pong = rpc:call(Offender, net_adm, ping, [Victim]),
- ?line verify_up(Offender, Victim),
+ verify_up(Offender, Victim),
%% We have a new connection between Offender and Victim, bad message
%% should not bring it down.
- ?line {message_queue_len, 1}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+ {message_queue_len, 1}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
- ?line exit(S, bang),
- ?line receive {'DOWN', MS, process, S, bang} -> ok end,
+ exit(S, bang),
+ receive {'DOWN', MS, process, S, bang} -> ok end,
%% Wait for a while (if the connection is taken down it might take a
%% while).
- ?line receive after 2000 -> ok end,
- ?line verify_still_up(Offender, Victim),
+ receive after 2000 -> ok end,
+ verify_still_up(Offender, Victim),
+
+ P ! check_msgs,
+ receive {P, messages_checked} -> ok end,
- ?line P ! check_msgs,
- ?line receive {P, messages_checked} -> ok end,
+ {message_queue_len, 0}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
- ?line {message_queue_len, 0}
- = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
-
- ?line verify_still_up(Offender, Victim),
- ?line P ! done,
- ?line unlink(P),
- ?line verify_no_down(Offender, Victim),
- ?line stop_node(Offender),
- ?line stop_node(Victim).
+ verify_still_up(Offender, Victim),
+ P ! done,
+ unlink(P),
+ verify_no_down(Offender, Victim),
+ stop_node(Offender),
+ stop_node(Victim).
bad_dist_struct_check_msgs([]) ->
receive
- Msg ->
- exit({unexpected_message, Msg})
+ Msg ->
+ exit({unexpected_message, Msg})
after 0 ->
- ok
+ ok
end;
bad_dist_struct_check_msgs([M|Ms]) ->
receive
- {'EXIT',_,_} = EM ->
- io:format("Ignoring exit message: ~p~n",[EM]),
- bad_dist_struct_check_msgs([M|Ms]);
- Msg ->
- M = Msg,
- bad_dist_struct_check_msgs(Ms)
+ {'EXIT',_,_} = EM ->
+ io:format("Ignoring exit message: ~p~n",[EM]),
+ bad_dist_struct_check_msgs([M|Ms]);
+ Msg ->
+ M = Msg,
+ bad_dist_struct_check_msgs(Ms)
end.
bad_dist_ext_check_msgs([]) ->
receive
- Msg ->
- exit({unexpected_message, Msg})
+ Msg ->
+ exit({unexpected_message, Msg})
after 0 ->
- ok
+ ok
end;
bad_dist_ext_check_msgs([M|Ms]) ->
receive
- Msg ->
- M = Msg,
- bad_dist_ext_check_msgs(Ms)
+ Msg ->
+ M = Msg,
+ bad_dist_ext_check_msgs(Ms)
end.
-
+
dport_reg_send(Node, Name, Msg) ->
DPrt = case dport(Node) of
- undefined ->
- pong = net_adm:ping(Node),
- dport(Node);
- Prt ->
- Prt
- end,
+ undefined ->
+ pong = net_adm:ping(Node),
+ dport(Node);
+ Prt ->
+ Prt
+ end,
port_command(DPrt, [dmsg_hdr(),
- dmsg_ext({?DOP_REG_SEND,
- self(),
- ?COOKIE,
- Name}),
- dmsg_ext(Msg)]).
+ dmsg_ext({?DOP_REG_SEND,
+ self(),
+ ?COOKIE,
+ Name}),
+ dmsg_ext(Msg)]).
dport_send(To, Msg) ->
Node = node(To),
DPrt = case dport(Node) of
- undefined ->
- pong = net_adm:ping(Node),
- dport(Node);
- Prt ->
- Prt
- end,
+ undefined ->
+ pong = net_adm:ping(Node),
+ dport(Node);
+ Prt ->
+ Prt
+ end,
port_command(DPrt, [dmsg_hdr(),
- dmsg_ext({?DOP_SEND,
- ?COOKIE,
- To}),
- dmsg_ext(Msg)]).
+ dmsg_ext({?DOP_SEND,
+ ?COOKIE,
+ To}),
+ dmsg_ext(Msg)]).
send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) ->
send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,[]).
send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) ->
Parent = self(),
Done = make_ref(),
spawn(Offender,
- fun () ->
- Node = node(Victim),
- pong = net_adm:ping(Node),
- DPrt = dport(Node),
- Bad1 = case WhereToPutSelf of
- 0 ->
- Bad;
- N when N > 0 ->
- setelement(N,Bad,self())
- end,
- DData = [dmsg_hdr(),
- dmsg_ext(Bad1)] ++
- case PayLoad of
- [] -> [];
- _Other -> [dmsg_ext(PayLoad)]
- end,
- port_command(DPrt, DData),
- Parent ! {DData,Done}
- end),
+ fun () ->
+ Node = node(Victim),
+ pong = net_adm:ping(Node),
+ DPrt = dport(Node),
+ Bad1 = case WhereToPutSelf of
+ 0 ->
+ Bad;
+ N when N > 0 ->
+ setelement(N,Bad,self())
+ end,
+ DData = [dmsg_hdr(),
+ dmsg_ext(Bad1)] ++
+ case PayLoad of
+ [] -> [];
+ _Other -> [dmsg_ext(PayLoad)]
+ end,
+ port_command(DPrt, DData),
+ Parent ! {DData,Done}
+ end),
receive
- {WhatSent,Done} ->
- io:format("Offender sent ~p~n",[WhatSent]),
- ok
+ {WhatSent,Done} ->
+ io:format("Offender sent ~p~n",[WhatSent]),
+ ok
after 5000 ->
- exit(unable_to_send)
+ exit(unable_to_send)
end.
-
+
%% send_bad_msgs():
%% Send a valid distribution header and control message
@@ -1861,21 +1782,21 @@ send_bad_msg(BadNode, To) ->
send_bad_msgs(BadNode, To, 1).
send_bad_msgs(BadNode, To, Repeat) when is_atom(BadNode),
- is_pid(To),
- is_integer(Repeat) ->
+ is_pid(To),
+ is_integer(Repeat) ->
Parent = self(),
Done = make_ref(),
spawn_link(BadNode,
- fun () ->
- Node = node(To),
- pong = net_adm:ping(Node),
- DPrt = dport(Node),
- DData = [dmsg_hdr(),
- dmsg_ext({?DOP_SEND, ?COOKIE, To}),
- dmsg_bad_atom_cache_ref()],
- repeat(fun () -> port_command(DPrt, DData) end, Repeat),
- Parent ! Done
- end),
+ fun () ->
+ Node = node(To),
+ pong = net_adm:ping(Node),
+ DPrt = dport(Node),
+ DData = [dmsg_hdr(),
+ dmsg_ext({?DOP_SEND, ?COOKIE, To}),
+ dmsg_bad_atom_cache_ref()],
+ repeat(fun () -> port_command(DPrt, DData) end, Repeat),
+ Parent ! Done
+ end),
receive Done -> ok end.
%% send_bad_ctl():
@@ -1884,24 +1805,24 @@ send_bad_ctl(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) ->
Parent = self(),
Done = make_ref(),
spawn_link(BadNode,
- fun () ->
- pong = net_adm:ping(ToNode),
- %% We creat a valid ctl msg and replace an
- %% atom with an invalid atom cache reference
- <<131,Replace/binary>> = term_to_binary(replace),
- Ctl = dmsg_ext({?DOP_REG_SEND,
- self(),
- ?COOKIE,
- replace}),
- CtlBeginSize = size(Ctl) - size(Replace),
- <<CtlBegin:CtlBeginSize/binary, Replace/binary>> = Ctl,
- port_command(dport(ToNode),
- [dmsg_fake_hdr2(),
- CtlBegin,
- dmsg_bad_atom_cache_ref(),
- dmsg_ext({a, message})]),
- Parent ! Done
- end),
+ fun () ->
+ pong = net_adm:ping(ToNode),
+ %% We creat a valid ctl msg and replace an
+ %% atom with an invalid atom cache reference
+ <<131,Replace/binary>> = term_to_binary(replace),
+ Ctl = dmsg_ext({?DOP_REG_SEND,
+ self(),
+ ?COOKIE,
+ replace}),
+ CtlBeginSize = size(Ctl) - size(Replace),
+ <<CtlBegin:CtlBeginSize/binary, Replace/binary>> = Ctl,
+ port_command(dport(ToNode),
+ [dmsg_fake_hdr2(),
+ CtlBegin,
+ dmsg_bad_atom_cache_ref(),
+ dmsg_ext({a, message})]),
+ Parent ! Done
+ end),
receive Done -> ok end.
%% send_bad_dhr():
@@ -1910,17 +1831,17 @@ send_bad_dhdr(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) ->
Parent = self(),
Done = make_ref(),
spawn_link(BadNode,
- fun () ->
- pong = net_adm:ping(ToNode),
- port_command(dport(ToNode), dmsg_bad_hdr()),
- Parent ! Done
- end),
+ fun () ->
+ pong = net_adm:ping(ToNode),
+ port_command(dport(ToNode), dmsg_bad_hdr()),
+ Parent ! Done
+ end),
receive Done -> ok end.
dport(Node) when is_atom(Node) ->
case catch erts_debug:get_internal_state(available_internal_state) of
- true -> true;
- _ -> erts_debug:set_internal_state(available_internal_state, true)
+ true -> true;
+ _ -> erts_debug:set_internal_state(available_internal_state, true)
end,
erts_debug:get_internal_state({dist_port, Node}).
@@ -1933,7 +1854,7 @@ dmsg_bad_hdr() ->
[131, % Version Magic
$D, % Dist header
255]. % 255 atom references
-
+
%% dmsg_fake_hdr1() ->
%% A = <<"fake header atom 1">>,
@@ -1974,21 +1895,21 @@ start_node(Name, Args, Rel) when is_atom(Name), is_list(Rel) ->
Pa = filename:dirname(code:which(?MODULE)),
Cookie = atom_to_list(erlang:get_cookie()),
RelArg = case Rel of
- [] -> [];
- _ -> [{erl,[{release,Rel}]}]
- end,
+ [] -> [];
+ _ -> [{erl,[{release,Rel}]}]
+ end,
test_server:start_node(Name, slave,
- [{args,
- Args++" -setcookie "++Cookie++" -pa \""++Pa++"\""}
- | RelArg]);
+ [{args,
+ Args++" -setcookie "++Cookie++" -pa \""++Pa++"\""}
+ | RelArg]);
start_node(Config, Args, Rel) when is_list(Config), is_list(Rel) ->
Name = list_to_atom((atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
- ++ "-"
- ++ integer_to_list(erlang:unique_integer([positive])))),
+ ++ "-"
+ ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive])))),
start_node(Name, Args, Rel).
stop_node(Node) ->
@@ -1999,13 +1920,13 @@ freeze_node(Node, MS) ->
DoingIt = make_ref(),
Freezer = self(),
spawn_link(Node,
- fun () ->
- erts_debug:set_internal_state(available_internal_state,
- true),
- dport_send(Freezer, DoingIt),
- receive after Own -> ok end,
- erts_debug:set_internal_state(block, MS+Own)
- end),
+ fun () ->
+ erts_debug:set_internal_state(available_internal_state,
+ true),
+ dport_send(Freezer, DoingIt),
+ receive after Own -> ok end,
+ erts_debug:set_internal_state(block, MS+Own)
+ end),
receive DoingIt -> ok end,
receive after Own -> ok end.
@@ -2016,46 +1937,46 @@ do_inet_rpc({_,_,Sock},M,F,A) ->
Bin = term_to_binary({M,F,A}),
gen_tcp:send(Sock,Bin),
case gen_tcp:recv(Sock,0) of
- {ok, Bin2} ->
- T = binary_to_term(Bin2),
- {ok,T};
- Else ->
- {error, Else}
+ {ok, Bin2} ->
+ T = binary_to_term(Bin2),
+ {ok,T};
+ Else ->
+ {error, Else}
end.
inet_rpc_server([Host, PortList]) ->
Port = list_to_integer(PortList),
{ok, Sock} = gen_tcp:connect(Host, Port,[binary, {packet, 4},
- {active, false}]),
+ {active, false}]),
inet_rpc_server_loop(Sock).
inet_rpc_server_loop(Sock) ->
case gen_tcp:recv(Sock,0) of
- {ok, Bin} ->
- {M,F,A} = binary_to_term(Bin),
- Res = (catch apply(M,F,A)),
- RB = term_to_binary(Res),
- gen_tcp:send(Sock,RB),
- inet_rpc_server_loop(Sock);
- _ ->
- erlang:halt()
+ {ok, Bin} ->
+ {M,F,A} = binary_to_term(Bin),
+ Res = (catch apply(M,F,A)),
+ RB = term_to_binary(Res),
+ gen_tcp:send(Sock,RB),
+ inet_rpc_server_loop(Sock);
+ _ ->
+ erlang:halt()
end.
-
+
start_relay_node(Node, Args) ->
Pa = filename:dirname(code:which(?MODULE)),
Cookie = "NOT"++atom_to_list(erlang:get_cookie()),
{ok, LSock} = gen_tcp:listen(0, [binary, {packet, 4},
- {active, false}]),
+ {active, false}]),
{ok, Port} = inet:port(LSock),
{ok, Host} = inet:gethostname(),
RunArg = "-run " ++ atom_to_list(?MODULE) ++ " inet_rpc_server " ++
- Host ++ " " ++ integer_to_list(Port),
+ Host ++ " " ++ integer_to_list(Port),
{ok, NN} =
- test_server:start_node(Node, peer,
- [{args, Args ++
- " -setcookie "++Cookie++" -pa "++Pa++" "++
- RunArg}]),
+ test_server:start_node(Node, peer,
+ [{args, Args ++
+ " -setcookie "++Cookie++" -pa "++Pa++" "++
+ RunArg}]),
[N,H] = string:tokens(atom_to_list(NN),"@"),
{ok, Sock} = gen_tcp:accept(LSock),
pang = net_adm:ping(NN),
@@ -2070,28 +1991,28 @@ wait_dead(N,H,0) ->
{error,{not_dead,N,H}};
wait_dead(N,H,X) ->
case erl_epmd:port_please(N,H) of
- {port,_,_} ->
- receive
- after 1000 ->
- ok
- end,
- wait_dead(N,H,X-1);
- noport ->
- ok;
- Else ->
- {error, {unexpected, Else}}
+ {port,_,_} ->
+ receive
+ after 1000 ->
+ ok
+ end,
+ wait_dead(N,H,X-1);
+ noport ->
+ ok;
+ Else ->
+ {error, {unexpected, Else}}
end.
-
+
start_node_monitors(Nodes) ->
Master = self(),
lists:foreach(fun (Node) ->
- spawn(Node,
- fun () ->
- node_monitor(Master)
- end)
- end,
- Nodes),
+ spawn(Node,
+ fun () ->
+ node_monitor(Master)
+ end)
+ end,
+ Nodes),
ok.
node_monitor(Master) ->
@@ -2100,42 +2021,42 @@ node_monitor(Master) ->
net_kernel:monitor_nodes(true, Opts),
Nodes1 = nodes(connected),
case lists:sort(Nodes0) == lists:sort(Nodes1) of
- true ->
- lists:foreach(fun (Node) ->
- Master ! {nodeup, node(), Node}
- end,
- Nodes0),
- ?t:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Nodes0]),
- node_monitor_loop(Master);
- false ->
- net_kernel:monitor_nodes(false, Opts),
- flush_node_changes(),
- node_monitor(Master)
+ true ->
+ lists:foreach(fun (Node) ->
+ Master ! {nodeup, node(), Node}
+ end,
+ Nodes0),
+ io:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Nodes0]),
+ node_monitor_loop(Master);
+ false ->
+ net_kernel:monitor_nodes(false, Opts),
+ flush_node_changes(),
+ node_monitor(Master)
end.
flush_node_changes() ->
receive
- {NodeChange, _Node, _InfoList} when NodeChange == nodeup;
- NodeChange == nodedown ->
- flush_node_changes()
+ {NodeChange, _Node, _InfoList} when NodeChange == nodeup;
+ NodeChange == nodedown ->
+ flush_node_changes()
after 0 ->
- ok
+ ok
end.
node_monitor_loop(Master) ->
receive
- {nodeup, Node, _InfoList} = Msg ->
- Master ! {nodeup, node(), Node},
- ?t:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]),
- node_monitor_loop(Master);
- {nodedown, Node, InfoList} = Msg ->
- Reason = case lists:keysearch(nodedown_reason, 1, InfoList) of
- {value, {nodedown_reason, R}} -> R;
- _ -> undefined
- end,
- Master ! {nodedown, node(), Node, Reason},
- ?t:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]),
- node_monitor_loop(Master)
+ {nodeup, Node, _InfoList} = Msg ->
+ Master ! {nodeup, node(), Node},
+ io:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]),
+ node_monitor_loop(Master);
+ {nodedown, Node, InfoList} = Msg ->
+ Reason = case lists:keysearch(nodedown_reason, 1, InfoList) of
+ {value, {nodedown_reason, R}} -> R;
+ _ -> undefined
+ end,
+ Master ! {nodedown, node(), Node, Reason},
+ io:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]),
+ node_monitor_loop(Master)
end.
verify_up(A, B) ->
@@ -2149,16 +2070,16 @@ verify_still_up(A, B) ->
verify_no_down(A, B) ->
receive
- {nodedown, A, B, _} = Msg0 ->
- ?t:fail(Msg0)
+ {nodedown, A, B, _} = Msg0 ->
+ ct:fail(Msg0)
after 0 ->
- ok
+ ok
end,
receive
- {nodedown, B, A, _} = Msg1 ->
- ?t:fail(Msg1)
+ {nodedown, B, A, _} = Msg1 ->
+ ct:fail(Msg1)
after 0 ->
- ok
+ ok
end.
%% verify_down(A, B) ->
@@ -2167,12 +2088,12 @@ verify_no_down(A, B) ->
verify_down(A, ReasonA, B, ReasonB) ->
receive
- {nodedown, A, B, _} = Msg0 ->
- {nodedown, A, B, ReasonA} = Msg0
+ {nodedown, A, B, _} = Msg0 ->
+ {nodedown, A, B, ReasonA} = Msg0
end,
receive
- {nodedown, B, A, _} = Msg1 ->
- {nodedown, B, A, ReasonB} = Msg1
+ {nodedown, B, A, _} = Msg1 ->
+ {nodedown, B, A, ReasonB} = Msg1
end,
ok.
@@ -2192,17 +2113,17 @@ from(_, []) -> [].
long_or_short() ->
case net_kernel:longnames() of
- true -> " -name ";
- false -> " -sname "
+ true -> " -name ";
+ false -> " -sname "
end.
until(Fun) ->
case Fun() of
- true ->
- ok;
- false ->
- receive after 10 -> ok end,
- until(Fun)
+ true ->
+ ok;
+ false ->
+ receive after 10 -> ok end,
+ until(Fun)
end.
forever(Fun) ->
@@ -2227,9 +2148,9 @@ stop_busy_dist_port_tracer(_) ->
busy_dist_port_tracer() ->
receive
- {monitor, _SuspendedProcess, busy_dist_port, _Port} = M ->
- erlang:display(M),
- busy_dist_port_tracer()
+ {monitor, _SuspendedProcess, busy_dist_port, _Port} = M ->
+ erlang:display(M),
+ busy_dist_port_tracer()
end.
repeat(_Fun, 0) ->
@@ -2242,38 +2163,38 @@ string_to_atom_ext(String) ->
Utf8List = string_to_utf8_list(String),
Len = length(Utf8List),
case Len < 256 of
- true ->
- [?SMALL_ATOM_UTF8_EXT, Len | Utf8List];
- false ->
- [?ATOM_UTF8_EXT, Len bsr 8, Len band 16#ff | Utf8List]
+ true ->
+ [?SMALL_ATOM_UTF8_EXT, Len | Utf8List];
+ false ->
+ [?ATOM_UTF8_EXT, Len bsr 8, Len band 16#ff | Utf8List]
end.
string_to_atom(String) ->
binary_to_term(list_to_binary([?VERSION_MAGIC
- | string_to_atom_ext(String)])).
+ | string_to_atom_ext(String)])).
string_to_utf8_list([]) ->
[];
string_to_utf8_list([CP|CPs]) when is_integer(CP),
- 0 =< CP,
- CP =< 16#7F ->
+ 0 =< CP,
+ CP =< 16#7F ->
[CP | string_to_utf8_list(CPs)];
string_to_utf8_list([CP|CPs]) when is_integer(CP),
- 16#80 =< CP,
- CP =< 16#7FF ->
+ 16#80 =< CP,
+ CP =< 16#7FF ->
[16#C0 bor (CP bsr 6),
16#80 bor (16#3F band CP)
| string_to_utf8_list(CPs)];
string_to_utf8_list([CP|CPs]) when is_integer(CP),
- 16#800 =< CP,
- CP =< 16#FFFF ->
+ 16#800 =< CP,
+ CP =< 16#FFFF ->
[16#E0 bor (CP bsr 12),
16#80 bor (16#3F band (CP bsr 6)),
16#80 bor (16#3F band CP)
| string_to_utf8_list(CPs)];
string_to_utf8_list([CP|CPs]) when is_integer(CP),
- 16#10000 =< CP,
- CP =< 16#10FFFF ->
+ 16#10000 =< CP,
+ CP =< 16#10FFFF ->
[16#F0 bor (CP bsr 18),
16#80 bor (16#3F band (CP bsr 12)),
16#80 bor (16#3F band (CP bsr 6)),
@@ -2283,47 +2204,47 @@ string_to_utf8_list([CP|CPs]) when is_integer(CP),
utf8_list_to_string([]) ->
[];
utf8_list_to_string([B|Bs]) when is_integer(B),
- 0 =< B,
- B =< 16#7F ->
+ 0 =< B,
+ B =< 16#7F ->
[B | utf8_list_to_string(Bs)];
utf8_list_to_string([B0, B1 | Bs]) when is_integer(B0),
- 16#C0 =< B0,
- B0 =< 16#DF,
- is_integer(B1),
- 16#80 =< B1,
- B1 =< 16#BF ->
+ 16#C0 =< B0,
+ B0 =< 16#DF,
+ is_integer(B1),
+ 16#80 =< B1,
+ B1 =< 16#BF ->
[(((B0 band 16#1F) bsl 6)
- bor (B1 band 16#3F))
+ bor (B1 band 16#3F))
| utf8_list_to_string(Bs)];
utf8_list_to_string([B0, B1, B2 | Bs]) when is_integer(B0),
- 16#E0 =< B0,
- B0 =< 16#EF,
- is_integer(B1),
- 16#80 =< B1,
- B1 =< 16#BF,
- is_integer(B2),
- 16#80 =< B2,
- B2 =< 16#BF ->
+ 16#E0 =< B0,
+ B0 =< 16#EF,
+ is_integer(B1),
+ 16#80 =< B1,
+ B1 =< 16#BF,
+ is_integer(B2),
+ 16#80 =< B2,
+ B2 =< 16#BF ->
[(((B0 band 16#F) bsl 12)
- bor ((B1 band 16#3F) bsl 6)
- bor (B2 band 16#3F))
+ bor ((B1 band 16#3F) bsl 6)
+ bor (B2 band 16#3F))
| utf8_list_to_string(Bs)];
utf8_list_to_string([B0, B1, B2, B3 | Bs]) when is_integer(B0),
- 16#F0 =< B0,
- B0 =< 16#F7,
- is_integer(B1),
- 16#80 =< B1,
- B1 =< 16#BF,
- is_integer(B2),
- 16#80 =< B2,
- B2 =< 16#BF,
- is_integer(B3),
- 16#80 =< B3,
- B3 =< 16#BF ->
+ 16#F0 =< B0,
+ B0 =< 16#F7,
+ is_integer(B1),
+ 16#80 =< B1,
+ B1 =< 16#BF,
+ is_integer(B2),
+ 16#80 =< B2,
+ B2 =< 16#BF,
+ is_integer(B3),
+ 16#80 =< B3,
+ B3 =< 16#BF ->
[(((B0 band 16#7) bsl 18)
- bor ((B1 band 16#3F) bsl 12)
- bor ((B2 band 16#3F) bsl 6)
- bor (B3 band 16#3F))
+ bor ((B1 band 16#3F) bsl 12)
+ bor ((B2 band 16#3F) bsl 6)
+ bor (B3 band 16#3F))
| utf8_list_to_string(Bs)].
mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) ->
@@ -2331,17 +2252,17 @@ mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) ->
mk_pid({NodeNameExt, Creation}, Number, Serial);
mk_pid({NodeNameExt, Creation}, Number, Serial) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?PID_EXT,
- NodeNameExt,
- uint32_be(Number),
- uint32_be(Serial),
- uint8(Creation)])) of
- Pid when is_pid(Pid) ->
- Pid;
- {'EXIT', {badarg, _}} ->
- exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]});
- Other ->
- exit({unexpected_binary_to_term_result, Other})
+ ?PID_EXT,
+ NodeNameExt,
+ uint32_be(Number),
+ uint32_be(Serial),
+ uint8(Creation)])) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
end.
mk_port({NodeName, Creation}, Number) when is_atom(NodeName) ->
@@ -2349,59 +2270,59 @@ mk_port({NodeName, Creation}, Number) when is_atom(NodeName) ->
mk_port({NodeNameExt, Creation}, Number);
mk_port({NodeNameExt, Creation}, Number) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?PORT_EXT,
- NodeNameExt,
- uint32_be(Number),
- uint8(Creation)])) of
- Port when is_port(Port) ->
- Port;
- {'EXIT', {badarg, _}} ->
- exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]});
- Other ->
- exit({unexpected_binary_to_term_result, Other})
+ ?PORT_EXT,
+ NodeNameExt,
+ uint32_be(Number),
+ uint8(Creation)])) of
+ Port when is_port(Port) ->
+ Port;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
end.
mk_ref({NodeName, Creation}, [Number] = NL) when is_atom(NodeName),
- is_integer(Creation),
- is_integer(Number) ->
+ is_integer(Creation),
+ is_integer(Number) ->
<<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName),
mk_ref({NodeNameExt, Creation}, NL);
mk_ref({NodeNameExt, Creation}, [Number]) when is_integer(Creation),
- is_integer(Number) ->
+ is_integer(Number) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?REFERENCE_EXT,
- NodeNameExt,
- uint32_be(Number),
- uint8(Creation)])) of
- Ref when is_reference(Ref) ->
- Ref;
- {'EXIT', {badarg, _}} ->
- exit({badarg, mk_ref, [{NodeNameExt, Creation}, [Number]]});
- Other ->
- exit({unexpected_binary_to_term_result, Other})
+ ?REFERENCE_EXT,
+ NodeNameExt,
+ uint32_be(Number),
+ uint8(Creation)])) of
+ Ref when is_reference(Ref) ->
+ Ref;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_ref, [{NodeNameExt, Creation}, [Number]]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
end;
mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName),
- is_integer(Creation),
- is_list(Numbers) ->
+ is_integer(Creation),
+ is_list(Numbers) ->
<<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName),
mk_ref({NodeNameExt, Creation}, Numbers);
mk_ref({NodeNameExt, Creation}, Numbers) when is_integer(Creation),
- is_list(Numbers) ->
+ is_list(Numbers) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?NEW_REFERENCE_EXT,
- uint16_be(length(Numbers)),
- NodeNameExt,
- uint8(Creation),
- lists:map(fun (N) ->
- uint32_be(N)
- end,
- Numbers)])) of
- Ref when is_reference(Ref) ->
- Ref;
- {'EXIT', {badarg, _}} ->
- exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]});
- Other ->
- exit({unexpected_binary_to_term_result, Other})
+ ?NEW_REFERENCE_EXT,
+ uint16_be(length(Numbers)),
+ NodeNameExt,
+ uint8(Creation),
+ lists:map(fun (N) ->
+ uint32_be(N)
+ end,
+ Numbers)])) of
+ Ref when is_reference(Ref) ->
+ Ref;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
end.
diff --git a/erts/emulator/test/distribution_SUITE_data/run.erl b/erts/emulator/test/distribution_SUITE_data/run.erl
index f5169e160c..d5ed139369 100644
--- a/erts/emulator/test/distribution_SUITE_data/run.erl
+++ b/erts/emulator/test/distribution_SUITE_data/run.erl
@@ -30,16 +30,19 @@ from(H, [_ | T]) -> from(H, T);
from(H, []) -> [].
start() ->
- net_kernel:start([fideridum,shortnames]),
- {ok, Node} = slave:start(host(), heppel),
- P = spawn(Node, a, b, []),
- B1 = term_to_binary(P),
- N1 = node(P),
- ok = net_kernel:stop(),
- N2 = node(P),
- io:format("~w~n", [N1 == N2]),
+ Result = do_it(),
+
+ %% Do GCs and node_and_dist_references
+ %% in an attempt to crash the VM (without OTP-13076 fix)
+ lists:foreach(fun(P) -> erlang:garbage_collect(P) end,
+ processes()),
+ erts_debug:set_internal_state(available_internal_state, true),
+ erts_debug:get_internal_state(node_and_dist_references),
+
+ io:format("~w~n", [Result]),
+
if
- N1 == N2 ->
+ Result ->
init:stop();
true ->
%% Make sure that the io:format/2 output is really written
@@ -47,3 +50,29 @@ start() ->
erlang:yield(),
init:stop()
end.
+
+
+do_it() ->
+ {ok, _} = net_kernel:start([fideridum,shortnames]),
+ {ok, Node} = slave:start(host(), heppel),
+ P = spawn(Node, net_kernel, stop, []),
+ B1 = term_to_binary(P),
+ N1 = node(P),
+ ok = net_kernel:stop(),
+ N2 = node(P),
+
+ %% OTP-13076
+ %% Restart distribution with same node name as previous remote node
+ %% Repeat to wrap around creation
+ Result = lists:foldl(fun(_, Acc) ->
+ timer:sleep(2), % give net_kernel:stop() time to take effect :-(
+ {ok, _} = net_kernel:start([heppel,shortnames]),
+ N3 = node(P),
+ ok = net_kernel:stop(),
+ N4 = node(P),
+ Acc and (N3 =:= N1) and (N4 =:= N1)
+ end,
+ (N2 =:= N1),
+ lists:seq(1,3)),
+
+ Result.
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index 4211c49848..c589470f5b 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -29,64 +29,64 @@
-module(driver_SUITE).
-export([all/0, suite/0,groups/0,init_per_suite/1,
- end_per_suite/1, init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
-
- a_test/1,
- outputv_echo/1,
- timer_measure/1,
- timer_cancel/1,
- timer_change/1,
- timer_delay/1,
- queue_echo/1,
- outputv_errors/1,
- driver_unloaded/1,
- io_ready_exit/1,
- use_fallback_pollset/1,
- bad_fd_in_pollset/1,
- driver_event/1,
- fd_change/1,
- steal_control/1,
- otp_6602/1,
- driver_system_info_base_ver/1,
- driver_system_info_prev_ver/1,
- driver_system_info_current_ver/1,
- driver_monitor/1,
-
- ioq_exit_ready_input/1,
- ioq_exit_ready_output/1,
- ioq_exit_timeout/1,
- ioq_exit_ready_async/1,
- ioq_exit_event/1,
- ioq_exit_ready_input_async/1,
- ioq_exit_ready_output_async/1,
- ioq_exit_timeout_async/1,
- ioq_exit_event_async/1,
- zero_extended_marker_garb_drv/1,
- invalid_extended_marker_drv/1,
- larger_major_vsn_drv/1,
- larger_minor_vsn_drv/1,
- smaller_major_vsn_drv/1,
- smaller_minor_vsn_drv/1,
- peek_non_existing_queue/1,
- otp_6879/1,
- caller/1,
- many_events/1,
- missing_callbacks/1,
- smp_select/1,
- driver_select_use/1,
- thread_mseg_alloc_cache_clean/1,
- otp_9302/1,
- thr_free_drv/1,
- async_blast/1,
- thr_msg_blast/1,
- consume_timeslice/1,
- z_test/1]).
+ end_per_suite/1, init_per_group/2,end_per_group/2,
+ init_per_testcase/2,
+ end_per_testcase/2,
+
+ a_test/1,
+ outputv_echo/1,
+ timer_measure/1,
+ timer_cancel/1,
+ timer_change/1,
+ timer_delay/1,
+ queue_echo/1,
+ outputv_errors/1,
+ driver_unloaded/1,
+ io_ready_exit/1,
+ use_fallback_pollset/1,
+ bad_fd_in_pollset/1,
+ driver_event/1,
+ fd_change/1,
+ steal_control/1,
+ otp_6602/1,
+ driver_system_info_base_ver/1,
+ driver_system_info_prev_ver/1,
+ driver_system_info_current_ver/1,
+ driver_monitor/1,
+
+ ioq_exit_ready_input/1,
+ ioq_exit_ready_output/1,
+ ioq_exit_timeout/1,
+ ioq_exit_ready_async/1,
+ ioq_exit_event/1,
+ ioq_exit_ready_input_async/1,
+ ioq_exit_ready_output_async/1,
+ ioq_exit_timeout_async/1,
+ ioq_exit_event_async/1,
+ zero_extended_marker_garb_drv/1,
+ invalid_extended_marker_drv/1,
+ larger_major_vsn_drv/1,
+ larger_minor_vsn_drv/1,
+ smaller_major_vsn_drv/1,
+ smaller_minor_vsn_drv/1,
+ peek_non_existing_queue/1,
+ otp_6879/1,
+ caller/1,
+ many_events/1,
+ missing_callbacks/1,
+ smp_select/1,
+ driver_select_use/1,
+ thread_mseg_alloc_cache_clean/1,
+ otp_9302/1,
+ thr_free_drv/1,
+ async_blast/1,
+ thr_msg_blast/1,
+ consume_timeslice/1,
+ z_test/1]).
-export([bin_prefix/2]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
% First byte in communication with the timer driver
@@ -119,22 +119,22 @@
-define(heap_binary_size, 64).
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(2)),
case catch erts_debug:get_internal_state(available_internal_state) of
- true -> ok;
- _ -> erts_debug:set_internal_state(available_internal_state, true)
+ true -> ok;
+ _ -> erts_debug:set_internal_state(available_internal_state, true)
end,
erlang:display({init_per_testcase, Case}),
- ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)),
- [{watchdog, Dog},{testcase, Case}|Config].
+ 0 = element(1, erts_debug:get_internal_state(check_io_debug)),
+ [{testcase, Case}|Config].
end_per_testcase(Case, Config) ->
- Dog = ?config(watchdog, Config),
erlang:display({end_per_testcase, Case}),
- ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)),
- ?t:timetrap_cancel(Dog).
+ 0 = element(1, erts_debug:get_internal_state(check_io_debug)),
+ ok.
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
all() -> %% Keep a_test first and z_test last...
[a_test, outputv_errors, outputv_echo, queue_echo, {group, timer},
@@ -179,42 +179,42 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-outputv_errors(doc) -> "Test sending bad types to port with an outputv-capable driver.";
+%% Test sending bad types to port with an outputv-capable driver.
outputv_errors(Config) when is_list(Config) ->
- ?line Path = ?config(data_dir, Config),
- ?line erl_ddll:start(),
- ?line ok = load_driver(Path, outputv_drv),
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
+ ok = load_driver(Path, outputv_drv),
outputv_bad_types(fun(T) ->
- ?line outputv_errors_1(T),
- ?line outputv_errors_1([1|T]),
- ?line L = [1,2,3],
- ?line outputv_errors_1([L,T]),
- ?line outputv_errors_1([L|T])
- end),
+ outputv_errors_1(T),
+ outputv_errors_1([1|T]),
+ L = [1,2,3],
+ outputv_errors_1([L,T]),
+ outputv_errors_1([L|T])
+ end),
outputv_errors_1(42),
%% Test iolists that do not fit in the address space.
%% Unfortunately, it would be too slow to test in a 64-bit emulator.
case erlang:system_info(wordsize) of
- 4 -> outputv_huge_iolists();
- _ -> ok
+ 4 -> outputv_huge_iolists();
+ _ -> ok
end.
outputv_bad_types(Test) ->
Types = [-1,256,atom,42.0,{a,b,c},make_ref(),fun() -> 42 end,
- [1|2],<<1:1>>,<<1:9>>,<<1:15>>],
+ [1|2],<<1:1>>,<<1:9>>,<<1:15>>],
_ = [Test(Type) || Type <- Types],
ok.
outputv_huge_iolists() ->
FourGigs = 1 bsl 32,
- ?line Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++
- [1 bsl N || N <- lists:seq(33, 37)],
- ?line Base = <<0:(1 bsl 20)/unit:8>>,
+ Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++
+ [1 bsl N || N <- lists:seq(33, 37)],
+ Base = <<0:(1 bsl 20)/unit:8>>,
[begin
- ?line L = build_iolist(Sz, Base),
- ?line outputv_errors_1(L)
+ L = build_iolist(Sz, Base),
+ outputv_errors_1(L)
end || Sz <- Sizes],
ok.
@@ -224,95 +224,94 @@ outputv_errors_1(Term) ->
port_close(Port).
build_iolist(N, Base) when N < 16 ->
- case random:uniform(3) of
- 1 ->
- <<Bin:N/binary,_/binary>> = Base,
- Bin;
- _ ->
- lists:seq(1, N)
+ case rand:uniform(3) of
+ 1 ->
+ <<Bin:N/binary,_/binary>> = Base,
+ Bin;
+ _ ->
+ lists:seq(1, N)
end;
build_iolist(N, Base) when N =< byte_size(Base) ->
- case random:uniform(3) of
- 1 ->
- <<Bin:N/binary,_/binary>> = Base,
- Bin;
- 2 ->
- <<Bin:N/binary,_/binary>> = Base,
- [Bin];
- 3 ->
- case N rem 2 of
- 0 ->
- L = build_iolist(N div 2, Base),
- [L,L];
- 1 ->
- L = build_iolist(N div 2, Base),
- [L,L,45]
- end
+ case rand:uniform(3) of
+ 1 ->
+ <<Bin:N/binary,_/binary>> = Base,
+ Bin;
+ 2 ->
+ <<Bin:N/binary,_/binary>> = Base,
+ [Bin];
+ 3 ->
+ case N rem 2 of
+ 0 ->
+ L = build_iolist(N div 2, Base),
+ [L,L];
+ 1 ->
+ L = build_iolist(N div 2, Base),
+ [L,L,45]
+ end
end;
build_iolist(N0, Base) ->
- Small = random:uniform(15),
+ Small = rand:uniform(15),
Seq = lists:seq(1, Small),
N = N0 - Small,
case N rem 2 of
- 0 ->
- L = build_iolist(N div 2, Base),
- [L,L|Seq];
- 1 ->
- L = build_iolist(N div 2, Base),
- [47,L,L|Seq]
+ 0 ->
+ L = build_iolist(N div 2, Base),
+ [L,L|Seq];
+ 1 ->
+ L = build_iolist(N div 2, Base),
+ [47,L,L|Seq]
end.
-outputv_echo(doc) -> ["Test echoing data with a driver that supports outputv."];
+%% Test echoing data with a driver that supports outputv.
outputv_echo(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(10)),
+ ct:timetrap({minutes, 10}),
Name = 'outputv_drv',
P = start_driver(Config, Name, true),
- ?line ov_test(P, {bin,0}),
- ?line ov_test(P, {bin,1}),
- ?line ov_test(P, {bin,2}),
- ?line ov_test(P, {bin,3}),
- ?line ov_test(P, {bin,4}),
- ?line ov_test(P, {bin,5}),
- ?line ov_test(P, {bin,6}),
- ?line ov_test(P, {bin,7}),
- ?line ov_test(P, {bin,8}),
- ?line ov_test(P, {bin,15}),
- ?line ov_test(P, {bin,16}),
- ?line ov_test(P, {bin,17}),
-
- ?line ov_test(P, {list,0}),
- ?line ov_test(P, {list,1}),
- ?line ov_test(P, {list,2}),
- ?line ov_test(P, [int,int,{list,0},int]),
- ?line ov_test(P, [int,int,{list,1},int]),
- ?line ov_test(P, [int,int,{list,2}]),
- ?line ov_test(P, [{list,3},int,int,{list,2}]),
- ?line ov_test(P, {list,33}),
-
- ?line ov_test(P, [{bin,0}]),
- ?line ov_test(P, [{bin,1}]),
- ?line ov_test(P, [{bin,2}]),
- ?line ov_test(P, [{bin,3}]),
- ?line ov_test(P, [{bin,4}]),
- ?line ov_test(P, [{bin,5}]),
- ?line ov_test(P, [{bin,6},int]),
- ?line ov_test(P, [int,{bin,3}]),
- ?line ov_test(P, [int|{bin,4}]),
- ?line ov_test(P, [{bin,17},int,{bin,13}|{bin,3}]),
-
- ?line ov_test(P, [int,{bin,17},int,{bin,?heap_binary_size+1}|{bin,3}]),
+ ov_test(P, {bin,0}),
+ ov_test(P, {bin,1}),
+ ov_test(P, {bin,2}),
+ ov_test(P, {bin,3}),
+ ov_test(P, {bin,4}),
+ ov_test(P, {bin,5}),
+ ov_test(P, {bin,6}),
+ ov_test(P, {bin,7}),
+ ov_test(P, {bin,8}),
+ ov_test(P, {bin,15}),
+ ov_test(P, {bin,16}),
+ ov_test(P, {bin,17}),
+
+ ov_test(P, {list,0}),
+ ov_test(P, {list,1}),
+ ov_test(P, {list,2}),
+ ov_test(P, [int,int,{list,0},int]),
+ ov_test(P, [int,int,{list,1},int]),
+ ov_test(P, [int,int,{list,2}]),
+ ov_test(P, [{list,3},int,int,{list,2}]),
+ ov_test(P, {list,33}),
+
+ ov_test(P, [{bin,0}]),
+ ov_test(P, [{bin,1}]),
+ ov_test(P, [{bin,2}]),
+ ov_test(P, [{bin,3}]),
+ ov_test(P, [{bin,4}]),
+ ov_test(P, [{bin,5}]),
+ ov_test(P, [{bin,6},int]),
+ ov_test(P, [int,{bin,3}]),
+ ov_test(P, [int|{bin,4}]),
+ ov_test(P, [{bin,17},int,{bin,13}|{bin,3}]),
+
+ ov_test(P, [int,{bin,17},int,{bin,?heap_binary_size+1}|{bin,3}]),
stop_driver(P, Name),
- ?line test_server:timetrap_cancel(Dog),
ok.
ov_test(Port, Template) ->
Self = self(),
spawn_opt(erlang, apply, [fun () -> ov_test(Self, Port, Template) end,[]],
- [link,{fullsweep_after,0}]),
+ [link,{fullsweep_after,0}]),
receive
- done -> ok
+ done -> ok
end.
ov_test(Parent, Port, Template) ->
@@ -354,21 +353,20 @@ ov_send_and_test(Port, Data, ExpectedResult) ->
io:format("~p ! ~P", [Port,Data,12]),
Port ! {self(),{command,Data}},
receive
- {Port,{data,ReturnData}} ->
- io:format("~p returned ~P", [Port,ReturnData,12]),
- compare(ReturnData, ExpectedResult);
- {Port,{data,OtherData}} ->
- io:format("~p returned WRONG data ~p", [Port,OtherData]),
- ?line test_server:fail();
- Wrong ->
- ?line test_server:fail({unexpected_port_or_data,Wrong})
+ {Port,{data,ReturnData}} ->
+ io:format("~p returned ~P", [Port,ReturnData,12]),
+ compare(ReturnData, ExpectedResult);
+ {Port,{data,OtherData}} ->
+ ct:fail("~p returned WRONG data ~p", [Port,OtherData]);
+ Wrong ->
+ ct:fail({unexpected_port_or_data,Wrong})
end.
compare(Got, Expected) ->
case {list_to_binary([Got]),list_to_binary([Expected])} of
- {B,B} -> ok;
- {_Gb,_Eb} ->
- ?t:fail(got_bad_data)
+ {B,B} -> ok;
+ {_Gb,_Eb} ->
+ ct:fail(got_bad_data)
end.
@@ -377,146 +375,138 @@ compare(Got, Expected) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-timer_measure(doc) -> ["Check that timers time out in good time."];
+%% Check that timers time out in good time.
timer_measure(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(1)),
Name = 'timer_drv',
- ?line Port = start_driver(Config, Name, false),
+ Port = start_driver(Config, Name, false),
- ?line try_timeouts(Port, 8997),
+ try_timeouts(Port, 8997),
- ?line stop_driver(Port, Name),
- ?line test_server:timetrap_cancel(Dog),
+ stop_driver(Port, Name),
ok.
try_timeouts(_, 0) -> ok;
try_timeouts(Port, Timeout) ->
- ?line TimeBefore = erlang:monotonic_time(),
- ?line erlang:port_command(Port, <<?START_TIMER,Timeout:32>>),
+ TimeBefore = erlang:monotonic_time(),
+ erlang:port_command(Port, <<?START_TIMER,Timeout:32>>),
receive
- {Port,{data,[?TIMER]}} ->
- ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore),
- io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed, Timeout]),
- if
- Elapsed < Timeout ->
- ?line ?t:fail(too_short);
- Elapsed > Timeout + ?delay ->
- ?line ?t:fail(too_long);
- true ->
- try_timeouts(Port, Timeout div 2)
- end
+ {Port,{data,[?TIMER]}} ->
+ Elapsed = erl_millisecs() - erl_millisecs(TimeBefore),
+ io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed, Timeout]),
+ if
+ Elapsed < Timeout ->
+ ct:fail(too_short);
+ Elapsed > Timeout + ?delay ->
+ ct:fail(too_long);
+ true ->
+ try_timeouts(Port, Timeout div 2)
+ end
after Timeout + ?delay ->
- ?line test_server:fail("driver failed to timeout")
+ ct:fail("driver failed to timeout")
end.
-timer_cancel(doc) -> ["Try cancelling timers set in a driver."];
+%% Try cancelling timers set in a driver.
timer_cancel(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(1)),
Name = 'timer_drv',
- ?line Port = start_driver(Config, Name, false),
+ Port = start_driver(Config, Name, false),
- ?line try_cancel(Port, 10000),
+ try_cancel(Port, 10000),
- ?line stop_driver(Port, Name),
- ?line test_server:timetrap_cancel(Dog),
+ stop_driver(Port, Name),
ok.
-
+
try_cancel(Port, Timeout) ->
- ?line T_before = erl_millisecs(),
+ T_before = erl_millisecs(),
Port ! {self(),{command,<<?START_TIMER,(Timeout + ?delay):32>>}},
receive
- {Port, {data, [?TIMER]}} ->
- ?line test_server:fail("driver timed out before cancelling it")
+ {Port, {data, [?TIMER]}} ->
+ ct:fail("driver timed out before cancelling it")
after Timeout ->
- Port ! {self(), {command, [?CANCEL_TIMER]}},
- receive
- {Port, {data, [?TIMER]}} ->
- ?line test_server:fail("driver timed out after cancelling it");
- {Port, {data, [?CANCELLED]}} ->
- ?line Time_milli_secs = erl_millisecs() - T_before,
-
- io:format("Time_milli_secs: ~p Timeout: ~p\n",
- [Time_milli_secs, Timeout]),
- if
- Time_milli_secs > (Timeout + ?delay) ->
- ?line test_server:fail("too long real time");
- Timeout == 0 -> ok;
- true -> try_cancel(Port, Timeout div 2)
- end
- after ?delay ->
- test_server:fail("No message from driver")
- end
+ Port ! {self(), {command, [?CANCEL_TIMER]}},
+ receive
+ {Port, {data, [?TIMER]}} ->
+ ct:fail("driver timed out after cancelling it");
+ {Port, {data, [?CANCELLED]}} ->
+ Time_milli_secs = erl_millisecs() - T_before,
+
+ io:format("Time_milli_secs: ~p Timeout: ~p\n",
+ [Time_milli_secs, Timeout]),
+ if
+ Time_milli_secs > (Timeout + ?delay) ->
+ ct:fail("too long real time");
+ Timeout == 0 -> ok;
+ true -> try_cancel(Port, Timeout div 2)
+ end
+ after ?delay ->
+ ct:fail("No message from driver")
+ end
end.
%% Test that timers don't time out too early if we do a sleep
%% before setting a timer.
timer_delay(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(1)),
Name = 'timer_drv',
- ?line Port = start_driver(Config, Name, false),
+ Port = start_driver(Config, Name, false),
- ?line TimeBefore = erlang:monotonic_time(),
+ TimeBefore = erlang:monotonic_time(),
Timeout0 = 350,
- ?line erlang:port_command(Port, <<?DELAY_START_TIMER,Timeout0:32>>),
+ erlang:port_command(Port, <<?DELAY_START_TIMER,Timeout0:32>>),
Timeout = Timeout0 +
- case os:type() of
- {win32,_} -> 0; %Driver doesn't sleep on Windows.
- _ -> 1000
- end,
+ case os:type() of
+ {win32,_} -> 0; %Driver doesn't sleep on Windows.
+ _ -> 1000
+ end,
receive
- {Port,{data,[?TIMER]}} ->
- ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore),
- io:format("Elapsed time: ~p Timeout: ~p\n",
- [Elapsed,Timeout]),
- if
- Elapsed < Timeout ->
- ?line ?t:fail(too_short);
- Elapsed > Timeout + ?delay ->
- ?line ?t:fail(too_long);
- true ->
- ok
- end
+ {Port,{data,[?TIMER]}} ->
+ Elapsed = erl_millisecs() - erl_millisecs(TimeBefore),
+ io:format("Elapsed time: ~p Timeout: ~p\n",
+ [Elapsed,Timeout]),
+ if
+ Elapsed < Timeout ->
+ ct:fail(too_short);
+ Elapsed > Timeout + ?delay ->
+ ct:fail(too_long);
+ true ->
+ ok
+ end
end,
- ?line stop_driver(Port, Name),
- ?line test_server:timetrap_cancel(Dog),
+ stop_driver(Port, Name),
ok.
%% Test that driver_set_timer with new timout really changes
%% the timer (ticket OTP-5942), it didn't work before
timer_change(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(1)),
Name = 'timer_drv',
- ?line Port = start_driver(Config, Name, false),
+ Port = start_driver(Config, Name, false),
- ?line try_change_timer(Port, 10000),
+ try_change_timer(Port, 10000),
- ?line stop_driver(Port, Name),
- ?line test_server:timetrap_cancel(Dog),
+ stop_driver(Port, Name),
ok.
-
+
try_change_timer(_Port, 0) -> ok;
try_change_timer(Port, Timeout) ->
- ?line Timeout_3 = Timeout*3,
- ?line TimeBefore = erlang:monotonic_time(),
- ?line erlang:port_command(Port, <<?START_TIMER,Timeout_3:32>>),
- ?line erlang:port_command(Port, <<?START_TIMER,Timeout:32>>),
+ Timeout_3 = Timeout*3,
+ TimeBefore = erlang:monotonic_time(),
+ erlang:port_command(Port, <<?START_TIMER,Timeout_3:32>>),
+ erlang:port_command(Port, <<?START_TIMER,Timeout:32>>),
receive
- {Port,{data,[?TIMER]}} ->
- ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore),
- io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]),
- if
- Elapsed < Timeout ->
- ?line ?t:fail(too_short);
- Elapsed > Timeout + ?delay ->
- ?line ?t:fail(too_long);
- true ->
- try_timeouts(Port, Timeout div 2)
- end
+ {Port,{data,[?TIMER]}} ->
+ Elapsed = erl_millisecs() - erl_millisecs(TimeBefore),
+ io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]),
+ if
+ Elapsed < Timeout ->
+ ct:fail(too_short);
+ Elapsed > Timeout + ?delay ->
+ ct:fail(too_long);
+ true ->
+ try_timeouts(Port, Timeout div 2)
+ end
after Timeout + ?delay ->
- ?line test_server:fail("driver failed to timeout")
+ ct:fail("driver failed to timeout")
end.
@@ -524,49 +514,47 @@ try_change_timer(Port, Timeout) ->
%% Queue test suites
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-queue_echo(doc) ->
- ["1) Queue up data in a driver that uses the full driver_queue API to do this."
- "2) Get the data back, a random amount at a time."];
+%% 1) Queue up data in a driver that uses the full driver_queue API to do this.
+%% 2) Get the data back, a random amount at a time.
queue_echo(Config) when is_list(Config) ->
- case ?t:is_native(?MODULE) of
- true -> exit(crashes_native_code);
- false -> queue_echo_1(Config)
+ case test_server:is_native(?MODULE) of
+ true -> exit(crashes_native_code);
+ false -> queue_echo_1(Config)
end.
queue_echo_1(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(10)),
+ ct:timetrap({minutes, 10}),
Name = 'queue_drv',
- ?line P = start_driver(Config, Name, true),
-
- ?line q_echo(P, [{?ENQ, {list,1}},
- {?ENQ, {list,0}},
- {?ENQ, {bin,0}},
- {?ENQ, {bin,1}},
- {?ENQ, {bin,2}},
- {?ENQ, {bin,3}},
- {?ENQ, {bin,4}},
- {?ENQ, {bin,5}},
- {?ENQ, {bin,600}},
- {?PUSHQ, {list,0}},
- {?PUSHQ, {list,1}},
- {?PUSHQ, {bin,0}},
- {?PUSHQ, {bin,1}},
- {?PUSHQ, {bin,888}},
- {?ENQ_BIN, {bin,0}},
- {?ENQ_BIN, {bin,1}},
- {?ENQ_BIN, {bin,2}},
- {?ENQ_BIN, {bin,3}},
- {?ENQ_BIN, {bin,4}},
- {?ENQ_BIN, {bin,777}},
- {?PUSHQ_BIN, {bin,0}},
- {?PUSHQ_BIN, {bin,1}},
- {?PUSHQ_BIN, {bin,334}},
- {?ENQV, [{bin,0},{list,1},{bin,1},{bin,555}]},
- {?ENQV, [{bin,0},{list,1},{bin,1}]},
- {?PUSHQV, [{bin,0},{list,1},{bin,1},{bin,319}]}]),
-
- ?line stop_driver(P, Name),
- ?line test_server:timetrap_cancel(Dog),
+ P = start_driver(Config, Name, true),
+
+ q_echo(P, [{?ENQ, {list,1}},
+ {?ENQ, {list,0}},
+ {?ENQ, {bin,0}},
+ {?ENQ, {bin,1}},
+ {?ENQ, {bin,2}},
+ {?ENQ, {bin,3}},
+ {?ENQ, {bin,4}},
+ {?ENQ, {bin,5}},
+ {?ENQ, {bin,600}},
+ {?PUSHQ, {list,0}},
+ {?PUSHQ, {list,1}},
+ {?PUSHQ, {bin,0}},
+ {?PUSHQ, {bin,1}},
+ {?PUSHQ, {bin,888}},
+ {?ENQ_BIN, {bin,0}},
+ {?ENQ_BIN, {bin,1}},
+ {?ENQ_BIN, {bin,2}},
+ {?ENQ_BIN, {bin,3}},
+ {?ENQ_BIN, {bin,4}},
+ {?ENQ_BIN, {bin,777}},
+ {?PUSHQ_BIN, {bin,0}},
+ {?PUSHQ_BIN, {bin,1}},
+ {?PUSHQ_BIN, {bin,334}},
+ {?ENQV, [{bin,0},{list,1},{bin,1},{bin,555}]},
+ {?ENQV, [{bin,0},{list,1},{bin,1}]},
+ {?PUSHQV, [{bin,0},{list,1},{bin,1},{bin,319}]}]),
+
+ stop_driver(P, Name),
ok.
q_echo(Port, SpecList) ->
@@ -606,7 +594,7 @@ q_echo(Port, SpecList) ->
feed_and_dequeue(Port, HeapData, 2),
feed_and_dequeue(Port, HeapData, 3),
feed_and_dequeue(Port, HeapData, 4),
-
+
io:format("\n").
feed_and_dequeue(Port, Data, DeqSize) ->
@@ -626,9 +614,9 @@ feed_driver(Port, [], ExpectedInPort, Qb) ->
{ExpectedInPort,Qb};
feed_driver(Port, [{Method0,Data}|T], Expected_return, Qb_before) ->
Method = case Method0 of
- ?RANDOM -> uniform(6)-1;
- Other -> Other
- end,
+ ?RANDOM -> uniform(6)-1;
+ Other -> Other
+ end,
Size = size(list_to_binary([Data])),
%% ***********************************************************************
@@ -643,22 +631,21 @@ feed_driver(Port, [{Method0,Data}|T], Expected_return, Qb_before) ->
Qb_in_driver = bytes_queued(Port),
case Qb_before + Size of
- Qb_in_driver -> ok;
- Sum ->
- io:format("Qb_before: ~p\n"
- "Qb_before+Size: ~p\n"
- "Qb_in_driver: ~p",
- [Qb_before,Sum,Qb_in_driver]),
- ?t:fail()
+ Qb_in_driver -> ok;
+ Sum ->
+ ct:fail("Qb_before: ~p\n"
+ "Qb_before+Size: ~p\n"
+ "Qb_in_driver: ~p",
+ [Qb_before,Sum,Qb_in_driver])
end,
X_return = case Method of
- ?ENQ -> list_to_binary([Expected_return,Data]);
- ?PUSHQ -> list_to_binary([Data,Expected_return]);
- ?PUSHQ_BIN -> list_to_binary([Data,Expected_return]);
- ?ENQ_BIN -> list_to_binary([Expected_return,Data]);
- ?PUSHQV -> list_to_binary([Data,Expected_return]);
- ?ENQV -> list_to_binary([Expected_return,Data])
- end,
+ ?ENQ -> list_to_binary([Expected_return,Data]);
+ ?PUSHQ -> list_to_binary([Data,Expected_return]);
+ ?PUSHQ_BIN -> list_to_binary([Data,Expected_return]);
+ ?ENQ_BIN -> list_to_binary([Expected_return,Data]);
+ ?PUSHQV -> list_to_binary([Data,Expected_return]);
+ ?ENQV -> list_to_binary([Expected_return,Data])
+ end,
feed_driver(Port, T, X_return, Qb_before + Size).
%% method_name(0) -> pushq;
@@ -676,26 +663,22 @@ compare_return(Port, _Data_list, 0, _Back_len) ->
0 = bytes_queued(Port);
compare_return(Port, QueuedInPort0, Len_to_get, DeqSize) ->
case bytes_queued(Port) of
- Len_to_get -> ok;
- BytesInQueue ->
- io:format("Len_to_get: ~p", [Len_to_get]),
- io:format("Bytes in queue: ~p", [BytesInQueue]),
- ?line test_server:fail()
+ Len_to_get -> ok;
+ BytesInQueue ->
+ ct:fail("Len_to_get: ~p\nBytes in queue: ~p", [Len_to_get,BytesInQueue])
end,
BytesToDequeue = if (DeqSize > Len_to_get) -> Len_to_get;
- true -> DeqSize
- end,
+ true -> DeqSize
+ end,
Dequeued = read_head(Port, BytesToDequeue),
case bin_prefix(Dequeued, QueuedInPort0) of
- true ->
- deq(Port, BytesToDequeue),
- <<_:BytesToDequeue/binary,QueuedInPort/binary>> = QueuedInPort0,
- compare_return(Port, QueuedInPort, Len_to_get - BytesToDequeue, DeqSize);
- false ->
- io:format("Bytes to dequeue: ~p", [BytesToDequeue]),
- io:format("Dequeued: ~p", [Dequeued]),
- io:format("Queued in port: ~P", [QueuedInPort0,12]),
- ?t:fail()
+ true ->
+ deq(Port, BytesToDequeue),
+ <<_:BytesToDequeue/binary,QueuedInPort/binary>> = QueuedInPort0,
+ compare_return(Port, QueuedInPort, Len_to_get - BytesToDequeue, DeqSize);
+ false ->
+ ct:fail("Bytes to dequeue: ~p\nDequeued: ~p\nQueued in port: ~P",
+ [BytesToDequeue, Dequeued, QueuedInPort0,12])
end.
%% bin_prefix(PrefixBinary, Binary)
@@ -713,8 +696,8 @@ queue_op(Port, Method, Data) ->
bytes_queued(Port) ->
case erlang:port_control(Port, ?BYTES_QUEUED, []) of
- <<I:32>> -> I;
- Bad -> ?t:fail({bad_result,Bad})
+ <<I:32>> -> I;
+ Bad -> ct:fail({bad_result,Bad})
end.
deq(Port, Size) ->
@@ -724,83 +707,77 @@ read_head(Port, Size) ->
erlang:port_control(Port, ?READ_HEAD, <<Size:32>>).
-driver_unloaded(doc) ->
- [];
-driver_unloaded(suite) ->
- [];
driver_unloaded(Config) when is_list(Config) ->
- ?line process_flag(trap_exit, true),
- ?line Drv = timer_drv,
- ?line User = self(),
- ?line Loaded = make_ref(),
- ?line Die = make_ref(),
- ?line Loader = spawn(fun () ->
- erl_ddll:start(),
- ok = load_driver(?config(data_dir,
- Config),
- Drv),
- User ! Loaded,
- receive Die -> exit(bye) end
- end),
- ?line receive Loaded -> ok end,
- ?line Port = open_port({spawn, Drv}, []),
- ?line Loader ! Die,
- ?line receive
- {'EXIT', Port, Reason} ->
- ?line driver_unloaded = Reason
- %% Reason used to be -1
- end.
-
-
-io_ready_exit(doc) -> [];
-io_ready_exit(suite) -> [];
+ process_flag(trap_exit, true),
+ Drv = timer_drv,
+ User = self(),
+ Loaded = make_ref(),
+ Die = make_ref(),
+ Loader = spawn(fun () ->
+ erl_ddll:start(),
+ ok = load_driver(proplists:get_value(data_dir,
+ Config),
+ Drv),
+ User ! Loaded,
+ receive Die -> exit(bye) end
+ end),
+ receive Loaded -> ok end,
+ Port = open_port({spawn, Drv}, []),
+ Loader ! Die,
+ receive
+ {'EXIT', Port, Reason} ->
+ driver_unloaded = Reason
+ %% Reason used to be -1
+ end.
+
+
io_ready_exit(Config) when is_list(Config) ->
- ?line OTE = process_flag(trap_exit, true),
- ?line Test = self(),
- ?line Dgawd = spawn(fun () ->
- ok = dgawd_handler:install(),
- Mon = erlang:monitor(process, Test),
- Test ! dgawd_handler_started,
- receive
- {'DOWN', Mon, _, _, _} -> ok;
- stop_dgawd_handler -> ok
- end,
- dgawd_handler:restore(),
- Test ! dgawd_handler_stopped
- end),
- ?line receive dgawd_handler_started -> ok end,
- ?line Drv = io_ready_exit_drv,
- ?line erl_ddll:start(),
- ?line ok = load_driver(?config(data_dir, Config), Drv),
- ?line Port = open_port({spawn, Drv}, []),
- ?line case erlang:port_control(Port, 0, "") of
- "ok" ->
- receive
- {'EXIT', Port, Reason} ->
- ?line case Reason of
- ready_output_driver_failure ->
- ?t:format("Exited in output_ready()~n"),
- ?line ok;
- ready_input_driver_failure ->
- ?t:format("Exited in input_ready()~n"),
- ?line ok;
- Error -> ?line ?t:fail(Error)
- end
- end,
- receive after 2000 -> ok end,
- ?line false = dgawd_handler:got_dgawd_report(),
- ?line Dgawd ! stop_dgawd_handler,
- ?line receive dgawd_handler_stopped -> ok end,
- ?line process_flag(trap_exit, OTE),
- ?line ok;
- "nyiftos" ->
- ?line process_flag(trap_exit, OTE),
- ?line {skipped, "Not yet implemented for this OS"};
- Error ->
- ?line process_flag(trap_exit, OTE),
- ?line ?t:fail({unexpected_control_result, Error})
- end.
-
+ OTE = process_flag(trap_exit, true),
+ Test = self(),
+ Dgawd = spawn(fun () ->
+ ok = dgawd_handler:install(),
+ Mon = erlang:monitor(process, Test),
+ Test ! dgawd_handler_started,
+ receive
+ {'DOWN', Mon, _, _, _} -> ok;
+ stop_dgawd_handler -> ok
+ end,
+ dgawd_handler:restore(),
+ Test ! dgawd_handler_stopped
+ end),
+ receive dgawd_handler_started -> ok end,
+ Drv = io_ready_exit_drv,
+ erl_ddll:start(),
+ ok = load_driver(proplists:get_value(data_dir, Config), Drv),
+ Port = open_port({spawn, Drv}, []),
+ case erlang:port_control(Port, 0, "") of
+ "ok" ->
+ receive
+ {'EXIT', Port, Reason} ->
+ case Reason of
+ ready_output_driver_failure ->
+ io:format("Exited in output_ready()~n"),
+ ok;
+ ready_input_driver_failure ->
+ io:format("Exited in input_ready()~n"),
+ ok;
+ Error -> ct:fail(Error)
+ end
+ end,
+ receive after 2000 -> ok end,
+ false = dgawd_handler:got_dgawd_report(),
+ Dgawd ! stop_dgawd_handler,
+ receive dgawd_handler_stopped -> ok end,
+ process_flag(trap_exit, OTE),
+ ok;
+ "nyiftos" ->
+ process_flag(trap_exit, OTE),
+ {skipped, "Not yet implemented for this OS"};
+ Error ->
+ process_flag(trap_exit, OTE),
+ ct:fail({unexpected_control_result, Error})
+ end.
+
-define(CHKIO_STOP, 0).
-define(CHKIO_USE_FALLBACK_POLLSET, 1).
@@ -812,138 +789,128 @@ io_ready_exit(Config) when is_list(Config) ->
-define(CHKIO_SMP_SELECT, 7).
-define(CHKIO_DRV_USE, 8).
-use_fallback_pollset(doc) -> [];
-use_fallback_pollset(suite) -> [];
use_fallback_pollset(Config) when is_list(Config) ->
FlbkFun = fun () ->
- ChkIoDuring = erlang:system_info(check_io),
- case lists:keysearch(fallback_poll_set_size,
- 1,
- ChkIoDuring) of
- {value,
- {fallback_poll_set_size, N}} when N > 0 ->
- ?line ok;
- Error ->
- ?line ?t:fail({failed_to_use_fallback, Error})
- end
- end,
- ?line {BckupTest, Handel, OkRes}
- = case chkio_test_init(Config) of
- {erts_poll_info, ChkIo} = Hndl ->
- case lists:keysearch(fallback, 1, ChkIo) of
- {value, {fallback, B}} when B =/= false ->
- ?line {FlbkFun, Hndl, ok};
- _ ->
- ?line {fun () -> ok end,
- Hndl,
- {comment,
- "This implementation does not use "
- "a fallback pollset"}}
- end;
- Skip ->
- {fun () -> ok end, Skip, ok}
- end,
- ?line case chkio_test_fini(chkio_test(Handel,
- ?CHKIO_USE_FALLBACK_POLLSET,
- fun () ->
- ?line sleep(1000),
- ?line BckupTest()
- end)) of
- {skipped, _} = Res -> ?line Res;
- _ -> ?line OkRes
- end.
-
-bad_fd_in_pollset(doc) -> [];
-bad_fd_in_pollset(suite) -> [];
+ ChkIoDuring = erlang:system_info(check_io),
+ case lists:keysearch(fallback_poll_set_size,
+ 1,
+ ChkIoDuring) of
+ {value,
+ {fallback_poll_set_size, N}} when N > 0 ->
+ ok;
+ Error ->
+ ct:fail({failed_to_use_fallback, Error})
+ end
+ end,
+ {BckupTest, Handel, OkRes}
+ = case chkio_test_init(Config) of
+ {erts_poll_info, ChkIo} = Hndl ->
+ case lists:keysearch(fallback, 1, ChkIo) of
+ {value, {fallback, B}} when B =/= false ->
+ {FlbkFun, Hndl, ok};
+ _ ->
+ {fun () -> ok end,
+ Hndl,
+ {comment,
+ "This implementation does not use "
+ "a fallback pollset"}}
+ end;
+ Skip ->
+ {fun () -> ok end, Skip, ok}
+ end,
+ case chkio_test_fini(chkio_test(Handel,
+ ?CHKIO_USE_FALLBACK_POLLSET,
+ fun () ->
+ sleep(1000),
+ BckupTest()
+ end)) of
+ {skipped, _} = Res -> Res;
+ _ -> OkRes
+ end.
+
bad_fd_in_pollset(Config) when is_list(Config) ->
- ?line chkio_test_fini(chkio_test(chkio_test_init(Config),
- ?CHKIO_BAD_FD_IN_POLLSET,
- fun () -> ?line sleep(1000) end)).
+ chkio_test_fini(chkio_test(chkio_test_init(Config),
+ ?CHKIO_BAD_FD_IN_POLLSET,
+ fun () -> sleep(1000) end)).
-driver_event(doc) -> [];
-driver_event(suite) -> [];
driver_event(Config) when is_list(Config) ->
- ?line chkio_test_fini(chkio_test(chkio_test_init(Config),
- ?CHKIO_DRIVER_EVENT,
- fun () -> ?line sleep(1000) end)).
+ chkio_test_fini(chkio_test(chkio_test_init(Config),
+ ?CHKIO_DRIVER_EVENT,
+ fun () -> sleep(1000) end)).
-fd_change(doc) -> [];
-fd_change(suite) -> [];
fd_change(Config) when is_list(Config) ->
- ?line chkio_test_fini(chkio_test(chkio_test_init(Config),
- ?CHKIO_FD_CHANGE,
- fun () -> ?line sleep(1000) end)).
+ chkio_test_fini(chkio_test(chkio_test_init(Config),
+ ?CHKIO_FD_CHANGE,
+ fun () -> sleep(1000) end)).
-steal_control(doc) -> [];
-steal_control(suite) -> [];
steal_control(Config) when is_list(Config) ->
- ?line chkio_test_fini(case chkio_test_init(Config) of
- {erts_poll_info, _} = Hndl ->
- ?line steal_control_test(Hndl);
- Skip ->
- ?line Skip
- end).
+ chkio_test_fini(case chkio_test_init(Config) of
+ {erts_poll_info, _} = Hndl ->
+ steal_control_test(Hndl);
+ Skip ->
+ Skip
+ end).
steal_control_test(Hndl = {erts_poll_info, Before}) ->
- ?line Port = open_chkio_port(),
- ?line case erlang:port_control(Port, ?CHKIO_STEAL_AUX, "") of
- [$f,$d,$s,$:| _] = FdList ->
- ?line chk_chkio_port(Port),
- sleep(500),
- ?line chk_chkio_port(Port),
- ?line Res = chkio_test(Hndl,
- ?CHKIO_STEAL,
- FdList,
- fun () ->
- ?line chk_chkio_port(Port),
- ?line sleep(500),
- ?line chk_chkio_port(Port)
- end),
- ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of
- "ok" ->
- ?line chk_chkio_port(Port),
- ?line ok;
- StopErr ->
- ?line chk_chkio_port(Port),
- ?line ?t:fail({stop_error, StopErr})
- end,
- ?line close_chkio_port(Port),
- ?line Res;
- [$s,$k,$i,$p,$:,$\ |Skip] ->
- ?line chk_chkio_port(Port),
- ?line close_chkio_port(Port),
- {chkio_test_result,
- {skipped, Skip},
- Before};
- StartErr ->
- ?line chk_chkio_port(Port),
- ?line ?t:fail({start_error, StartErr})
- end.
+ Port = open_chkio_port(),
+ case erlang:port_control(Port, ?CHKIO_STEAL_AUX, "") of
+ [$f,$d,$s,$:| _] = FdList ->
+ chk_chkio_port(Port),
+ sleep(500),
+ chk_chkio_port(Port),
+ Res = chkio_test(Hndl,
+ ?CHKIO_STEAL,
+ FdList,
+ fun () ->
+ chk_chkio_port(Port),
+ sleep(500),
+ chk_chkio_port(Port)
+ end),
+ case erlang:port_control(Port, ?CHKIO_STOP, "") of
+ "ok" ->
+ chk_chkio_port(Port),
+ ok;
+ StopErr ->
+ chk_chkio_port(Port),
+ ct:fail({stop_error, StopErr})
+ end,
+ close_chkio_port(Port),
+ Res;
+ [$s,$k,$i,$p,$:,$\ |Skip] ->
+ chk_chkio_port(Port),
+ close_chkio_port(Port),
+ {chkio_test_result,
+ {skipped, Skip},
+ Before};
+ StartErr ->
+ chk_chkio_port(Port),
+ ct:fail({start_error, StartErr})
+ end.
chkio_test_init(Config) when is_list(Config) ->
- ?line ChkIo = get_stable_check_io_info(),
- ?line case catch lists:keysearch(name, 1, ChkIo) of
- {value, {name, erts_poll}} ->
- ?line ?t:format("Before test: ~p~n", [ChkIo]),
- ?line Path = ?config(data_dir, Config),
- ?line erl_ddll:start(),
- ?line ok = load_driver(Path, 'chkio_drv'),
- ?line process_flag(trap_exit, true),
- ?line {erts_poll_info, ChkIo};
- _ ->
- ?line {skipped, "Test written to test erts_poll() which isn't used"}
- end.
-
+ ChkIo = get_stable_check_io_info(),
+ case catch lists:keysearch(name, 1, ChkIo) of
+ {value, {name, erts_poll}} ->
+ io:format("Before test: ~p~n", [ChkIo]),
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
+ ok = load_driver(Path, 'chkio_drv'),
+ process_flag(trap_exit, true),
+ {erts_poll_info, ChkIo};
+ _ ->
+ {skipped, "Test written to test erts_poll() which isn't used"}
+ end.
+
chkio_test_fini({skipped, _} = Res) ->
Res;
chkio_test_fini({chkio_test_result, Res, Before}) ->
- ?line ok = erl_ddll:unload_driver('chkio_drv'),
- ?line ok = erl_ddll:stop(),
- ?line After = get_stable_check_io_info(),
- ?line ?t:format("After test: ~p~n", [After]),
- ?line verify_chkio_state(Before, After),
- ?line Res.
+ ok = erl_ddll:unload_driver('chkio_drv'),
+ ok = erl_ddll:stop(),
+ After = get_stable_check_io_info(),
+ io:format("After test: ~p~n", [After]),
+ verify_chkio_state(Before, After),
+ Res.
open_chkio_port() ->
open_port({spawn, 'chkio_drv'}, []).
@@ -951,269 +918,255 @@ open_chkio_port() ->
close_chkio_port(Port) when is_port(Port) ->
true = erlang:port_close(Port),
receive
- {'EXIT', Port, normal} ->
- ok;
- {'EXIT', Port, Reason} ->
- ?t:fail({abnormal_port_exit, Port, Reason});
- {Port, Message} ->
- ?t:fail({strange_message_from_port, Message})
+ {'EXIT', Port, normal} ->
+ ok;
+ {'EXIT', Port, Reason} ->
+ ct:fail({abnormal_port_exit, Port, Reason});
+ {Port, Message} ->
+ ct:fail({strange_message_from_port, Message})
end.
chk_chkio_port(Port) ->
receive
- {'EXIT', Port, Reason} when Reason /= normal ->
- ?t:fail({port_exited, Port, Reason})
+ {'EXIT', Port, Reason} when Reason /= normal ->
+ ct:fail({port_exited, Port, Reason})
after 0 ->
- ok
+ ok
end.
-
+
chkio_test({skipped, _} = Res, _Test, _Fun) ->
- ?line Res;
+ Res;
chkio_test({erts_poll_info, _Before} = EPI, Test, Fun) when is_integer(Test) ->
chkio_test(EPI, Test, "", Fun).
chkio_test({skipped, _} = Res, _Test, _TestArgs, _Fun) ->
- ?line Res;
+ Res;
chkio_test({erts_poll_info, Before},
- Test,
- TestArgs,
- Fun) when is_integer(Test),
- is_list(TestArgs) ->
- ?line Port = open_chkio_port(),
- ?line case erlang:port_control(Port, Test, TestArgs) of
- "ok" ->
- ?line chk_chkio_port(Port),
- ?line Fun(),
- ?line During = erlang:system_info(check_io),
- ?line erlang:display(During),
- ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)),
- ?line ?t:format("During test: ~p~n", [During]),
- ?line chk_chkio_port(Port),
- ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of
- Res when is_list(Res) ->
- ?line chk_chkio_port(Port),
- ?line ?t:format("~s", [Res]),
- ?line close_chkio_port(Port),
- ?line Res,
- ?line case Res of
- [$c,$o,$m,$m,$e,$n,$t,$:,$\ |Cmnt] ->
- ?line {chkio_test_result,
- {comment, Cmnt},
- Before};
- _ ->
- ?line {chkio_test_result,
- Res,
- Before}
- end;
- StopErr ->
- ?line chk_chkio_port(Port),
- ?line ?t:fail({stop_error, StopErr})
- end;
- [$s,$k,$i,$p,$:,$\ |Skip] ->
- ?line chk_chkio_port(Port),
- ?line close_chkio_port(Port),
- {chkio_test_result,
- {skipped, Skip},
- Before};
- StartErr ->
- ?line chk_chkio_port(Port),
- ?line ?t:fail({start_error, StartErr})
- end.
+ Test,
+ TestArgs,
+ Fun) when is_integer(Test),
+ is_list(TestArgs) ->
+ Port = open_chkio_port(),
+ case erlang:port_control(Port, Test, TestArgs) of
+ "ok" ->
+ chk_chkio_port(Port),
+ Fun(),
+ During = erlang:system_info(check_io),
+ erlang:display(During),
+ 0 = element(1, erts_debug:get_internal_state(check_io_debug)),
+ io:format("During test: ~p~n", [During]),
+ chk_chkio_port(Port),
+ case erlang:port_control(Port, ?CHKIO_STOP, "") of
+ Res when is_list(Res) ->
+ chk_chkio_port(Port),
+ io:format("~s", [Res]),
+ close_chkio_port(Port),
+ Res,
+ case Res of
+ [$c,$o,$m,$m,$e,$n,$t,$:,$\ |Cmnt] ->
+ {chkio_test_result,
+ {comment, Cmnt},
+ Before};
+ _ ->
+ {chkio_test_result,
+ Res,
+ Before}
+ end;
+ StopErr ->
+ chk_chkio_port(Port),
+ ct:fail({stop_error, StopErr})
+ end;
+ [$s,$k,$i,$p,$:,$\ |Skip] ->
+ chk_chkio_port(Port),
+ close_chkio_port(Port),
+ {chkio_test_result,
+ {skipped, Skip},
+ Before};
+ StartErr ->
+ chk_chkio_port(Port),
+ ct:fail({start_error, StartErr})
+ end.
verify_chkio_state(Before, After) ->
- ?line TotSetSize = lists:keysearch(total_poll_set_size, 1, Before),
- ?line TotSetSize = lists:keysearch(total_poll_set_size, 1, After),
- ?line case lists:keysearch(fallback, 1, Before) of
- {value,{fallback,false}} ->
- ?line ok;
- _ ->
- ?line BckupSetSize = lists:keysearch(fallback_poll_set_size,
- 1,
- Before),
- ?line BckupSetSize = lists:keysearch(fallback_poll_set_size,
- 1,
- After)
- end,
- ?line ok.
+ TotSetSize = lists:keysearch(total_poll_set_size, 1, Before),
+ TotSetSize = lists:keysearch(total_poll_set_size, 1, After),
+ case lists:keysearch(fallback, 1, Before) of
+ {value,{fallback,false}} ->
+ ok;
+ _ ->
+ BckupSetSize = lists:keysearch(fallback_poll_set_size,
+ 1,
+ Before),
+ BckupSetSize = lists:keysearch(fallback_poll_set_size,
+ 1,
+ After)
+ end,
+ ok.
get_stable_check_io_info() ->
ChkIo = erlang:system_info(check_io),
PendUpdNo = case lists:keysearch(pending_updates, 1, ChkIo) of
- {value, {pending_updates, PendNo}} ->
- PendNo;
- false ->
- 0
- end,
+ {value, {pending_updates, PendNo}} ->
+ PendNo;
+ false ->
+ 0
+ end,
{value, {active_fds, ActFds}} = lists:keysearch(active_fds, 1, ChkIo),
case {PendUpdNo, ActFds} of
- {0, 0} ->
- ChkIo;
- _ ->
- receive after 10 -> ok end,
- get_stable_check_io_info()
+ {0, 0} ->
+ ChkIo;
+ _ ->
+ receive after 10 -> ok end,
+ get_stable_check_io_info()
end.
-otp_6602(doc) -> ["Missed port lock when stealing control of fd from a "
- "driver that didn't use the same lock. The lock checker "
- "used to trigger on this and dump core."];
-otp_6602(suite) ->
- [];
+%% Missed port lock when stealing control of fd from a
+%% driver that didn't use the same lock. The lock checker
+%% used to trigger on this and dump core.
otp_6602(Config) when is_list(Config) ->
- ?line {ok, Node} = start_node(Config),
- ?line Done = make_ref(),
- ?line Parent = self(),
- ?line Tester = spawn_link(Node,
- fun () ->
- %% Inet driver use port locking...
- {ok, S} = gen_udp:open(0),
- {ok, Fd} = inet:getfd(S),
- %% Steal fd (lock checker used to
- %% trigger here).
- {ok, _S2} = gen_udp:open(0,[{fd,Fd}]),
- Parent ! Done
- end),
- ?line receive Done -> ok end,
- ?line unlink(Tester),
- ?line stop_node(Node),
- ?line ok.
+ {ok, Node} = start_node(Config),
+ Done = make_ref(),
+ Parent = self(),
+ Tester = spawn_link(Node,
+ fun () ->
+ %% Inet driver use port locking...
+ {ok, S} = gen_udp:open(0),
+ {ok, Fd} = inet:getfd(S),
+ %% Steal fd (lock checker used to
+ %% trigger here).
+ {ok, _S2} = gen_udp:open(0,[{fd,Fd}]),
+ Parent ! Done
+ end),
+ receive Done -> ok end,
+ unlink(Tester),
+ stop_node(Node),
+ ok.
-define(EXPECTED_SYSTEM_INFO_NAMES1,
- ["drv_drv_vsn",
- "emu_drv_vsn",
- "erts_vsn",
- "otp_vsn",
- "thread",
- "smp"]).
+ ["drv_drv_vsn",
+ "emu_drv_vsn",
+ "erts_vsn",
+ "otp_vsn",
+ "thread",
+ "smp"]).
-define(EXPECTED_SYSTEM_INFO_NAMES2,
- (?EXPECTED_SYSTEM_INFO_NAMES1 ++
- ["async_thrs",
- "sched_thrs"])).
+ (?EXPECTED_SYSTEM_INFO_NAMES1 ++
+ ["async_thrs",
+ "sched_thrs"])).
-define(EXPECTED_SYSTEM_INFO_NAMES3,
- (?EXPECTED_SYSTEM_INFO_NAMES2 ++
- ["emu_nif_vsn"])).
+ (?EXPECTED_SYSTEM_INFO_NAMES2 ++
+ ["emu_nif_vsn"])).
-define(EXPECTED_SYSTEM_INFO_NAMES4,
- (?EXPECTED_SYSTEM_INFO_NAMES3 ++
- ["dirty_sched"])).
+ (?EXPECTED_SYSTEM_INFO_NAMES3 ++
+ ["dirty_sched"])).
-define(EXPECTED_SYSTEM_INFO_NAMES, ?EXPECTED_SYSTEM_INFO_NAMES4).
-'driver_system_info_base_ver'(doc) ->
- [];
-'driver_system_info_base_ver'(suite) ->
- [];
'driver_system_info_base_ver'(Config) when is_list(Config) ->
- ?line driver_system_info_test(Config, sys_info_base_drv).
+ driver_system_info_test(Config, sys_info_base_drv).
-'driver_system_info_prev_ver'(doc) ->
- [];
-'driver_system_info_prev_ver'(suite) ->
- [];
'driver_system_info_prev_ver'(Config) when is_list(Config) ->
- ?line driver_system_info_test(Config, sys_info_prev_drv).
+ driver_system_info_test(Config, sys_info_prev_drv).
-driver_system_info_current_ver(doc) ->
- [];
-driver_system_info_current_ver(suite) ->
- [];
driver_system_info_current_ver(Config) when is_list(Config) ->
- ?line driver_system_info_test(Config, sys_info_curr_drv).
+ driver_system_info_test(Config, sys_info_curr_drv).
driver_system_info_test(Config, Name) ->
- ?line Port = start_driver(Config, Name, false),
- ?line case erlang:port_control(Port, 0, []) of
- [$o,$k,$:,_ | Result] ->
- ?line check_driver_system_info_result(Result);
- [$e,$r,$r,$o,$r,$:,_ | Error] ->
- ?line ?t:fail(Error);
- Unexpected ->
- ?line ?t:fail({unexpected_result, Unexpected})
- end,
- ?line stop_driver(Port, Name),
- ?line ok.
+ Port = start_driver(Config, Name, false),
+ case erlang:port_control(Port, 0, []) of
+ [$o,$k,$:,_ | Result] ->
+ check_driver_system_info_result(Result);
+ [$e,$r,$r,$o,$r,$:,_ | Error] ->
+ ct:fail(Error);
+ Unexpected ->
+ ct:fail({unexpected_result, Unexpected})
+ end,
+ stop_driver(Port, Name),
+ ok.
check_driver_system_info_result(Result) ->
- ?line ?t:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]),
- ?line ?t:format("Result: ~p~n", [Result]),
- ?line {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) ->
- string:tokens(Str, "=")
- end,
- string:tokens(Result, " ")),
- ?EXPECTED_SYSTEM_INFO_NAMES),
- ?line case {DDVSN,
- drv_vsn_str2tup(erlang:system_info(driver_version))} of
- {DDVSN, DDVSN} ->
- ?line [] = Ns;
- %% {{1, 0}, _} ->
- %% ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES
- %% -- ?EXPECTED_SYSTEM_INFO_NAMES1),
- %% ?line ExpNs = lists:sort(Ns);
- %% {{1, 1}, _} ->
- %% ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES
- %% -- ?EXPECTED_SYSTEM_INFO_NAMES2),
- %% ?line ExpNs = lists:sort(Ns);
- {{3, 0}, _} ->
- ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES
- -- ?EXPECTED_SYSTEM_INFO_NAMES3),
- ?line ExpNs = lists:sort(Ns)
- end.
+ io:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]),
+ io:format("Result: ~p~n", [Result]),
+ {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) ->
+ string:tokens(Str, "=")
+ end,
+ string:tokens(Result, " ")),
+ ?EXPECTED_SYSTEM_INFO_NAMES),
+ case {DDVSN,
+ drv_vsn_str2tup(erlang:system_info(driver_version))} of
+ {DDVSN, DDVSN} ->
+ [] = Ns;
+ %% {{1, 0}, _} ->
+ %% ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES
+ %% -- ?EXPECTED_SYSTEM_INFO_NAMES1),
+ %% ExpNs = lists:sort(Ns);
+ %% {{1, 1}, _} ->
+ %% ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES
+ %% -- ?EXPECTED_SYSTEM_INFO_NAMES2),
+ %% ExpNs = lists:sort(Ns);
+ {{3, 0}, _} ->
+ ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES
+ -- ?EXPECTED_SYSTEM_INFO_NAMES3),
+ ExpNs = lists:sort(Ns)
+ end.
chk_sis(SIs, Ns) ->
chk_sis(SIs, Ns, unknown).
chk_sis(SIs, [], DDVSN) ->
- ?line {SIs, [], DDVSN};
+ {SIs, [], DDVSN};
chk_sis([], Ns, DDVSN) ->
- ?line {[], Ns, DDVSN};
+ {[], Ns, DDVSN};
chk_sis([[N, _] = SI| SIs], Ns, DDVSN) ->
- ?line true = lists:member(N, Ns),
- ?line case check_si_res(SI) of
- {driver_version, NewDDVSN} ->
- ?line chk_sis(SIs, lists:delete(N, Ns), NewDDVSN);
- _ ->
- ?line chk_sis(SIs, lists:delete(N, Ns), DDVSN)
- end.
+ true = lists:member(N, Ns),
+ case check_si_res(SI) of
+ {driver_version, NewDDVSN} ->
+ chk_sis(SIs, lists:delete(N, Ns), NewDDVSN);
+ _ ->
+ chk_sis(SIs, lists:delete(N, Ns), DDVSN)
+ end.
%% Data in first version of driver_system_info() (driver version 1.0)
check_si_res(["drv_drv_vsn", Value]) ->
- ?line DDVSN = drv_vsn_str2tup(Value),
- ?line {Major, DMinor} = DDVSN,
- ?line {Major, EMinor} = drv_vsn_str2tup(erlang:system_info(driver_version)),
- ?line true = DMinor =< EMinor,
- ?line {driver_version, DDVSN};
+ DDVSN = drv_vsn_str2tup(Value),
+ {Major, DMinor} = DDVSN,
+ {Major, EMinor} = drv_vsn_str2tup(erlang:system_info(driver_version)),
+ true = DMinor =< EMinor,
+ {driver_version, DDVSN};
check_si_res(["emu_drv_vsn", Value]) ->
- ?line Value = erlang:system_info(driver_version);
+ Value = erlang:system_info(driver_version);
check_si_res(["erts_vsn", Value]) ->
- ?line Value = erlang:system_info(version);
+ Value = erlang:system_info(version);
check_si_res(["otp_vsn", Value]) ->
- ?line Value = erlang:system_info(otp_release);
+ Value = erlang:system_info(otp_release);
check_si_res(["thread", "true"]) ->
- ?line true = erlang:system_info(threads);
+ true = erlang:system_info(threads);
check_si_res(["thread", "false"]) ->
- ?line false = erlang:system_info(threads);
+ false = erlang:system_info(threads);
check_si_res(["smp", "true"]) ->
- ?line true = erlang:system_info(smp_support);
+ true = erlang:system_info(smp_support);
check_si_res(["smp", "false"]) ->
- ?line false = erlang:system_info(smp_support);
+ false = erlang:system_info(smp_support);
%% Data added in second version of driver_system_info() (driver version 1.1)
check_si_res(["async_thrs", Value]) ->
- ?line Value = integer_to_list(erlang:system_info(thread_pool_size));
+ Value = integer_to_list(erlang:system_info(thread_pool_size));
check_si_res(["sched_thrs", Value]) ->
- ?line Value = integer_to_list(erlang:system_info(schedulers));
+ Value = integer_to_list(erlang:system_info(schedulers));
%% Data added in 3rd version of driver_system_info() (driver version 1.5)
check_si_res(["emu_nif_vsn", Value]) ->
- ?line Value = erlang:system_info(nif_version);
+ Value = erlang:system_info(nif_version);
%% Data added in 4th version of driver_system_info() (driver version 3.1)
check_si_res(["dirty_sched", _Value]) ->
true;
check_si_res(Unexpected) ->
- ?line ?t:fail({unexpected_result, Unexpected}).
+ ct:fail({unexpected_result, Unexpected}).
-define(MON_OP_I_AM_IPID,1).
-define(MON_OP_MONITOR_ME,2).
@@ -1221,171 +1174,168 @@ check_si_res(Unexpected) ->
-define(MON_OP_MONITOR_ME_LATER,4).
-define(MON_OP_DO_DELAYED_MONITOR,5).
-driver_monitor(suite) ->
- [];
-driver_monitor(doc) ->
- ["Test monitoring of processes from drivers"];
+%% Test monitoring of processes from drivers
driver_monitor(Config) when is_list(Config) ->
- ?line Name = monitor_drv,
- ?line Port = start_driver(Config, Name, false),
- ?line "ok" = port_control(Port,?MON_OP_I_AM_IPID,[]),
- ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]),
- ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
- ?line {monitors, []} = erlang:port_info(Port,monitors),
-
- ?line "ok:"++Id1 = port_control(Port,?MON_OP_MONITOR_ME_LATER,[]),
- ?line {monitored_by, []} = process_info(self(),monitored_by),
- ?line "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id1),
- ?line {monitored_by, [Port]} = process_info(self(),monitored_by),
- ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
- ?line {monitored_by, []} = process_info(self(),monitored_by),
-
- ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]),
- ?line Me = self(),
- ?line {Pid1,Ref1} =
- spawn_monitor(fun() ->
- Me ! port_control(Port,?MON_OP_MONITOR_ME,[]),
- Me ! process_info(self(),monitored_by),
- Me ! erlang:port_info(Port,monitors)
- end),
- ?line ok = receive
- "ok" ->
- ok
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {monitored_by, L} ->
- L2 = lists:sort(L),
- L3 = lists:sort([Me,Port]),
- case L2 of
- L3 ->
- ok;
- _ ->
- mismatch
- end
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {monitors, LL} ->
- LL2 = lists:sort(LL),
- LL3 = lists:sort([{process,Me},{process,Pid1}]),
- case LL2 of
- LL3 ->
- ok;
- _ ->
- mismatch
- end
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {'DOWN', Ref1, process, Pid1, _} ->
- ok
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {monitor_fired,Port,Pid1} ->
- ok
- after 1000 ->
- timeout
- end,
- ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
- ?line {monitors,[]} = erlang:port_info(Port,monitors),
- ?line {monitored_by, []} = process_info(self(),monitored_by),
-
- ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]),
- ?line {Pid2,Ref2} =
- spawn_monitor(fun() ->
- receive go -> ok end,
- Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]),
- Me ! process_info(self(),monitored_by),
- Me ! erlang:port_info(Port,monitors)
- end),
- ?line Pid2 ! go,
- ?line {ok,Id2} = receive
- "ok:"++II ->
- {ok,II}
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {monitored_by, [Me]} ->
- ok
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {monitors, [{process,Me}]} ->
- ok
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {'DOWN', Ref2, process, Pid2, _} ->
- ok
- after 1000 ->
- timeout
- end,
- ?line "noproc" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2),
- ?line {monitors,[{process,Me}]} = erlang:port_info(Port,monitors),
- ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
- ?line "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
- ?line {monitors,[]} = erlang:port_info(Port,monitors),
- ?line {monitored_by, []} = process_info(self(),monitored_by),
-
-
- ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]),
- ?line {Pid3,Ref3} =
- spawn_monitor(fun() ->
- receive go -> ok end,
- Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]),
- Me ! process_info(self(),monitored_by),
- Me ! erlang:port_info(Port,monitors) ,
- receive die -> ok end
- end),
- ?line Pid3 ! go,
- ?line {ok,Id3} = receive
- "ok:"++III ->
- {ok,III}
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {monitored_by, [Me]} ->
- ok
- after 1000 ->
- timeout
- end,
- ?line ok = receive
- {monitors, [{process,Me}]} ->
- ok
- after 1000 ->
- timeout
- end,
- ?line "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id3),
- ?line LLL1 = lists:sort([{process,Me},{process,Pid3}]),
- ?line {monitors,LLL2} = erlang:port_info(Port,monitors),
- ?line LLL1 = lists:sort(LLL2),
- ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
- ?line {monitors,[{process,Pid3}]} = erlang:port_info(Port,monitors),
- ?line Pid3 ! die,
- ?line ok = receive
- {'DOWN', Ref3, process, Pid3, _} ->
- ok
- after 1000 ->
- timeout
- end,
- ?line "not_found" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2),
- ?line {monitors,[]} = erlang:port_info(Port,monitors),
- ?line "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
- ?line {monitors,[]} = erlang:port_info(Port,monitors),
- ?line {monitored_by, []} = process_info(self(),monitored_by),
-
- ?line stop_driver(Port, Name),
- ?line ok.
+ Name = monitor_drv,
+ Port = start_driver(Config, Name, false),
+ "ok" = port_control(Port,?MON_OP_I_AM_IPID,[]),
+ "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]),
+ "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
+ {monitors, []} = erlang:port_info(Port,monitors),
+
+ "ok:"++Id1 = port_control(Port,?MON_OP_MONITOR_ME_LATER,[]),
+ {monitored_by, []} = process_info(self(),monitored_by),
+ "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id1),
+ {monitored_by, [Port]} = process_info(self(),monitored_by),
+ "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
+ {monitored_by, []} = process_info(self(),monitored_by),
+
+ "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]),
+ Me = self(),
+ {Pid1,Ref1} =
+ spawn_monitor(fun() ->
+ Me ! port_control(Port,?MON_OP_MONITOR_ME,[]),
+ Me ! process_info(self(),monitored_by),
+ Me ! erlang:port_info(Port,monitors)
+ end),
+ ok = receive
+ "ok" ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {monitored_by, L} ->
+ L2 = lists:sort(L),
+ L3 = lists:sort([Me,Port]),
+ case L2 of
+ L3 ->
+ ok;
+ _ ->
+ mismatch
+ end
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {monitors, LL} ->
+ LL2 = lists:sort(LL),
+ LL3 = lists:sort([{process,Me},{process,Pid1}]),
+ case LL2 of
+ LL3 ->
+ ok;
+ _ ->
+ mismatch
+ end
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {'DOWN', Ref1, process, Pid1, _} ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {monitor_fired,Port,Pid1} ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
+ {monitors,[]} = erlang:port_info(Port,monitors),
+ {monitored_by, []} = process_info(self(),monitored_by),
+
+ "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]),
+ {Pid2,Ref2} =
+ spawn_monitor(fun() ->
+ receive go -> ok end,
+ Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]),
+ Me ! process_info(self(),monitored_by),
+ Me ! erlang:port_info(Port,monitors)
+ end),
+ Pid2 ! go,
+ {ok,Id2} = receive
+ "ok:"++II ->
+ {ok,II}
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {monitored_by, [Me]} ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {monitors, [{process,Me}]} ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {'DOWN', Ref2, process, Pid2, _} ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ "noproc" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2),
+ {monitors,[{process,Me}]} = erlang:port_info(Port,monitors),
+ "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
+ "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
+ {monitors,[]} = erlang:port_info(Port,monitors),
+ {monitored_by, []} = process_info(self(),monitored_by),
+
+
+ "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]),
+ {Pid3,Ref3} =
+ spawn_monitor(fun() ->
+ receive go -> ok end,
+ Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]),
+ Me ! process_info(self(),monitored_by),
+ Me ! erlang:port_info(Port,monitors) ,
+ receive die -> ok end
+ end),
+ Pid3 ! go,
+ {ok,Id3} = receive
+ "ok:"++III ->
+ {ok,III}
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {monitored_by, [Me]} ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ ok = receive
+ {monitors, [{process,Me}]} ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id3),
+ LLL1 = lists:sort([{process,Me},{process,Pid3}]),
+ {monitors,LLL2} = erlang:port_info(Port,monitors),
+ LLL1 = lists:sort(LLL2),
+ "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
+ {monitors,[{process,Pid3}]} = erlang:port_info(Port,monitors),
+ Pid3 ! die,
+ ok = receive
+ {'DOWN', Ref3, process, Pid3, _} ->
+ ok
+ after 1000 ->
+ timeout
+ end,
+ "not_found" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2),
+ {monitors,[]} = erlang:port_info(Port,monitors),
+ "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]),
+ {monitors,[]} = erlang:port_info(Port,monitors),
+ {monitored_by, []} = process_info(self(),monitored_by),
+
+ stop_driver(Port, Name),
+ ok.
-define(IOQ_EXIT_READY_INPUT, 1).
@@ -1399,726 +1349,663 @@ driver_monitor(Config) when is_list(Config) ->
-define(IOQ_EXIT_EVENT_ASYNC, 9).
ioq_exit_test(Config, TestNo) ->
- ?line Drv = ioq_exit_drv,
- ?line try
- begin
- ?line case load_driver(?config(data_dir, Config),
- Drv) of
- ok -> ?line ok;
- {error, permanent} -> ?line ok;
- LoadError -> ?line ?t:fail({load_error, LoadError})
- end,
- case open_port({spawn, Drv}, []) of
- Port when is_port(Port) ->
- try port_control(Port, TestNo, "") of
- "ok" ->
- ?line ok;
- "nyiftos" ->
- ?line throw({skipped,
- "Not yet implemented for "
- "this OS"});
- [$s,$k,$i,$p,$:,$ | Comment] ->
- ?line throw({skipped, Comment});
- [$e,$r,$r,$o,$r,$:,$ | Error] ->
- ?line ?t:fail(Error)
- after
- Port ! {self(), close},
- receive {Port, closed} -> ok end,
- false = lists:member(Port, erlang:ports()),
- ok
- end;
- Error ->
- ?line ?t:fail({open_port_failed, Error})
- end
- end
- catch
- throw:Term -> ?line Term
- after
- erl_ddll:unload_driver(Drv)
- end.
-
-ioq_exit_ready_input(doc) -> [];
-ioq_exit_ready_input(suite) -> [];
+ Drv = ioq_exit_drv,
+ try
+ begin
+ case load_driver(proplists:get_value(data_dir, Config),
+ Drv) of
+ ok -> ok;
+ {error, permanent} -> ok;
+ LoadError -> ct:fail({load_error, LoadError})
+ end,
+ case open_port({spawn, Drv}, []) of
+ Port when is_port(Port) ->
+ try port_control(Port, TestNo, "") of
+ "ok" ->
+ ok;
+ "nyiftos" ->
+ throw({skipped,
+ "Not yet implemented for "
+ "this OS"});
+ [$s,$k,$i,$p,$:,$ | Comment] ->
+ throw({skipped, Comment});
+ [$e,$r,$r,$o,$r,$:,$ | Error] ->
+ ct:fail(Error)
+ after
+ Port ! {self(), close},
+ receive {Port, closed} -> ok end,
+ false = lists:member(Port, erlang:ports()),
+ ok
+ end;
+ Error ->
+ ct:fail({open_port_failed, Error})
+ end
+ end
+ catch
+ throw:Term -> Term
+ after
+ erl_ddll:unload_driver(Drv)
+ end.
+
ioq_exit_ready_input(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT).
-ioq_exit_ready_output(doc) -> [];
-ioq_exit_ready_output(suite) -> [];
ioq_exit_ready_output(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_READY_OUTPUT).
-ioq_exit_timeout(doc) -> [];
-ioq_exit_timeout(suite) -> [];
ioq_exit_timeout(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT).
-ioq_exit_ready_async(doc) -> [];
-ioq_exit_ready_async(suite) -> [];
ioq_exit_ready_async(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_READY_ASYNC).
-ioq_exit_event(doc) -> [];
-ioq_exit_event(suite) -> [];
ioq_exit_event(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_EVENT).
-ioq_exit_ready_input_async(doc) -> [];
-ioq_exit_ready_input_async(suite) -> [];
ioq_exit_ready_input_async(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT_ASYNC).
-ioq_exit_ready_output_async(doc) -> [];
-ioq_exit_ready_output_async(suite) -> [];
ioq_exit_ready_output_async(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_READY_OUTPUT_ASYNC).
-ioq_exit_timeout_async(doc) -> [];
-ioq_exit_timeout_async(suite) -> [];
ioq_exit_timeout_async(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT_ASYNC).
-ioq_exit_event_async(doc) -> [];
-ioq_exit_event_async(suite) -> [];
ioq_exit_event_async(Config) when is_list(Config) ->
ioq_exit_test(Config, ?IOQ_EXIT_EVENT_ASYNC).
vsn_mismatch_test(Config, LoadResult) ->
- ?line Path = ?config(data_dir, Config),
- ?line DrvName = ?config(testcase, Config),
- ?line LoadResult = load_driver(Path, DrvName),
- ?line case LoadResult of
- ok ->
- ?line Port = open_port({spawn, DrvName}, []),
- ?line true = is_port(Port),
- ?line true = port_close(Port),
- ?line ok = erl_ddll:unload_driver(DrvName);
- _ ->
- ?line ok
- end.
-
-zero_extended_marker_garb_drv(doc) -> [];
-zero_extended_marker_garb_drv(suite) -> [];
+ Path = proplists:get_value(data_dir, Config),
+ DrvName = proplists:get_value(testcase, Config),
+ LoadResult = load_driver(Path, DrvName),
+ case LoadResult of
+ ok ->
+ Port = open_port({spawn, DrvName}, []),
+ true = is_port(Port),
+ true = port_close(Port),
+ ok = erl_ddll:unload_driver(DrvName);
+ _ ->
+ ok
+ end.
+
zero_extended_marker_garb_drv(Config) when is_list(Config) ->
vsn_mismatch_test(Config, {error, driver_incorrect_version}).
-invalid_extended_marker_drv(doc) -> [];
-invalid_extended_marker_drv(suite) -> [];
invalid_extended_marker_drv(Config) when is_list(Config) ->
vsn_mismatch_test(Config, {error, driver_incorrect_version}).
-larger_major_vsn_drv(doc) -> [];
-larger_major_vsn_drv(suite) -> [];
larger_major_vsn_drv(Config) when is_list(Config) ->
vsn_mismatch_test(Config, {error, driver_incorrect_version}).
-larger_minor_vsn_drv(doc) -> [];
-larger_minor_vsn_drv(suite) -> [];
larger_minor_vsn_drv(Config) when is_list(Config) ->
vsn_mismatch_test(Config, {error, driver_incorrect_version}).
-smaller_major_vsn_drv(doc) -> [];
-smaller_major_vsn_drv(suite) -> [];
smaller_major_vsn_drv(Config) when is_list(Config) ->
vsn_mismatch_test(Config, {error, driver_incorrect_version}).
-smaller_minor_vsn_drv(doc) -> [];
-smaller_minor_vsn_drv(suite) -> [];
smaller_minor_vsn_drv(Config) when is_list(Config) ->
DrvVsnStr = erlang:system_info(driver_version),
case drv_vsn_str2tup(DrvVsnStr) of
- {_, 0} ->
- {skipped,
- "Cannot perform test when minor driver version is 0. "
- "Current driver version is " ++ DrvVsnStr ++ "."};
- _ ->
- vsn_mismatch_test(Config, ok)
+ {_, 0} ->
+ {skipped,
+ "Cannot perform test when minor driver version is 0. "
+ "Current driver version is " ++ DrvVsnStr ++ "."};
+ _ ->
+ vsn_mismatch_test(Config, ok)
end.
-define(PEEK_NONXQ_TEST, 0).
-define(PEEK_NONXQ_WAIT, 1).
-peek_non_existing_queue(doc) -> [];
-peek_non_existing_queue(suite) -> [];
peek_non_existing_queue(Config) when is_list(Config) ->
- ?line OTE = process_flag(trap_exit, true),
- ?line Drv = peek_non_existing_queue_drv,
- ?line try
- begin
- ?line case load_driver(?config(data_dir, Config),
- Drv) of
- ok -> ?line ok;
- {error, permanent} -> ?line ok;
- LoadError -> ?line ?t:fail({load_error, LoadError})
- end,
- case open_port({spawn, Drv}, []) of
- Port1 when is_port(Port1) ->
- try port_control(Port1, ?PEEK_NONXQ_TEST, "") of
- "ok" ->
- ?line ok;
- [$s,$k,$i,$p,$p,$e,$d,$:,$ | SkipReason] ->
- ?line throw({skipped, SkipReason});
- [$e,$r,$r,$o,$r,$:,$ | Error1] ->
- ?line ?t:fail(Error1)
- after
- exit(Port1, kill),
- receive {'EXIT', Port1, _} -> ok end
- end;
- Error1 ->
- ?line ?t:fail({open_port1_failed, Error1})
- end,
- case open_port({spawn, Drv}, []) of
- Port2 when is_port(Port2) ->
- try port_control(Port2, ?PEEK_NONXQ_WAIT, "") of
- "ok" ->
- ?line ok;
- [$e,$r,$r,$o,$r,$:,$ | Error2] ->
- ?line ?t:fail(Error2)
- after
- receive {Port2, test_successful} -> ok end,
- Port2 ! {self(), close},
- receive {Port2, closed} -> ok end
- end;
- Error2 ->
- ?line ?t:fail({open_port2_failed, Error2})
- end
- end
- catch
- throw:Term -> ?line Term
- after
- process_flag(trap_exit, OTE),
- erl_ddll:unload_driver(Drv)
- end.
-
-otp_6879(doc) ->
- [];
-otp_6879(suite) ->
- [];
+ OTE = process_flag(trap_exit, true),
+ Drv = peek_non_existing_queue_drv,
+ try
+ begin
+ case load_driver(proplists:get_value(data_dir, Config),
+ Drv) of
+ ok -> ok;
+ {error, permanent} -> ok;
+ LoadError -> ct:fail({load_error, LoadError})
+ end,
+ case open_port({spawn, Drv}, []) of
+ Port1 when is_port(Port1) ->
+ try port_control(Port1, ?PEEK_NONXQ_TEST, "") of
+ "ok" ->
+ ok;
+ [$s,$k,$i,$p,$p,$e,$d,$:,$ | SkipReason] ->
+ throw({skipped, SkipReason});
+ [$e,$r,$r,$o,$r,$:,$ | Error1] ->
+ ct:fail(Error1)
+ after
+ exit(Port1, kill),
+ receive {'EXIT', Port1, _} -> ok end
+ end;
+ Error1 ->
+ ct:fail({open_port1_failed, Error1})
+ end,
+ case open_port({spawn, Drv}, []) of
+ Port2 when is_port(Port2) ->
+ try port_control(Port2, ?PEEK_NONXQ_WAIT, "") of
+ "ok" ->
+ ok;
+ [$e,$r,$r,$o,$r,$:,$ | Error2] ->
+ ct:fail(Error2)
+ after
+ receive {Port2, test_successful} -> ok end,
+ Port2 ! {self(), close},
+ receive {Port2, closed} -> ok end
+ end;
+ Error2 ->
+ ct:fail({open_port2_failed, Error2})
+ end
+ end
+ catch
+ throw:Term -> Term
+ after
+ process_flag(trap_exit, OTE),
+ erl_ddll:unload_driver(Drv)
+ end.
+
otp_6879(Config) when is_list(Config) ->
- ?line Drv = 'otp_6879_drv',
- ?line Parent = self(),
- ?line ok = load_driver(?config(data_dir, Config), Drv),
- ?line Procs = lists:map(
- fun (No) ->
- spawn_link(
- fun () ->
- case open_port({spawn, Drv}, []) of
- Port when is_port(Port) ->
- Res = otp_6879_call(Port, No, 10000),
- erlang:port_close(Port),
- Parent ! {self(), Res};
- _ ->
- Parent ! {self(),
- open_port_failed}
- end
- end)
- end,
- lists:seq(1,10)),
- ?line lists:foreach(fun (P) ->
- ?line receive
- {P, ok} ->
- ?line ok;
- {P, Error} ->
- ?line ?t:fail({P, Error})
- end
- end,
- Procs),
+ Drv = 'otp_6879_drv',
+ Parent = self(),
+ ok = load_driver(proplists:get_value(data_dir, Config), Drv),
+ Procs = lists:map(
+ fun (No) ->
+ spawn_link(
+ fun () ->
+ case open_port({spawn, Drv}, []) of
+ Port when is_port(Port) ->
+ Res = otp_6879_call(Port, No, 10000),
+ erlang:port_close(Port),
+ Parent ! {self(), Res};
+ _ ->
+ Parent ! {self(),
+ open_port_failed}
+ end
+ end)
+ end,
+ lists:seq(1,10)),
+ lists:foreach(fun (P) ->
+ receive
+ {P, ok} ->
+ ok;
+ {P, Error} ->
+ ct:fail({P, Error})
+ end
+ end,
+ Procs),
%% Also try it when input exceeds default buffer (256 bytes)
- ?line Data = lists:seq(1, 1000),
- ?line case open_port({spawn, Drv}, []) of
- Port when is_port(Port) ->
- ?line ok = otp_6879_call(Port, Data, 10),
- ?line erlang:port_close(Port);
- _ ->
- ?line ?t:fail(open_port_failed)
- end,
- ?line erl_ddll:unload_driver(Drv),
- ?line ok.
+ Data = lists:seq(1, 1000),
+ case open_port({spawn, Drv}, []) of
+ Port when is_port(Port) ->
+ ok = otp_6879_call(Port, Data, 10),
+ erlang:port_close(Port);
+ _ ->
+ ct:fail(open_port_failed)
+ end,
+ erl_ddll:unload_driver(Drv),
+ ok.
otp_6879_call(_Port, _Data, 0) ->
ok;
otp_6879_call(Port, Data, N) ->
case catch erlang:port_call(Port, 0, Data) of
- Data -> otp_6879_call(Port, Data, N-1);
- BadData -> {mismatch, Data, BadData}
+ Data -> otp_6879_call(Port, Data, N-1);
+ BadData -> {mismatch, Data, BadData}
end.
-caller(doc) ->
- [];
-caller(suite) ->
- [];
caller(Config) when is_list(Config) ->
- ?line run_caller_test(Config, false),
- ?line run_caller_test(Config, true).
-
+ run_caller_test(Config, false),
+ run_caller_test(Config, true).
+
run_caller_test(Config, Outputv) ->
- ?line Drv = 'caller_drv',
- ?line Cmd = case Outputv of
- true ->
- ?line os:putenv("CALLER_DRV_USE_OUTPUTV",
- "true"),
- outputv;
- false ->
- ?line os:putenv("CALLER_DRV_USE_OUTPUTV",
- "false"),
- output
- end,
- ?line ok = load_driver(?config(data_dir, Config), Drv),
- ?line Port = open_port({spawn, Drv}, []),
- ?line true = is_port(Port),
- ?line chk_caller(Port, start, self()),
- ?line chk_caller(Port,
- Cmd,
- spawn_link(
- fun () ->
- port_command(Port, "")
- end)),
- ?line Port ! {self(), {command, ""}},
- ?line chk_caller(Port, Cmd, self()),
- ?line chk_caller(Port,
- control,
- spawn_link(
- fun () ->
- port_control(Port, 0, "")
- end)),
- ?line chk_caller(Port,
- call,
- spawn_link(
- fun () ->
- erlang:port_call(Port, 0, "")
- end)),
- ?line true = port_close(Port),
- ?line erl_ddll:unload_driver(Drv),
- ?line ok.
+ Drv = 'caller_drv',
+ Cmd = case Outputv of
+ true ->
+ os:putenv("CALLER_DRV_USE_OUTPUTV",
+ "true"),
+ outputv;
+ false ->
+ os:putenv("CALLER_DRV_USE_OUTPUTV",
+ "false"),
+ output
+ end,
+ ok = load_driver(proplists:get_value(data_dir, Config), Drv),
+ Port = open_port({spawn, Drv}, []),
+ true = is_port(Port),
+ chk_caller(Port, start, self()),
+ chk_caller(Port,
+ Cmd,
+ spawn_link(
+ fun () ->
+ port_command(Port, "")
+ end)),
+ Port ! {self(), {command, ""}},
+ chk_caller(Port, Cmd, self()),
+ chk_caller(Port,
+ control,
+ spawn_link(
+ fun () ->
+ port_control(Port, 0, "")
+ end)),
+ chk_caller(Port,
+ call,
+ spawn_link(
+ fun () ->
+ erlang:port_call(Port, 0, "")
+ end)),
+ true = port_close(Port),
+ erl_ddll:unload_driver(Drv),
+ ok.
chk_caller(Port, Callback, ExpectedCaller) ->
receive
- {caller, Port, Callback, Caller} ->
- ExpectedCaller = Caller
+ {caller, Port, Callback, Caller} ->
+ ExpectedCaller = Caller
end.
-many_events(suite) ->
- [];
-many_events(doc) ->
- ["Check that many simultaneously signalled events work (win32)"];
+%% Check that many simultaneously signalled events work (win32)
many_events(Config) when is_list(Config) ->
- ?line Name = 'many_events_drv',
- ?line Port = start_driver(Config, Name, false),
+ Name = 'many_events_drv',
+ Port = start_driver(Config, Name, false),
Number = "1000",
Port ! {self(), {command, Number}},
receive
- {Port, {data,Number}} ->
- ?line receive %% Just to make sure the emulator does not crash
- %% after this case is run (if faulty)
- after 2000 ->
- ok
- end
+ {Port, {data,Number}} ->
+ receive %% Just to make sure the emulator does not crash
+ %% after this case is run (if faulty)
+ after 2000 ->
+ ok
+ end
after 1000 ->
- ?line exit(the_driver_does_not_respond)
+ exit(the_driver_does_not_respond)
end,
- ?line stop_driver(Port, Name),
- ?line ok.
-
-
-missing_callbacks(doc) ->
- [];
-missing_callbacks(suite) ->
- [];
+ stop_driver(Port, Name),
+ ok.
+
+
missing_callbacks(Config) when is_list(Config) ->
- ?line Name = 'missing_callback_drv',
- ?line Port = start_driver(Config, Name, false),
+ Name = 'missing_callback_drv',
+ Port = start_driver(Config, Name, false),
- ?line Port ! {self(), {command, "tjenix"}},
- ?line true = erlang:port_command(Port, "halloj"),
- ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(Port, 4711, "mors")),
- ?line {'EXIT', {badarg, _}} = (catch erlang:port_call(Port, 17, "hej")),
+ Port ! {self(), {command, "tjenix"}},
+ true = erlang:port_command(Port, "halloj"),
+ {'EXIT', {badarg, _}} = (catch erlang:port_control(Port, 4711, "mors")),
+ {'EXIT', {badarg, _}} = (catch erlang:port_call(Port, 17, "hej")),
- ?line %% Give the (non-existing) ready_output(), ready_input(), event(),
- ?line %% and timeout() some time to be called.
- ?line receive after 1000 -> ok end,
+ %% Give the (non-existing) ready_output(), ready_input(), event(),
+ %% and timeout() some time to be called.
+ receive after 1000 -> ok end,
- ?line stop_driver(Port, Name),
- ?line ok.
+ stop_driver(Port, Name),
+ ok.
-smp_select(doc) ->
- ["Test concurrent calls to driver_select."];
-smp_select(suite) ->
- [];
+%% Test concurrent calls to driver_select.
smp_select(Config) when is_list(Config) ->
case os:type() of
- {win32,_} -> {skipped, "Test not implemented for this OS"};
- _ -> smp_select0(Config)
+ {win32,_} -> {skipped, "Test not implemented for this OS"};
+ _ -> smp_select0(Config)
end.
-
+
smp_select0(Config) ->
- ?line DrvName = 'chkio_drv',
- Path = ?config(data_dir, Config),
+ DrvName = 'chkio_drv',
+ Path = proplists:get_value(data_dir, Config),
erl_ddll:start(),
- ?line ok = load_driver(Path, DrvName),
+ ok = load_driver(Path, DrvName),
Master = self(),
ProcFun = fun()-> io:format("Worker ~p starting\n",[self()]),
- ?line Port = open_port({spawn, DrvName}, []),
- smp_select_loop(Port, 100000),
- sleep(1000), % wait for driver to handle pending events
- ?line true = erlang:port_close(Port),
- Master ! {ok,self()},
- io:format("Worker ~p finished\n",[self()])
- end,
- ?line Pids = lists:map(fun(_) -> spawn_link(ProcFun) end,
- lists:seq(1,4)),
+ Port = open_port({spawn, DrvName}, []),
+ smp_select_loop(Port, 100000),
+ sleep(1000), % wait for driver to handle pending events
+ true = erlang:port_close(Port),
+ Master ! {ok,self()},
+ io:format("Worker ~p finished\n",[self()])
+ end,
+ Pids = lists:map(fun(_) -> spawn_link(ProcFun) end,
+ lists:seq(1,4)),
TimeoutMsg = make_ref(),
{ok,TRef} = timer:send_after(5*1000, TimeoutMsg), % Limit test duration on slow machines
smp_select_wait(Pids, TimeoutMsg),
timer:cancel(TRef),
- ?line ok = erl_ddll:unload_driver(DrvName),
- ?line ok = erl_ddll:stop(),
+ ok = erl_ddll:unload_driver(DrvName),
+ ok = erl_ddll:stop(),
ok.
smp_select_loop(_, 0) ->
ok;
smp_select_loop(Port, N) ->
- ?line "ok" = erlang:port_control(Port, ?CHKIO_SMP_SELECT, []),
+ "ok" = erlang:port_control(Port, ?CHKIO_SMP_SELECT, []),
receive
- stop ->
- io:format("Worker ~p stopped with ~p laps left\n",[self(), N]),
- ok
+ stop ->
+ io:format("Worker ~p stopped with ~p laps left\n",[self(), N]),
+ ok
after 0 ->
- smp_select_loop(Port, N-1)
+ smp_select_loop(Port, N-1)
end.
smp_select_wait([], _) ->
ok;
smp_select_wait(Pids, TimeoutMsg) ->
receive
- {ok,Pid} when is_pid(Pid) ->
- smp_select_wait(lists:delete(Pid,Pids), TimeoutMsg);
- TimeoutMsg ->
- lists:foreach(fun(Pid)-> Pid ! stop end,
- Pids),
- smp_select_wait(Pids, TimeoutMsg)
+ {ok,Pid} when is_pid(Pid) ->
+ smp_select_wait(lists:delete(Pid,Pids), TimeoutMsg);
+ TimeoutMsg ->
+ lists:foreach(fun(Pid)-> Pid ! stop end,
+ Pids),
+ smp_select_wait(Pids, TimeoutMsg)
end.
-driver_select_use(doc) ->
- ["Test driver_select() with new ERL_DRV_USE flag."];
-driver_select_use(suite) ->
- [];
+%% Test driver_select() with new ERL_DRV_USE flag.
driver_select_use(Config) when is_list(Config) ->
case os:type() of
- {win32,_} -> {skipped, "Test not implemented for this OS"};
- _ -> driver_select_use0(Config)
+ {win32,_} -> {skipped, "Test not implemented for this OS"};
+ _ -> driver_select_use0(Config)
end.
-
+
driver_select_use0(Config) ->
- ?line DrvName = 'chkio_drv',
- Path = ?config(data_dir, Config),
+ DrvName = 'chkio_drv',
+ Path = proplists:get_value(data_dir, Config),
erl_ddll:start(),
- ?line ok = load_driver(Path, DrvName),
- ?line Port = open_port({spawn, DrvName}, []),
- ?line "ok" = erlang:port_control(Port, ?CHKIO_DRV_USE, []),
- ?line {Port,{data,"TheEnd"}} = receive Msg -> Msg
- after 10000 -> timeout end,
- ?line true = erlang:port_close(Port),
- ?line ok = erl_ddll:unload_driver(DrvName),
- ?line ok = erl_ddll:stop(),
+ ok = load_driver(Path, DrvName),
+ Port = open_port({spawn, DrvName}, []),
+ "ok" = erlang:port_control(Port, ?CHKIO_DRV_USE, []),
+ {Port,{data,"TheEnd"}} = receive Msg -> Msg
+ after 10000 -> timeout end,
+ true = erlang:port_close(Port),
+ ok = erl_ddll:unload_driver(DrvName),
+ ok = erl_ddll:stop(),
ok.
thread_mseg_alloc_cache_clean(Config) when is_list(Config) ->
case {erlang:system_info(threads),
- erlang:system_info({allocator,mseg_alloc}),
- driver_alloc_sbct()} of
- {_, false, _} ->
- ?line {skipped, "No mseg_alloc"};
- {false, _, _} ->
- ?line {skipped, "No threads"};
- {_, _, false} ->
- ?line {skipped, "driver_alloc() not using the alloc_util framework"};
- {_, _, SBCT} when is_integer(SBCT), SBCT > 10*1024*1024 ->
- ?line {skipped, "driver_alloc() using too large single block threshold"};
- {_, _, 0} ->
- ?line {skipped, "driver_alloc() using too low single block threshold"};
- {true, _MsegAllocInfo, SBCT} ->
- ?line DrvName = 'thr_alloc_drv',
- ?line Path = ?config(data_dir, Config),
- ?line erl_ddll:start(),
- ?line ok = load_driver(Path, DrvName),
- ?line Port = open_port({spawn, DrvName}, []),
- ?line CCI = 1000,
- ?line ?t:format("CCI = ~p~n", [CCI]),
- ?line CCC = mseg_alloc_ccc(),
- ?line ?t:format("CCC = ~p~n", [CCC]),
- ?line thread_mseg_alloc_cache_clean_test(Port,
- 10,
- CCI,
- SBCT+100),
- ?line true = erlang:port_close(Port),
- ?line ok = erl_ddll:unload_driver(DrvName),
- ?line ok = erl_ddll:stop(),
- ?line ok
+ erlang:system_info({allocator,mseg_alloc}),
+ driver_alloc_sbct()} of
+ {_, false, _} ->
+ {skipped, "No mseg_alloc"};
+ {false, _, _} ->
+ {skipped, "No threads"};
+ {_, _, false} ->
+ {skipped, "driver_alloc() not using the alloc_util framework"};
+ {_, _, SBCT} when is_integer(SBCT), SBCT > 10*1024*1024 ->
+ {skipped, "driver_alloc() using too large single block threshold"};
+ {_, _, 0} ->
+ {skipped, "driver_alloc() using too low single block threshold"};
+ {true, _MsegAllocInfo, SBCT} ->
+ DrvName = 'thr_alloc_drv',
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
+ ok = load_driver(Path, DrvName),
+ Port = open_port({spawn, DrvName}, []),
+ CCI = 1000,
+ io:format("CCI = ~p~n", [CCI]),
+ CCC = mseg_alloc_ccc(),
+ io:format("CCC = ~p~n", [CCC]),
+ thread_mseg_alloc_cache_clean_test(Port,
+ 10,
+ CCI,
+ SBCT+100),
+ true = erlang:port_close(Port),
+ ok = erl_ddll:unload_driver(DrvName),
+ ok = erl_ddll:stop(),
+ ok
end.
mseg_alloc_cci(MsegAllocInfo) ->
- ?line {value,{options, OL}}
- = lists:keysearch(options, 1, MsegAllocInfo),
- ?line {value,{cci,CCI}} = lists:keysearch(cci,1,OL),
- ?line CCI.
+ {value,{options, OL}}
+ = lists:keysearch(options, 1, MsegAllocInfo),
+ {value,{cci,CCI}} = lists:keysearch(cci,1,OL),
+ CCI.
mseg_alloc_ccc() ->
mseg_alloc_ccc(mseg_inst_info(0)).
mseg_alloc_ccc(MsegAllocInfo) ->
- ?line {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo),
- ?line {value,{calls, CL}} = lists:keysearch(calls, 1, MKL),
- ?line {value,{mseg_check_cache, GigaCCC, CCC}}
- = lists:keysearch(mseg_check_cache, 1, CL),
- ?line GigaCCC*1000000000 + CCC.
+ {value,{memkind, MKL}} = lists:keysearch(memkind,1,MsegAllocInfo),
+ {value,{calls, CL}} = lists:keysearch(calls, 1, MKL),
+ {value,{mseg_check_cache, GigaCCC, CCC}}
+ = lists:keysearch(mseg_check_cache, 1, CL),
+ GigaCCC*1000000000 + CCC.
mseg_alloc_cached_segments() ->
mseg_alloc_cached_segments(mseg_inst_info(0)).
mseg_alloc_cached_segments(MsegAllocInfo) ->
- MemName = case is_halfword_vm() of
- true -> "high memory";
- false -> "all memory"
- end,
- ?line [{memkind,DrvMem}]
- = lists:filter(fun(E) -> case E of
- {memkind, [{name, MemName} | _]} -> true;
- _ -> false
- end end, MsegAllocInfo),
- ?line {value,{status, SL}}
- = lists:keysearch(status, 1, DrvMem),
- ?line {value,{cached_segments, CS}}
- = lists:keysearch(cached_segments, 1, SL),
- ?line CS.
+ MemName = "all memory",
+ [{memkind,DrvMem}]
+ = lists:filter(fun(E) -> case E of
+ {memkind, [{name, MemName} | _]} -> true;
+ _ -> false
+ end end, MsegAllocInfo),
+ {value,{status, SL}}
+ = lists:keysearch(status, 1, DrvMem),
+ {value,{cached_segments, CS}}
+ = lists:keysearch(cached_segments, 1, SL),
+ CS.
mseg_inst_info(I) ->
{value, {instance, I, Value}}
- = lists:keysearch(I,
- 2,
- erlang:system_info({allocator,mseg_alloc})),
+ = lists:keysearch(I,
+ 2,
+ erlang:system_info({allocator,mseg_alloc})),
Value.
-is_halfword_vm() ->
- case {erlang:system_info({wordsize, internal}),
- erlang:system_info({wordsize, external})} of
- {4, 8} -> true;
- {WS, WS} -> false
- end.
-
driver_alloc_sbct() ->
{_, _, _, As} = erlang:system_info(allocator),
case lists:keysearch(driver_alloc, 1, As) of
- {value,{driver_alloc,DAOPTs}} ->
- case lists:keysearch(sbct, 1, DAOPTs) of
- {value,{sbct,SBCT}} ->
- SBCT;
- _ ->
- false
- end;
- _ ->
- false
+ {value,{driver_alloc,DAOPTs}} ->
+ case lists:keysearch(sbct, 1, DAOPTs) of
+ {value,{sbct,SBCT}} ->
+ SBCT;
+ _ ->
+ false
+ end;
+ _ ->
+ false
end.
thread_mseg_alloc_cache_clean_test(_Port, 0, _CCI, _Size) ->
- ?line ok;
+ ok;
thread_mseg_alloc_cache_clean_test(Port, N, CCI, Size) ->
- ?line wait_until(fun () -> 0 == mseg_alloc_cached_segments() end),
- ?line receive after CCI+500 -> ok end,
- ?line OCCC = mseg_alloc_ccc(),
- ?line "ok" = erlang:port_control(Port, 0, integer_to_list(Size)),
- ?line receive after CCI+500 -> ok end,
- ?line CCC = mseg_alloc_ccc(),
- ?line ?t:format("CCC = ~p~n", [CCC]),
- ?line true = CCC > OCCC,
- ?line thread_mseg_alloc_cache_clean_test(Port, N-1, CCI, Size).
+ wait_until(fun () -> 0 == mseg_alloc_cached_segments() end),
+ receive after CCI+500 -> ok end,
+ OCCC = mseg_alloc_ccc(),
+ "ok" = erlang:port_control(Port, 0, integer_to_list(Size)),
+ receive after CCI+500 -> ok end,
+ CCC = mseg_alloc_ccc(),
+ io:format("CCC = ~p~n", [CCC]),
+ true = CCC > OCCC,
+ thread_mseg_alloc_cache_clean_test(Port, N-1, CCI, Size).
otp_9302(Config) when is_list(Config) ->
- ?line Path = ?config(data_dir, Config),
- ?line erl_ddll:start(),
- ?line ok = load_driver(Path, otp_9302_drv),
- ?line Port = open_port({spawn, otp_9302_drv}, []),
- ?line true = is_port(Port),
- ?line port_command(Port, ""),
- ?line {msg, block} = get_port_msg(Port, infinity),
- ?line {msg, job} = get_port_msg(Port, infinity),
- ?line C = case erlang:system_info(thread_pool_size) of
- 0 ->
- ?line {msg, cancel} = get_port_msg(Port, infinity),
- ?line {msg, job} = get_port_msg(Port, infinity),
- ?line false;
- _ ->
- case get_port_msg(Port, infinity) of
- {msg, cancel} -> %% Cancel always fail in Rel >= 15
- ?line {msg, job} = get_port_msg(Port, infinity),
- ?line false;
- {msg, job} ->
- ?line ok,
- ?line true
- end
- end,
- ?line {msg, end_of_jobs} = get_port_msg(Port, infinity),
- ?line no_msg = get_port_msg(Port, 2000),
- ?line port_close(Port),
- ?line case C of
- true ->
- ?line {comment, "Async job cancelled"};
- false ->
- ?line {comment, "Async job not cancelled"}
- end.
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
+ ok = load_driver(Path, otp_9302_drv),
+ Port = open_port({spawn, otp_9302_drv}, []),
+ true = is_port(Port),
+ port_command(Port, ""),
+ {msg, block} = get_port_msg(Port, infinity),
+ {msg, job} = get_port_msg(Port, infinity),
+ C = case erlang:system_info(thread_pool_size) of
+ 0 ->
+ {msg, cancel} = get_port_msg(Port, infinity),
+ {msg, job} = get_port_msg(Port, infinity),
+ false;
+ _ ->
+ case get_port_msg(Port, infinity) of
+ {msg, cancel} -> %% Cancel always fail in Rel >= 15
+ {msg, job} = get_port_msg(Port, infinity),
+ false;
+ {msg, job} ->
+ ok,
+ true
+ end
+ end,
+ {msg, end_of_jobs} = get_port_msg(Port, infinity),
+ no_msg = get_port_msg(Port, 2000),
+ port_close(Port),
+ case C of
+ true ->
+ {comment, "Async job cancelled"};
+ false ->
+ {comment, "Async job not cancelled"}
+ end.
thr_free_drv(Config) when is_list(Config) ->
case erlang:system_info(threads) of
- false ->
- {skipped, "No thread support"};
- true ->
- thr_free_drv_do(Config)
+ false ->
+ {skipped, "No thread support"};
+ true ->
+ thr_free_drv_do(Config)
end.
thr_free_drv_do(Config) ->
- ?line Path = ?config(data_dir, Config),
- ?line erl_ddll:start(),
- ?line ok = load_driver(Path, thr_free_drv),
- ?line MemBefore = driver_alloc_size(),
-% io:format("SID=~p", [erlang:system_info(scheduler_id)]),
- ?line Port = open_port({spawn, thr_free_drv}, []),
- ?line MemPeek = driver_alloc_size(),
- ?line true = is_port(Port),
- ?line ok = thr_free_drv_control(Port, 0),
- ?line port_close(Port),
- ?line MemAfter = driver_alloc_size(),
- ?line io:format("MemPeek=~p~n", [MemPeek]),
- ?line io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]),
- ?line MemBefore = MemAfter,
- ?line case MemPeek of
- undefined -> ok;
- _ ->
- ?line true = MemPeek > MemBefore
- end,
- ?line ok.
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
+ ok = load_driver(Path, thr_free_drv),
+ MemBefore = driver_alloc_size(),
+ % io:format("SID=~p", [erlang:system_info(scheduler_id)]),
+ Port = open_port({spawn, thr_free_drv}, []),
+ MemPeek = driver_alloc_size(),
+ true = is_port(Port),
+ ok = thr_free_drv_control(Port, 0),
+ port_close(Port),
+ MemAfter = driver_alloc_size(),
+ io:format("MemPeek=~p~n", [MemPeek]),
+ io:format("MemBefore=~p, MemAfter=~p~n", [MemBefore, MemAfter]),
+ MemBefore = MemAfter,
+ case MemPeek of
+ undefined -> ok;
+ _ ->
+ true = MemPeek > MemBefore
+ end,
+ ok.
thr_free_drv_control(Port, N) ->
case erlang:port_control(Port, 0, "") of
- "done" ->
- ok;
- "more" ->
- erlang:yield(),
-% io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]),
- thr_free_drv_control(Port, N+1)
+ "done" ->
+ ok;
+ "more" ->
+ erlang:yield(),
+ % io:format("N=~p, SID=~p", [N, erlang:system_info(scheduler_id)]),
+ thr_free_drv_control(Port, N+1)
end.
-
+
async_blast(Config) when is_list(Config) ->
- ?line Path = ?config(data_dir, Config),
- ?line erl_ddll:start(),
- ?line ok = load_driver(Path, async_blast_drv),
- ?line SchedOnln = erlang:system_info(schedulers_online),
- ?line MemBefore = driver_alloc_size(),
- ?line Start = os:timestamp(),
- ?line Blast = fun () ->
- Port = open_port({spawn, async_blast_drv}, []),
- true = is_port(Port),
- port_command(Port, ""),
- receive
- {Port, done} ->
- ok
- end,
- port_close(Port)
- end,
- ?line Ps = lists:map(fun (N) ->
- spawn_opt(Blast,
- [{scheduler,
- (N rem SchedOnln)+ 1},
- monitor])
- end,
- lists:seq(1, 100)),
- ?line MemMid = driver_alloc_size(),
- ?line lists:foreach(fun ({Pid, Mon}) ->
- receive
- {'DOWN',Mon,process,Pid,_} -> ok
- end
- end, Ps),
- ?line End = os:timestamp(),
- ?line MemAfter = driver_alloc_size(),
- ?line io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n",
- [MemBefore, MemMid, MemAfter]),
- ?line AsyncBlastTime = timer:now_diff(End,Start)/1000000,
- ?line io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]),
- ?line MemBefore = MemAfter,
- ?line erlang:display({async_blast_time, AsyncBlastTime}),
- ?line ok.
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
+ ok = load_driver(Path, async_blast_drv),
+ SchedOnln = erlang:system_info(schedulers_online),
+ MemBefore = driver_alloc_size(),
+ Start = os:timestamp(),
+ Blast = fun () ->
+ Port = open_port({spawn, async_blast_drv}, []),
+ true = is_port(Port),
+ port_command(Port, ""),
+ receive
+ {Port, done} ->
+ ok
+ end,
+ port_close(Port)
+ end,
+ Ps = lists:map(fun (N) ->
+ spawn_opt(Blast,
+ [{scheduler,
+ (N rem SchedOnln)+ 1},
+ monitor])
+ end,
+ lists:seq(1, 100)),
+ MemMid = driver_alloc_size(),
+ lists:foreach(fun ({Pid, Mon}) ->
+ receive
+ {'DOWN',Mon,process,Pid,_} -> ok
+ end
+ end, Ps),
+ End = os:timestamp(),
+ MemAfter = driver_alloc_size(),
+ io:format("MemBefore=~p, MemMid=~p, MemAfter=~p~n",
+ [MemBefore, MemMid, MemAfter]),
+ AsyncBlastTime = timer:now_diff(End,Start)/1000000,
+ io:format("AsyncBlastTime=~p~n", [AsyncBlastTime]),
+ MemBefore = MemAfter,
+ erlang:display({async_blast_time, AsyncBlastTime}),
+ ok.
thr_msg_blast_receiver(_Port, N, N) ->
ok;
thr_msg_blast_receiver(Port, N, Max) ->
receive
- {Port, hi} ->
- thr_msg_blast_receiver(Port, N+1, Max)
+ {Port, hi} ->
+ thr_msg_blast_receiver(Port, N+1, Max)
end.
thr_msg_blast_receiver_proc(Port, Max, Parent, Done) ->
case port_control(Port, 0, "") of
- "receiver" ->
- spawn(fun () ->
- thr_msg_blast_receiver_proc(Port, Max+1, Parent, Done)
- end),
- thr_msg_blast_receiver(Port, 0, Max);
- "done" ->
- Parent ! Done
+ "receiver" ->
+ spawn(fun () ->
+ thr_msg_blast_receiver_proc(Port, Max+1, Parent, Done)
+ end),
+ thr_msg_blast_receiver(Port, 0, Max);
+ "done" ->
+ Parent ! Done
end.
thr_msg_blast(Config) when is_list(Config) ->
case erlang:system_info(smp_support) of
- false ->
- {skipped, "Non-SMP emulator; nothing to test..."};
- true ->
- Path = ?config(data_dir, Config),
- erl_ddll:start(),
- ok = load_driver(Path, thr_msg_blast_drv),
- MemBefore = driver_alloc_size(),
- Start = os:timestamp(),
- Port = open_port({spawn, thr_msg_blast_drv}, []),
- true = is_port(Port),
- Done = make_ref(),
- Me = self(),
- spawn(fun () ->
- thr_msg_blast_receiver_proc(Port, 1, Me, Done)
- end),
- receive
- Done -> ok
- end,
- ok = thr_msg_blast_receiver(Port, 0, 32*10000),
- port_close(Port),
- End = os:timestamp(),
- receive
- Garbage ->
- ?t:fail({received_garbage, Port, Garbage})
- after 2000 ->
- ok
- end,
- MemAfter = driver_alloc_size(),
- io:format("MemBefore=~p, MemAfter=~p~n",
- [MemBefore, MemAfter]),
- ThrMsgBlastTime = timer:now_diff(End,Start)/1000000,
- io:format("ThrMsgBlastTime=~p~n", [ThrMsgBlastTime]),
- MemBefore = MemAfter,
- Res = {thr_msg_blast_time, ThrMsgBlastTime},
- erlang:display(Res),
- Res
+ false ->
+ {skipped, "Non-SMP emulator; nothing to test..."};
+ true ->
+ Path = proplists:get_value(data_dir, Config),
+ erl_ddll:start(),
+ ok = load_driver(Path, thr_msg_blast_drv),
+ MemBefore = driver_alloc_size(),
+ Start = os:timestamp(),
+ Port = open_port({spawn, thr_msg_blast_drv}, []),
+ true = is_port(Port),
+ Done = make_ref(),
+ Me = self(),
+ spawn(fun () ->
+ thr_msg_blast_receiver_proc(Port, 1, Me, Done)
+ end),
+ receive
+ Done -> ok
+ end,
+ ok = thr_msg_blast_receiver(Port, 0, 32*10000),
+ port_close(Port),
+ End = os:timestamp(),
+ receive
+ Garbage ->
+ ct:fail({received_garbage, Port, Garbage})
+ after 2000 ->
+ ok
+ end,
+ MemAfter = driver_alloc_size(),
+ io:format("MemBefore=~p, MemAfter=~p~n",
+ [MemBefore, MemAfter]),
+ ThrMsgBlastTime = timer:now_diff(End,Start)/1000000,
+ io:format("ThrMsgBlastTime=~p~n", [ThrMsgBlastTime]),
+ MemBefore = MemAfter,
+ Res = {thr_msg_blast_time, ThrMsgBlastTime},
+ erlang:display(Res),
+ Res
end.
-define(IN_RANGE(LoW_, VaLuE_, HiGh_),
- case in_range(LoW_, VaLuE_, HiGh_) of
- true -> ok;
- false ->
- case erlang:system_info(lock_checking) of
- true ->
- ?t:format("~p:~p: Ignore bad sched count due to "
- "lock checking~n",
- [?MODULE,?LINE]);
- false ->
- ?t:fail({unexpected_sched_counts, VaLuE_})
- end
- end).
+ case in_range(LoW_, VaLuE_, HiGh_) of
+ true -> ok;
+ false ->
+ case erlang:system_info(lock_checking) of
+ true ->
+ io:format("~p:~p: Ignore bad sched count due to "
+ "lock checking~n",
+ [?MODULE,?LINE]);
+ false ->
+ ct:fail({unexpected_sched_counts, VaLuE_})
+ end
+ end).
consume_timeslice(Config) when is_list(Config) ->
@@ -2150,7 +2037,7 @@ consume_timeslice(Config) when is_list(Config) ->
%% the port instead.
%%
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
erl_ddll:start(),
ok = load_driver(Path, consume_timeslice_drv),
Port = open_port({spawn, consume_timeslice_drv}, [{parallelism, false}]),
@@ -2160,18 +2047,18 @@ consume_timeslice(Config) when is_list(Config) ->
"enabled" = port_control(Port, $E, ""),
Proc1 = spawn_link(fun () ->
- receive Go -> ok end,
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}}
- end),
+ receive Go -> ok end,
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}}
+ end),
receive after 100 -> ok end,
count_pp_sched_start(),
Proc1 ! Go,
@@ -2182,18 +2069,18 @@ consume_timeslice(Config) when is_list(Config) ->
"disabled" = port_control(Port, $D, ""),
Proc2 = spawn_link(fun () ->
- receive Go -> ok end,
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}},
- Port ! {Parent, {command, ""}}
- end),
+ receive Go -> ok end,
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}},
+ Port ! {Parent, {command, ""}}
+ end),
receive after 100 -> ok end,
count_pp_sched_start(),
Proc2 ! Go,
@@ -2204,18 +2091,18 @@ consume_timeslice(Config) when is_list(Config) ->
"enabled" = port_control(Port, $E, ""),
Proc3 = spawn_link(fun () ->
- receive Go -> ok end,
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, "")
- end),
+ receive Go -> ok end,
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, "")
+ end),
count_pp_sched_start(),
Proc3 ! Go,
wait_command_msgs(Port, 10),
@@ -2225,18 +2112,18 @@ consume_timeslice(Config) when is_list(Config) ->
"disabled" = port_control(Port, $D, ""),
Proc4 = spawn_link(fun () ->
- receive Go -> ok end,
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, ""),
- port_command(Port, "")
- end),
+ receive Go -> ok end,
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, ""),
+ port_command(Port, "")
+ end),
count_pp_sched_start(),
Proc4 ! Go,
wait_command_msgs(Port, 10),
@@ -2248,43 +2135,43 @@ consume_timeslice(Config) when is_list(Config) ->
%% If only one scheduler use port with parallelism set to true,
%% in order to trigger scheduling of command signals
Port2 = case SOnl of
- 1 ->
- Port ! {self(), close},
- receive {Port, closed} -> ok end,
- open_port({spawn, consume_timeslice_drv},
- [{parallelism, true}]);
- _ ->
- process_flag(scheduler, 1),
- 1 = erlang:system_info(scheduler_id),
- Port
- end,
+ 1 ->
+ Port ! {self(), close},
+ receive {Port, closed} -> ok end,
+ open_port({spawn, consume_timeslice_drv},
+ [{parallelism, true}]);
+ _ ->
+ process_flag(scheduler, 1),
+ 1 = erlang:system_info(scheduler_id),
+ Port
+ end,
count_pp_sched_start(),
"enabled" = port_control(Port2, $E, ""),
W5 = case SOnl of
- 1 ->
- false;
- _ ->
- W1= spawn_opt(fun () ->
- 2 = erlang:system_info(scheduler_id),
- "sleeped" = port_control(Port2, $S, "")
- end, [link,{scheduler,2}]),
- receive after 100 -> ok end,
- W1
- end,
+ 1 ->
+ false;
+ _ ->
+ W1= spawn_opt(fun () ->
+ 2 = erlang:system_info(scheduler_id),
+ "sleeped" = port_control(Port2, $S, "")
+ end, [link,{scheduler,2}]),
+ receive after 100 -> ok end,
+ W1
+ end,
Proc5 = spawn_opt(fun () ->
- receive Go -> ok end,
- 1 = erlang:system_info(scheduler_id),
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}}
- end, [link,{scheduler,1}]),
+ receive Go -> ok end,
+ 1 = erlang:system_info(scheduler_id),
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}}
+ end, [link,{scheduler,1}]),
receive after 100 -> ok end,
Proc5 ! Go,
wait_procs_exit([W5, Proc5]),
@@ -2292,34 +2179,34 @@ consume_timeslice(Config) when is_list(Config) ->
[{Port2, Sprt5}, {Proc5, Sproc5}] = count_pp_sched_stop([Port2, Proc5]),
?IN_RANGE(2, Sproc5, 3),
?IN_RANGE(6, Sprt5, 20),
-
+
count_pp_sched_start(),
"disabled" = port_control(Port2, $D, ""),
W6 = case SOnl of
- 1 ->
- false;
- _ ->
- W2= spawn_opt(fun () ->
- 2 = erlang:system_info(scheduler_id),
- "sleeped" = port_control(Port2, $S, "")
- end, [link,{scheduler,2}]),
- receive after 100 -> ok end,
- W2
- end,
+ 1 ->
+ false;
+ _ ->
+ W2= spawn_opt(fun () ->
+ 2 = erlang:system_info(scheduler_id),
+ "sleeped" = port_control(Port2, $S, "")
+ end, [link,{scheduler,2}]),
+ receive after 100 -> ok end,
+ W2
+ end,
Proc6 = spawn_opt(fun () ->
- receive Go -> ok end,
- 1 = erlang:system_info(scheduler_id),
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}},
- Port2 ! {Parent, {command, ""}}
- end, [link,{scheduler,1}]),
+ receive Go -> ok end,
+ 1 = erlang:system_info(scheduler_id),
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}},
+ Port2 ! {Parent, {command, ""}}
+ end, [link,{scheduler,1}]),
receive after 100 -> ok end,
Proc6 ! Go,
wait_procs_exit([W6, Proc6]),
@@ -2339,19 +2226,19 @@ wait_command_msgs(_, 0) ->
ok;
wait_command_msgs(Port, N) ->
receive
- {Port, command} ->
- wait_command_msgs(Port, N-1)
+ {Port, command} ->
+ wait_command_msgs(Port, N-1)
end.
in_range(Low, Val, High) when is_integer(Low),
- is_integer(Val),
- is_integer(High),
- Low =< Val,
- Val =< High ->
+ is_integer(Val),
+ is_integer(High),
+ Low =< Val,
+ Val =< High ->
true;
in_range(Low, Val, High) when is_integer(Low),
- is_integer(Val),
- is_integer(High) ->
+ is_integer(Val),
+ is_integer(High) ->
false.
count_pp_sched_start() ->
@@ -2364,7 +2251,7 @@ count_pp_sched_stop(Ps) ->
PNs = lists:map(fun (P) -> {P, 0} end, Ps),
receive {trace_delivered, all, Td} -> ok end,
Res = count_proc_sched(Ps, PNs),
- ?t:format("Scheduling counts: ~p~n", [Res]),
+ io:format("Scheduling counts: ~p~n", [Res]),
erlang:display({scheduling_counts, Res}),
Res.
@@ -2377,22 +2264,22 @@ do_inc_pn(P, [PN|PNs]) ->
inc_pn(P, PNs) ->
try
- do_inc_pn(P, PNs)
+ do_inc_pn(P, PNs)
catch
- throw:undefined -> PNs
+ throw:undefined -> PNs
end.
count_proc_sched(Ps, PNs) ->
receive
- TT when element(1, TT) == trace, element(3, TT) == in ->
-% erlang:display(TT),
- count_proc_sched(Ps, inc_pn(element(2, TT), PNs));
- TT when element(1, TT) == trace, element(3, TT) == out ->
- count_proc_sched(Ps, PNs)
+ TT when element(1, TT) == trace, element(3, TT) == in ->
+ % erlang:display(TT),
+ count_proc_sched(Ps, inc_pn(element(2, TT), PNs));
+ TT when element(1, TT) == trace, element(3, TT) == out ->
+ count_proc_sched(Ps, PNs)
after 0 ->
- PNs
+ PNs
end.
-
+
a_test(Config) when is_list(Config) ->
check_io_debug().
@@ -2405,13 +2292,35 @@ z_test(Config) when is_list(Config) ->
check_io_debug() ->
get_stable_check_io_info(),
- {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs}
- = erts_debug:get_internal_state(check_io_debug),
+ {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug
+ = erts_debug:get_internal_state(check_io_debug),
+ HasGetHost = has_gethost(),
+ ct:log("check_io_debug: ~p~n"
+ "HasGetHost: ~p",[CheckIoDebug, HasGetHost]),
0 = NoErrorFds,
- NoUsedFds = NoDrvSelStructs,
+ if
+ NoUsedFds == NoDrvSelStructs ->
+ ok;
+ HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) ->
+ %% If the inet_gethost port is alive, we may have
+ %% one extra used fd that is not selected on
+ ok
+ end,
0 = NoDrvEvStructs,
ok.
+has_gethost() ->
+ has_gethost(erlang:ports()).
+has_gethost([P|T]) ->
+ case erlang:port_info(P, name) of
+ {name,"inet_gethost"++_} ->
+ true;
+ _ ->
+ has_gethost(T)
+ end;
+has_gethost([]) ->
+ false.
+
%flush_msgs() ->
% receive
% M ->
@@ -2426,26 +2335,26 @@ wait_procs_exit([]) ->
wait_procs_exit([P|Ps]) when is_pid(P) ->
Mon = erlang:monitor(process, P),
receive
- {'DOWN', Mon, process, P, _} ->
- wait_procs_exit(Ps)
+ {'DOWN', Mon, process, P, _} ->
+ wait_procs_exit(Ps)
end;
wait_procs_exit([_|Ps]) ->
wait_procs_exit(Ps).
get_port_msg(Port, Timeout) ->
receive
- {Port, What} ->
- {msg, What}
+ {Port, What} ->
+ {msg, What}
after Timeout ->
- no_msg
+ no_msg
end.
wait_until(Fun) ->
case Fun() of
- true -> ok;
- false ->
- receive after 100 -> ok end,
- wait_until(Fun)
+ true -> ok;
+ false ->
+ receive after 100 -> ok end,
+ wait_until(Fun)
end.
drv_vsn_str2tup(Str) ->
@@ -2476,11 +2385,11 @@ transform_bins(_Transform, Other) -> Other.
make_sub_binaries(Term) ->
MakeSub = fun(Bin0) ->
- Bin1 = <<243:8,0:3,Bin0/binary,31:5,19:8>>,
- Sz = size(Bin0),
- <<243:8,0:3,Bin:Sz/binary,31:5,19:8>> = id(Bin1),
- Bin
- end,
+ Bin1 = <<243:8,0:3,Bin0/binary,31:5,19:8>>,
+ Sz = size(Bin0),
+ <<243:8,0:3,Bin:Sz/binary,31:5,19:8>> = id(Bin1),
+ Bin
+ end,
transform_bins(MakeSub, Term).
id(I) -> I.
@@ -2512,14 +2421,7 @@ random_char() ->
uniform(256) - 1.
uniform(N) ->
- case get(random_seed) of
- undefined ->
- {X, Y, Z} = time(),
- random:seed(X, Y, Z);
- _ ->
- ok
- end,
- random:uniform(N).
+ rand:uniform(N).
erl_millisecs() ->
erl_millisecs(erlang:monotonic_time()).
@@ -2529,7 +2431,7 @@ erl_millisecs(MonotonicTime) ->
%% Start/stop drivers.
start_driver(Config, Name, Binary) ->
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
erl_ddll:start(),
%% Load the driver
@@ -2537,31 +2439,31 @@ start_driver(Config, Name, Binary) ->
%% open port.
case Binary of
- true ->
- open_port({spawn, Name}, [binary]);
- false ->
- open_port({spawn, Name}, [])
+ true ->
+ open_port({spawn, Name}, [binary]);
+ false ->
+ open_port({spawn, Name}, [])
end.
stop_driver(Port, Name) ->
- ?line true = erlang:port_close(Port),
+ true = erlang:port_close(Port),
receive
- {Port,Message} ->
- ?t:fail({strange_message_from_port,Message})
+ {Port,Message} ->
+ ct:fail({strange_message_from_port,Message})
after 0 ->
- ok
+ ok
end,
%% Unload the driver.
ok = erl_ddll:unload_driver(Name),
- ?line ok = erl_ddll:stop().
+ ok = erl_ddll:stop().
load_driver(Dir, Driver) ->
case erl_ddll:load_driver(Dir, Driver) of
- ok -> ok;
- {error, Error} = Res ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- Res
+ ok -> ok;
+ {error, Error} = Res ->
+ io:format("~s\n", [erl_ddll:format_error(Error)]),
+ Res
end.
sleep() ->
@@ -2576,50 +2478,50 @@ sleep(Ms) when is_integer(Ms), Ms >= 0 ->
start_node(Config) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
- ++ "-"
- ++ integer_to_list(erlang:unique_integer([positive]))),
- ?t:start_node(Name, slave, [{args, "-pa "++Pa}]).
+ ++ "-"
+ ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ test_server:start_node(Name, slave, [{args, "-pa "++Pa}]).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
wait_deallocations() ->
try
- erts_debug:set_internal_state(wait, deallocations)
+ erts_debug:set_internal_state(wait, deallocations)
catch error:undef ->
- erts_debug:set_internal_state(available_internal_state, true),
- wait_deallocations()
+ erts_debug:set_internal_state(available_internal_state, true),
+ wait_deallocations()
end.
driver_alloc_size() ->
case erlang:system_info(smp_support) of
- true ->
- ok;
- false ->
- %% driver_alloc also used by elements in lock-free queues,
- %% give these some time to be deallocated...
- receive after 100 -> ok end
+ true ->
+ ok;
+ false ->
+ %% driver_alloc also used by elements in lock-free queues,
+ %% give these some time to be deallocated...
+ receive after 100 -> ok end
end,
wait_deallocations(),
case erlang:system_info({allocator_sizes, driver_alloc}) of
- false ->
- undefined;
- MemInfo ->
- CS = lists:foldl(
- fun ({instance, _, L}, Acc) ->
- {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
- {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
- [MBCS,SBCS | Acc]
- end,
- [],
- MemInfo),
- lists:foldl(
- fun(L, Sz0) ->
- {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L),
- Sz0+Sz
- end, 0, CS)
+ false ->
+ undefined;
+ MemInfo ->
+ CS = lists:foldl(
+ fun ({instance, _, L}, Acc) ->
+ {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
+ {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
+ [MBCS,SBCS | Acc]
+ end,
+ [],
+ MemInfo),
+ lists:foldl(
+ fun(L, Sz0) ->
+ {value,{_,Sz,_,_}} = lists:keysearch(blocks_size, 1, L),
+ Sz0+Sz
+ end, 0, CS)
end.
diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl
index 4d8d89db9b..cefa35a3ee 100644
--- a/erts/emulator/test/efile_SUITE.erl
+++ b/erts/emulator/test/efile_SUITE.erl
@@ -18,34 +18,18 @@
%% %CopyrightEnd%
-module(efile_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
+-export([all/0, suite/0]).
-export([iter_max_files/1, async_dist/1]).
-export([do_iter_max_files/2, do_async_dist/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[iter_max_files, async_dist].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
do_async_dist(Dir) ->
X = 100,
AT = erlang:system_info(thread_pool_size),
@@ -70,59 +54,58 @@ file_keys(Dir,Num,FdList,FnList) ->
Name = "dummy"++integer_to_list(Num),
FN = filename:join([Dir,Name]),
case file:open(FN,[write,raw]) of
- {ok,FD} ->
- {file_descriptor,prim_file,{Port,_}} = FD,
- <<X:32/integer-big>> =
- iolist_to_binary(erlang:port_control(Port,$K,[])),
- [X | file_keys(Dir,Num-1,[FD|FdList],[FN|FnList])];
- {error,_} ->
- % Try freeing up FD's if there are any
- case FdList of
- [] ->
- exit({cannot_open_file,FN});
- _ ->
- [ file:close(FD) || FD <- FdList ],
- [ file:delete(F) || F <- FnList ],
- file_keys(Dir,Num,[],[])
- end
+ {ok,FD} ->
+ {file_descriptor,prim_file,{Port,_}} = FD,
+ <<X:32/integer-big>> =
+ iolist_to_binary(erlang:port_control(Port,$K,[])),
+ [X | file_keys(Dir,Num-1,[FD|FdList],[FN|FnList])];
+ {error,_} ->
+ % Try freeing up FD's if there are any
+ case FdList of
+ [] ->
+ exit({cannot_open_file,FN});
+ _ ->
+ [ file:close(FD) || FD <- FdList ],
+ [ file:delete(F) || F <- FnList ],
+ file_keys(Dir,Num,[],[])
+ end
end.
-async_dist(doc) ->
- "Check that the distribution of files over async threads is fair";
+%% Check that the distribution of files over async threads is fair
async_dist(Config) when is_list(Config) ->
- DataDir = ?config(data_dir,Config),
+ DataDir = proplists:get_value(data_dir,Config),
TestFile = filename:join(DataDir, "existing_file"),
Dir = filename:dirname(code:which(?MODULE)),
AsyncSizes = [7,10,100,255,256,64,63,65],
Max = 0.5,
lists:foreach(fun(Size) ->
- {ok,Node} =
- test_server:start_node
- (test_iter_max_files,slave,
- [{args,
- "+A "++integer_to_list(Size)++
- " -pa " ++ Dir}]),
- {Distr,SD} = rpc:call(Node,?MODULE,do_async_dist,
- [DataDir]),
- test_server:stop_node(Node),
- if
- SD > Max ->
- io:format("Bad async queue distribution for "
- "~p async threads:~n"
- " Standard deviation is ~p~n"
- " Key distribution:~n ~lp~n",
- [Size,SD,Distr]),
- exit({bad_async_dist,Size,SD,Distr});
- true ->
- io:format("OK async queue distribution for "
- "~p async threads:~n"
- " Standard deviation is ~p~n"
- " Key distribution:~n ~lp~n",
- [Size,SD,Distr]),
- ok
- end
- end, AsyncSizes),
+ {ok,Node} =
+ test_server:start_node
+ (test_iter_max_files,slave,
+ [{args,
+ "+A "++integer_to_list(Size)++
+ " -pa " ++ Dir}]),
+ {Distr,SD} = rpc:call(Node,?MODULE,do_async_dist,
+ [DataDir]),
+ test_server:stop_node(Node),
+ if
+ SD > Max ->
+ io:format("Bad async queue distribution for "
+ "~p async threads:~n"
+ " Standard deviation is ~p~n"
+ " Key distribution:~n ~lp~n",
+ [Size,SD,Distr]),
+ exit({bad_async_dist,Size,SD,Distr});
+ true ->
+ io:format("OK async queue distribution for "
+ "~p async threads:~n"
+ " Standard deviation is ~p~n"
+ " Key distribution:~n ~lp~n",
+ [Size,SD,Distr]),
+ ok
+ end
+ end, AsyncSizes),
ok.
%%
@@ -130,54 +113,53 @@ async_dist(Config) when is_list(Config) ->
%% that we get the same number of files every time.
%%
-iter_max_files(suite) -> [];
iter_max_files(Config) when is_list(Config) ->
- DataDir = ?config(data_dir,Config),
+ DataDir = proplists:get_value(data_dir,Config),
TestFile = filename:join(DataDir, "existing_file"),
N = 10,
%% Run on a different node in order to set the max ports
Dir = filename:dirname(code:which(?MODULE)),
{ok,Node} = test_server:start_node(test_iter_max_files,slave,
- [{args,"+Q 1524 -pa " ++ Dir}]),
+ [{args,"+Q 1524 -pa " ++ Dir}]),
L = rpc:call(Node,?MODULE,do_iter_max_files,[N, TestFile]),
test_server:stop_node(Node),
io:format("Number of files opened in each test:~n~w\n", [L]),
all_equal(L),
Head = hd(L),
if Head >= 2 -> ok;
- true -> ?line test_server:fail(too_few_files)
+ true -> ct:fail(too_few_files)
end,
{comment, "Max files: " ++ integer_to_list(hd(L))}.
do_iter_max_files(N, Name) when N > 0 ->
- ?line [max_files(Name)| do_iter_max_files(N-1, Name)];
+ [max_files(Name)| do_iter_max_files(N-1, Name)];
do_iter_max_files(_, _) ->
[].
all_equal([E, E| T]) ->
- ?line all_equal([E| T]);
+ all_equal([E| T]);
all_equal([_]) ->
ok;
all_equal([]) ->
ok.
-
+
max_files(Name) ->
- ?line Fds = open_files(Name),
- ?line N = length(Fds),
- ?line close_files(Fds),
+ Fds = open_files(Name),
+ N = length(Fds),
+ close_files(Fds),
N.
close_files([Fd| Fds]) ->
- ?line file:close(Fd),
- ?line close_files(Fds);
+ file:close(Fd),
+ close_files(Fds);
close_files([]) ->
ok.
open_files(Name) ->
- ?line case file:open(Name, [read,raw]) of
- {ok, Fd} ->
- [Fd| open_files(Name)];
- {error, _Reason} ->
-% io:format("Error reason: ~p", [_Reason]),
- []
- end.
+ case file:open(Name, [read,raw]) of
+ {ok, Fd} ->
+ [Fd| open_files(Name)];
+ {error, _Reason} ->
+ % io:format("Error reason: ~p", [_Reason]),
+ []
+ end.
diff --git a/erts/emulator/test/emulator.spec.ose b/erts/emulator/test/emulator.spec.ose
deleted file mode 100644
index 9f494609d9..0000000000
--- a/erts/emulator/test/emulator.spec.ose
+++ /dev/null
@@ -1,2 +0,0 @@
-{topcase, {dir, "../emulator_test"}}.
-{skip, {obsolete_SUITE, "Not on ose"}}.
diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl
index 2cd569ce4f..41a761229c 100644
--- a/erts/emulator/test/erl_drv_thread_SUITE.erl
+++ b/erts/emulator/test/erl_drv_thread_SUITE.erl
@@ -20,12 +20,11 @@
-module(erl_drv_thread_SUITE).
-author('[email protected]').
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
+-export([all/0, suite/0]).
-export([basic/1, rwlock/1, tsd/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(DEFAULT_TIMETRAP_SECS, 240).
@@ -34,38 +33,17 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[basic, rwlock, tsd].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %%
%% Testcases %%
%% %%
-basic(suite) -> [];
-basic(doc) -> [];
-basic(Cfg) -> ?line drv_case(Cfg, basic).
+basic(Cfg) -> drv_case(Cfg, basic).
-rwlock(suite) -> [];
-rwlock(doc) -> [];
-rwlock(Cfg) -> ?line drv_case(Cfg, rwlock).
+rwlock(Cfg) -> drv_case(Cfg, rwlock).
-tsd(suite) -> [];
-tsd(doc) -> [];
-tsd(Cfg) -> ?line drv_case(Cfg, tsd).
+tsd(Cfg) -> drv_case(Cfg, tsd).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% %%
@@ -81,58 +59,54 @@ drv_case(Config, CaseName, Command) when is_list(Command) ->
drv_case(Config, CaseName, Command, ?DEFAULT_TIMETRAP_SECS).
drv_case(Config, CaseName, TimeTrap, Command) when is_list(Command),
- is_integer(TimeTrap) ->
+ is_integer(TimeTrap) ->
drv_case(Config, CaseName, Command, TimeTrap);
drv_case(Config, CaseName, Command, TimeTrap) when is_list(Config),
- is_atom(CaseName),
- is_list(Command),
- is_integer(TimeTrap) ->
- case ?t:os_type() of
- {Family, _} when Family == unix; Family == win32 ->
- ?line run_drv_case(Config, CaseName, Command, TimeTrap);
- SkipOs ->
- ?line {skipped,
- lists:flatten(["Not run on "
- | io_lib:format("~p",[SkipOs])])}
+ is_atom(CaseName),
+ is_list(Command),
+ is_integer(TimeTrap) ->
+ case test_server:os_type() of
+ {Family, _} when Family == unix; Family == win32 ->
+ run_drv_case(Config, CaseName, Command, TimeTrap);
+ SkipOs ->
+ {skipped, lists:flatten(["Not run on " | io_lib:format("~p",[SkipOs])])}
end.
run_drv_case(Config, CaseName, Command, TimeTrap) ->
- ?line Dog = test_server:timetrap(test_server:seconds(TimeTrap)),
- ?line DataDir = ?config(data_dir,Config),
+ ct:timetrap({seconds, TimeTrap}),
+ DataDir = proplists:get_value(data_dir,Config),
case erl_ddll:load_driver(DataDir, CaseName) of
- ok -> ok;
- {error, Error} ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- ?line ?t:fail()
+ ok -> ok;
+ {error, Error} ->
+ ct:fail(erl_ddll:format_error(Error))
+ end,
+ Port = open_port({spawn, atom_to_list(CaseName)}, []),
+ true = is_port(Port),
+ Port ! {self(), {command, Command}},
+ Result = receive_drv_result(Port, CaseName),
+ Port ! {self(), close},
+ receive
+ {Port, closed} ->
+ ok
end,
- ?line Port = open_port({spawn, atom_to_list(CaseName)}, []),
- ?line true = is_port(Port),
- ?line Port ! {self(), {command, Command}},
- ?line Result = receive_drv_result(Port, CaseName),
- ?line Port ! {self(), close},
- ?line receive
- {Port, closed} ->
- ok
- end,
- ?line ok = erl_ddll:unload_driver(CaseName),
- ?line test_server:timetrap_cancel(Dog),
- ?line Result.
+ ok = erl_ddll:unload_driver(CaseName),
+ Result.
receive_drv_result(Port, CaseName) ->
- ?line receive
- {print, Port, CaseName, Str} ->
- ?line ?t:format("~s", [Str]),
- ?line receive_drv_result(Port, CaseName);
- {'EXIT', Port, Error} ->
- ?line ?t:fail(Error);
- {'EXIT', error, Error} ->
- ?line ?t:fail(Error);
- {failed, Port, CaseName, Comment} ->
- ?line ?t:fail(Comment);
- {skipped, Port, CaseName, Comment} ->
- ?line {skipped, Comment};
- {succeeded, Port, CaseName, ""} ->
- ?line succeeded;
- {succeeded, Port, CaseName, Comment} ->
- ?line {comment, Comment}
- end.
+ receive
+ {print, Port, CaseName, Str} ->
+ io:format("~s", [Str]),
+ receive_drv_result(Port, CaseName);
+ {'EXIT', Port, Error} ->
+ ct:fail(Error);
+ {'EXIT', error, Error} ->
+ ct:fail(Error);
+ {failed, Port, CaseName, Comment} ->
+ ct:fail(Comment);
+ {skipped, Port, CaseName, Comment} ->
+ {skipped, Comment};
+ {succeeded, Port, CaseName, ""} ->
+ succeeded;
+ {succeeded, Port, CaseName, Comment} ->
+ {comment, Comment}
+ end.
diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl
index a7a45046ca..56fdfc35c0 100644
--- a/erts/emulator/test/erl_link_SUITE.erl
+++ b/erts/emulator/test/erl_link_SUITE.erl
@@ -29,24 +29,23 @@
-author('[email protected]').
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
+-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]).
% Test cases
-export([links/1,
- dist_links/1,
- monitor_nodes/1,
- process_monitors/1,
- dist_process_monitors/1,
- busy_dist_port_monitor/1,
- busy_dist_port_link/1,
- otp_5772_link/1,
- otp_5772_dist_link/1,
- otp_5772_monitor/1,
- otp_5772_dist_monitor/1,
- otp_7946/1]).
+ dist_links/1,
+ monitor_nodes/1,
+ process_monitors/1,
+ dist_process_monitors/1,
+ busy_dist_port_monitor/1,
+ busy_dist_port_link/1,
+ otp_5772_link/1,
+ otp_5772_dist_link/1,
+ otp_5772_monitor/1,
+ otp_5772_dist_monitor/1,
+ otp_7946/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -65,21 +64,20 @@
-record(erl_link, {type = ?LINK_UNDEF,
- pid = [],
- targets = []}).
+ pid = [],
+ targets = []}).
% This is to be kept in sync with erl_bif_info.c (make_monitor_list)
--record(erl_monitor, {
- type, % MON_ORIGIN or MON_TARGET (1 or 3)
- ref,
- pid, % Process or nodename
- name = [] % registered name or []
- }).
+-record(erl_monitor, {type, % MON_ORIGIN or MON_TARGET (1 or 3)
+ ref,
+ pid, % Process or nodename
+ name = []}). % registered name or []
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
all() ->
[links, dist_links, monitor_nodes, process_monitors,
@@ -87,8 +85,15 @@ all() ->
busy_dist_port_link, otp_5772_link, otp_5772_dist_link,
otp_5772_monitor, otp_5772_dist_monitor, otp_7946].
-groups() ->
- [].
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ case catch erts_debug:get_internal_state(available_internal_state) of
+ true -> ok;
+ _ -> erts_debug:set_internal_state(available_internal_state, true)
+ end,
+ Config.
+
+end_per_testcase(_Func, _Config) ->
+ ok.
init_per_suite(Config) ->
Config.
@@ -96,419 +101,397 @@ init_per_suite(Config) ->
end_per_suite(_Config) ->
catch erts_debug:set_internal_state(available_internal_state, false).
-init_per_group(_GroupName, Config) ->
- Config.
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-links(doc) -> ["Tests node local links"];
-links(suite) -> [];
+%% Tests node local links
links(Config) when is_list(Config) ->
- ?line common_link_test(node(), node()),
- ?line true = link(self()),
- ?line [] = find_erl_link(self(), ?LINK_PID, self()),
- ?line true = unlink(self()),
- ?line ok.
-
-dist_links(doc) -> ["Tests distributed links"];
-dist_links(suite) -> [];
+ common_link_test(node(), node()),
+ true = link(self()),
+ [] = find_erl_link(self(), ?LINK_PID, self()),
+ true = unlink(self()),
+ ok.
+
+%% Tests distributed links
dist_links(Config) when is_list(Config) ->
- ?line [NodeName] = get_names(1, dist_link),
- ?line {ok, Node} = start_node(NodeName),
- ?line common_link_test(node(), Node),
- ?line TP4 = spawn(?MODULE, test_proc, []),
- ?line TP5 = spawn(?MODULE, test_proc, []),
- ?line TP6 = spawn(Node, ?MODULE, test_proc, []),
- ?line true = tp_call(TP6, fun() -> link(TP4) end),
- ?line check_link(TP4, TP6),
- ?line true = tp_call(TP5,
- fun() ->
- process_flag(trap_exit,true),
- link(TP6)
- end),
- ?line check_link(TP5, TP6),
- ?line rpc:cast(Node, erlang, halt, []),
- ?line wait_until(fun () -> ?line is_proc_dead(TP4) end),
- ?line check_unlink(TP4, TP6),
- ?line true = tp_call(TP5,
- fun() ->
- receive
- {'EXIT', TP6, noconnection} ->
- true
- end
- end),
- ?line check_unlink(TP5, TP6),
- ?line tp_cast(TP5, fun() -> exit(normal) end),
- ?line ok.
+ [NodeName] = get_names(1, dist_link),
+ {ok, Node} = start_node(NodeName),
+ common_link_test(node(), Node),
+ TP4 = spawn(?MODULE, test_proc, []),
+ TP5 = spawn(?MODULE, test_proc, []),
+ TP6 = spawn(Node, ?MODULE, test_proc, []),
+ true = tp_call(TP6, fun() -> link(TP4) end),
+ check_link(TP4, TP6),
+ true = tp_call(TP5,
+ fun() ->
+ process_flag(trap_exit,true),
+ link(TP6)
+ end),
+ check_link(TP5, TP6),
+ rpc:cast(Node, erlang, halt, []),
+ wait_until(fun () -> is_proc_dead(TP4) end),
+ check_unlink(TP4, TP6),
+ true = tp_call(TP5,
+ fun() ->
+ receive
+ {'EXIT', TP6, noconnection} ->
+ true
+ end
+ end),
+ check_unlink(TP5, TP6),
+ tp_cast(TP5, fun() -> exit(normal) end),
+ ok.
common_link_test(NodeA, NodeB) ->
- ?line TP1 = spawn(NodeA, ?MODULE, test_proc, []),
- ?line check_unlink(TP1, self()),
- ?line TP2 = tp_call(TP1,
- fun () ->
- spawn_link(NodeB, ?MODULE, test_proc, [])
- end),
- ?line check_link(TP1, TP2),
- ?line true = tp_call(TP2, fun() -> unlink(TP1) end),
- ?line check_unlink(TP1, TP2),
- ?line true = tp_call(TP2, fun() -> link(TP1) end),
- ?line check_link(TP1, TP2),
- ?line false = tp_call(TP2, fun() -> process_flag(trap_exit, true) end),
- ?line tp_cast(TP1, fun () -> exit(died) end),
- ?line true = tp_call(TP2, fun() ->
- receive
- {'EXIT', TP1, died} ->
- true
- end
- end),
- ?line check_unlink(TP1, TP2),
- ?line TP3 = tp_call(TP2,
- fun () ->
- spawn_link(NodeA, ?MODULE, test_proc, [])
- end),
- ?line check_link(TP3, TP2),
- ?line tp_cast(TP2, fun() -> exit(died) end),
- ?line wait_until(fun () -> ?line is_proc_dead(TP3) end),
- ?line check_unlink(TP3, TP2),
- ?line ok.
-
-monitor_nodes(doc) -> ["Tests monitor of nodes"];
-monitor_nodes(suite) -> [];
+ TP1 = spawn(NodeA, ?MODULE, test_proc, []),
+ check_unlink(TP1, self()),
+ TP2 = tp_call(TP1,
+ fun () ->
+ spawn_link(NodeB, ?MODULE, test_proc, [])
+ end),
+ check_link(TP1, TP2),
+ true = tp_call(TP2, fun() -> unlink(TP1) end),
+ check_unlink(TP1, TP2),
+ true = tp_call(TP2, fun() -> link(TP1) end),
+ check_link(TP1, TP2),
+ false = tp_call(TP2, fun() -> process_flag(trap_exit, true) end),
+ tp_cast(TP1, fun () -> exit(died) end),
+ true = tp_call(TP2, fun() ->
+ receive
+ {'EXIT', TP1, died} ->
+ true
+ end
+ end),
+ check_unlink(TP1, TP2),
+ TP3 = tp_call(TP2,
+ fun () ->
+ spawn_link(NodeA, ?MODULE, test_proc, [])
+ end),
+ check_link(TP3, TP2),
+ tp_cast(TP2, fun() -> exit(died) end),
+ wait_until(fun () -> is_proc_dead(TP3) end),
+ check_unlink(TP3, TP2),
+ ok.
+
+%% Tests monitor of nodes
monitor_nodes(Config) when is_list(Config) ->
- ?line [An, Bn, Cn, Dn] = get_names(4, dist_link),
- ?line {ok, A} = start_node(An),
- ?line {ok, B} = start_node(Bn),
- ?line C = list_to_atom(lists:concat([Cn, "@", hostname()])),
- ?line D = list_to_atom(lists:concat([Dn, "@", hostname()])),
- ?line 0 = no_of_monitor_node(self(), A),
- ?line 0 = no_of_monitor_node(self(), B),
- ?line monitor_node(A, true),
- ?line monitor_node(B, true),
- ?line monitor_node(D, true),
- ?line monitor_node(D, true),
+ [An, Bn, Cn, Dn] = get_names(4, dist_link),
+ {ok, A} = start_node(An),
+ {ok, B} = start_node(Bn),
+ C = list_to_atom(lists:concat([Cn, "@", hostname()])),
+ D = list_to_atom(lists:concat([Dn, "@", hostname()])),
+ 0 = no_of_monitor_node(self(), A),
+ 0 = no_of_monitor_node(self(), B),
+ monitor_node(A, true),
+ monitor_node(B, true),
+ monitor_node(D, true),
+ monitor_node(D, true),
%% Has been known to crash the emulator.
- ?line {memory,_} = process_info(self(), memory),
-
- ?line monitor_node(A, false),
- ?line monitor_node(B, true),
- ?line monitor_node(C, true),
- ?line monitor_node(C, false),
- ?line monitor_node(C, true),
- ?line monitor_node(B, true),
- ?line monitor_node(A, false),
- ?line monitor_node(B, true),
- ?line monitor_node(B, false),
- ?line monitor_node(A, true),
- ?line check_monitor_node(self(), A, 1),
- ?line check_monitor_node(self(), B, 3),
- ?line check_monitor_node(self(), C, 0),
- ?line check_monitor_node(self(), D, 0),
- ?line receive {nodedown, C} -> ok end,
- ?line receive {nodedown, C} -> ok end,
- ?line receive {nodedown, C} -> ok end,
- ?line receive {nodedown, D} -> ok end,
- ?line receive {nodedown, D} -> ok end,
- ?line stop_node(A),
- ?line receive {nodedown, A} -> ok end,
- ?line check_monitor_node(self(), A, 0),
- ?line check_monitor_node(self(), B, 3),
- ?line stop_node(B),
- ?line receive {nodedown, B} -> ok end,
- ?line receive {nodedown, B} -> ok end,
- ?line receive {nodedown, B} -> ok end,
- ?line check_monitor_node(self(), B, 0),
- ?line receive
- {nodedown, X} ->
- ?line ?t:fail({unexpected_nodedown, X})
- after 0 ->
- ?line ok
- end,
- ?line ok.
-
-
-process_monitors(doc) -> ["Tests node local process monitors"];
-process_monitors(suite) -> [];
+ {memory,_} = process_info(self(), memory),
+
+ monitor_node(A, false),
+ monitor_node(B, true),
+ monitor_node(C, true),
+ monitor_node(C, false),
+ monitor_node(C, true),
+ monitor_node(B, true),
+ monitor_node(A, false),
+ monitor_node(B, true),
+ monitor_node(B, false),
+ monitor_node(A, true),
+ check_monitor_node(self(), A, 1),
+ check_monitor_node(self(), B, 3),
+ check_monitor_node(self(), C, 0),
+ check_monitor_node(self(), D, 0),
+ receive {nodedown, C} -> ok end,
+ receive {nodedown, C} -> ok end,
+ receive {nodedown, C} -> ok end,
+ receive {nodedown, D} -> ok end,
+ receive {nodedown, D} -> ok end,
+ stop_node(A),
+ receive {nodedown, A} -> ok end,
+ check_monitor_node(self(), A, 0),
+ check_monitor_node(self(), B, 3),
+ stop_node(B),
+ receive {nodedown, B} -> ok end,
+ receive {nodedown, B} -> ok end,
+ receive {nodedown, B} -> ok end,
+ check_monitor_node(self(), B, 0),
+ receive
+ {nodedown, X} ->
+ ct:fail({unexpected_nodedown, X})
+ after 0 ->
+ ok
+ end,
+ ok.
+
+
+%% Tests node local process monitors
process_monitors(Config) when is_list(Config) ->
- ?line common_process_monitors(node(), node()),
- ?line Mon1 = erlang:monitor(process,self()),
- ?line [] = find_erl_monitor(self(), Mon1),
- ?line [Name] = get_names(1, process_monitors),
- ?line true = register(Name, self()),
- ?line Mon2 = erlang:monitor(process, Name),
- ?line [] = find_erl_monitor(self(), Mon2),
- ?line receive
- {'DOWN', Mon1, _, _, _} = Msg ->
- ?line ?t:fail({unexpected_down_msg, Msg});
- {'DOWN', Mon2, _, _, _} = Msg ->
- ?line ?t:fail({unexpected_down_msg, Msg})
- after 500 ->
- ?line true = erlang:demonitor(Mon1),
- ?line true = erlang:demonitor(Mon2),
- ?line ok
- end.
-
-dist_process_monitors(doc) -> ["Tests distributed process monitors"];
-dist_process_monitors(suite) -> [];
+ common_process_monitors(node(), node()),
+ Mon1 = erlang:monitor(process,self()),
+ [] = find_erl_monitor(self(), Mon1),
+ [Name] = get_names(1, process_monitors),
+ true = register(Name, self()),
+ Mon2 = erlang:monitor(process, Name),
+ [] = find_erl_monitor(self(), Mon2),
+ receive
+ {'DOWN', Mon1, _, _, _} = Msg ->
+ ct:fail({unexpected_down_msg, Msg});
+ {'DOWN', Mon2, _, _, _} = Msg ->
+ ct:fail({unexpected_down_msg, Msg})
+ after 500 ->
+ true = erlang:demonitor(Mon1),
+ true = erlang:demonitor(Mon2),
+ ok
+ end.
+
+%% Tests distributed process monitors
dist_process_monitors(Config) when is_list(Config) ->
- ?line [Name] = get_names(1,dist_process_monitors),
- ?line {ok, Node} = start_node(Name),
- ?line common_process_monitors(node(), Node),
- ?line TP1 = spawn(Node, ?MODULE, test_proc, []),
- ?line R1 = erlang:monitor(process, TP1),
- ?line TP1O = get_down_object(TP1, self()),
- ?line check_process_monitor(self(), TP1, R1),
- ?line tp_cast(TP1, fun () -> halt() end),
- ?line receive
- {'DOWN',R1,process,TP1O,noconnection} ->
- ?line ok
- end,
- ?line check_process_demonitor(self(), TP1, R1),
- ?line R2 = erlang:monitor(process, TP1),
- ?line receive
- {'DOWN',R2,process,TP1O,noconnection} ->
- ?line ok
- end,
- ?line check_process_demonitor(self(), TP1, R2),
- ?line ok.
+ [Name] = get_names(1,dist_process_monitors),
+ {ok, Node} = start_node(Name),
+ common_process_monitors(node(), Node),
+ TP1 = spawn(Node, ?MODULE, test_proc, []),
+ R1 = erlang:monitor(process, TP1),
+ TP1O = get_down_object(TP1, self()),
+ check_process_monitor(self(), TP1, R1),
+ tp_cast(TP1, fun () -> halt() end),
+ receive
+ {'DOWN',R1,process,TP1O,noconnection} ->
+ ok
+ end,
+ check_process_demonitor(self(), TP1, R1),
+ R2 = erlang:monitor(process, TP1),
+ receive
+ {'DOWN',R2,process,TP1O,noconnection} ->
+ ok
+ end,
+ check_process_demonitor(self(), TP1, R2),
+ ok.
common_process_monitors(NodeA, NodeB) ->
- ?line TP1 = spawn(NodeA, ?MODULE, test_proc, []),
- ?line TP2 = spawn(NodeB, ?MODULE, test_proc, []),
- ?line run_common_process_monitors(TP1, TP2),
- ?line TP3 = spawn(NodeA, ?MODULE, test_proc, []),
- ?line TP4 = spawn(NodeB, ?MODULE, test_proc, []),
- ?line [TP4N] = get_names(1, common_process_monitors),
- ?line true = tp_call(TP4, fun () -> register(TP4N,self()) end),
- ?line run_common_process_monitors(TP3,
- case node() == node(TP4) of
- true -> TP4N;
- false -> {TP4N, node(TP4)}
- end),
- ?line ok.
+ TP1 = spawn(NodeA, ?MODULE, test_proc, []),
+ TP2 = spawn(NodeB, ?MODULE, test_proc, []),
+ run_common_process_monitors(TP1, TP2),
+ TP3 = spawn(NodeA, ?MODULE, test_proc, []),
+ TP4 = spawn(NodeB, ?MODULE, test_proc, []),
+ [TP4N] = get_names(1, common_process_monitors),
+ true = tp_call(TP4, fun () -> register(TP4N,self()) end),
+ run_common_process_monitors(TP3,
+ case node() == node(TP4) of
+ true -> TP4N;
+ false -> {TP4N, node(TP4)}
+ end),
+ ok.
run_common_process_monitors(TP1, TP2) ->
- ?line R1 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
- ?line check_process_monitor(TP1, TP2, R1),
-
- ?line tp_call(TP2, fun () -> catch erlang:demonitor(R1) end),
- ?line check_process_monitor(TP1, TP2, R1),
-
- ?line true = tp_call(TP1, fun () -> erlang:demonitor(R1) end),
- ?line check_process_demonitor(TP1, TP2, R1),
-
- ?line R2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
- ?line TP2O = get_down_object(TP2, TP1),
- ?line check_process_monitor(TP1, TP2, R2),
- ?line tp_cast(TP2, fun () -> exit(bye) end),
- ?line wait_until(fun () -> ?line is_proc_dead(TP2) end),
- ?line ok = tp_call(TP1, fun () ->
- ?line receive
- {'DOWN',R2,process,TP2O,bye} ->
- ?line ok
- end
- end),
- ?line check_process_demonitor(TP1, TP2, R2),
-
- ?line R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
- ?line ok = tp_call(TP1, fun () ->
- ?line receive
- {'DOWN',R3,process,TP2O,noproc} ->
- ?line ok
- end
- end),
- ?line check_process_demonitor(TP1, TP2, R3),
-
- ?line tp_cast(TP1, fun () -> exit(normal) end),
- ?line wait_until(fun () -> ?line is_proc_dead(TP1) end),
- ?line ok.
-
-
-busy_dist_port_monitor(doc) -> ["Tests distributed monitor/2, demonitor/1, "
- "and 'DOWN' message over busy distribution "
- "port"];
-busy_dist_port_monitor(suite) -> [];
+ R1 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
+ check_process_monitor(TP1, TP2, R1),
+
+ tp_call(TP2, fun () -> catch erlang:demonitor(R1) end),
+ check_process_monitor(TP1, TP2, R1),
+
+ true = tp_call(TP1, fun () -> erlang:demonitor(R1) end),
+ check_process_demonitor(TP1, TP2, R1),
+
+ R2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
+ TP2O = get_down_object(TP2, TP1),
+ check_process_monitor(TP1, TP2, R2),
+ tp_cast(TP2, fun () -> exit(bye) end),
+ wait_until(fun () -> is_proc_dead(TP2) end),
+ ok = tp_call(TP1, fun () ->
+ receive
+ {'DOWN',R2,process,TP2O,bye} ->
+ ok
+ end
+ end),
+ check_process_demonitor(TP1, TP2, R2),
+
+ R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
+ ok = tp_call(TP1, fun () ->
+ receive
+ {'DOWN',R3,process,TP2O,noproc} ->
+ ok
+ end
+ end),
+ check_process_demonitor(TP1, TP2, R3),
+
+ tp_cast(TP1, fun () -> exit(normal) end),
+ wait_until(fun () -> is_proc_dead(TP1) end),
+ ok.
+
+
+%% Tests distributed monitor/2, demonitor/1, and 'DOWN' message
+%% over busy distribution port
busy_dist_port_monitor(Config) when is_list(Config) ->
- ?line Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of
- "true" -> start_busy_dist_port_tracer();
- _ -> false
- end,
+ Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of
+ "true" -> start_busy_dist_port_tracer();
+ _ -> false
+ end,
- ?line [An] = get_names(1, busy_dist_port_monitor),
- ?line {ok, A} = start_node(An),
- ?line TP1 = spawn(A, ?MODULE, test_proc, []),
+ [An] = get_names(1, busy_dist_port_monitor),
+ {ok, A} = start_node(An),
+ TP1 = spawn(A, ?MODULE, test_proc, []),
%% Check monitor over busy port
- ?line M1 = suspend_on_busy_test(A,
- "erlang:monitor(process, TP1)",
- fun () -> erlang:monitor(process, TP1) end),
- ?line check_process_monitor(self(), TP1, M1),
+ M1 = suspend_on_busy_test(A,
+ "erlang:monitor(process, TP1)",
+ fun () -> erlang:monitor(process, TP1) end),
+ check_process_monitor(self(), TP1, M1),
%% Check demonitor over busy port
- ?line suspend_on_busy_test(A,
- "erlang:demonitor(M1)",
- fun () -> erlang:demonitor(M1) end),
- ?line check_process_demonitor(self(), TP1, M1),
+ suspend_on_busy_test(A,
+ "erlang:demonitor(M1)",
+ fun () -> erlang:demonitor(M1) end),
+ check_process_demonitor(self(), TP1, M1),
%% Check down message over busy port
- ?line TP2 = spawn(?MODULE, test_proc, []),
- ?line M2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
- ?line check_process_monitor(TP1, TP2, M2),
- ?line Ref = make_ref(),
- ?line Busy = make_busy(A, 1000),
- ?line receive after 100 -> ok end,
- ?line tp_cast(TP2, fun () -> exit(Ref) end),
- ?line receive after 100 -> ok end,
- ?line unmake_busy(Busy),
- ?line Ref = tp_call(TP1, fun () ->
- receive
- {'DOWN', M2, process, TP2, Ref} ->
- Ref
- end
- end),
- ?line tp_cast(TP1, fun () -> exit(normal) end),
- ?line stop_node(A),
- ?line stop_busy_dist_port_tracer(Tracer),
- ?line ok.
-
-busy_dist_port_link(doc) -> ["Tests distributed link/1, unlink/1, and 'EXIT'",
- " message over busy distribution port"];
-busy_dist_port_link(suite) -> [];
+ TP2 = spawn(?MODULE, test_proc, []),
+ M2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end),
+ check_process_monitor(TP1, TP2, M2),
+ Ref = make_ref(),
+ Busy = make_busy(A, 1000),
+ receive after 100 -> ok end,
+ tp_cast(TP2, fun () -> exit(Ref) end),
+ receive after 100 -> ok end,
+ unmake_busy(Busy),
+ Ref = tp_call(TP1, fun () ->
+ receive
+ {'DOWN', M2, process, TP2, Ref} ->
+ Ref
+ end
+ end),
+ tp_cast(TP1, fun () -> exit(normal) end),
+ stop_node(A),
+ stop_busy_dist_port_tracer(Tracer),
+ ok.
+
+%% Tests distributed link/1, unlink/1, and 'EXIT'
+%% message over busy distribution port
busy_dist_port_link(Config) when is_list(Config) ->
- ?line Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of
- "true" -> start_busy_dist_port_tracer();
- _ -> false
- end,
-
- ?line [An] = get_names(1, busy_dist_port_link),
- ?line {ok, A} = start_node(An),
- ?line TP1 = spawn(A, ?MODULE, test_proc, []),
+ Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of
+ "true" -> start_busy_dist_port_tracer();
+ _ -> false
+ end,
+
+ [An] = get_names(1, busy_dist_port_link),
+ {ok, A} = start_node(An),
+ TP1 = spawn(A, ?MODULE, test_proc, []),
%% Check link over busy port
- ?line suspend_on_busy_test(A,
- "link(TP1)",
- fun () -> link(TP1) end),
- ?line check_link(self(), TP1),
+ suspend_on_busy_test(A,
+ "link(TP1)",
+ fun () -> link(TP1) end),
+ check_link(self(), TP1),
%% Check unlink over busy port
- ?line suspend_on_busy_test(A,
- "unlink(TP1)",
- fun () -> unlink(TP1) end),
- ?line check_unlink(self(), TP1),
+ suspend_on_busy_test(A,
+ "unlink(TP1)",
+ fun () -> unlink(TP1) end),
+ check_unlink(self(), TP1),
%% Check trap exit message over busy port
- ?line TP2 = spawn(?MODULE, test_proc, []),
- ?line ok = tp_call(TP1, fun () ->
- process_flag(trap_exit, true),
- link(TP2),
- ok
- end),
- ?line check_link(TP1, TP2),
- ?line Ref = make_ref(),
- ?line Busy = make_busy(A, 1000),
- ?line receive after 100 -> ok end,
- ?line tp_cast(TP2, fun () -> exit(Ref) end),
- ?line receive after 100 -> ok end,
- ?line unmake_busy(Busy),
- ?line Ref = tp_call(TP1, fun () ->
- receive
- {'EXIT', TP2, Ref} ->
- Ref
- end
- end),
- ?line tp_cast(TP1, fun () -> exit(normal) end),
- ?line stop_node(A),
- ?line stop_busy_dist_port_tracer(Tracer),
- ?line ok.
-
-
-otp_5772_link(doc) -> [];
-otp_5772_link(suite) -> [];
+ TP2 = spawn(?MODULE, test_proc, []),
+ ok = tp_call(TP1, fun () ->
+ process_flag(trap_exit, true),
+ link(TP2),
+ ok
+ end),
+ check_link(TP1, TP2),
+ Ref = make_ref(),
+ Busy = make_busy(A, 1000),
+ receive after 100 -> ok end,
+ tp_cast(TP2, fun () -> exit(Ref) end),
+ receive after 100 -> ok end,
+ unmake_busy(Busy),
+ Ref = tp_call(TP1, fun () ->
+ receive
+ {'EXIT', TP2, Ref} ->
+ Ref
+ end
+ end),
+ tp_cast(TP1, fun () -> exit(normal) end),
+ stop_node(A),
+ stop_busy_dist_port_tracer(Tracer),
+ ok.
+
+
otp_5772_link(Config) when is_list(Config) ->
- ?line otp_5772_link_test(node()).
+ otp_5772_link_test(node()).
-otp_5772_dist_link(doc) -> [];
-otp_5772_dist_link(suite) -> [];
otp_5772_dist_link(Config) when is_list(Config) ->
- ?line [An] = get_names(1, otp_5772_dist_link),
- ?line {ok, A} = start_node(An),
- ?line otp_5772_link_test(A),
- ?line stop_node(A).
+ [An] = get_names(1, otp_5772_dist_link),
+ {ok, A} = start_node(An),
+ otp_5772_link_test(A),
+ stop_node(A).
otp_5772_link_test(Node) ->
- ?line Prio = process_flag(priority, high),
- ?line TE = process_flag(trap_exit, true),
- ?line TP1 = spawn_opt(Node, ?MODULE, test_proc, [],
- [link, {priority, low}]),
+ Prio = process_flag(priority, high),
+ TE = process_flag(trap_exit, true),
+ TP1 = spawn_opt(Node, ?MODULE, test_proc, [],
+ [link, {priority, low}]),
exit(TP1, bang),
unlink(TP1),
- ?line receive
- {'EXIT', TP1, _} ->
- ?line ok
- after 0 ->
- ?line ok
- end,
- ?line receive
- {'EXIT', TP1, _} = Exit ->
- ?line ?t:fail({got_late_exit_message, Exit})
- after 1000 ->
- ?line ok
- end,
- ?line process_flag(trap_exit, TE),
- ?line process_flag(priority, Prio),
- ?line ok.
-
-otp_5772_monitor(doc) -> [];
-otp_5772_monitor(suite) -> [];
+ receive
+ {'EXIT', TP1, _} ->
+ ok
+ after 0 ->
+ ok
+ end,
+ receive
+ {'EXIT', TP1, _} = Exit ->
+ ct:fail({got_late_exit_message, Exit})
+ after 1000 ->
+ ok
+ end,
+ process_flag(trap_exit, TE),
+ process_flag(priority, Prio),
+ ok.
+
otp_5772_monitor(Config) when is_list(Config) ->
- ?line otp_5772_monitor_test(node()).
+ otp_5772_monitor_test(node()).
-otp_5772_dist_monitor(doc) -> [];
-otp_5772_dist_monitor(suite) -> [];
otp_5772_dist_monitor(Config) when is_list(Config) ->
- ?line [An] = get_names(1, otp_5772_dist_monitor),
- ?line {ok, A} = start_node(An),
- ?line otp_5772_monitor_test(A),
- ?line stop_node(A),
- ?line ok.
+ [An] = get_names(1, otp_5772_dist_monitor),
+ {ok, A} = start_node(An),
+ otp_5772_monitor_test(A),
+ stop_node(A),
+ ok.
otp_5772_monitor_test(Node) ->
- ?line Prio = process_flag(priority, high),
- ?line TP1 = spawn_opt(Node, ?MODULE, test_proc, [], [{priority, low}]),
- ?line M1 = erlang:monitor(process, TP1),
- ?line exit(TP1, bang),
- ?line erlang:demonitor(M1),
- ?line receive
- {'DOWN', M1, _, _, _} ->
- ?line ok
- after 0 ->
- ?line ok
- end,
- ?line receive
- {'DOWN', M1, _, _, _} = Down ->
- ?line ?t:fail({got_late_down_message, Down})
- after 1000 ->
- ?line ok
- end,
- ?line process_flag(priority, Prio),
- ?line ok.
+ Prio = process_flag(priority, high),
+ TP1 = spawn_opt(Node, ?MODULE, test_proc, [], [{priority, low}]),
+ M1 = erlang:monitor(process, TP1),
+ exit(TP1, bang),
+ erlang:demonitor(M1),
+ receive
+ {'DOWN', M1, _, _, _} ->
+ ok
+ after 0 ->
+ ok
+ end,
+ receive
+ {'DOWN', M1, _, _, _} = Down ->
+ ct:fail({got_late_down_message, Down})
+ after 1000 ->
+ ok
+ end,
+ process_flag(priority, Prio),
+ ok.
otp_7946(Config) when is_list(Config) ->
- ?line [NodeName] = get_names(1, otp_7946),
- ?line {ok, Node} = start_node(NodeName),
- ?line Proc = rpc:call(Node, erlang, whereis, [net_kernel]),
- ?line Mon = erlang:monitor(process, Proc),
- ?line rpc:cast(Node, erlang, halt, []),
- ?line receive {'DOWN', Mon, process, Proc , _} -> ok end,
- ?line {Linker, LMon} = spawn_monitor(fun () ->
- link(Proc),
- receive
- after infinity -> ok
- end
- end),
- ?line receive
- {'DOWN', LMon, process, Linker, Reason} ->
- ?line ?t:format("Reason=~p~n", [Reason]),
- ?line Reason = noconnection
- end.
+ [NodeName] = get_names(1, otp_7946),
+ {ok, Node} = start_node(NodeName),
+ Proc = rpc:call(Node, erlang, whereis, [net_kernel]),
+ Mon = erlang:monitor(process, Proc),
+ rpc:cast(Node, erlang, halt, []),
+ receive {'DOWN', Mon, process, Proc , _} -> ok end,
+ {Linker, LMon} = spawn_monitor(fun () ->
+ link(Proc),
+ receive
+ after infinity -> ok
+ end
+ end),
+ receive
+ {'DOWN', LMon, process, Linker, Reason} ->
+ io:format("Reason=~p~n", [Reason]),
+ Reason = noconnection
+ end.
%%
%% -- Internal utils --------------------------------------------------------
@@ -519,27 +502,27 @@ otp_7946(Config) when is_list(Config) ->
busy_data() ->
case get(?BUSY_DATA_KEY) of
- undefined ->
- set_busy_data([]);
- Data ->
- true = is_binary(Data),
- true = size(Data) == ?BUSY_DATA_SIZE,
- Data
+ undefined ->
+ set_busy_data([]);
+ Data ->
+ true = is_binary(Data),
+ true = size(Data) == ?BUSY_DATA_SIZE,
+ Data
end.
set_busy_data(SetData) ->
case get(?BUSY_DATA_KEY) of
- undefined ->
- Data = case SetData of
- D when is_binary(D), size(D) == ?BUSY_DATA_SIZE ->
- SetData;
- _ ->
- list_to_binary(lists:duplicate(?BUSY_DATA_SIZE, 253))
- end,
- put(?BUSY_DATA_KEY, Data),
- Data;
- OldData ->
- OldData
+ undefined ->
+ Data = case SetData of
+ D when is_binary(D), size(D) == ?BUSY_DATA_SIZE ->
+ SetData;
+ _ ->
+ list_to_binary(lists:duplicate(?BUSY_DATA_SIZE, 253))
+ end,
+ put(?BUSY_DATA_KEY, Data),
+ Data;
+ OldData ->
+ OldData
end.
freeze_node(Node, MS) ->
@@ -547,13 +530,13 @@ freeze_node(Node, MS) ->
DoingIt = make_ref(),
Freezer = self(),
spawn_link(Node,
- fun () ->
- erts_debug:set_internal_state(available_internal_state,
- true),
- dport_send(Freezer, DoingIt),
- receive after Own -> ok end,
- erts_debug:set_internal_state(block, MS+Own)
- end),
+ fun () ->
+ erts_debug:set_internal_state(available_internal_state,
+ true),
+ dport_send(Freezer, DoingIt),
+ receive after Own -> ok end,
+ erts_debug:set_internal_state(block, MS+Own)
+ end),
receive DoingIt -> ok end,
receive after Own -> ok end.
@@ -563,27 +546,27 @@ make_busy(Node, Time) when is_integer(Time) ->
Data = busy_data(),
%% first make port busy
Pid = spawn_link(fun () ->
- forever(fun () ->
- dport_reg_send(Node,
- '__noone__',
- Data)
- end)
- end),
+ forever(fun () ->
+ dport_reg_send(Node,
+ '__noone__',
+ Data)
+ end)
+ end),
receive after Own -> ok end,
wait_until(fun () ->
- case process_info(Pid, status) of
- {status, suspended} -> true;
- _ -> false
- end
- end),
+ case process_info(Pid, status) of
+ {status, suspended} -> true;
+ _ -> false
+ end
+ end),
%% then dist entry
make_busy(Node, [nosuspend], Data),
Pid.
make_busy(Node, Opts, Data) ->
case erlang:send({'__noone__', Node}, Data, Opts) of
- nosuspend -> nosuspend;
- _ -> make_busy(Node, Opts, Data)
+ nosuspend -> nosuspend;
+ _ -> make_busy(Node, Opts, Data)
end.
unmake_busy(Pid) ->
@@ -596,33 +579,33 @@ suspend_on_busy_test(Node, Doing, Fun) ->
Done = make_ref(),
Data = busy_data(),
spawn_link(fun () ->
- set_busy_data(Data),
- Busy = make_busy(Node, 1000),
- Tester ! DoIt,
- receive after 100 -> ok end,
- Info = process_info(Tester, [status, current_function]),
- unmake_busy(Busy),
- ?t:format("~p doing ~s: ~p~n", [Tester, Doing, Info]),
- Tester ! {Done, Info}
- end),
+ set_busy_data(Data),
+ Busy = make_busy(Node, 1000),
+ Tester ! DoIt,
+ receive after 100 -> ok end,
+ Info = process_info(Tester, [status, current_function]),
+ unmake_busy(Busy),
+ io:format("~p doing ~s: ~p~n", [Tester, Doing, Info]),
+ Tester ! {Done, Info}
+ end),
receive DoIt -> ok end,
Res = Fun(),
receive
- {Done, MyInfo} ->
- %% Don't match arity; it is different in
- %% debug and optimized emulator
- [{status, suspended},
- {current_function, {erlang, bif_return_trap, _}}] = MyInfo,
- ok
+ {Done, MyInfo} ->
+ %% Don't match arity; it is different in
+ %% debug and optimized emulator
+ [{status, suspended},
+ {current_function, {erlang, bif_return_trap, _}}] = MyInfo,
+ ok
end,
Res.
% get_node(Name) when is_atom(Name) ->
-% ?line node();
+% node();
% get_node({Name, Node}) when is_atom(Name) ->
-% ?line Node;
+% Node;
% get_node(NC) when is_pid(NC); is_port(NC); is_reference(NC) ->
-% ?line node(NC).
+% node(NC).
get_down_object(Item, _) when is_pid(Item) ->
Item;
@@ -637,90 +620,78 @@ get_down_object(Item, Watcher) when is_atom(Item), is_atom(Watcher) ->
is_proc_dead(P) ->
case is_proc_alive(P) of
- true -> false;
- false -> true
+ true -> false;
+ false -> true
end.
is_proc_alive(Pid) when is_pid(Pid), node(Pid) == node() ->
- ?line is_process_alive(Pid);
+ is_process_alive(Pid);
is_proc_alive(Name) when is_atom(Name) ->
- ?line case catch whereis(Name) of
- Pid when is_pid(Pid) ->
- ?line is_proc_alive(Pid);
- _ ->
- ?line false
- end;
+ case catch whereis(Name) of
+ Pid when is_pid(Pid) ->
+ is_proc_alive(Pid);
+ _ ->
+ false
+ end;
is_proc_alive({Name, Node}) when is_atom(Name), Node == node() ->
- ?line is_proc_alive(Name);
+ is_proc_alive(Name);
is_proc_alive(Proc) ->
- ?line is_remote_proc_alive(Proc).
+ is_remote_proc_alive(Proc).
is_remote_proc_alive({Name, Node}) when is_atom(Name), is_atom(Node) ->
- ?line is_remote_proc_alive(Name, Node);
+ is_remote_proc_alive(Name, Node);
is_remote_proc_alive(Pid) when is_pid(Pid) ->
- ?line is_remote_proc_alive(Pid, node(Pid));
+ is_remote_proc_alive(Pid, node(Pid));
is_remote_proc_alive(_) ->
- ?line false.
+ false.
is_remote_proc_alive(PN, Node) ->
- ?line S = self(),
- ?line R = make_ref(),
- ?line monitor_node(Node, true),
- ?line _P = spawn(Node, fun () -> S ! {R, is_proc_alive(PN)} end),
- ?line receive
- {R, Bool} ->
- ?line monitor_node(Node, false),
- ?line Bool;
- {nodedown, Node} ->
- ?line false
- end.
+ S = self(),
+ R = make_ref(),
+ monitor_node(Node, true),
+ _P = spawn(Node, fun () -> S ! {R, is_proc_alive(PN)} end),
+ receive
+ {R, Bool} ->
+ monitor_node(Node, false),
+ Bool;
+ {nodedown, Node} ->
+ false
+ end.
wait_until(Fun) ->
- ?line case Fun() of
- true ->
- ?line ok;
- _ ->
- ?line receive
- after 100 ->
- ?line wait_until(Fun)
- end
- end.
+ case Fun() of
+ true ->
+ ok;
+ _ ->
+ receive
+ after 100 ->
+ wait_until(Fun)
+ end
+ end.
forever(Fun) ->
Fun(),
forever(Fun).
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- ?line Dog = ?t:timetrap(?t:minutes(1)),
- case catch erts_debug:get_internal_state(available_internal_state) of
- true -> ok;
- _ -> erts_debug:set_internal_state(available_internal_state, true)
- end,
- ?line [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- ?line Dog = ?config(watchdog, Config),
- ?line ?t:timetrap_cancel(Dog).
-
tp_call(Tp, Fun) ->
- ?line R = make_ref(),
- ?line Tp ! {call, self(), R, Fun},
- ?line receive
- {R, Res} ->
- ?line Res
- end.
+ R = make_ref(),
+ Tp ! {call, self(), R, Fun},
+ receive
+ {R, Res} ->
+ Res
+ end.
tp_cast(Tp, Fun) ->
- ?line Tp ! {cast, Fun}.
+ Tp ! {cast, Fun}.
test_proc() ->
- ?line receive
- {call, From, Ref, Fun} ->
- ?line From ! {Ref, Fun()};
- {cast, Fun} ->
- ?line Fun()
- end,
- ?line test_proc().
+ receive
+ {call, From, Ref, Fun} ->
+ From ! {Ref, Fun()};
+ {cast, Fun} ->
+ Fun()
+ end,
+ test_proc().
expand_link_list([#erl_link{type = ?LINK_NODE, targets = N} = Rec | T]) ->
lists:duplicate(N,Rec#erl_link{targets = []}) ++ expand_link_list(T);
@@ -728,7 +699,7 @@ expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}]} = Rec | T]) ->
[Rec#erl_link{targets = [Pid]} | expand_link_list(T)];
expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}|TT]} = Rec | T]) ->
[ Rec#erl_link{targets = [Pid]} | expand_link_list(
- [Rec#erl_link{targets = TT} | T])];
+ [Rec#erl_link{targets = TT} | T])];
expand_link_list([#erl_link{targets = []} = Rec | T]) ->
[Rec | expand_link_list(T)];
expand_link_list([]) ->
@@ -736,19 +707,19 @@ expand_link_list([]) ->
get_local_link_list(Obj) ->
case catch erts_debug:get_internal_state({link_list, Obj}) of
- LL when is_list(LL) ->
- expand_link_list(LL);
- _ ->
- []
+ LL when is_list(LL) ->
+ expand_link_list(LL);
+ _ ->
+ []
end.
get_remote_link_list(Node, Obj) ->
case catch rpc:call(Node, erts_debug, get_internal_state,
- [{link_list, Obj}]) of
- LL when is_list(LL) ->
- expand_link_list(LL);
- _ ->
- []
+ [{link_list, Obj}]) of
+ LL when is_list(LL) ->
+ expand_link_list(LL);
+ _ ->
+ []
end.
@@ -758,30 +729,30 @@ get_link_list({Node, DistEntry}) when is_atom(Node), is_atom(DistEntry) ->
get_remote_link_list(Node, DistEntry);
get_link_list(P) when is_pid(P); is_port(P) ->
case node(P) of
- Node when Node == node() ->
- get_local_link_list(P);
- Node ->
- get_remote_link_list(Node, P)
- end;
+ Node when Node == node() ->
+ get_local_link_list(P);
+ Node ->
+ get_remote_link_list(Node, P)
+ end;
get_link_list(undefined) ->
[].
get_local_monitor_list(Obj) ->
case catch erts_debug:get_internal_state({monitor_list, Obj}) of
- LL when is_list(LL) ->
- LL;
- _ ->
- []
- end.
+ LL when is_list(LL) ->
+ LL;
+ _ ->
+ []
+ end.
get_remote_monitor_list(Node, Obj) ->
case catch rpc:call(Node, erts_debug, get_internal_state,
- [{monitor_list, Obj}]) of
- LL when is_list(LL) ->
- LL;
- _ ->
- []
- end.
+ [{monitor_list, Obj}]) of
+ LL when is_list(LL) ->
+ LL;
+ _ ->
+ []
+ end.
get_monitor_list({Node, DistEntry}) when Node == node(), is_atom(DistEntry) ->
@@ -790,242 +761,242 @@ get_monitor_list({Node, DistEntry}) when is_atom(Node), is_atom(DistEntry) ->
get_remote_monitor_list(Node, DistEntry);
get_monitor_list(P) when is_pid(P) ->
case node(P) of
- Node when Node == node() ->
- get_local_monitor_list(P);
- Node ->
- get_remote_monitor_list(Node, P)
- end;
+ Node when Node == node() ->
+ get_local_monitor_list(P);
+ Node ->
+ get_remote_monitor_list(Node, P)
+ end;
get_monitor_list(undefined) ->
[].
find_erl_monitor(Pid, Ref) when is_reference(Ref) ->
lists:foldl(fun (#erl_monitor{ref = R} = EL, Acc) when R == Ref ->
- [EL|Acc];
- (_, Acc) ->
- Acc
- end,
- [],
- get_monitor_list(Pid)).
+ [EL|Acc];
+ (_, Acc) ->
+ Acc
+ end,
+ [],
+ get_monitor_list(Pid)).
% find_erl_link(Obj, Ref) when is_reference(Ref) ->
-% ?line lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref ->
-% ?line [EL|Acc];
+% lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref ->
+% [EL|Acc];
% (_, Acc) ->
-% ?line Acc
+% Acc
% end,
% [],
% get_link_list(Obj)).
find_erl_link(Obj, Type, [Item, Data]) when is_pid(Item);
- is_port(Item);
- is_atom(Item) ->
+ is_port(Item);
+ is_atom(Item) ->
lists:foldl(fun (#erl_link{type = T, pid = I, targets = D} = EL,
- Acc) when T == Type, I == Item ->
- case Data of
- D ->
- [EL|Acc];
- [] ->
- [EL|Acc];
- _ ->
- Acc
- end;
- (_, Acc) ->
- Acc
- end,
- [],
- get_link_list(Obj));
+ Acc) when T == Type, I == Item ->
+ case Data of
+ D ->
+ [EL|Acc];
+ [] ->
+ [EL|Acc];
+ _ ->
+ Acc
+ end;
+ (_, Acc) ->
+ Acc
+ end,
+ [],
+ get_link_list(Obj));
find_erl_link(Obj, Type, Item) when is_pid(Item); is_port(Item); is_atom(Item) ->
find_erl_link(Obj, Type, [Item, []]).
-
+
check_link(A, B) ->
- ?line [#erl_link{type = ?LINK_PID,
- pid = B,
- targets = []}] = find_erl_link(A, ?LINK_PID, B),
- ?line [#erl_link{type = ?LINK_PID,
- pid = A,
- targets = []}] = find_erl_link(B, ?LINK_PID, A),
- ?line case node(A) == node(B) of
- false ->
- ?line [#erl_link{type = ?LINK_PID,
- pid = A,
- targets = [B]}] = find_erl_link({node(A),
- node(B)},
- ?LINK_PID,
- [A, [B]]),
- ?line [#erl_link{type = ?LINK_PID,
- pid = B,
- targets = [A]}] = find_erl_link({node(B),
- node(A)},
- ?LINK_PID,
- [B, [A]]);
- true ->
- ?line [] = find_erl_link({node(A), node(B)},
- ?LINK_PID,
- [A, [B]]),
- ?line [] = find_erl_link({node(B), node(A)},
- ?LINK_PID,
- [B, [A]])
- end,
- ?line ok.
+ [#erl_link{type = ?LINK_PID,
+ pid = B,
+ targets = []}] = find_erl_link(A, ?LINK_PID, B),
+ [#erl_link{type = ?LINK_PID,
+ pid = A,
+ targets = []}] = find_erl_link(B, ?LINK_PID, A),
+ case node(A) == node(B) of
+ false ->
+ [#erl_link{type = ?LINK_PID,
+ pid = A,
+ targets = [B]}] = find_erl_link({node(A),
+ node(B)},
+ ?LINK_PID,
+ [A, [B]]),
+ [#erl_link{type = ?LINK_PID,
+ pid = B,
+ targets = [A]}] = find_erl_link({node(B),
+ node(A)},
+ ?LINK_PID,
+ [B, [A]]);
+ true ->
+ [] = find_erl_link({node(A), node(B)},
+ ?LINK_PID,
+ [A, [B]]),
+ [] = find_erl_link({node(B), node(A)},
+ ?LINK_PID,
+ [B, [A]])
+ end,
+ ok.
check_unlink(A, B) ->
- ?line [] = find_erl_link(A, ?LINK_PID, B),
- ?line [] = find_erl_link(B, ?LINK_PID, A),
- ?line [] = find_erl_link({node(A), node(B)}, ?LINK_PID, [A, [B]]),
- ?line [] = find_erl_link({node(B), node(A)}, ?LINK_PID, [B, [A]]),
- ?line ok.
+ [] = find_erl_link(A, ?LINK_PID, B),
+ [] = find_erl_link(B, ?LINK_PID, A),
+ [] = find_erl_link({node(A), node(B)}, ?LINK_PID, [A, [B]]),
+ [] = find_erl_link({node(B), node(A)}, ?LINK_PID, [B, [A]]),
+ ok.
check_process_monitor(From, {Name, Node}, Ref) when is_pid(From),
- is_atom(Name),
- Node == node(From),
- is_reference(Ref) ->
- ?line check_process_monitor(From, Name, Ref);
+ is_atom(Name),
+ Node == node(From),
+ is_reference(Ref) ->
+ check_process_monitor(From, Name, Ref);
check_process_monitor(From, {Name, Node}, Ref) when is_pid(From),
- is_atom(Name),
- is_atom(Node),
- is_reference(Ref) ->
- ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]),
- ?line [#erl_monitor{type = ?MON_ORIGIN,
- ref = Ref,
- pid = Node,
- name = Name}] = find_erl_monitor(From, Ref),
- ?line [#erl_monitor{type = ?MON_TARGET,
- ref = Ref,
- pid = From,
- name = Name}] = find_erl_monitor({node(From), Node}, Ref),
- ?line [#erl_monitor{type = ?MON_ORIGIN,
- ref = Ref,
- pid = MonitoredPid,
- name = Name}] = find_erl_monitor({Node, node(From)}, Ref),
- ?line [#erl_monitor{type = ?MON_TARGET,
- ref = Ref,
- pid = From,
- name = Name}] = find_erl_monitor(MonitoredPid, Ref),
- ?line ok;
+ is_atom(Name),
+ is_atom(Node),
+ is_reference(Ref) ->
+ MonitoredPid = rpc:call(Node, erlang, whereis, [Name]),
+ [#erl_monitor{type = ?MON_ORIGIN,
+ ref = Ref,
+ pid = Node,
+ name = Name}] = find_erl_monitor(From, Ref),
+ [#erl_monitor{type = ?MON_TARGET,
+ ref = Ref,
+ pid = From,
+ name = Name}] = find_erl_monitor({node(From), Node}, Ref),
+ [#erl_monitor{type = ?MON_ORIGIN,
+ ref = Ref,
+ pid = MonitoredPid,
+ name = Name}] = find_erl_monitor({Node, node(From)}, Ref),
+ [#erl_monitor{type = ?MON_TARGET,
+ ref = Ref,
+ pid = From,
+ name = Name}] = find_erl_monitor(MonitoredPid, Ref),
+ ok;
check_process_monitor(From, Name, Ref) when is_pid(From),
- is_atom(Name),
- undefined /= Name,
- is_reference(Ref) ->
- ?line MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]),
-
- ?line [#erl_monitor{type = ?MON_ORIGIN,
- ref = Ref,
- pid = MonitoredPid,
- name = Name}] = find_erl_monitor(From, Ref),
-
-
- ?line [#erl_monitor{type = ?MON_TARGET,
- ref = Ref,
- pid = From,
- name = Name}] = find_erl_monitor(MonitoredPid,Ref),
+ is_atom(Name),
+ undefined /= Name,
+ is_reference(Ref) ->
+ MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]),
+
+ [#erl_monitor{type = ?MON_ORIGIN,
+ ref = Ref,
+ pid = MonitoredPid,
+ name = Name}] = find_erl_monitor(From, Ref),
+
+
+ [#erl_monitor{type = ?MON_TARGET,
+ ref = Ref,
+ pid = From,
+ name = Name}] = find_erl_monitor(MonitoredPid,Ref),
ok;
check_process_monitor(From, To, Ref) when is_pid(From),
- is_pid(To),
- is_reference(Ref) ->
- ?line OriMon = [#erl_monitor{type = ?MON_ORIGIN,
- ref = Ref,
- pid = To}],
-
- ?line OriMon = find_erl_monitor(From, Ref),
-
- ?line TargMon = [#erl_monitor{type = ?MON_TARGET,
- ref = Ref,
- pid = From}],
- ?line TargMon = find_erl_monitor(To, Ref),
-
-
- ?line case node(From) == node(To) of
- false ->
- ?line TargMon = find_erl_monitor({node(From), node(To)}, Ref),
- ?line OriMon = find_erl_monitor({node(To), node(From)}, Ref);
- true ->
- ?line [] = find_erl_monitor({node(From), node(From)}, Ref)
- end,
- ?line ok.
+ is_pid(To),
+ is_reference(Ref) ->
+ OriMon = [#erl_monitor{type = ?MON_ORIGIN,
+ ref = Ref,
+ pid = To}],
+
+ OriMon = find_erl_monitor(From, Ref),
+
+ TargMon = [#erl_monitor{type = ?MON_TARGET,
+ ref = Ref,
+ pid = From}],
+ TargMon = find_erl_monitor(To, Ref),
+
+
+ case node(From) == node(To) of
+ false ->
+ TargMon = find_erl_monitor({node(From), node(To)}, Ref),
+ OriMon = find_erl_monitor({node(To), node(From)}, Ref);
+ true ->
+ [] = find_erl_monitor({node(From), node(From)}, Ref)
+ end,
+ ok.
check_process_demonitor(From, {undefined, Node}, Ref) when is_pid(From),
- is_reference(Ref) ->
- ?line [] = find_erl_monitor(From, Ref),
- ?line case node(From) == Node of
- false ->
- ?line [] = find_erl_monitor({node(From), Node}, Ref),
- ?line [] = find_erl_monitor({Node, node(From)}, Ref);
- true ->
- ?line [] = find_erl_monitor({Node, Node}, Ref)
- end,
- ?line ok;
+ is_reference(Ref) ->
+ [] = find_erl_monitor(From, Ref),
+ case node(From) == Node of
+ false ->
+ [] = find_erl_monitor({node(From), Node}, Ref),
+ [] = find_erl_monitor({Node, node(From)}, Ref);
+ true ->
+ [] = find_erl_monitor({Node, Node}, Ref)
+ end,
+ ok;
check_process_demonitor(From, {Name, Node}, Ref) when is_pid(From),
- is_atom(Name),
- Node == node(From),
- is_reference(Ref) ->
- ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]),
- ?line case rpc:call(Node, erlang, whereis, [Name]) of
- undefined ->
- ?line check_process_demonitor(From, {undefined, Node}, Ref);
- MonitoredPid ->
- ?line check_process_demonitor(From, MonitoredPid, Ref)
- end;
+ is_atom(Name),
+ Node == node(From),
+ is_reference(Ref) ->
+ MonitoredPid = rpc:call(Node, erlang, whereis, [Name]),
+ case rpc:call(Node, erlang, whereis, [Name]) of
+ undefined ->
+ check_process_demonitor(From, {undefined, Node}, Ref);
+ MonitoredPid ->
+ check_process_demonitor(From, MonitoredPid, Ref)
+ end;
check_process_demonitor(From, {Name, Node}, Ref) when is_pid(From),
- is_atom(Name),
- is_atom(Node),
- is_reference(Ref) ->
- ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]),
- ?line [] = find_erl_monitor(From, Ref),
- ?line [] = find_erl_monitor({node(From), Node}, Ref),
- ?line [] = find_erl_monitor({Node, node(From)}, Ref),
- ?line [] = find_erl_monitor(MonitoredPid, Ref),
- ?line ok;
+ is_atom(Name),
+ is_atom(Node),
+ is_reference(Ref) ->
+ MonitoredPid = rpc:call(Node, erlang, whereis, [Name]),
+ [] = find_erl_monitor(From, Ref),
+ [] = find_erl_monitor({node(From), Node}, Ref),
+ [] = find_erl_monitor({Node, node(From)}, Ref),
+ [] = find_erl_monitor(MonitoredPid, Ref),
+ ok;
check_process_demonitor(From, undefined, Ref) when is_pid(From),
- is_reference(Ref) ->
- ?line [] = find_erl_monitor(From, Ref),
- ?line case node(From) == node() of
- false ->
- ?line [] = find_erl_monitor({node(From), node()}, Ref),
- ?line [] = find_erl_monitor({node(), node(From)}, Ref);
- true ->
- ?line [] = find_erl_monitor({node(), node()}, Ref)
- end,
- ?line ok;
+ is_reference(Ref) ->
+ [] = find_erl_monitor(From, Ref),
+ case node(From) == node() of
+ false ->
+ [] = find_erl_monitor({node(From), node()}, Ref),
+ [] = find_erl_monitor({node(), node(From)}, Ref);
+ true ->
+ [] = find_erl_monitor({node(), node()}, Ref)
+ end,
+ ok;
check_process_demonitor(From, Name, Ref) when is_pid(From),
- is_atom(Name),
- undefined /= Name,
- is_reference(Ref) ->
- ?line check_process_demonitor(From, {Name, node()}, Ref);
+ is_atom(Name),
+ undefined /= Name,
+ is_reference(Ref) ->
+ check_process_demonitor(From, {Name, node()}, Ref);
check_process_demonitor(From, To, Ref) when is_pid(From),
- is_pid(To),
- is_reference(Ref) ->
- ?line [] = find_erl_monitor(From, Ref),
- ?line [] = find_erl_monitor(To, Ref),
- ?line case node(From) == node(To) of
- false ->
- ?line [] = find_erl_monitor({node(From), node(To)}, Ref),
- ?line [] = find_erl_monitor({node(To), node(From)}, Ref);
- true ->
- ?line [] = find_erl_monitor({node(From), node(From)}, Ref)
- end,
- ?line ok.
+ is_pid(To),
+ is_reference(Ref) ->
+ [] = find_erl_monitor(From, Ref),
+ [] = find_erl_monitor(To, Ref),
+ case node(From) == node(To) of
+ false ->
+ [] = find_erl_monitor({node(From), node(To)}, Ref),
+ [] = find_erl_monitor({node(To), node(From)}, Ref);
+ true ->
+ [] = find_erl_monitor({node(From), node(From)}, Ref)
+ end,
+ ok.
no_of_monitor_node(From, Node) when is_pid(From), is_atom(Node) ->
- ?line length(find_erl_link(From, ?LINK_NODE, Node)).
+ length(find_erl_link(From, ?LINK_NODE, Node)).
check_monitor_node(From, Node, No) when is_pid(From),
- is_atom(Node),
- is_integer(No),
- No >= 0 ->
- ?line LL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = Node}),
- ?line DLL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = From}),
- ?line LL = find_erl_link(From, ?LINK_NODE, Node),
- ?line DLL = find_erl_link({node(From), Node}, ?LINK_NODE, From),
- ?line ok.
+ is_atom(Node),
+ is_integer(No),
+ No >= 0 ->
+ LL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = Node}),
+ DLL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = From}),
+ LL = find_erl_link(From, ?LINK_NODE, Node),
+ DLL = find_erl_link({node(From), Node}, ?LINK_NODE, From),
+ ok.
hostname() ->
- ?line from($@, atom_to_list(node())).
+ from($@, atom_to_list(node())).
from(H, [H | T]) -> T;
from(H, [_ | T]) -> from(H, T);
@@ -1037,27 +1008,27 @@ get_names(0, _, Acc) ->
Acc;
get_names(N, T, Acc) ->
get_names(N-1, T, [list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(T)
- ++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
- ++ "-"
- ++ integer_to_list(erlang:unique_integer([positive]))) | Acc]).
+ ++ "-"
+ ++ atom_to_list(T)
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))) | Acc]).
start_node(Name) ->
- ?line start_node(Name, "").
+ start_node(Name, "").
start_node(Name, Args) ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line Res = ?t:start_node(Name, slave, [{args, Args ++ " -pa " ++ Pa}]),
- ?line {ok, Node} = Res,
- ?line rpc:call(Node, erts_debug, set_internal_state,
- [available_internal_state, true]),
- ?line Res.
-
+ Pa = filename:dirname(code:which(?MODULE)),
+ Res = test_server:start_node(Name, slave, [{args, Args ++ " -pa " ++ Pa}]),
+ {ok, Node} = Res,
+ rpc:call(Node, erts_debug, set_internal_state,
+ [available_internal_state, true]),
+ Res.
+
stop_node(Node) ->
- ?line ?t:stop_node(Node).
+ test_server:stop_node(Node).
-define(COOKIE, '').
-define(DOP_LINK, 1).
@@ -1080,37 +1051,37 @@ stop_node(Node) ->
dport_send(To, Msg) ->
Node = node(To),
DPrt = case dport(Node) of
- undefined ->
- pong = net_adm:ping(Node),
- dport(Node);
- Prt ->
- Prt
- end,
+ undefined ->
+ pong = net_adm:ping(Node),
+ dport(Node);
+ Prt ->
+ Prt
+ end,
port_command(DPrt, [dmsg_hdr(),
- dmsg_ext({?DOP_SEND,
- ?COOKIE,
- To}),
- dmsg_ext(Msg)]).
+ dmsg_ext({?DOP_SEND,
+ ?COOKIE,
+ To}),
+ dmsg_ext(Msg)]).
dport_reg_send(Node, Name, Msg) ->
DPrt = case dport(Node) of
- undefined ->
- pong = net_adm:ping(Node),
- dport(Node);
- Prt ->
- Prt
- end,
+ undefined ->
+ pong = net_adm:ping(Node),
+ dport(Node);
+ Prt ->
+ Prt
+ end,
port_command(DPrt, [dmsg_hdr(),
- dmsg_ext({?DOP_REG_SEND,
- self(),
- ?COOKIE,
- Name}),
- dmsg_ext(Msg)]).
+ dmsg_ext({?DOP_REG_SEND,
+ self(),
+ ?COOKIE,
+ Name}),
+ dmsg_ext(Msg)]).
dport(Node) when is_atom(Node) ->
case catch erts_debug:get_internal_state(available_internal_state) of
- true -> true;
- _ -> erts_debug:set_internal_state(available_internal_state, true)
+ true -> true;
+ _ -> erts_debug:set_internal_state(available_internal_state, true)
end,
erts_debug:get_internal_state({dist_port, Node}).
@@ -1136,11 +1107,7 @@ stop_busy_dist_port_tracer(_) ->
busy_dist_port_tracer() ->
receive
- {monitor, _SuspendedProcess, busy_dist_port, _Port} = M ->
- erlang:display(M),
- busy_dist_port_tracer()
+ {monitor, _SuspendedProcess, busy_dist_port, _Port} = M ->
+ erlang:display(M),
+ busy_dist_port_tracer()
end.
-
-
-
-
diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl
index 35677f9953..e757ebdb3d 100644
--- a/erts/emulator/test/erts_debug_SUITE.erl
+++ b/erts/emulator/test/erts_debug_SUITE.erl
@@ -19,42 +19,18 @@
%%
-module(erts_debug_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
- test_size/1,flat_size_big/1,df/1,
+-export([all/0, suite/0,
+ test_size/1,flat_size_big/1,df/1,term_type/1,
instructions/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
all() ->
- [test_size, flat_size_big, df, instructions].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(2)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
+ [test_size, flat_size_big, df, instructions, term_type].
test_size(Config) when is_list(Config) ->
ConsCell1 = id([a|b]),
@@ -138,9 +114,50 @@ flat_size_big_1(Term, Size0, Limit) when Size0 < Limit ->
end;
flat_size_big_1(_, _, _) -> ok.
+
+term_type(Config) when is_list(Config) ->
+ Ts = [{fixnum, 1},
+ {fixnum, -1},
+ {bignum, 1 bsl 300},
+ {bignum, -(1 bsl 300)},
+ {hfloat, 0.0},
+ {hfloat, 0.0/-1},
+ {hfloat, 1.0/(1 bsl 302)},
+ {hfloat, 1.0*(1 bsl 302)},
+ {hfloat, -1.0/(1 bsl 302)},
+ {hfloat, -1.0*(1 bsl 302)},
+ {hfloat, 3.1416},
+ {hfloat, 1.0e18},
+ {hfloat, -3.1416},
+ {hfloat, -1.0e18},
+
+ {heap_binary, <<1,2,3>>},
+ {refc_binary, <<0:(8*80)>>},
+ {sub_binary, <<5:7>>},
+
+ {flatmap, #{ a => 1}},
+ {hashmap, maps:from_list([{I,I}||I <- lists:seq(1,76)])},
+
+ {list, [1,2,3]},
+ {nil, []},
+ {tuple, {1,2,3}},
+ {tuple, {}},
+
+ {export, fun lists:sort/1},
+ {'fun', fun() -> ok end},
+ {pid, self()},
+ {atom, atom}],
+ lists:foreach(fun({E,Val}) ->
+ R = erts_internal:term_type(Val),
+ io:format("expecting term type ~w, got ~w (~p)~n", [E,R,Val]),
+ E = R
+ end, Ts),
+ ok.
+
+
df(Config) when is_list(Config) ->
P0 = pps(),
- PrivDir = ?config(priv_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
ok = file:set_cwd(PrivDir),
AllLoaded = [M || {M,_} <- code:all_loaded()],
diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl
index dc8f0aaee9..93728b299b 100644
--- a/erts/emulator/test/estone_SUITE.erl
+++ b/erts/emulator/test/estone_SUITE.erl
@@ -19,9 +19,8 @@
-module(estone_SUITE).
%% Test functions
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,estone/1,estone_bench/1]).
--export([init_per_testcase/2, end_per_testcase/2]).
+-export([all/0, suite/0, groups/0,
+ estone/1, estone_bench/1]).
%% Internal exports for EStone tests
-export([lists/1,
@@ -46,12 +45,9 @@
run_micro/3,p1/1,ppp/3,macro/2,micros/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("common_test/include/ct_event.hrl").
-%% Test suite defines
--define(default_timeout, ?t:minutes(10)).
-
%% EStone defines
-define(TOTAL, (3000 * 1000 * 100)). %% 300 secs
-define(BIGPROCS, 2).
@@ -66,17 +62,9 @@
str}). %% Header string
-
-
-init_per_testcase(_Case, Config) ->
- ?line Dog=test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
- ok.
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
[estone].
@@ -84,34 +72,18 @@ all() ->
groups() ->
[{estone_bench, [{repeat,50}],[estone_bench]}].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-estone(suite) ->
- [];
-estone(doc) ->
- ["EStone Test"];
+%% EStone Test
estone(Config) when is_list(Config) ->
- ?line DataDir = ?config(data_dir,Config),
- ?line Mhz=get_cpu_speed(os:type(),DataDir),
- ?line L = ?MODULE:macro(?MODULE:micros(),DataDir),
- ?line {Total, Stones} = sum_micros(L, 0, 0),
- ?line pp(Mhz,Total,Stones,L),
- ?line {comment,Mhz ++ " MHz, " ++
- integer_to_list(Stones) ++ " ESTONES"}.
+ DataDir = proplists:get_value(data_dir,Config),
+ Mhz=get_cpu_speed(os:type(),DataDir),
+ L = ?MODULE:macro(?MODULE:micros(),DataDir),
+ {Total, Stones} = sum_micros(L, 0, 0),
+ pp(Mhz,Total,Stones,L),
+ {comment,Mhz ++ " MHz, " ++ integer_to_list(Stones) ++ " ESTONES"}.
estone_bench(Config) ->
- DataDir = ?config(data_dir,Config),
+ DataDir = proplists:get_value(data_dir,Config),
L = ?MODULE:macro(?MODULE:micros(),DataDir),
[ct_event:notify(
#event{name = benchmark_data,
@@ -382,11 +354,11 @@ apply_micro(M) ->
{weight_percentage, M#micro.weight},
{loops, M#micro.loops},
{microsecs,MicroSecs},
- {estones, (M#micro.weight * M#micro.weight * ?STONEFACTOR) div MicroSecs},
+ {estones, (M#micro.weight * M#micro.weight * ?STONEFACTOR) div max(1,MicroSecs)},
{gcs, GC1 - GC0},
{kilo_word_reclaimed, (Words1 - Words0) div 1000},
{kilo_reductions, Reds div 1000},
- {gc_intensity, gci(Elapsed, GC1 - GC0, Words1 - Words0)}].
+ {gc_intensity, gci(max(1,Elapsed), GC1 - GC0, Words1 - Words0)}].
monotonic_time() ->
try erlang:monotonic_time() catch error:undef -> erlang:now() end.
@@ -1136,4 +1108,3 @@ wait_for_pids([P|Tail]) ->
send_procs([P|Tail], Msg) -> P ! Msg, send_procs(Tail, Msg);
send_procs([], _) -> ok.
-
diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl
index 484d2a8bf5..5f5a0ef305 100644
--- a/erts/emulator/test/evil_SUITE.erl
+++ b/erts/emulator/test/evil_SUITE.erl
@@ -19,23 +19,22 @@
-module(evil_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
- heap_frag/1,
- encode_decode_ext/1,
- decode_integer_ext/1,
- decode_small_big_ext/1,
- decode_large_big_ext/1,
- decode_small_big_ext_neg/1,
- decode_large_big_ext_neg/1,
- decode_too_small/1,
- decode_pos_neg_zero/1
- ]).
-
--include_lib("test_server/include/test_server.hrl").
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+-export([all/0, suite/0,
+ heap_frag/1,
+ encode_decode_ext/1,
+ decode_integer_ext/1,
+ decode_small_big_ext/1,
+ decode_large_big_ext/1,
+ decode_small_big_ext_neg/1,
+ decode_large_big_ext_neg/1,
+ decode_too_small/1,
+ decode_pos_neg_zero/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 30}}].
all() ->
[heap_frag, encode_decode_ext, decode_integer_ext,
@@ -43,41 +42,16 @@ all() ->
decode_small_big_ext_neg, decode_large_big_ext_neg,
decode_too_small, decode_pos_neg_zero].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(_Case, Config) ->
- ?line Dog = test_server:timetrap(?t:minutes(0.5)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
heap_frag(Config) when is_list(Config) ->
N = 512,
Self = self(),
- ?line Pid = spawn_link(fun() -> appender(Self, N) end),
+ Pid = spawn_link(fun() -> appender(Self, N) end),
receive
- {Pid,Res} ->
- ?line Res = my_appender(N);
- Garbage ->
- io:format("Garbage: ~p\n", [Garbage]),
- ?line ?t:fail(got_garbage)
+ {Pid,Res} ->
+ Res = my_appender(N);
+ Garbage ->
+ io:format("Garbage: ~p\n", [Garbage]),
+ ct:fail(got_garbage)
end.
@@ -87,29 +61,28 @@ heap_frag(Config) when is_list(Config) ->
%% These test cases are not "evil" but the next test case is....
encode_decode_ext(Config) when is_list(Config) ->
- ?line enc_dec( 2, 0), % SMALL_INTEGER_EXT smallest
- ?line enc_dec( 2, 255), % SMALL_INTEGER_EXT largest
- ?line enc_dec( 5, 256), % INTEGER_EXT smallest pos (*)
- ?line enc_dec( 5, -1), % INTEGER_EXT largest neg
-
- ?line enc_dec( 5, 16#07ffffff), % INTEGER_EXT largest (28 bits)
- ?line enc_dec( 5,-16#08000000), % INTEGER_EXT smallest
- ?line enc_dec( 7, 16#08000000), % SMALL_BIG_EXT smallest pos(*)
- ?line enc_dec( 7,-16#08000001), % SMALL_BIG_EXT largest neg (*)
-
- ?line enc_dec( 7, 16#7fffffff), % SMALL_BIG_EXT largest i32
- ?line enc_dec( 7,-16#80000000), % SMALL_BIG_EXT smallest i32
-
- ?line enc_dec( 7, 16#80000000), % SMALL_BIG_EXT u32
- ?line enc_dec( 7, 16#ffffffff), % SMALL_BIG_EXT largest u32
-
- ?line enc_dec( 9, 16#7fffffffffff), % largest i48
- ?line enc_dec( 9,-16#800000000000), % smallest i48
- ?line enc_dec( 9, 16#ffffffffffff), % largest u48
- ?line enc_dec(11, 16#7fffffffffffffff), % largest i64
- ?line enc_dec(11,-16#8000000000000000), % smallest i64
- ?line enc_dec(11, 16#ffffffffffffffff), % largest u64
-
+ enc_dec( 2, 0), % SMALL_INTEGER_EXT smallest
+ enc_dec( 2, 255), % SMALL_INTEGER_EXT largest
+ enc_dec( 5, 256), % INTEGER_EXT smallest pos (*)
+ enc_dec( 5, -1), % INTEGER_EXT largest neg
+
+ enc_dec( 5, 16#07ffffff), % INTEGER_EXT largest (28 bits)
+ enc_dec( 5,-16#08000000), % INTEGER_EXT smallest
+ enc_dec( 7, 16#08000000), % SMALL_BIG_EXT smallest pos(*)
+ enc_dec( 7,-16#08000001), % SMALL_BIG_EXT largest neg (*)
+
+ enc_dec( 7, 16#7fffffff), % SMALL_BIG_EXT largest i32
+ enc_dec( 7,-16#80000000), % SMALL_BIG_EXT smallest i32
+
+ enc_dec( 7, 16#80000000), % SMALL_BIG_EXT u32
+ enc_dec( 7, 16#ffffffff), % SMALL_BIG_EXT largest u32
+
+ enc_dec( 9, 16#7fffffffffff), % largest i48
+ enc_dec( 9,-16#800000000000), % smallest i48
+ enc_dec( 9, 16#ffffffffffff), % largest u48
+ enc_dec(11, 16#7fffffffffffffff), % largest i64
+ enc_dec(11,-16#8000000000000000), % smallest i64
+ enc_dec(11, 16#ffffffffffffffff), % largest u64
ok.
@@ -125,213 +98,213 @@ encode_decode_ext(Config) when is_list(Config) ->
%% erl_interface, i.e. not how it is encoded in the test case below.
decode_integer_ext(Config) when is_list(Config) ->
- ?line decode( 0, <<131,98, 0:32>>), % SMALL_INTEGER_EXT
- ?line decode( 42, <<131,98, 42:32>>), % SMALL_INTEGER_EXT
- ?line decode(255, <<131,98,255:32>>), % SMALL_INTEGER_EXT
- ?line decode( 16#08000000, <<131,98, 16#08000000:32>>), % SMALL_BIG_EXT
- ?line decode(-16#08000001, <<131,98,-16#08000001:32>>), % SMALL_BIG_EXT
- ?line decode( 16#7fffffff, <<131,98, 16#7fffffff:32>>), % SMALL_BIG_EXT
- ?line decode(-16#80000000, <<131,98,-16#80000000:32>>), % SMALL_BIG_EXT
+ decode( 0, <<131,98, 0:32>>), % SMALL_INTEGER_EXT
+ decode( 42, <<131,98, 42:32>>), % SMALL_INTEGER_EXT
+ decode(255, <<131,98,255:32>>), % SMALL_INTEGER_EXT
+ decode( 16#08000000, <<131,98, 16#08000000:32>>), % SMALL_BIG_EXT
+ decode(-16#08000001, <<131,98,-16#08000001:32>>), % SMALL_BIG_EXT
+ decode( 16#7fffffff, <<131,98, 16#7fffffff:32>>), % SMALL_BIG_EXT
+ decode(-16#80000000, <<131,98,-16#80000000:32>>), % SMALL_BIG_EXT
ok.
decode_small_big_ext(Config) when is_list(Config) ->
- ?line decode(256,<<131,110,2,0,0,1>>), % INTEGER_EXT
- ?line decode(16#07ffffff,<<131,110,4,0,255,255,255,7>>), % INTEGER_EXT
- ?line decode(16#7fffffff,<<131,110,4,0,255,255,255,127>>), % SMALL_BIG_EXT
-
- ?line decode(42,<<131,110,1,0,42>>), % SMALL_INTEGER_EXT
- ?line decode(42,<<131,110,2,0,42,0>>), % Redundant zeros from now on
- ?line decode(42,<<131,110,3,0,42,0,0>>),
- ?line decode(42,<<131,110,4,0,42,0,0,0>>),
- ?line decode(42,<<131,110,5,0,42,0,0,0,0>>),
- ?line decode(42,<<131,110,6,0,42,0,0,0,0,0>>),
- ?line decode(42,<<131,110,7,0,42,0,0,0,0,0,0>>),
- ?line decode(42,<<131,110,8,0,42,0,0,0,0,0,0,0>>),
+ decode(256,<<131,110,2,0,0,1>>), % INTEGER_EXT
+ decode(16#07ffffff,<<131,110,4,0,255,255,255,7>>), % INTEGER_EXT
+ decode(16#7fffffff,<<131,110,4,0,255,255,255,127>>), % SMALL_BIG_EXT
+
+ decode(42,<<131,110,1,0,42>>), % SMALL_INTEGER_EXT
+ decode(42,<<131,110,2,0,42,0>>), % Redundant zeros from now on
+ decode(42,<<131,110,3,0,42,0,0>>),
+ decode(42,<<131,110,4,0,42,0,0,0>>),
+ decode(42,<<131,110,5,0,42,0,0,0,0>>),
+ decode(42,<<131,110,6,0,42,0,0,0,0,0>>),
+ decode(42,<<131,110,7,0,42,0,0,0,0,0,0>>),
+ decode(42,<<131,110,8,0,42,0,0,0,0,0,0,0>>),
ok.
decode_large_big_ext(Config) when is_list(Config) ->
- ?line decode(256,<<131,111,2:32,0,0,1>>), % INTEGER_EXT
- ?line decode(16#07ffffff,<<131,111,4:32,0,255,255,255,7>>), % INTEG_EXT
- ?line decode(16#7fffffff,<<131,111,4:32,0,255,255,255,127>>), % SMA_BIG
- ?line decode(16#ffffffff,<<131,111,4:32,0,255,255,255,255>>), % SMA_BIG
+ decode(256,<<131,111,2:32,0,0,1>>), % INTEGER_EXT
+ decode(16#07ffffff,<<131,111,4:32,0,255,255,255,7>>), % INTEG_EXT
+ decode(16#7fffffff,<<131,111,4:32,0,255,255,255,127>>), % SMA_BIG
+ decode(16#ffffffff,<<131,111,4:32,0,255,255,255,255>>), % SMA_BIG
N = largest_small_big(),
- ?line decode(N,<<131,111,255:32,0,N:2040/little>>), % SMALL_BIG_EXT
-
- ?line decode(42,<<131,111,1:32,0,42>>),
- ?line decode(42,<<131,111,2:32,0,42,0>>), % Redundant zeros from now on
- ?line decode(42,<<131,111,3:32,0,42,0,0>>),
- ?line decode(42,<<131,111,4:32,0,42,0,0,0>>),
- ?line decode(42,<<131,111,5:32,0,42,0,0,0,0>>),
- ?line decode(42,<<131,111,6:32,0,42,0,0,0,0,0>>),
- ?line decode(42,<<131,111,7:32,0,42,0,0,0,0,0,0>>),
- ?line decode(42,<<131,111,8:32,0,42,0,0,0,0,0,0,0>>),
+ decode(N,<<131,111,255:32,0,N:2040/little>>), % SMALL_BIG_EXT
+
+ decode(42,<<131,111,1:32,0,42>>),
+ decode(42,<<131,111,2:32,0,42,0>>), % Redundant zeros from now on
+ decode(42,<<131,111,3:32,0,42,0,0>>),
+ decode(42,<<131,111,4:32,0,42,0,0,0>>),
+ decode(42,<<131,111,5:32,0,42,0,0,0,0>>),
+ decode(42,<<131,111,6:32,0,42,0,0,0,0,0>>),
+ decode(42,<<131,111,7:32,0,42,0,0,0,0,0,0>>),
+ decode(42,<<131,111,8:32,0,42,0,0,0,0,0,0,0>>),
ok.
decode_small_big_ext_neg(Config) when is_list(Config) ->
- ?line decode(-1,<<131,110,1,1,1>>), % INTEGER_EXT
- ?line decode(-16#08000000,<<131,110,4,1,0,0,0,8>>), % INTEGER_EXT
- ?line decode(-16#80000000,<<131,110,4,1,0,0,0,128>>), % SMALL_BIG_EXT
- ?line decode(-16#ffffffff,<<131,110,4,1,255,255,255,255>>), % SMALL_BIG_EXT
+ decode(-1,<<131,110,1,1,1>>), % INTEGER_EXT
+ decode(-16#08000000,<<131,110,4,1,0,0,0,8>>), % INTEGER_EXT
+ decode(-16#80000000,<<131,110,4,1,0,0,0,128>>), % SMALL_BIG_EXT
+ decode(-16#ffffffff,<<131,110,4,1,255,255,255,255>>), % SMALL_BIG_EXT
N = largest_small_big(),
- ?line decode(-N,<<131,111,255:32,1,N:2040/little>>), % SMALL_BIG_EXT
-
- ?line decode(-42,<<131,110,1,1,42>>),
- ?line decode(-42,<<131,110,2,1,42,0>>), % Redundant zeros from now on
- ?line decode(-42,<<131,110,3,1,42,0,0>>),
- ?line decode(-42,<<131,110,4,1,42,0,0,0>>),
- ?line decode(-42,<<131,110,5,1,42,0,0,0,0>>),
- ?line decode(-42,<<131,110,6,1,42,0,0,0,0,0>>),
- ?line decode(-42,<<131,110,7,1,42,0,0,0,0,0,0>>),
- ?line decode(-42,<<131,110,8,1,42,0,0,0,0,0,0,0>>),
+ decode(-N,<<131,111,255:32,1,N:2040/little>>), % SMALL_BIG_EXT
+
+ decode(-42,<<131,110,1,1,42>>),
+ decode(-42,<<131,110,2,1,42,0>>), % Redundant zeros from now on
+ decode(-42,<<131,110,3,1,42,0,0>>),
+ decode(-42,<<131,110,4,1,42,0,0,0>>),
+ decode(-42,<<131,110,5,1,42,0,0,0,0>>),
+ decode(-42,<<131,110,6,1,42,0,0,0,0,0>>),
+ decode(-42,<<131,110,7,1,42,0,0,0,0,0,0>>),
+ decode(-42,<<131,110,8,1,42,0,0,0,0,0,0,0>>),
ok.
decode_large_big_ext_neg(Config) when is_list(Config) ->
- ?line decode(-1,<<131,111,1:32,1,1>>), % INTEGER_EXT
- ?line decode(-16#08000000,<<131,111,4:32,1,0,0,0,8>>), % INTEGER_EXT
- ?line decode(-16#80000000,<<131,111,4:32,1,0,0,0,128>>), % SMALL_BIG_EXT
-
- ?line decode(-42,<<131,111,1:32,1,42>>),
- ?line decode(-42,<<131,111,2:32,1,42,0>>), % Redundant zeros from now on
- ?line decode(-42,<<131,111,3:32,1,42,0,0>>),
- ?line decode(-42,<<131,111,4:32,1,42,0,0,0>>),
- ?line decode(-42,<<131,111,5:32,1,42,0,0,0,0>>),
- ?line decode(-42,<<131,111,6:32,1,42,0,0,0,0,0>>),
- ?line decode(-42,<<131,111,7:32,1,42,0,0,0,0,0,0>>),
- ?line decode(-42,<<131,111,8:32,1,42,0,0,0,0,0,0,0>>),
+ decode(-1,<<131,111,1:32,1,1>>), % INTEGER_EXT
+ decode(-16#08000000,<<131,111,4:32,1,0,0,0,8>>), % INTEGER_EXT
+ decode(-16#80000000,<<131,111,4:32,1,0,0,0,128>>), % SMALL_BIG_EXT
+
+ decode(-42,<<131,111,1:32,1,42>>),
+ decode(-42,<<131,111,2:32,1,42,0>>), % Redundant zeros from now on
+ decode(-42,<<131,111,3:32,1,42,0,0>>),
+ decode(-42,<<131,111,4:32,1,42,0,0,0>>),
+ decode(-42,<<131,111,5:32,1,42,0,0,0,0>>),
+ decode(-42,<<131,111,6:32,1,42,0,0,0,0,0>>),
+ decode(-42,<<131,111,7:32,1,42,0,0,0,0,0,0>>),
+ decode(-42,<<131,111,8:32,1,42,0,0,0,0,0,0,0>>),
ok.
decode_pos_neg_zero(Config) when is_list(Config) ->
- ?line decode( 0, <<131,110,0,0>>), % SMALL_BIG_EXT (positive zero)
- ?line decode( 0, <<131,110,1,0,0>>), % SMALL_BIG_EXT (positive zero)
- ?line decode( 0, <<131,110,0,1>>), % SMALL_BIG_EXT (negative zero)
- ?line decode( 0, <<131,110,1,1,0>>), % SMALL_BIG_EXT (negative zero)
+ decode( 0, <<131,110,0,0>>), % SMALL_BIG_EXT (positive zero)
+ decode( 0, <<131,110,1,0,0>>), % SMALL_BIG_EXT (positive zero)
+ decode( 0, <<131,110,0,1>>), % SMALL_BIG_EXT (negative zero)
+ decode( 0, <<131,110,1,1,0>>), % SMALL_BIG_EXT (negative zero)
- ?line decode( 0, <<131,111,0:32,0>>), % SMALL_BIG_EXT (positive zero)
- ?line decode( 0, <<131,111,1:32,0,0>>), % SMALL_BIG_EXT (positive zero)
- ?line decode( 0, <<131,111,0:32,1>>), % SMALL_BIG_EXT (negative zero)
- ?line decode( 0, <<131,111,1:32,1,0>>), % SMALL_BIG_EXT (negative zero)
+ decode( 0, <<131,111,0:32,0>>), % SMALL_BIG_EXT (positive zero)
+ decode( 0, <<131,111,1:32,0,0>>), % SMALL_BIG_EXT (positive zero)
+ decode( 0, <<131,111,0:32,1>>), % SMALL_BIG_EXT (negative zero)
+ decode( 0, <<131,111,1:32,1,0>>), % SMALL_BIG_EXT (negative zero)
N = largest_small_big(),
- ?line decode( N,<<131,110,255,0,N:2040/little>>), % largest SMALL_BIG_EXT
- ?line decode(-N,<<131,110,255,1,N:2040/little>>), % largest SMALL_BIG_EXT
+ decode( N,<<131,110,255,0,N:2040/little>>), % largest SMALL_BIG_EXT
+ decode(-N,<<131,110,255,1,N:2040/little>>), % largest SMALL_BIG_EXT
ok.
%% Test to decode uncompleted encodings for all in "erl_ext_dist.txt"
decode_too_small(Config) when is_list(Config) ->
- ?line decode_badarg(<<131, 97>>),
- ?line decode_badarg(<<131, 98>>),
- ?line decode_badarg(<<131, 98, 0>>),
- ?line decode_badarg(<<131, 98, 0, 0>>),
- ?line decode_badarg(<<131, 98, 0, 0, 0>>),
- ?line decode_badarg(<<131, 99>>),
- ?line decode_badarg(<<131, 99, 0>>),
- ?line decode_badarg(<<131, 99, 0:240>>),
-
- ?line decode_badarg(<<131,100>>),
- ?line decode_badarg(<<131,100, 1:16/big>>),
- ?line decode_badarg(<<131,100, 2:16/big>>),
- ?line decode_badarg(<<131,100, 2:16/big, "A">>),
+ decode_badarg(<<131, 97>>),
+ decode_badarg(<<131, 98>>),
+ decode_badarg(<<131, 98, 0>>),
+ decode_badarg(<<131, 98, 0, 0>>),
+ decode_badarg(<<131, 98, 0, 0, 0>>),
+ decode_badarg(<<131, 99>>),
+ decode_badarg(<<131, 99, 0>>),
+ decode_badarg(<<131, 99, 0:240>>),
+
+ decode_badarg(<<131,100>>),
+ decode_badarg(<<131,100, 1:16/big>>),
+ decode_badarg(<<131,100, 2:16/big>>),
+ decode_badarg(<<131,100, 2:16/big, "A">>),
% FIXME node name "A" seem ok, should it be?
-% ?line decode_badarg(<<131,101,100,1:16/big,"A",42:32/big,0>>),
-
- ?line decode_badarg(<<131,101>>),
- ?line decode_badarg(<<131,101,106>>),
- ?line decode_badarg(<<131,101,255>>),
- ?line decode_badarg(<<131,101,106,42:8/big>>),
- ?line decode_badarg(<<131,101,106,42:16/big>>),
- ?line decode_badarg(<<131,101,255,42:24/big>>),
- ?line decode_badarg(<<131,101,255,42:32/big,0>>),
- ?line decode_badarg(<<131,101,100,1:16/big,"A">>),
- ?line decode_badarg(<<131,101,100,1:16/big,"A",42:32/big>>),
-
- ?line decode_badarg(<<131,102>>),
- ?line decode_badarg(<<131,102,106,42:32/big,0>>),
- ?line decode_badarg(<<131,102,255,42:32/big,0>>),
- ?line decode_badarg(<<131,102,100,1:16/big,"A">>),
- ?line decode_badarg(<<131,102,100,1:16/big,"A",42:32/big>>),
-
- ?line decode_badarg(<<131,103>>),
- ?line decode_badarg(<<131,103,106,42:32/big,0>>),
- ?line decode_badarg(<<131,103,255,42:32/big,0>>),
- ?line decode_badarg(<<131,103,100,1:16/big,"A">>),
- ?line decode_badarg(<<131,103,100,1:16/big,"A",42:32/big>>),
- ?line decode_badarg(<<131,103,100,1:16/big,"A",4:32/big,2:32/big>>),
-
- ?line decode_badarg(<<131,104>>),
- ?line decode_badarg(<<131,104, 1>>),
- ?line decode_badarg(<<131,104, 2, 106>>),
- ?line decode_badarg(<<131,105, 1:32/big>>),
- ?line decode_badarg(<<131,105, 2:32/big, 106>>),
-
- ?line decode_badarg(<<131,107>>),
- ?line decode_badarg(<<131,107, 1:16/big>>),
- ?line decode_badarg(<<131,107, 2:16/big>>),
- ?line decode_badarg(<<131,107, 2:16/big, "A">>),
-
- ?line decode_badarg(<<131,108>>),
- ?line decode_badarg(<<131,108, 1:32/big>>),
- ?line decode_badarg(<<131,108, 2:32/big>>),
- ?line decode_badarg(<<131,108, 2:32/big, 106>>), % FIXME don't use NIL
-
- ?line decode_badarg(<<131,109>>),
- ?line decode_badarg(<<131,109, 1:32/big>>),
- ?line decode_badarg(<<131,109, 2:32/big>>),
- ?line decode_badarg(<<131,109, 2:32/big, 42>>),
+ % decode_badarg(<<131,101,100,1:16/big,"A",42:32/big,0>>),
+
+ decode_badarg(<<131,101>>),
+ decode_badarg(<<131,101,106>>),
+ decode_badarg(<<131,101,255>>),
+ decode_badarg(<<131,101,106,42:8/big>>),
+ decode_badarg(<<131,101,106,42:16/big>>),
+ decode_badarg(<<131,101,255,42:24/big>>),
+ decode_badarg(<<131,101,255,42:32/big,0>>),
+ decode_badarg(<<131,101,100,1:16/big,"A">>),
+ decode_badarg(<<131,101,100,1:16/big,"A",42:32/big>>),
+
+ decode_badarg(<<131,102>>),
+ decode_badarg(<<131,102,106,42:32/big,0>>),
+ decode_badarg(<<131,102,255,42:32/big,0>>),
+ decode_badarg(<<131,102,100,1:16/big,"A">>),
+ decode_badarg(<<131,102,100,1:16/big,"A",42:32/big>>),
+
+ decode_badarg(<<131,103>>),
+ decode_badarg(<<131,103,106,42:32/big,0>>),
+ decode_badarg(<<131,103,255,42:32/big,0>>),
+ decode_badarg(<<131,103,100,1:16/big,"A">>),
+ decode_badarg(<<131,103,100,1:16/big,"A",42:32/big>>),
+ decode_badarg(<<131,103,100,1:16/big,"A",4:32/big,2:32/big>>),
+
+ decode_badarg(<<131,104>>),
+ decode_badarg(<<131,104, 1>>),
+ decode_badarg(<<131,104, 2, 106>>),
+ decode_badarg(<<131,105, 1:32/big>>),
+ decode_badarg(<<131,105, 2:32/big, 106>>),
+
+ decode_badarg(<<131,107>>),
+ decode_badarg(<<131,107, 1:16/big>>),
+ decode_badarg(<<131,107, 2:16/big>>),
+ decode_badarg(<<131,107, 2:16/big, "A">>),
+
+ decode_badarg(<<131,108>>),
+ decode_badarg(<<131,108, 1:32/big>>),
+ decode_badarg(<<131,108, 2:32/big>>),
+ decode_badarg(<<131,108, 2:32/big, 106>>), % FIXME don't use NIL
+
+ decode_badarg(<<131,109>>),
+ decode_badarg(<<131,109, 1:32/big>>),
+ decode_badarg(<<131,109, 2:32/big>>),
+ decode_badarg(<<131,109, 2:32/big, 42>>),
N = largest_small_big(),
- ?line decode_badarg(<<131,110>>),
- ?line decode_badarg(<<131,110,1>>),
- ?line decode_badarg(<<131,110,1,0>>),
- ?line decode_badarg(<<131,110,1,1>>),
- ?line decode_badarg(<<131,110,2,0,42>>),
- ?line decode_badarg(<<131,110,2,1,42>>),
- ?line decode_badarg(<<131,110,255,0,N:2032/little>>),
- ?line decode_badarg(<<131,110,255,1,N:2032/little>>),
-
- ?line decode_badarg(<<131,111>>),
- ?line decode_badarg(<<131,111, 1:32/big>>),
- ?line decode_badarg(<<131,111, 1:32/big,0>>),
- ?line decode_badarg(<<131,111, 1:32/big,1>>),
- ?line decode_badarg(<<131,111, 2:32/big,0,42>>),
- ?line decode_badarg(<<131,111, 2:32/big,1,42>>),
- ?line decode_badarg(<<131,111,256:32/big,0,N:2032/little>>),
- ?line decode_badarg(<<131,111,256:32/big,1,N:2032/little>>),
- ?line decode_badarg(<<131,111,256:32/big,0,N:2040/little>>),
- ?line decode_badarg(<<131,111,256:32/big,1,N:2040/little>>),
- ?line decode_badarg(<<131,111,257:32/big,0,N:2048/little>>),
- ?line decode_badarg(<<131,111,257:32/big,1,N:2048/little>>),
+ decode_badarg(<<131,110>>),
+ decode_badarg(<<131,110,1>>),
+ decode_badarg(<<131,110,1,0>>),
+ decode_badarg(<<131,110,1,1>>),
+ decode_badarg(<<131,110,2,0,42>>),
+ decode_badarg(<<131,110,2,1,42>>),
+ decode_badarg(<<131,110,255,0,N:2032/little>>),
+ decode_badarg(<<131,110,255,1,N:2032/little>>),
+
+ decode_badarg(<<131,111>>),
+ decode_badarg(<<131,111, 1:32/big>>),
+ decode_badarg(<<131,111, 1:32/big,0>>),
+ decode_badarg(<<131,111, 1:32/big,1>>),
+ decode_badarg(<<131,111, 2:32/big,0,42>>),
+ decode_badarg(<<131,111, 2:32/big,1,42>>),
+ decode_badarg(<<131,111,256:32/big,0,N:2032/little>>),
+ decode_badarg(<<131,111,256:32/big,1,N:2032/little>>),
+ decode_badarg(<<131,111,256:32/big,0,N:2040/little>>),
+ decode_badarg(<<131,111,256:32/big,1,N:2040/little>>),
+ decode_badarg(<<131,111,257:32/big,0,N:2048/little>>),
+ decode_badarg(<<131,111,257:32/big,1,N:2048/little>>),
% Emulator dies if trying to create large bignum....
-% ?line decode_badarg(<<131,111,16#ffffffff:32/big,0>>),
-% ?line decode_badarg(<<131,111,16#ffffffff:32/big,1>>),
-
- ?line decode_badarg(<<131, 78>>),
- ?line decode_badarg(<<131, 78, 42>>),
- ?line decode_badarg(<<131, 78, 42, 1>>),
- ?line decode_badarg(<<131, 78, 42, 1:16/big>>),
- ?line decode_badarg(<<131, 78, 42, 2:16/big>>),
- ?line decode_badarg(<<131, 78, 42, 2:16/big, "A">>),
-
- ?line decode_badarg(<<131, 67>>),
-
- ?line decode_badarg(<<131,114>>),
- ?line decode_badarg(<<131,114,0>>),
- ?line decode_badarg(<<131,114,1:16/big>>),
- ?line decode_badarg(<<131,114,1:16/big,100>>),
- ?line decode_badarg(<<131,114,1:16/big,100,1:16/big>>),
- ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A">>),
- ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0>>),
- ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:8>>),
- ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:16>>),
- ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:24>>),
-
- ?line decode_badarg(<<131,117>>), % FIXME needs more tests
+ % decode_badarg(<<131,111,16#ffffffff:32/big,0>>),
+ % decode_badarg(<<131,111,16#ffffffff:32/big,1>>),
+
+ decode_badarg(<<131, 78>>),
+ decode_badarg(<<131, 78, 42>>),
+ decode_badarg(<<131, 78, 42, 1>>),
+ decode_badarg(<<131, 78, 42, 1:16/big>>),
+ decode_badarg(<<131, 78, 42, 2:16/big>>),
+ decode_badarg(<<131, 78, 42, 2:16/big, "A">>),
+
+ decode_badarg(<<131, 67>>),
+
+ decode_badarg(<<131,114>>),
+ decode_badarg(<<131,114,0>>),
+ decode_badarg(<<131,114,1:16/big>>),
+ decode_badarg(<<131,114,1:16/big,100>>),
+ decode_badarg(<<131,114,1:16/big,100,1:16/big>>),
+ decode_badarg(<<131,114,1:16/big,100,1:16/big,"A">>),
+ decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0>>),
+ decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:8>>),
+ decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:16>>),
+ decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:24>>),
+
+ decode_badarg(<<131,117>>), % FIXME needs more tests
ok.
@@ -380,12 +353,11 @@ my_appender_1(N, T0) ->
U = rnd_term(),
T = [U|T0],
my_appender_1(N-1, T).
-
+
seed() ->
- random:seed(3172, 9815, 20129).
+ rand:seed(exsplus, {3172,9815,20129}).
rnd_term() ->
- U0 = random:uniform(),
+ U0 = rand:uniform(),
B = <<U0/float>>,
{U0,U0 * 2.5 + 3.14,[U0*2.3,B]}.
-
diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl
index 11caea3698..1cad7e7920 100644
--- a/erts/emulator/test/exception_SUITE.erl
+++ b/erts/emulator/test/exception_SUITE.erl
@@ -20,67 +20,52 @@
-module(exception_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- badmatch/1, pending_errors/1, nil_arith/1,
+-export([all/0, suite/0,
+ badmatch/1, pending_errors/1, nil_arith/1,
stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1,
- exception_with_heap_frag/1, line_numbers/1]).
+ exception_with_heap_frag/1, line_numbers/1]).
-export([bad_guy/2]).
-export([crash/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-import(lists, [foreach/2]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 10}}].
all() ->
[badmatch, pending_errors, nil_arith, stacktrace,
nested_stacktrace, raise, gunilla, per,
exception_with_heap_frag, line_numbers].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-define(try_match(E),
- catch ?MODULE:bar(),
- {'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))).
+ catch ?MODULE:bar(),
+ {'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))).
%% Test that deliberately bad matches are reported correctly.
badmatch(Config) when is_list(Config) ->
- ?line ?try_match(a),
- ?line ?try_match(42),
- ?line ?try_match({a, b, c}),
- ?line ?try_match([]),
- ?line ?try_match(1.0),
+ ?try_match(a),
+ ?try_match(42),
+ ?try_match({a, b, c}),
+ ?try_match([]),
+ ?try_match(1.0),
ok.
%% Test various exceptions, in the presence of a previous error suppressed
%% in a guard.
pending_errors(Config) when is_list(Config) ->
- ?line pending(e_badmatch, {badmatch, b}),
- ?line pending(x, function_clause),
- ?line pending(e_case, {case_clause, xxx}),
- ?line pending(e_if, if_clause),
- ?line pending(e_badarith, badarith),
- ?line pending(e_undef, undef),
- ?line pending(e_timeoutval, timeout_value),
- ?line pending(e_badarg, badarg),
- ?line pending(e_badarg_spawn, badarg),
+ pending(e_badmatch, {badmatch, b}),
+ pending(x, function_clause),
+ pending(e_case, {case_clause, xxx}),
+ pending(e_if, if_clause),
+ pending(e_badarith, badarith),
+ pending(e_undef, undef),
+ pending(e_timeoutval, timeout_value),
+ pending(e_badarg, badarg),
+ pending(e_badarg_spawn, badarg),
ok.
bad_guy(pe_badarith, Other) when Other+1 == 0 -> % badarith (suppressed)
@@ -89,11 +74,11 @@ bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed)
ok;
bad_guy(_, e_case) ->
case id(xxx) of
- ok -> ok
+ ok -> ok
end; % case_clause
bad_guy(_, e_if) ->
if
- a == b -> ok
+ a == b -> ok
end; % if_clause
bad_guy(_, e_badarith) ->
1+b; % badarith
@@ -101,9 +86,9 @@ bad_guy(_, e_undef) ->
non_existing_module:foo(); % undef
bad_guy(_, e_timeoutval) ->
receive
- after arne -> % timeout_value
- ok
- end;
+ after arne -> % timeout_value
+ ok
+ end;
bad_guy(_, e_badarg) ->
node(xxx); % badarg
bad_guy(_, e_badarg_spawn) ->
@@ -122,30 +107,30 @@ pending(First, Second, Expected) ->
pending_catched(First, Second, Expected) ->
ok = io:format("Catching bad_guy(~p, ~p)", [First, Second]),
case catch bad_guy(First, Second) of
- {'EXIT', Reason} ->
- pending(Reason, bad_guy, [First, Second], Expected);
- Other ->
- test_server:fail({not_exit, Other})
+ {'EXIT', Reason} ->
+ pending(Reason, bad_guy, [First, Second], Expected);
+ Other ->
+ ct:fail({not_exit, Other})
end.
pending_exit_message(Args, Expected) ->
ok = io:format("Trapping EXITs from spawn_link(~p, ~p, ~p)",
- [?MODULE, bad_guy, Args]),
+ [?MODULE, bad_guy, Args]),
process_flag(trap_exit, true),
Pid = spawn_link(?MODULE, bad_guy, Args),
receive
- {'EXIT', Pid, Reason} ->
- pending(Reason, bad_guy, Args, Expected);
- Other ->
- test_server:fail({unexpected_message, Other})
+ {'EXIT', Pid, Reason} ->
+ pending(Reason, bad_guy, Args, Expected);
+ Other ->
+ ct:fail({unexpected_message, Other})
after 10000 ->
- test_server:fail(timeout)
+ ct:fail(timeout)
end,
process_flag(trap_exit, false).
pending({badarg,[{erlang,Bif,BifArgs,Loc1},
- {?MODULE,Func,Arity,Loc2}|_]},
- Func, Args, _Code)
+ {?MODULE,Func,Arity,Loc2}|_]},
+ Func, Args, _Code)
when is_atom(Bif), is_list(BifArgs), length(Args) =:= Arity,
is_list(Loc1), is_list(Loc2) ->
ok;
@@ -159,67 +144,67 @@ pending({Code,[{?MODULE,Func,Arity,Loc}|_]}, Func, Args, Code)
when length(Args) =:= Arity, is_list(Loc) ->
ok;
pending(Reason, _Function, _Args, _Code) ->
- test_server:fail({bad_exit_reason,Reason}).
+ ct:fail({bad_exit_reason,Reason}).
%% Test that doing arithmetics on [] gives a badarith EXIT and not a crash.
nil_arith(Config) when is_list(Config) ->
- ?line ba_plus_minus_times([], []),
-
- ?line ba_plus_minus_times([], 0),
- ?line ba_plus_minus_times([], 42),
- ?line ba_plus_minus_times([], 38724978123478923784),
- ?line ba_plus_minus_times([], 38.72),
-
- ?line ba_plus_minus_times(0, []),
- ?line ba_plus_minus_times(334, []),
- ?line ba_plus_minus_times(387249797813478923784, []),
- ?line ba_plus_minus_times(344.22, []),
-
- ?line ba_div_rem([], []),
-
- ?line ba_div_rem([], 0),
- ?line ba_div_rem([], 1),
- ?line ba_div_rem([], 42),
- ?line ba_div_rem([], 38724978123478923784),
- ?line ba_div_rem(344.22, []),
-
- ?line ba_div_rem(0, []),
- ?line ba_div_rem(1, []),
- ?line ba_div_rem(334, []),
- ?line ba_div_rem(387249797813478923784, []),
- ?line ba_div_rem(344.22, []),
-
- ?line ba_div_rem(344.22, 0.0),
- ?line ba_div_rem(1, 0.0),
- ?line ba_div_rem(392873498733971, 0.0),
-
- ?line ba_bop([], []),
- ?line ba_bop(0, []),
- ?line ba_bop(42, []),
- ?line ba_bop(-42342742987343, []),
- ?line ba_bop(238.342, []),
- ?line ba_bop([], 0),
- ?line ba_bop([], -243),
- ?line ba_bop([], 243),
- ?line ba_bop([], 2438724982478933),
- ?line ba_bop([], 3987.37),
-
- ?line ba_bnot([]),
- ?line ba_bnot(23.33),
-
- ?line ba_shift([], []),
- ?line ba_shift([], 0),
- ?line ba_shift([], 4),
- ?line ba_shift([], -4),
- ?line ba_shift([], 2343333333333),
- ?line ba_shift([], -333333333),
- ?line ba_shift([], 234.00),
- ?line ba_shift(23, []),
- ?line ba_shift(0, []),
- ?line ba_shift(-3433443433433323, []),
- ?line ba_shift(433443433433323, []),
- ?line ba_shift(343.93, []),
+ ba_plus_minus_times([], []),
+
+ ba_plus_minus_times([], 0),
+ ba_plus_minus_times([], 42),
+ ba_plus_minus_times([], 38724978123478923784),
+ ba_plus_minus_times([], 38.72),
+
+ ba_plus_minus_times(0, []),
+ ba_plus_minus_times(334, []),
+ ba_plus_minus_times(387249797813478923784, []),
+ ba_plus_minus_times(344.22, []),
+
+ ba_div_rem([], []),
+
+ ba_div_rem([], 0),
+ ba_div_rem([], 1),
+ ba_div_rem([], 42),
+ ba_div_rem([], 38724978123478923784),
+ ba_div_rem(344.22, []),
+
+ ba_div_rem(0, []),
+ ba_div_rem(1, []),
+ ba_div_rem(334, []),
+ ba_div_rem(387249797813478923784, []),
+ ba_div_rem(344.22, []),
+
+ ba_div_rem(344.22, 0.0),
+ ba_div_rem(1, 0.0),
+ ba_div_rem(392873498733971, 0.0),
+
+ ba_bop([], []),
+ ba_bop(0, []),
+ ba_bop(42, []),
+ ba_bop(-42342742987343, []),
+ ba_bop(238.342, []),
+ ba_bop([], 0),
+ ba_bop([], -243),
+ ba_bop([], 243),
+ ba_bop([], 2438724982478933),
+ ba_bop([], 3987.37),
+
+ ba_bnot([]),
+ ba_bnot(23.33),
+
+ ba_shift([], []),
+ ba_shift([], 0),
+ ba_shift([], 4),
+ ba_shift([], -4),
+ ba_shift([], 2343333333333),
+ ba_shift([], -333333333),
+ ba_shift([], 234.00),
+ ba_shift(23, []),
+ ba_shift(0, []),
+ ba_shift(-3433443433433323, []),
+ ba_shift(433443433433323, []),
+ ba_shift(343.93, []),
ok.
ba_plus_minus_times(A, B) ->
@@ -251,7 +236,7 @@ ba_shift(A, B) ->
{'EXIT', {badarith, _}} = (catch A bsl B),
io:format("~p bsr ~p", [A, B]),
{'EXIT', {badarith, _}} = (catch A bsr B).
-
+
ba_bnot(A) ->
io:format("bnot ~p", [A]),
{'EXIT', {badarith, _}} = (catch bnot A).
@@ -260,38 +245,38 @@ ba_bnot(A) ->
stacktrace(Conf) when is_list(Conf) ->
Tag = make_ref(),
- ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end),
- ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end,
+ {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end),
+ {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end,
V = [make_ref()|self()],
- ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} =
- stacktrace_1({'abs',V}, error, {value,V}),
- ?line St1 = erase(stacktrace1),
- ?line St1 = erase(stacktrace2),
- ?line St1 = erlang:get_stacktrace(),
- ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} =
- stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}),
- ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1),
- ?line St2 = erase(stacktrace2),
- ?line St2 = erlang:get_stacktrace(),
- ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} =
- stacktrace_1({value,V}, error, {value,V}),
- ?line St3 = erase(stacktrace1),
- ?line St3 = erase(stacktrace2),
- ?line St3 = erlang:get_stacktrace(),
- ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} =
- stacktrace_1({value,V}, error, {throw,V}),
- ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1),
- ?line St4 = erase(stacktrace2),
- ?line St4 = erlang:get_stacktrace(),
+ {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} =
+ stacktrace_1({'abs',V}, error, {value,V}),
+ St1 = erase(stacktrace1),
+ St1 = erase(stacktrace2),
+ St1 = erlang:get_stacktrace(),
+ {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} =
+ stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}),
+ [{?MODULE,my_div,2,_}|_] = erase(stacktrace1),
+ St2 = erase(stacktrace2),
+ St2 = erlang:get_stacktrace(),
+ {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} =
+ stacktrace_1({value,V}, error, {value,V}),
+ St3 = erase(stacktrace1),
+ St3 = erase(stacktrace2),
+ St3 = erlang:get_stacktrace(),
+ {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} =
+ stacktrace_1({value,V}, error, {throw,V}),
+ [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1),
+ St4 = erase(stacktrace2),
+ St4 = erlang:get_stacktrace(),
try
- ?line stacktrace_2()
+ stacktrace_2()
catch
- error:{badmatch,_} ->
- [{?MODULE,stacktrace_2,0,_},
- {?MODULE,stacktrace,1,_}|_] =
- erlang:get_stacktrace(),
- ok
+ error:{badmatch,_} ->
+ [{?MODULE,stacktrace_2,0,_},
+ {?MODULE,stacktrace,1,_}|_] =
+ erlang:get_stacktrace(),
+ ok
end.
stacktrace_1(X, C1, Y) ->
@@ -303,7 +288,7 @@ stacktrace_1(X, C1, Y) ->
C1:D1 -> {caught1,D1,erlang:get_stacktrace()}
after
put(stacktrace1, erlang:get_stacktrace()),
- foo(Y)
+ foo(Y)
end of
V2 -> {value2,V2}
catch
@@ -319,21 +304,21 @@ stacktrace_2() ->
nested_stacktrace(Conf) when is_list(Conf) ->
V = [{make_ref()}|[self()]],
- ?line value1 =
- nested_stacktrace_1({{value,{V,x1}},void,{V,x1}},
- {void,void,void}),
- ?line {caught1,
- [{?MODULE,my_add,2,_}|_],
- value2,
- [{?MODULE,my_add,2,_}|_]} =
- nested_stacktrace_1({{'add',{V,x1}},error,badarith},
- {{value,{V,x2}},void,{V,x2}}),
- ?line {caught1,
- [{?MODULE,my_add,2,_}|_],
- {caught2,[{erlang,abs,[V],_}|_]},
- [{erlang,abs,[V],_}|_]} =
- nested_stacktrace_1({{'add',{V,x1}},error,badarith},
- {{'abs',V},error,badarg}),
+ value1 =
+ nested_stacktrace_1({{value,{V,x1}},void,{V,x1}},
+ {void,void,void}),
+ {caught1,
+ [{?MODULE,my_add,2,_}|_],
+ value2,
+ [{?MODULE,my_add,2,_}|_]} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{value,{V,x2}},void,{V,x2}}),
+ {caught1,
+ [{?MODULE,my_add,2,_}|_],
+ {caught2,[{erlang,abs,[V],_}|_]},
+ [{erlang,abs,[V],_}|_]} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{'abs',V},error,badarg}),
ok.
nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) ->
@@ -341,64 +326,64 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) ->
V1 -> value1
catch
C1:V1 ->
- S1 = erlang:get_stacktrace(),
+ S1 = erlang:get_stacktrace(),
T2 =
- try foo(X2) of
- V2 -> value2
- catch
- C2:V2 -> {caught2,erlang:get_stacktrace()}
- end,
+ try foo(X2) of
+ V2 -> value2
+ catch
+ C2:V2 -> {caught2,erlang:get_stacktrace()}
+ end,
{caught1,S1,T2,erlang:get_stacktrace()}
end.
raise(Conf) when is_list(Conf) ->
- ?line erase(raise),
- ?line A =
- try
- ?line try foo({'div',{1,0}})
- catch
- error:badarith ->
- put(raise, A0 = erlang:get_stacktrace()),
- ?line erlang:raise(error, badarith, A0)
- end
- catch
- error:badarith ->
- ?line A1 = erlang:get_stacktrace(),
- ?line A1 = get(raise)
- end,
- ?line A = erlang:get_stacktrace(),
- ?line A = get(raise),
- ?line [{?MODULE,my_div,2,_}|_] = A,
+ erase(raise),
+ A =
+ try
+ try foo({'div',{1,0}})
+ catch
+ error:badarith ->
+ put(raise, A0 = erlang:get_stacktrace()),
+ erlang:raise(error, badarith, A0)
+ end
+ catch
+ error:badarith ->
+ A1 = erlang:get_stacktrace(),
+ A1 = get(raise)
+ end,
+ A = erlang:get_stacktrace(),
+ A = get(raise),
+ [{?MODULE,my_div,2,_}|_] = A,
%%
N = 8, % Must be even
- ?line N = erlang:system_flag(backtrace_depth, N),
- ?line B = odd_even(N, []),
- ?line try even(N)
- catch error:function_clause -> ok
- end,
- ?line B = erlang:get_stacktrace(),
+ N = erlang:system_flag(backtrace_depth, N),
+ B = odd_even(N, []),
+ try even(N)
+ catch error:function_clause -> ok
+ end,
+ B = erlang:get_stacktrace(),
%%
- ?line C0 = odd_even(N+1, []),
- ?line C = lists:sublist(C0, N),
- ?line try odd(N+1)
- catch error:function_clause -> ok
- end,
- ?line C = erlang:get_stacktrace(),
- ?line try erlang:raise(error, function_clause, C0)
- catch error:function_clause -> ok
- end,
- ?line C = erlang:get_stacktrace(),
+ C0 = odd_even(N+1, []),
+ C = lists:sublist(C0, N),
+ try odd(N+1)
+ catch error:function_clause -> ok
+ end,
+ C = erlang:get_stacktrace(),
+ try erlang:raise(error, function_clause, C0)
+ catch error:function_clause -> ok
+ end,
+ C = erlang:get_stacktrace(),
ok.
odd_even(N, R) when is_integer(N), N > 1 ->
odd_even(N-1,
- [if (N rem 2) == 0 ->
- {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]};
- true ->
- {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]}
- end|R]);
+ [if (N rem 2) == 0 ->
+ {?MODULE,even,1,[{file,"odd_even.erl"},{line,3}]};
+ true ->
+ {?MODULE,odd,1,[{file,"odd_even.erl"},{line,6}]}
+ end|R]);
odd_even(1, R) ->
[{?MODULE,odd,[1],[{file,"odd_even.erl"},{line,5}]}|R].
@@ -428,18 +413,18 @@ my_add(A, B) ->
my_abs(X) -> abs(X).
gunilla(Config) when is_list(Config) ->
- ?line {throw,kalle} = gunilla_1(),
- ?line [] = erlang:get_stacktrace(),
+ {throw,kalle} = gunilla_1(),
+ [] = erlang:get_stacktrace(),
ok.
gunilla_1() ->
try try arne()
- after
- pelle
- end
+ after
+ pelle
+ end
catch
- C:R ->
- {C,R}
+ C:R ->
+ {C,R}
end.
arne() ->
@@ -448,18 +433,18 @@ arne() ->
per(Config) when is_list(Config) ->
try
- t1(0,pad,0),
- t2(0,pad,0)
+ t1(0,pad,0),
+ t2(0,pad,0)
catch
- error:badarith ->
- ok
+ error:badarith ->
+ ok
end.
t1(_,X,_) ->
- (1 bsl X) + 1.
+ (1 bsl X) + 1.
t2(_,X,_) ->
- (X bsl 1) + 1.
+ (X bsl 1) + 1.
%%
%% Make sure that even if a BIF builds an heap fragment, then causes an exception,
@@ -471,155 +456,155 @@ exception_with_heap_frag(Config) when is_list(Config) ->
%% Floats are only validated when the heap fragment has been allocated.
BadFloat = <<131,99,53,46,48,$X,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,101,45,48,49,0,0,0,0,0>>,
- ?line do_exception_with_heap_frag(BadFloat, Sizes),
+ do_exception_with_heap_frag(BadFloat, Sizes),
%% {Binary,BadFloat}: When the error in float is discovered, a refc-binary
%% has been allocated and the list of refc-binaries goes through the
%% heap fragment.
BinAndFloat =
- <<131,104,2,109,0,0,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
- 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,
- 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,
- 71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
- 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,
- 116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,
- 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,
- 154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,
- 173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,
- 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,
- 211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,
- 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,
- 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48,
- 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>,
- ?line do_exception_with_heap_frag(BinAndFloat, Sizes),
+ <<131,104,2,109,0,0,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
+ 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,
+ 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,
+ 71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
+ 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,
+ 116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,
+ 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,
+ 154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,
+ 173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,
+ 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,
+ 211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,
+ 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,
+ 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48,
+ 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>,
+ do_exception_with_heap_frag(BinAndFloat, Sizes),
%% {Fun,BadFloat}
FunAndFloat =
- <<131,104,2,112,0,0,0,66,0,238,239,135,138,137,216,89,57,22,111,52,126,16,84,
- 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111,
- 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48,
- $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>,
- ?line do_exception_with_heap_frag(FunAndFloat, Sizes),
+ <<131,104,2,112,0,0,0,66,0,238,239,135,138,137,216,89,57,22,111,52,126,16,84,
+ 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111,
+ 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48,
+ $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>,
+ do_exception_with_heap_frag(FunAndFloat, Sizes),
%% [ExternalPid|BadFloat]
ExtPidAndFloat =
- <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101,
- 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48,
- 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>,
- ?line do_exception_with_heap_frag(ExtPidAndFloat, Sizes),
-
+ <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101,
+ 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48,
+ 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>,
+ do_exception_with_heap_frag(ExtPidAndFloat, Sizes),
+
ok.
do_exception_with_heap_frag(Bin, [Sz|Sizes]) ->
Filler = erlang:make_tuple(Sz, a),
spawn(fun() ->
- try
- binary_to_term(Bin)
- catch
- _:_ ->
- %% term_to_binary/1 is an easy way to traverse the
- %% entire stacktrace term to make sure that every part
- %% of it is OK.
- term_to_binary(erlang:get_stacktrace())
- end,
- id(Filler)
- end),
+ try
+ binary_to_term(Bin)
+ catch
+ _:_ ->
+ %% term_to_binary/1 is an easy way to traverse the
+ %% entire stacktrace term to make sure that every part
+ %% of it is OK.
+ term_to_binary(erlang:get_stacktrace())
+ end,
+ id(Filler)
+ end),
do_exception_with_heap_frag(Bin, Sizes);
do_exception_with_heap_frag(_, []) -> ok.
line_numbers(Config) when is_list(Config) ->
{'EXIT',{{case_clause,bad_tag},
- [{?MODULE,line1,2,
- [{file,"fake_file.erl"},{line,3}]},
- {?MODULE,line_numbers,1,_}|_]}} =
- (catch line1(bad_tag, 0)),
+ [{?MODULE,line1,2,
+ [{file,"fake_file.erl"},{line,3}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch line1(bad_tag, 0)),
{'EXIT',{badarith,
- [{?MODULE,line1,2,
- [{file,"fake_file.erl"},{line,5}]},
- {?MODULE,line_numbers,1,_}|_]}} =
- (catch line1(a, not_an_integer)),
+ [{?MODULE,line1,2,
+ [{file,"fake_file.erl"},{line,5}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch line1(a, not_an_integer)),
{'EXIT',{{badmatch,{ok,1}},
- [{?MODULE,line1,2,
- [{file,"fake_file.erl"},{line,7}]},
- {?MODULE,line_numbers,1,_}|_]}} =
- (catch line1(a, 0)),
+ [{?MODULE,line1,2,
+ [{file,"fake_file.erl"},{line,7}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch line1(a, 0)),
{'EXIT',{crash,
- [{?MODULE,crash,1,
- [{file,"fake_file.erl"},{line,14}]},
- {?MODULE,line_numbers,1,_}|_]}} =
- (catch line1(a, 41)),
+ [{?MODULE,crash,1,
+ [{file,"fake_file.erl"},{line,14}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch line1(a, 41)),
ModFile = ?MODULE_STRING++".erl",
[{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]},
{?MODULE,call1,0,[{file,"call.erl"},{line,14}]},
{?MODULE,close_calls,1,[{file,"call.erl"},{line,5}]},
{?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] =
- close_calls(call1),
+ close_calls(call1),
[{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]},
{?MODULE,call2,0,[{file,"call.erl"},{line,18}]},
{?MODULE,close_calls,1,[{file,"call.erl"},{line,6}]},
{?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] =
- close_calls(call2),
+ close_calls(call2),
[{?MODULE,maybe_crash,1,[{file,"call.erl"},{line,28}]},
{?MODULE,call3,0,[{file,"call.erl"},{line,22}]},
{?MODULE,close_calls,1,[{file,"call.erl"},{line,7}]},
{?MODULE,line_numbers,1,[{file,ModFile},{line,_}]}|_] =
- close_calls(call3),
+ close_calls(call3),
no_crash = close_calls(other),
<<0,0>> = build_binary1(16),
{'EXIT',{badarg,
- [{?MODULE,build_binary1,1,
- [{file,"bit_syntax.erl"},{line,72503}]},
- {?MODULE,line_numbers,1,
- [{file,ModFile},{line,_}]}|_]}} =
- (catch build_binary1(bad_size)),
+ [{?MODULE,build_binary1,1,
+ [{file,"bit_syntax.erl"},{line,72503}]},
+ {?MODULE,line_numbers,1,
+ [{file,ModFile},{line,_}]}|_]}} =
+ (catch build_binary1(bad_size)),
<<7,1,2,3>> = build_binary2(8, <<1,2,3>>),
{'EXIT',{badarg,
- [{?MODULE,build_binary2,2,
- [{file,"bit_syntax.erl"},{line,72507}]},
- {?MODULE,line_numbers,1,
- [{file,ModFile},{line,_}]}|_]}} =
- (catch build_binary2(bad_size, <<>>)),
+ [{?MODULE,build_binary2,2,
+ [{file,"bit_syntax.erl"},{line,72507}]},
+ {?MODULE,line_numbers,1,
+ [{file,ModFile},{line,_}]}|_]}} =
+ (catch build_binary2(bad_size, <<>>)),
{'EXIT',{badarg,
- [{erlang,bit_size,[bad_binary],[]},
- {?MODULE,build_binary2,2,
- [{file,"bit_syntax.erl"},{line,72507}]},
- {?MODULE,line_numbers,1,
- [{file,ModFile},{line,_}]}|_]}} =
- (catch build_binary2(8, bad_binary)),
+ [{erlang,bit_size,[bad_binary],[]},
+ {?MODULE,build_binary2,2,
+ [{file,"bit_syntax.erl"},{line,72507}]},
+ {?MODULE,line_numbers,1,
+ [{file,ModFile},{line,_}]}|_]}} =
+ (catch build_binary2(8, bad_binary)),
<<"abc",357:16>> = build_binary3(<<"abc">>),
{'EXIT',{badarg,[{?MODULE,build_binary3,1,
- [{file,"bit_syntax.erl"},{line,72511}]},
- {?MODULE,line_numbers,1,
- [{file,ModFile},{line,_}]}|_]}} =
- (catch build_binary3(no_binary)),
+ [{file,"bit_syntax.erl"},{line,72511}]},
+ {?MODULE,line_numbers,1,
+ [{file,ModFile},{line,_}]}|_]}} =
+ (catch build_binary3(no_binary)),
{'EXIT',{function_clause,
- [{?MODULE,do_call_abs,[y,y],
- [{file,"gc_bif.erl"},{line,18}]},
- {?MODULE,line_numbers,1,_}|_]}} =
- (catch do_call_abs(y, y)),
+ [{?MODULE,do_call_abs,[y,y],
+ [{file,"gc_bif.erl"},{line,18}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch do_call_abs(y, y)),
{'EXIT',{badarg,
- [{erlang,abs,[[]],[]},
- {?MODULE,do_call_abs,2,
- [{file,"gc_bif.erl"},{line,19}]},
- {?MODULE,line_numbers,1,_}|_]}} =
- (catch do_call_abs(x, [])),
+ [{erlang,abs,[[]],[]},
+ {?MODULE,do_call_abs,2,
+ [{file,"gc_bif.erl"},{line,19}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch do_call_abs(x, [])),
{'EXIT',{{badmatch,"42"},
- [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]},
- {?MODULE,line_numbers,1,_}|_]}} =
- (catch applied_bif_1(42)),
+ [{MODULE,applied_bif_1,1,[{file,"applied_bif.erl"},{line,5}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch applied_bif_1(42)),
{'EXIT',{{badmatch,{current_location,
- {?MODULE,applied_bif_2,0,
- [{file,"applied_bif.erl"},{line,9}]}}},
- [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]},
- {?MODULE,line_numbers,1,_}|_]}} =
- (catch applied_bif_2()),
+ {?MODULE,applied_bif_2,0,
+ [{file,"applied_bif.erl"},{line,9}]}}},
+ [{MODULE,applied_bif_2,0,[{file,"applied_bif.erl"},{line,10}]},
+ {?MODULE,line_numbers,1,_}|_]}} =
+ (catch applied_bif_2()),
ok.
@@ -646,13 +631,13 @@ odd(N) when is_integer(N), N > 1, (N rem 2) == 1 ->
-file("fake_file.erl", 1). %Line 1
line1(Tag, X) -> %Line 2
case Tag of %Line 3
- a ->
- Y = X + 1, %Line 5
- Res = id({ok,Y}), %Line 6
- ?MODULE:crash({ok,42} = Res); %Line 7
- b ->
- x = id(x), %Line 9
- ok %Line 10
+ a ->
+ Y = X + 1, %Line 5
+ Res = id({ok,Y}), %Line 6
+ ?MODULE:crash({ok,42} = Res); %Line 7
+ b ->
+ x = id(x), %Line 9
+ ok %Line 10
end. %Line 11
crash(_) -> %Line 13
@@ -662,12 +647,12 @@ crash(_) -> %Line 13
close_calls(Where) -> %Line 2
put(where_to_crash, Where), %Line 3
try
- call1(), %Line 5
- call2(), %Line 6
- call3(), %Line 7
- no_crash %Line 8
+ call1(), %Line 5
+ call2(), %Line 6
+ call3(), %Line 7
+ no_crash %Line 8
catch error:crash ->
- erlang:get_stacktrace() %Line 10
+ erlang:get_stacktrace() %Line 10
end. %Line 11
call1() -> %Line 13
@@ -684,10 +669,10 @@ call3() -> %Line 21
maybe_crash(Name) -> %Line 25
case get(where_to_crash) of %Line 26
- Name ->
- erlang:error(crash); %Line 28
- _ ->
- ok %Line 30
+ Name ->
+ erlang:error(crash); %Line 28
+ _ ->
+ ok %Line 30
end.
-file("bit_syntax.erl", 72500). %Line 72500
diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl
index c1a76b8af4..78dec8c725 100644
--- a/erts/emulator/test/float_SUITE.erl
+++ b/erts/emulator/test/float_SUITE.erl
@@ -20,63 +20,40 @@
-module(float_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
- fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1,
- bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]).
+-export([all/0, suite/0, groups/0,
+ fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1,
+ t_mul_add_ops/1,
+ bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]).
-export([otp_7178/1]).
-export([hidden_inf/1]).
+-export([arith/1]).
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:minutes(3)),
- [{watchdog, Dog},{testcase,Func}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 3}}].
all() ->
[fpe, fp_drv, fp_drv_thread, otp_7178, denormalized,
match, bad_float_unpack, write, {group, comparison}
,hidden_inf
- ].
+ ,arith, t_mul_add_ops].
groups() ->
[{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
%%
%% OTP-7178, list_to_float on very small numbers should give 0.0
%% instead of exception, i.e. ignore underflow.
%%
-otp_7178(suite) ->
- [];
-otp_7178(doc) ->
- ["test that list_to_float on very small numbers give 0.0"];
+%% test that list_to_float on very small numbers give 0.0
otp_7178(Config) when is_list(Config) ->
- ?line X = list_to_float("1.0e-325"),
- ?line true = (X < 0.00000001) and (X > -0.00000001),
- ?line Y = list_to_float("1.0e-325325325"),
- ?line true = (Y < 0.00000001) and (Y > -0.00000001),
- ?line {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")),
+ X = list_to_float("1.0e-325"),
+ true = (X < 0.00000001) and (X > -0.00000001),
+ Y = list_to_float("1.0e-325325325"),
+ true = (Y < 0.00000001) and (Y > -0.00000001),
+ {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")),
ok.
%% Forces floating point exceptions and tests that subsequent, legal,
@@ -84,15 +61,15 @@ otp_7178(Config) when is_list(Config) ->
%% Strollo.
fpe(Config) when is_list(Config) ->
- ?line 0.0 = math:log(1.0),
- ?line {'EXIT', {badarith, _}} = (catch math:log(-1.0)),
- ?line 0.0 = math:log(1.0),
- ?line {'EXIT', {badarith, _}} = (catch math:log(0.0)),
- ?line 0.0 = math:log(1.0),
- ?line {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)),
- ?line 0.0 = math:log(1.0),
- ?line {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)),
- ?line 0.0 = math:log(1.0),
+ 0.0 = math:log(1.0),
+ {'EXIT', {badarith, _}} = (catch math:log(-1.0)),
+ 0.0 = math:log(1.0),
+ {'EXIT', {badarith, _}} = (catch math:log(0.0)),
+ 0.0 = math:log(1.0),
+ {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)),
+ 0.0 = math:log(1.0),
+ {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)),
+ 0.0 = math:log(1.0),
ok.
@@ -100,70 +77,70 @@ fpe(Config) when is_list(Config) ->
-define(ERTS_FP_THREAD_TEST, 1).
fp_drv(Config) when is_list(Config) ->
- fp_drv_test(?ERTS_FP_CONTROL_TEST, ?config(data_dir, Config)).
+ fp_drv_test(?ERTS_FP_CONTROL_TEST, proplists:get_value(data_dir, Config)).
fp_drv_thread(Config) when is_list(Config) ->
%% Run in a separate node since it used to crash the emulator...
- ?line Parent = self(),
- ?line DrvDir = ?config(data_dir, Config),
- ?line {ok,Node} = start_node(Config),
- ?line Tester = spawn_link(Node,
- fun () ->
- Parent !
- {self(),
- fp_drv_test(?ERTS_FP_THREAD_TEST,
- DrvDir)}
- end),
- ?line Result = receive {Tester, Res} -> Res end,
- ?line stop_node(Node),
- ?line Result.
+ Parent = self(),
+ DrvDir = proplists:get_value(data_dir, Config),
+ {ok,Node} = start_node(Config),
+ Tester = spawn_link(Node,
+ fun () ->
+ Parent !
+ {self(),
+ fp_drv_test(?ERTS_FP_THREAD_TEST,
+ DrvDir)}
+ end),
+ Result = receive {Tester, Res} -> Res end,
+ stop_node(Node),
+ Result.
fp_drv_test(Test, DrvDir) ->
- ?line Drv = fp_drv,
- ?line try
- begin
- ?line case erl_ddll:load_driver(DrvDir, Drv) of
- ok ->
- ok;
- {error, permanent} ->
- ok;
- {error, LoadError} ->
- exit({load_error,
- erl_ddll:format_error(LoadError)});
- LoadError ->
- exit({load_error, LoadError})
- end,
- case open_port({spawn, Drv}, []) of
- Port when is_port(Port) ->
- try port_control(Port, Test, "") of
- "ok" ->
- 0.0 = math:log(1.0),
- ok;
- [$s,$k,$i,$p,$:,$ | Reason] ->
- {skipped, Reason};
- Error ->
- exit(Error)
- after
- Port ! {self(), close},
- receive {Port, closed} -> ok end,
- false = lists:member(Port, erlang:ports()),
- ok
- end;
- Error ->
- exit({open_port_failed, Error})
- end
- end
- catch
- throw:Term -> ?line Term
- after
- erl_ddll:unload_driver(Drv)
- end.
+ Drv = fp_drv,
+ try
+ begin
+ case erl_ddll:load_driver(DrvDir, Drv) of
+ ok ->
+ ok;
+ {error, permanent} ->
+ ok;
+ {error, LoadError} ->
+ exit({load_error,
+ erl_ddll:format_error(LoadError)});
+ LoadError ->
+ exit({load_error, LoadError})
+ end,
+ case open_port({spawn, Drv}, []) of
+ Port when is_port(Port) ->
+ try port_control(Port, Test, "") of
+ "ok" ->
+ 0.0 = math:log(1.0),
+ ok;
+ [$s,$k,$i,$p,$:,$ | Reason] ->
+ {skipped, Reason};
+ Error ->
+ exit(Error)
+ after
+ Port ! {self(), close},
+ receive {Port, closed} -> ok end,
+ false = lists:member(Port, erlang:ports()),
+ ok
+ end;
+ Error ->
+ exit({open_port_failed, Error})
+ end
+ end
+ catch
+ throw:Term -> Term
+ after
+ erl_ddll:unload_driver(Drv)
+ end.
denormalized(Config) when is_list(Config) ->
- ?line Denormalized = 1.0e-307 / 1000,
- ?line roundtrip(Denormalized),
- ?line NegDenormalized = -1.0e-307 / 1000,
- ?line roundtrip(NegDenormalized),
+ Denormalized = 1.0e-307 / 1000,
+ roundtrip(Denormalized),
+ NegDenormalized = -1.0e-307 / 1000,
+ roundtrip(NegDenormalized),
ok.
roundtrip(N) ->
@@ -171,12 +148,12 @@ roundtrip(N) ->
N = binary_to_term(term_to_binary(N, [{minor_version,1}])).
match(Config) when is_list(Config) ->
- ?line one = match_1(1.0),
- ?line two = match_1(2.0),
- ?line a_lot = match_1(1000.0),
- ?line {'EXIT',_} = (catch match_1(0.5)),
+ one = match_1(1.0),
+ two = match_1(2.0),
+ a_lot = match_1(1000.0),
+ {'EXIT',_} = (catch match_1(0.5)),
ok.
-
+
match_1(1.0) -> one;
match_1(2.0) -> two;
match_1(1000.0) -> a_lot.
@@ -184,8 +161,8 @@ match_1(1000.0) -> a_lot.
%% Thanks to Per Gustafsson.
bad_float_unpack(Config) when is_list(Config) ->
- ?line Bin = <<-1:64>>,
- ?line -1 = bad_float_unpack_match(Bin),
+ Bin = <<-1:64>>,
+ -1 = bad_float_unpack_match(Bin),
ok.
bad_float_unpack_match(<<F:64/float>>) -> F;
@@ -237,75 +214,75 @@ span_cmp(Axis, Incr, Length) ->
%% Diff: How much the float and int should differ when comparing
span_cmp(Axis, Incr, Length, Diff) ->
[begin
- cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr),
- cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr)
+ cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr),
+ cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr)
end || I <- lists:seq((Length div 2)*-1,(Length div 2))],
[begin
- cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr),
- cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr)
+ cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr),
+ cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr)
end || I <- lists:seq((Length div 2)*-1,(Length div 2))].
cmp(Big,Small) when is_float(Big) ->
BigGtSmall = lists:flatten(
- io_lib:format("~f > ~p",[Big,Small])),
+ io_lib:format("~f > ~p",[Big,Small])),
BigLtSmall = lists:flatten(
- io_lib:format("~f < ~p",[Big,Small])),
+ io_lib:format("~f < ~p",[Big,Small])),
BigEqSmall = lists:flatten(
- io_lib:format("~f == ~p",[Big,Small])),
+ io_lib:format("~f == ~p",[Big,Small])),
SmallGtBig = lists:flatten(
- io_lib:format("~p > ~f",[Small,Big])),
+ io_lib:format("~p > ~f",[Small,Big])),
SmallLtBig = lists:flatten(
- io_lib:format("~p < ~f",[Small,Big])),
+ io_lib:format("~p < ~f",[Small,Big])),
SmallEqBig = lists:flatten(
- io_lib:format("~p == ~f",[Small,Big])),
+ io_lib:format("~p == ~f",[Small,Big])),
cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
- SmallEqBig,BigEqSmall);
+ SmallEqBig,BigEqSmall);
cmp(Big,Small) when is_float(Small) ->
BigGtSmall = lists:flatten(
- io_lib:format("~p > ~f",[Big,Small])),
+ io_lib:format("~p > ~f",[Big,Small])),
BigLtSmall = lists:flatten(
- io_lib:format("~p < ~f",[Big,Small])),
+ io_lib:format("~p < ~f",[Big,Small])),
BigEqSmall = lists:flatten(
- io_lib:format("~p == ~f",[Big,Small])),
+ io_lib:format("~p == ~f",[Big,Small])),
SmallGtBig = lists:flatten(
- io_lib:format("~f > ~p",[Small,Big])),
+ io_lib:format("~f > ~p",[Small,Big])),
SmallLtBig = lists:flatten(
- io_lib:format("~f < ~p",[Small,Big])),
+ io_lib:format("~f < ~p",[Small,Big])),
SmallEqBig = lists:flatten(
- io_lib:format("~f == ~p",[Small,Big])),
+ io_lib:format("~f == ~p",[Small,Big])),
cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
- SmallEqBig,BigEqSmall).
+ SmallEqBig,BigEqSmall).
cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
SmallEqBig,BigEqSmall) ->
{_,_,_,true} = {Big,Small,BigGtSmall,
- Big > Small},
+ Big > Small},
{_,_,_,false} = {Big,Small,BigLtSmall,
- Big < Small},
+ Big < Small},
{_,_,_,false} = {Big,Small,SmallGtBig,
- Small > Big},
+ Small > Big},
{_,_,_,true} = {Big,Small,SmallLtBig,
- Small < Big},
+ Small < Big},
{_,_,_,false} = {Big,Small,SmallEqBig,
- Small == Big},
+ Small == Big},
{_,_,_,false} = {Big,Small,BigEqSmall,
- Big == Small}.
+ Big == Small}.
id(I) -> I.
-
+
start_node(Config) when is_list(Config) ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
- ++ "-"
- ++ integer_to_list(erlang:unique_integer([positive]))),
- ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]).
+ Pa = filename:dirname(code:which(?MODULE)),
+ Name = list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ test_server:start_node(Name, slave, [{args, "-pa "++Pa}]).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
%% Test that operations that might hide infinite intermediate results
@@ -315,8 +292,8 @@ hidden_inf(Config) when is_list(Config) ->
ZeroN = id(ZeroP) * (-1),
[hidden_inf_1(A, B, Z, 9.23e307)
|| A <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN],
- B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN],
- Z <- [ZeroP, ZeroN]],
+ B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN],
+ Z <- [ZeroP, ZeroN]],
ok.
hidden_inf_1(A, B, Zero, Huge) ->
@@ -328,3 +305,122 @@ hidden_inf_1(A, B, Zero, Huge) ->
{'EXIT',{badarith,_}} = (catch (B * (Huge + Huge))),
{'EXIT',{badarith,_}} = (catch (B / (-Huge - Huge))),
{'EXIT',{badarith,_}} = (catch (B * (-Huge - Huge))).
+
+%% Improve code coverage in our different arithmetic functions
+%% and make sure they yield consistent results.
+arith(_Config) ->
+ _TAG_IMMED1_SIZE = 4,
+
+ <<FLOAT_MAX/float>> = <<0:1, 16#7fe:11, -1:52>>,
+ <<FLOAT_MIN/float>> = <<0:1, 0:11, 1:52>>,
+ <<FloatNegZero/float>> = <<1:1, 0:11, 0:52>>,
+
+ WORD_BITS = erlang:system_info(wordsize) * 8,
+ SMALL_BITS = (WORD_BITS - _TAG_IMMED1_SIZE),
+ SMALL_MAX = (1 bsl (SMALL_BITS-1)) - 1,
+ SMALL_MIN = -(1 bsl (SMALL_BITS-1)),
+ BIG1_MAX = (1 bsl WORD_BITS) - 1,
+ BIG2_MAX = (1 bsl (WORD_BITS*2)) - 1,
+
+ fixnum = erts_internal:term_type(SMALL_MAX),
+ fixnum = erts_internal:term_type(SMALL_MIN),
+ bignum = erts_internal:term_type(SMALL_MAX + 1),
+ bignum = erts_internal:term_type(SMALL_MIN - 1),
+
+ L = [0, 0.0, FloatNegZero, 1, 1.0, 17, 17.0, 0.17,
+ FLOAT_MIN, FLOAT_MAX,
+ SMALL_MAX, SMALL_MAX+1,
+ SMALL_MIN, SMALL_MIN-1,
+ BIG1_MAX, BIG1_MAX+1,
+ BIG2_MAX, BIG2_MAX+1,
+ trunc(FLOAT_MAX), trunc(FLOAT_MAX)+1, trunc(FLOAT_MAX)*2,
+ immed_badarg,
+ "list badarg",
+ {"boxed badarg"}],
+
+ foreach_pair(fun(A,B) -> do_bin_ops(A,B) end, L).
+
+foreach_pair(F, L) ->
+ lists:foreach(
+ fun(A) -> lists:foreach(fun(B) -> F(A,B) end, L) end,
+ L).
+
+do_bin_ops(A, B) ->
+ Fun = fun(Op) ->
+ Op(A,B),
+ is_number(A) andalso Op(-A,B),
+ is_number(B) andalso Op(A,-B),
+ is_number(A) andalso is_number(B) andalso Op(-A,-B)
+ end,
+ lists:foreach(Fun,
+ [fun op_add/2, fun op_sub/2, fun op_mul/2, fun op_div/2]).
+
+op_add(A, B) ->
+ Info = [A,B],
+ R = unify(catch A + B, Info),
+ R = unify(my_apply(erlang,'+',[A,B]), Info),
+ case R of
+ _ when A + B =:= element(1,R) -> ok;
+ {{'EXIT',badarith}, Info} -> ok
+ end.
+
+op_sub(A, B) ->
+ Info = [A,B],
+ R = unify(catch A - B, Info),
+ R = unify(my_apply(erlang,'-',[A,B]), Info),
+ case R of
+ _ when A - B =:= element(1,R) -> ok;
+ {{'EXIT',badarith}, Info} -> ok
+ end.
+
+op_mul(A, B) ->
+ Info = [A,B],
+ R = unify(catch A * B, Info),
+ R = unify(my_apply(erlang,'*',[A,B]), Info),
+ case R of
+ _ when A * B =:= element(1,R) -> ok;
+ {{'EXIT',badarith}, Info} -> ok
+ end.
+
+op_div(A, B) ->
+ Info = [A,B],
+ R = unify(catch A / B, Info),
+ R = unify(my_apply(erlang,'/',[A,B]), Info),
+ case R of
+ _ when A / B =:= element(1,R) -> ok;
+ {{'EXIT',badarith}, Info} -> ok
+ end.
+
+my_apply(M, F, A) ->
+ catch apply(id(M), id(F), A).
+
+% Unify exceptions be removing stack traces.
+% and add argument info to make it easer to debug failed matches.
+unify({'EXIT',{Reason,_Stack}}, Info) ->
+ {{'EXIT', Reason}, Info};
+unify(Other, Info) ->
+ {Other, Info}.
+
+
+-define(epsilon, 1.0e-20).
+check_epsilon(R,Val) ->
+ if erlang:abs(R-Val) < ?epsilon -> ok;
+ true -> ct:fail({R,Val})
+ end.
+
+t_mul_add_ops(Config) when is_list(Config) ->
+ check_epsilon(op_mul_add(1, 2.0, 1.0, 0.0), 1.0),
+ check_epsilon(op_mul_add(2, 2.0, 1.0, 0.0), 3.0),
+ check_epsilon(op_mul_add(3, 2.0, 1.0, 0.0), 7.0),
+ check_epsilon(op_mul_add(4, 2.0, 1.0, 0.0), 15.0),
+ check_epsilon(op_mul_add(5, 2.0, 1.0, 0.0), 31.0),
+ check_epsilon(op_mul_add(6, 2.0, 1.0, 0.0), 63.0),
+ check_epsilon(op_mul_add(6, 2.0, 1.3, 0.0), 81.9),
+ check_epsilon(op_mul_add(6, 2.03, 1.3, 0.0), 87.06260151458997),
+ ok.
+
+
+op_mul_add(0, _, _, R) -> R;
+op_mul_add(N, A, B, R) when is_float(A), is_float(B), is_float(R) ->
+ op_mul_add(N - 1, A, B, R * A + B).
+
diff --git a/erts/emulator/test/float_SUITE_data/fp_drv.c b/erts/emulator/test/float_SUITE_data/fp_drv.c
index 5919dd8e2f..a91d622040 100644
--- a/erts/emulator/test/float_SUITE_data/fp_drv.c
+++ b/erts/emulator/test/float_SUITE_data/fp_drv.c
@@ -18,6 +18,7 @@
*/
#if defined(DEBUG) || 0
+# include <stdio.h>
# define PRINTF(X) printf X
#else
# define PRINTF(X)
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index b18f9f5c6b..044c6aabca 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -21,11 +21,7 @@
-module(fun_SUITE).
-compile({nowarn_deprecated_function, {erlang,hash,2}}).
--define(default_timeout, ?t:minutes(1)).
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
+-export([all/0, suite/0,
bad_apply/1,bad_fun_call/1,badarity/1,ext_badarity/1,
equality/1,ordering/1,
fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1,
@@ -35,9 +31,12 @@
-export([nothing/0]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
-suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[bad_apply, bad_fun_call, badarity, ext_badarity,
@@ -46,45 +45,18 @@ all() ->
const_propagation, t_arity, t_is_function2, t_fun_info,
t_fun_info_mfa].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(_Case, Config) ->
- ?line Dog = test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-bad_apply(doc) ->
- "Test that the correct EXIT code is returned for all types of bad funs.";
-bad_apply(suite) -> [];
+%% Test that the correct EXIT code is returned for all types of bad funs.
bad_apply(Config) when is_list(Config) ->
- ?line bad_apply_fc(42, [0]),
- ?line bad_apply_fc(xx, [1]),
- ?line bad_apply_fc({}, [2]),
- ?line bad_apply_fc({1}, [3]),
- ?line bad_apply_fc({1,2,3}, [4]),
- ?line bad_apply_fc({1,2,3}, [5]),
- ?line bad_apply_fc({1,2,3,4}, [6]),
- ?line bad_apply_fc({1,2,3,4,5,6}, [7]),
- ?line bad_apply_fc({1,2,3,4,5}, [8]),
- ?line bad_apply_badarg({1,2}, [9]),
+ bad_apply_fc(42, [0]),
+ bad_apply_fc(xx, [1]),
+ bad_apply_fc({}, [2]),
+ bad_apply_fc({1}, [3]),
+ bad_apply_fc({1,2,3}, [4]),
+ bad_apply_fc({1,2,3}, [5]),
+ bad_apply_fc({1,2,3,4}, [6]),
+ bad_apply_fc({1,2,3,4,5,6}, [7]),
+ bad_apply_fc({1,2,3,4,5}, [8]),
+ bad_apply_badarg({1,2}, [9]),
ok.
bad_apply_fc(Fun, Args) ->
@@ -96,7 +68,7 @@ bad_apply_fc(Fun, Args) ->
ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]);
Other ->
ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]),
- ?t:fail({bad_result,Other})
+ ct:fail({bad_result,Other})
end.
bad_apply_badarg(Fun, Args) ->
@@ -108,23 +80,21 @@ bad_apply_badarg(Fun, Args) ->
ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]);
Other ->
ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]),
- ?t:fail({bad_result, Other})
+ ct:fail({bad_result, Other})
end.
-bad_fun_call(doc) ->
- "Try directly calling bad funs.";
-bad_fun_call(suite) -> [];
+%% Try directly calling bad funs.
bad_fun_call(Config) when is_list(Config) ->
- ?line bad_call_fc(42),
- ?line bad_call_fc(xx),
- ?line bad_call_fc({}),
- ?line bad_call_fc({1}),
- ?line bad_call_fc({1,2,3}),
- ?line bad_call_fc({1,2,3}),
- ?line bad_call_fc({1,2,3,4}),
- ?line bad_call_fc({1,2,3,4,5,6}),
- ?line bad_call_fc({1,2,3,4,5}),
- ?line bad_call_fc({1,2}),
+ bad_call_fc(42),
+ bad_call_fc(xx),
+ bad_call_fc({}),
+ bad_call_fc({1}),
+ bad_call_fc({1,2,3}),
+ bad_call_fc({1,2,3}),
+ bad_call_fc({1,2,3,4}),
+ bad_call_fc({1,2,3,4,5,6}),
+ bad_call_fc({1,2,3,4,5}),
+ bad_call_fc({1,2}),
ok.
bad_call_fc(Fun) ->
@@ -135,74 +105,74 @@ bad_call_fc(Fun) ->
ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]);
Other ->
ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]),
- ?t:fail({bad_result,Other})
+ ct:fail({bad_result,Other})
end.
%% Call and apply valid funs with wrong number of arguments.
badarity(Config) when is_list(Config) ->
- ?line Fun = fun() -> ok end,
- ?line Stupid = {stupid,arguments},
- ?line Args = [some,{stupid,arguments},here],
+ Fun = fun() -> ok end,
+ Stupid = {stupid,arguments},
+ Args = [some,{stupid,arguments},here],
%% Simple call.
- ?line Res = (catch Fun(some, Stupid, here)),
+ Res = (catch Fun(some, Stupid, here)),
erlang:garbage_collect(),
erlang:yield(),
case Res of
{'EXIT',{{badarity,{Fun,Args}},_}} ->
- ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]);
+ ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]);
_ ->
- ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]),
- ?line ?t:fail({bad_result,Res})
+ ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]),
+ ct:fail({bad_result,Res})
end,
%% Apply.
- ?line Res2 = (catch apply(Fun, Args)),
+ Res2 = (catch apply(Fun, Args)),
erlang:garbage_collect(),
erlang:yield(),
case Res2 of
{'EXIT',{{badarity,{Fun,Args}},_}} ->
- ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]);
+ ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]);
_ ->
- ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]),
- ?line ?t:fail({bad_result,Res2})
+ ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]),
+ ct:fail({bad_result,Res2})
end,
ok.
%% Call and apply valid external funs with wrong number of arguments.
ext_badarity(Config) when is_list(Config) ->
- ?line Fun = fun ?MODULE:nothing/0,
- ?line Stupid = {stupid,arguments},
- ?line Args = [some,{stupid,arguments},here],
+ Fun = fun ?MODULE:nothing/0,
+ Stupid = {stupid,arguments},
+ Args = [some,{stupid,arguments},here],
%% Simple call.
- ?line Res = (catch Fun(some, Stupid, here)),
+ Res = (catch Fun(some, Stupid, here)),
erlang:garbage_collect(),
erlang:yield(),
case Res of
{'EXIT',{{badarity,{Fun,Args}},_}} ->
- ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]);
+ ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]);
_ ->
- ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]),
- ?line ?t:fail({bad_result,Res})
+ ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]),
+ ct:fail({bad_result,Res})
end,
%% Apply.
- ?line Res2 = (catch apply(Fun, Args)),
+ Res2 = (catch apply(Fun, Args)),
erlang:garbage_collect(),
erlang:yield(),
case Res2 of
{'EXIT',{{badarity,{Fun,Args}},_}} ->
- ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]);
+ ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]);
_ ->
- ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]),
- ?line ?t:fail({bad_result,Res2})
+ ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]),
+ ct:fail({bad_result,Res2})
end,
ok.
@@ -214,29 +184,29 @@ nothing() ->
equality(Config) when is_list(Config) ->
F0 = fun() -> 1 end,
F0_copy = copy_term(F0),
- ?line true = eq(F0, F0),
- ?line true = eq(F0, F0_copy),
+ true = eq(F0, F0),
+ true = eq(F0, F0_copy),
%% Compare different arities.
F1 = fun(X) -> X + 1 end,
- ?line true = eq(F1, F1),
- ?line false = eq(F0, F1),
- ?line false = eq(F0_copy, F1),
+ true = eq(F1, F1),
+ false = eq(F0, F1),
+ false = eq(F0_copy, F1),
%% Compare different environments.
G1 = make_fun(1),
G2 = make_fun(2),
- ?line true = eq(G1, G1),
- ?line true = eq(G2, G2),
- ?line false = eq(G1, G2),
- ?line false = eq(G2, G1),
+ true = eq(G1, G1),
+ true = eq(G2, G2),
+ false = eq(G1, G2),
+ false = eq(G2, G1),
G1_copy = copy_term(G1),
- ?line true = eq(G1, G1_copy),
+ true = eq(G1, G1_copy),
%% Compare fun with binaries.
B = list_to_binary([7,8,9]),
- ?line false = eq(B, G1),
- ?line false = eq(G1, B),
+ false = eq(B, G1),
+ false = eq(G1, B),
%% Compare external funs.
FF0 = fun aa:blurf/0,
@@ -246,23 +216,23 @@ equality(Config) when is_list(Config) ->
FF3 = fun erlang:exit/2,
FF4 = fun z:ff/0,
- ?line true = eq(FF0, FF0),
- ?line true = eq(FF0, FF0_copy),
- ?line true = eq(FF1, FF1),
- ?line true = eq(FF2, FF2),
- ?line true = eq(FF3, FF3),
- ?line true = eq(FF4, FF4),
- ?line false = eq(FF0, FF1),
- ?line false = eq(FF0, FF2),
- ?line false = eq(FF0, FF3),
- ?line false = eq(FF0, FF4),
- ?line false = eq(FF1, FF0),
- ?line false = eq(FF1, FF2),
- ?line false = eq(FF1, FF3),
- ?line false = eq(FF1, FF4),
- ?line false = eq(FF2, FF3),
- ?line false = eq(FF2, FF4),
- ?line false = eq(FF3, FF4),
+ true = eq(FF0, FF0),
+ true = eq(FF0, FF0_copy),
+ true = eq(FF1, FF1),
+ true = eq(FF2, FF2),
+ true = eq(FF3, FF3),
+ true = eq(FF4, FF4),
+ false = eq(FF0, FF1),
+ false = eq(FF0, FF2),
+ false = eq(FF0, FF3),
+ false = eq(FF0, FF4),
+ false = eq(FF1, FF0),
+ false = eq(FF1, FF2),
+ false = eq(FF1, FF3),
+ false = eq(FF1, FF4),
+ false = eq(FF2, FF3),
+ false = eq(FF2, FF4),
+ false = eq(FF3, FF4),
%% EEP37
H1 = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end,
@@ -285,7 +255,7 @@ copy_term(Term) ->
make_fun(X) ->
fun() -> X end.
-ordering(doc) -> "Tests ordering of funs.";
+%% Tests ordering of funs.
ordering(Config) when is_list(Config) ->
F1 = make_fun(1, 2),
F1_copy = copy_term(F1),
@@ -298,140 +268,139 @@ ordering(Config) when is_list(Config) ->
FF3 = fun erlang:exit/2,
FF4 = fun z:ff/0,
- ?line true = FF0 < FF1,
- ?line true = FF1 < FF2,
- ?line true = FF2 < FF3,
- ?line true = FF3 < FF4,
+ true = FF0 < FF1,
+ true = FF1 < FF2,
+ true = FF2 < FF3,
+ true = FF3 < FF4,
- ?line true = FF0 > F1,
- ?line true = FF0 > F2,
- ?line true = FF0 > F3,
- ?line true = FF4 > F1,
- ?line true = FF4 > F2,
- ?line true = FF4 > F3,
+ true = FF0 > F1,
+ true = FF0 > F2,
+ true = FF0 > F3,
+ true = FF4 > F1,
+ true = FF4 > F2,
+ true = FF4 > F3,
- ?line true = F1 == F1,
- ?line true = F1 == F1_copy,
- ?line true = F1 /= F2,
+ true = F1 == F1,
+ true = F1 == F1_copy,
+ true = F1 /= F2,
- ?line true = F1 < F2,
- ?line true = F2 > F1,
- ?line true = F2 < F3,
- ?line true = F3 > F2,
+ true = F1 < F2,
+ true = F2 > F1,
+ true = F2 < F3,
+ true = F3 > F2,
- ?line false = F1 > F2,
- ?line false = F2 > F3,
+ false = F1 > F2,
+ false = F2 > F3,
%% Compare with binaries.
B = list_to_binary([7,8,9,10]),
- ?line false = B == F1,
- ?line false = F1 == B,
+ false = B == F1,
+ false = F1 == B,
- ?line true = F1 < B,
- ?line true = B > F2,
+ true = F1 < B,
+ true = B > F2,
- ?line false = F1 > B,
- ?line false = B < F2,
+ false = F1 > B,
+ false = B < F2,
- ?line false = F1 >= B,
- ?line false = B =< F2,
+ false = F1 >= B,
+ false = B =< F2,
%% Compare module funs with binaries.
- ?line false = B == FF1,
- ?line false = FF1 == B,
+ false = B == FF1,
+ false = FF1 == B,
- ?line true = FF1 < B,
- ?line true = B > FF2,
+ true = FF1 < B,
+ true = B > FF2,
- ?line false = FF1 > B,
- ?line false = B < FF2,
+ false = FF1 > B,
+ false = B < FF2,
- ?line false = FF1 >= B,
- ?line false = B =< FF2,
+ false = FF1 >= B,
+ false = B =< FF2,
%% Create a port and ref.
- ?line Path = ?config(priv_dir, Config),
- ?line AFile = filename:join(Path, "vanilla_file"),
- ?line P = open_port(AFile, [out]),
- ?line R = make_ref(),
+ Path = proplists:get_value(priv_dir, Config),
+ AFile = filename:join(Path, "vanilla_file"),
+ P = open_port(AFile, [out]),
+ R = make_ref(),
%% Compare funs with ports and refs.
- ?line true = R < F3,
- ?line true = F3 > R,
- ?line true = F3 < P,
- ?line true = P > F3,
+ true = R < F3,
+ true = F3 > R,
+ true = F3 < P,
+ true = P > F3,
- ?line true = R =< F3,
- ?line true = F3 >= R,
- ?line true = F3 =< P,
- ?line true = P >= F3,
+ true = R =< F3,
+ true = F3 >= R,
+ true = F3 =< P,
+ true = P >= F3,
- ?line false = R > F3,
- ?line false = F3 < R,
- ?line false = F3 > P,
- ?line false = P < F3,
+ false = R > F3,
+ false = F3 < R,
+ false = F3 > P,
+ false = P < F3,
%% Compare funs with conses and nils.
- ?line true = F1 < [a],
- ?line true = F1 < [],
- ?line true = [a,b] > F1,
- ?line true = [] > F1,
+ true = F1 < [a],
+ true = F1 < [],
+ true = [a,b] > F1,
+ true = [] > F1,
- ?line false = [1] < F1,
- ?line false = [] < F1,
- ?line false = F1 > [2],
- ?line false = F1 > [],
+ false = [1] < F1,
+ false = [] < F1,
+ false = F1 > [2],
+ false = F1 > [],
- ?line false = [1] =< F1,
- ?line false = [] =< F1,
- ?line false = F1 >= [2],
- ?line false = F1 >= [],
+ false = [1] =< F1,
+ false = [] =< F1,
+ false = F1 >= [2],
+ false = F1 >= [],
%% Compare module funs with conses and nils.
- ?line true = FF1 < [a],
- ?line true = FF1 < [],
- ?line true = [a,b] > FF1,
- ?line true = [] > FF1,
+ true = FF1 < [a],
+ true = FF1 < [],
+ true = [a,b] > FF1,
+ true = [] > FF1,
- ?line false = [1] < FF1,
- ?line false = [] < FF1,
- ?line false = FF1 > [2],
- ?line false = FF1 > [],
+ false = [1] < FF1,
+ false = [] < FF1,
+ false = FF1 > [2],
+ false = FF1 > [],
- ?line false = [1] =< FF1,
- ?line false = [] =< FF1,
- ?line false = FF1 >= [2],
- ?line false = FF1 >= [],
+ false = [1] =< FF1,
+ false = [] =< FF1,
+ false = FF1 >= [2],
+ false = FF1 >= [],
ok.
make_fun(X, Y) ->
fun(A) -> A*X+Y end.
-fun_to_port(doc) -> "Try sending funs to ports (should fail).";
-fun_to_port(suite) -> [];
+%% Try sending funs to ports (should fail).
fun_to_port(Config) when is_list(Config) ->
- ?line fun_to_port(Config, xxx),
- ?line fun_to_port(Config, fun() -> 42 end),
- ?line fun_to_port(Config, [fun() -> 43 end]),
- ?line fun_to_port(Config, [1,fun() -> 44 end]),
- ?line fun_to_port(Config, [0,1|fun() -> 45 end]),
+ fun_to_port(Config, xxx),
+ fun_to_port(Config, fun() -> 42 end),
+ fun_to_port(Config, [fun() -> 43 end]),
+ fun_to_port(Config, [1,fun() -> 44 end]),
+ fun_to_port(Config, [0,1|fun() -> 45 end]),
B64K = build_io_list(65536),
- ?line fun_to_port(Config, [B64K,fun() -> 45 end]),
- ?line fun_to_port(Config, [B64K|fun() -> 45 end]),
+ fun_to_port(Config, [B64K,fun() -> 45 end]),
+ fun_to_port(Config, [B64K|fun() -> 45 end]),
ok.
fun_to_port(Config, IoList) ->
- Path = ?config(priv_dir, Config),
+ Path = proplists:get_value(priv_dir, Config),
AFile = filename:join(Path, "vanilla_file"),
Port = open_port(AFile, [out]),
case catch port_command(Port, IoList) of
{'EXIT',{badarg,_}} -> ok;
- Other -> ?t:fail({unexpected_retval,Other})
+ Other -> ct:fail({unexpected_retval,Other})
end.
build_io_list(0) -> [];
@@ -443,86 +412,83 @@ build_io_list(N) ->
1 -> [7,L|L]
end.
-t_hash(doc) -> "Test the hash/2 BIF on funs.";
-t_hash(suite) -> [];
+%% Test the hash/2 BIF on funs.
t_hash(Config) when is_list(Config) ->
F1 = fun(_X) -> 1 end,
F2 = fun(_X) -> 2 end,
- ?line true = hash(F1) /= hash(F2),
+ true = hash(F1) /= hash(F2),
G1 = make_fun(1, 2, 3),
G2 = make_fun(1, 2, 3),
G3 = make_fun(1, 2, 4),
- ?line true = hash(G1) == hash(G2),
- ?line true = hash(G2) /= hash(G3),
+ true = hash(G1) == hash(G2),
+ true = hash(G2) /= hash(G3),
FF0 = fun erlang:abs/1,
FF1 = fun erlang:exit/1,
FF2 = fun erlang:exit/2,
FF3 = fun blurf:exit/2,
- ?line true = hash(FF0) =/= hash(FF1),
- ?line true = hash(FF0) =/= hash(FF2),
- ?line true = hash(FF0) =/= hash(FF3),
- ?line true = hash(FF1) =/= hash(FF2),
- ?line true = hash(FF1) =/= hash(FF3),
- ?line true = hash(FF2) =/= hash(FF3),
+ true = hash(FF0) =/= hash(FF1),
+ true = hash(FF0) =/= hash(FF2),
+ true = hash(FF0) =/= hash(FF3),
+ true = hash(FF1) =/= hash(FF2),
+ true = hash(FF1) =/= hash(FF3),
+ true = hash(FF2) =/= hash(FF3),
ok.
hash(Term) ->
erlang:hash(Term, 16#7ffffff).
-t_phash(doc) -> "Test the phash/2 BIF on funs.";
-t_phash(suite) -> [];
+%% Test the phash/2 BIF on funs.
t_phash(Config) when is_list(Config) ->
F1 = fun(_X) -> 1 end,
F2 = fun(_X) -> 2 end,
- ?line true = phash(F1) /= phash(F2),
+ true = phash(F1) /= phash(F2),
G1 = make_fun(1, 2, 3),
G2 = make_fun(1, 2, 3),
G3 = make_fun(1, 2, 4),
- ?line true = phash(G1) == phash(G2),
- ?line true = phash(G2) /= phash(G3),
+ true = phash(G1) == phash(G2),
+ true = phash(G2) /= phash(G3),
FF0 = fun erlang:abs/1,
FF1 = fun erlang:exit/1,
FF2 = fun erlang:exit/2,
FF3 = fun blurf:exit/2,
- ?line true = phash(FF0) =/= phash(FF1),
- ?line true = phash(FF0) =/= phash(FF2),
- ?line true = phash(FF0) =/= phash(FF3),
- ?line true = phash(FF1) =/= phash(FF2),
- ?line true = phash(FF1) =/= phash(FF3),
- ?line true = phash(FF2) =/= phash(FF3),
+ true = phash(FF0) =/= phash(FF1),
+ true = phash(FF0) =/= phash(FF2),
+ true = phash(FF0) =/= phash(FF3),
+ true = phash(FF1) =/= phash(FF2),
+ true = phash(FF1) =/= phash(FF3),
+ true = phash(FF2) =/= phash(FF3),
ok.
phash(Term) ->
erlang:phash(Term, 16#7ffffff).
-t_phash2(doc) -> "Test the phash2/2 BIF on funs.";
-t_phash2(suite) -> [];
+%% Test the phash2/2 BIF on funs.
t_phash2(Config) when is_list(Config) ->
F1 = fun(_X) -> 1 end,
F2 = fun(_X) -> 2 end,
- ?line true = phash2(F1) /= phash2(F2),
+ true = phash2(F1) /= phash2(F2),
G1 = make_fun(1, 2, 3),
G2 = make_fun(1, 2, 3),
G3 = make_fun(1, 2, 4),
- ?line true = phash2(G1) == phash2(G2),
- ?line true = phash2(G2) /= phash2(G3),
+ true = phash2(G1) == phash2(G2),
+ true = phash2(G2) /= phash2(G3),
FF0 = fun erlang:abs/1,
FF1 = fun erlang:exit/1,
FF2 = fun erlang:exit/2,
FF3 = fun blurf:exit/2,
- ?line true = phash2(FF0) =/= phash2(FF1),
- ?line true = phash2(FF0) =/= phash2(FF2),
- ?line true = phash2(FF0) =/= phash2(FF3),
- ?line true = phash2(FF1) =/= phash2(FF2),
- ?line true = phash2(FF1) =/= phash2(FF3),
- ?line true = phash2(FF2) =/= phash2(FF3),
+ true = phash2(FF0) =/= phash2(FF1),
+ true = phash2(FF0) =/= phash2(FF2),
+ true = phash2(FF0) =/= phash2(FF3),
+ true = phash2(FF1) =/= phash2(FF2),
+ true = phash2(FF1) =/= phash2(FF3),
+ true = phash2(FF2) =/= phash2(FF3),
ok.
@@ -532,52 +498,51 @@ phash2(Term) ->
make_fun(X, Y, Z) ->
fun() -> {X,Y,Z} end.
-md5(doc) -> "Test that MD5 bifs reject funs properly.";
-md5(suite) -> [];
+%% Test that MD5 bifs reject funs properly.
md5(Config) when is_list(Config) ->
_ = size(erlang:md5_init()),
%% Try funs in the i/o list.
- ?line bad_md5(fun(_X) -> 42 end),
- ?line bad_md5([fun(_X) -> 43 end]),
- ?line bad_md5([1,fun(_X) -> 44 end]),
- ?line bad_md5([1|fun(_X) -> 45 end]),
- ?line B64K = build_io_list(65536),
- ?line bad_md5([B64K,fun(_X) -> 46 end]),
- ?line bad_md5([B64K|fun(_X) -> 46 end]),
+ bad_md5(fun(_X) -> 42 end),
+ bad_md5([fun(_X) -> 43 end]),
+ bad_md5([1,fun(_X) -> 44 end]),
+ bad_md5([1|fun(_X) -> 45 end]),
+ B64K = build_io_list(65536),
+ bad_md5([B64K,fun(_X) -> 46 end]),
+ bad_md5([B64K|fun(_X) -> 46 end]),
ok.
bad_md5(Bad) ->
{'EXIT',{badarg,_}} = (catch erlang:md5(Bad)).
refc(Config) when is_list(Config) ->
- ?line F1 = fun_factory(2),
- ?line {refc,2} = erlang:fun_info(F1, refc),
- ?line F2 = fun_factory(42),
- ?line {refc,3} = erlang:fun_info(F1, refc),
+ F1 = fun_factory(2),
+ {refc,2} = erlang:fun_info(F1, refc),
+ F2 = fun_factory(42),
+ {refc,3} = erlang:fun_info(F1, refc),
- ?line process_flag(trap_exit, true),
- ?line Pid = spawn_link(fun() -> {refc,4} = erlang:fun_info(F1, refc) end),
+ process_flag(trap_exit, true),
+ Pid = spawn_link(fun() -> {refc,4} = erlang:fun_info(F1, refc) end),
receive
{'EXIT',Pid,normal} -> ok;
- Other -> ?line ?t:fail({unexpected,Other})
+ Other -> ct:fail({unexpected,Other})
end,
- ?line process_flag(trap_exit, false),
- ?line {refc,3} = erlang:fun_info(F1, refc),
+ process_flag(trap_exit, false),
+ {refc,3} = erlang:fun_info(F1, refc),
%% Garbage collect. Only the F2 fun will be left.
- ?line 7 = F1(5),
- ?line true = erlang:garbage_collect(),
- ?line 40 = F2(-2),
- ?line {refc,2} = erlang:fun_info(F2, refc),
+ 7 = F1(5),
+ true = erlang:garbage_collect(),
+ 40 = F2(-2),
+ {refc,2} = erlang:fun_info(F2, refc),
ok.
fun_factory(Const) ->
fun(X) -> X + Const end.
refc_ets(Config) when is_list(Config) ->
- ?line F = fun(X) -> X + 33 end,
- ?line {refc,2} = erlang:fun_info(F, refc),
+ F = fun(X) -> X + 33 end,
+ {refc,2} = erlang:fun_info(F, refc),
refc_ets_set(F, [set]),
refc_ets_set(F, [ordered_set]),
@@ -586,115 +551,112 @@ refc_ets(Config) when is_list(Config) ->
ok.
refc_ets_set(F1, Options) ->
- ?line io:format("~p", [Options]),
- ?line Tab = ets:new(kalle, Options),
- ?line true = ets:insert(Tab, {a_key,F1}),
- ?line 3 = fun_refc(F1),
- ?line [{a_key,F3}] = ets:lookup(Tab, a_key),
- ?line 4 = fun_refc(F1),
- ?line true = ets:insert(Tab, {a_key,not_a_fun}),
- ?line 3 = fun_refc(F1),
- ?line true = ets:insert(Tab, {another_key,F1}),
- ?line 4 = fun_refc(F1),
- ?line true = ets:delete(Tab),
- ?line 3 = fun_refc(F1),
- ?line 10 = F3(-23),
- ?line true = erlang:garbage_collect(),
- ?line 2 = fun_refc(F1),
+ io:format("~p", [Options]),
+ Tab = ets:new(kalle, Options),
+ true = ets:insert(Tab, {a_key,F1}),
+ 3 = fun_refc(F1),
+ [{a_key,F3}] = ets:lookup(Tab, a_key),
+ 4 = fun_refc(F1),
+ true = ets:insert(Tab, {a_key,not_a_fun}),
+ 3 = fun_refc(F1),
+ true = ets:insert(Tab, {another_key,F1}),
+ 4 = fun_refc(F1),
+ true = ets:delete(Tab),
+ 3 = fun_refc(F1),
+ 10 = F3(-23),
+ true = erlang:garbage_collect(),
+ 2 = fun_refc(F1),
ok.
refc_ets_bag(F1, Options) ->
- ?line io:format("~p", [Options]),
- ?line Tab = ets:new(kalle, Options),
- ?line true = ets:insert(Tab, {a_key,F1}),
- ?line 3 = fun_refc(F1),
- ?line [{a_key,F3}] = ets:lookup(Tab, a_key),
- ?line 4 = fun_refc(F1),
- ?line true = ets:insert(Tab, {a_key,not_a_fun}),
- ?line 4 = fun_refc(F1),
- ?line true = ets:insert(Tab, {another_key,F1}),
- ?line 5 = fun_refc(F1),
- ?line true = ets:delete(Tab),
- ?line 3 = fun_refc(F1),
- ?line 10 = F3(-23),
- ?line true = erlang:garbage_collect(),
- ?line 2 = fun_refc(F1),
+ io:format("~p", [Options]),
+ Tab = ets:new(kalle, Options),
+ true = ets:insert(Tab, {a_key,F1}),
+ 3 = fun_refc(F1),
+ [{a_key,F3}] = ets:lookup(Tab, a_key),
+ 4 = fun_refc(F1),
+ true = ets:insert(Tab, {a_key,not_a_fun}),
+ 4 = fun_refc(F1),
+ true = ets:insert(Tab, {another_key,F1}),
+ 5 = fun_refc(F1),
+ true = ets:delete(Tab),
+ 3 = fun_refc(F1),
+ 10 = F3(-23),
+ true = erlang:garbage_collect(),
+ 2 = fun_refc(F1),
ok.
refc_dist(Config) when is_list(Config) ->
- ?line {ok,Node} = start_node(fun_SUITE_refc_dist),
- ?line process_flag(trap_exit, true),
- ?line Pid = spawn_link(Node,
- fun() -> receive
- Fun when is_function(Fun) ->
- 2 = fun_refc(Fun),
- exit({normal,Fun}) end
- end),
- ?line F = fun() -> 42 end,
- ?line 2 = fun_refc(F),
- ?line Pid ! F,
+ {ok,Node} = start_node(fun_SUITE_refc_dist),
+ process_flag(trap_exit, true),
+ Pid = spawn_link(Node, fun() -> receive
+ Fun when is_function(Fun) ->
+ 2 = fun_refc(Fun),
+ exit({normal,Fun}) end
+ end),
+ F = fun() -> 42 end,
+ 2 = fun_refc(F),
+ Pid ! F,
F2 = receive
{'EXIT',Pid,{normal,Fun}} -> Fun;
- Other -> ?line ?t:fail({unexpected,Other})
+ Other -> ct:fail({unexpected,Other})
end,
%% dist.c:net_mess2 have a reference to Fun for a while since
%% Fun is passed in an exit signal. Wait until it is gone.
- ?line wait_until(fun () -> 4 =/= fun_refc(F2) end),
- ?line 3 = fun_refc(F2),
- ?line true = erlang:garbage_collect(),
- ?line 2 = fun_refc(F),
+ wait_until(fun () -> 4 =/= fun_refc(F2) end),
+ 3 = fun_refc(F2),
+ true = erlang:garbage_collect(),
+ 2 = fun_refc(F),
refc_dist_send(Node, F).
refc_dist_send(Node, F) ->
- ?line Pid = spawn_link(Node,
- fun() -> receive
- {To,Fun} when is_function(Fun) ->
- wait_until(fun () ->
- 2 =:= fun_refc(Fun)
- end),
- To ! Fun
- end
- end),
- ?line 2 = fun_refc(F),
+ Pid = spawn_link(Node, fun() -> receive
+ {To,Fun} when is_function(Fun) ->
+ wait_until(fun () ->
+ 2 =:= fun_refc(Fun)
+ end),
+ To ! Fun
+ end
+ end),
+ 2 = fun_refc(F),
Pid ! {self(),F},
F2 = receive
Fun when is_function(Fun) -> Fun;
- Other -> ?line ?t:fail({unexpected,Other})
+ Other -> ct:fail({unexpected,Other})
end,
receive {'EXIT',Pid,normal} -> ok end,
%% No reference from dist.c:net_mess2 since Fun is passed
%% in an ordinary message.
- ?line 3 = fun_refc(F),
- ?line 3 = fun_refc(F2),
+ 3 = fun_refc(F),
+ 3 = fun_refc(F2),
refc_dist_reg_send(Node, F).
refc_dist_reg_send(Node, F) ->
- ?line true = erlang:garbage_collect(),
- ?line 2 = fun_refc(F),
- ?line Ref = make_ref(),
- ?line Me = self(),
- ?line Pid = spawn_link(Node,
- fun() ->
- true = register(my_fun_tester, self()),
- Me ! Ref,
- receive
- {Me,Fun} when is_function(Fun) ->
- 2 = fun_refc(Fun),
- Me ! Fun
- end
- end),
+ true = erlang:garbage_collect(),
+ 2 = fun_refc(F),
+ Ref = make_ref(),
+ Me = self(),
+ Pid = spawn_link(Node, fun() ->
+ true = register(my_fun_tester, self()),
+ Me ! Ref,
+ receive
+ {Me,Fun} when is_function(Fun) ->
+ 2 = fun_refc(Fun),
+ Me ! Fun
+ end
+ end),
erlang:yield(),
- ?line 2 = fun_refc(F),
+ 2 = fun_refc(F),
receive Ref -> ok end,
{my_fun_tester,Node} ! {self(),F},
F2 = receive
Fun when is_function(Fun) -> Fun;
- Other -> ?line ?t:fail({unexpected,Other})
+ Other -> ct:fail({unexpected,Other})
end,
receive {'EXIT',Pid,normal} -> ok end,
- ?line 3 = fun_refc(F),
- ?line 3 = fun_refc(F2),
+ 3 = fun_refc(F),
+ 3 = fun_refc(F2),
ok.
fun_refc(F) ->
@@ -702,67 +664,67 @@ fun_refc(F) ->
Count.
const_propagation(Config) when is_list(Config) ->
- ?line Fun1 = fun start_node/1,
- ?line 2 = fun_refc(Fun1),
- ?line Fun2 = Fun1,
- ?line my_cmp({Fun1,Fun2}),
-
- ?line Fun3 = fun() -> ok end,
- ?line 2 = fun_refc(Fun3),
- ?line Fun4 = Fun3,
- ?line my_cmp({Fun3,Fun4}),
+ Fun1 = fun start_node/1,
+ 2 = fun_refc(Fun1),
+ Fun2 = Fun1,
+ my_cmp({Fun1,Fun2}),
+
+ Fun3 = fun() -> ok end,
+ 2 = fun_refc(Fun3),
+ Fun4 = Fun3,
+ my_cmp({Fun3,Fun4}),
ok.
my_cmp({Fun,Fun}) -> ok;
my_cmp({Fun1,Fun2}) ->
io:format("Fun1: ~p", [erlang:fun_info(Fun1)]),
io:format("Fun2: ~p", [erlang:fun_info(Fun2)]),
- ?t:fail().
+ ct:fail(no_match).
t_arity(Config) when is_list(Config) ->
- ?line 0 = fun_arity(fun() -> ok end),
- ?line 0 = fun_arity(fun() -> Config end),
- ?line 1 = fun_arity(fun(X) -> X+1 end),
- ?line 1 = fun_arity(fun(X) -> Config =:= X end),
+ 0 = fun_arity(fun() -> ok end),
+ 0 = fun_arity(fun() -> Config end),
+ 1 = fun_arity(fun(X) -> X+1 end),
+ 1 = fun_arity(fun(X) -> Config =:= X end),
A = id(42),
%% Test that the arity is transferred properly.
- ?line process_flag(trap_exit, true),
- ?line {ok,Node} = start_node(fun_test_arity),
- ?line hello_world = spawn_call(Node, fun() -> hello_world end),
- ?line 0 = spawn_call(Node, fun(X) -> X end),
- ?line 42 = spawn_call(Node, fun(_X) -> A end),
- ?line 43 = spawn_call(Node, fun(X, Y) -> A+X+Y end),
- ?line 1 = spawn_call(Node, fun(X, Y) -> X+Y end),
- ?line 45 = spawn_call(Node, fun(X, Y, Z) -> A+X+Y+Z end),
+ process_flag(trap_exit, true),
+ {ok,Node} = start_node(fun_test_arity),
+ hello_world = spawn_call(Node, fun() -> hello_world end),
+ 0 = spawn_call(Node, fun(X) -> X end),
+ 42 = spawn_call(Node, fun(_X) -> A end),
+ 43 = spawn_call(Node, fun(X, Y) -> A+X+Y end),
+ 1 = spawn_call(Node, fun(X, Y) -> X+Y end),
+ 45 = spawn_call(Node, fun(X, Y, Z) -> A+X+Y+Z end),
ok.
t_is_function2(Config) when is_list(Config) ->
false = is_function(id({a,b}), 0),
false = is_function(id({a,b}), 234343434333433433),
- ?line true = is_function(fun() -> ok end, 0),
- ?line true = is_function(fun(_) -> ok end, 1),
- ?line false = is_function(fun(_) -> ok end, 0),
+ true = is_function(fun() -> ok end, 0),
+ true = is_function(fun(_) -> ok end, 1),
+ false = is_function(fun(_) -> ok end, 0),
- ?line true = is_function(fun erlang:abs/1, 1),
- ?line true = is_function(fun erlang:abs/99, 99),
- ?line false = is_function(fun erlang:abs/1, 0),
- ?line false = is_function(fun erlang:abs/99, 0),
+ true = is_function(fun erlang:abs/1, 1),
+ true = is_function(fun erlang:abs/99, 99),
+ false = is_function(fun erlang:abs/1, 0),
+ false = is_function(fun erlang:abs/99, 0),
- ?line false = is_function(id(self()), 0),
- ?line false = is_function(id({a,b,c}), 0),
- ?line false = is_function(id({a}), 0),
- ?line false = is_function(id([a,b,c]), 0),
+ false = is_function(id(self()), 0),
+ false = is_function(id({a,b,c}), 0),
+ false = is_function(id({a}), 0),
+ false = is_function(id([a,b,c]), 0),
%% Bad arity argument.
- ?line bad_arity(a),
- ?line bad_arity(-1),
- ?line bad_arity(-9738974938734938793873498378),
- ?line bad_arity([]),
- ?line bad_arity(fun() -> ok end),
- ?line bad_arity({}),
- ?line bad_arity({a,b}),
- ?line bad_arity(self()),
+ bad_arity(a),
+ bad_arity(-1),
+ bad_arity(-9738974938734938793873498378),
+ bad_arity([]),
+ bad_arity(fun() -> ok end),
+ bad_arity({}),
+ bad_arity({a,b}),
+ bad_arity(self()),
ok.
bad_arity(A) ->
@@ -771,59 +733,57 @@ bad_arity(A) ->
ok.
t_fun_info(Config) when is_list(Config) ->
- ?line F = fun t_fun_info/1,
- ?line try F(blurf) of
+ F = fun t_fun_info/1,
+ try F(blurf) of
FAny ->
- io:format("should fail; returned ~p\n", [FAny]),
- ?line ?t:fail()
+ ct:fail("should fail; returned ~p\n", [FAny])
catch
error:function_clause -> ok
end,
- ?line {module,?MODULE} = erlang:fun_info(F, module),
- ?line case erlang:fun_info(F, name) of
+ {module,?MODULE} = erlang:fun_info(F, module),
+ case erlang:fun_info(F, name) of
undefined ->
- ?line ?t:fail();
+ ct:fail(no_fun_info);
_ -> ok
end,
- ?line {arity,1} = erlang:fun_info(F, arity),
- ?line {env,[]} = erlang:fun_info(F, env),
- ?line verify_not_undef(F, index),
- ?line verify_not_undef(F, uniq),
- ?line verify_not_undef(F, new_index),
- ?line verify_not_undef(F, new_uniq),
- ?line verify_not_undef(F, refc),
- ?line {'EXIT',_} = (catch erlang:fun_info(F, blurf)),
+ {arity,1} = erlang:fun_info(F, arity),
+ {env,[]} = erlang:fun_info(F, env),
+ verify_not_undef(F, index),
+ verify_not_undef(F, uniq),
+ verify_not_undef(F, new_index),
+ verify_not_undef(F, new_uniq),
+ verify_not_undef(F, refc),
+ {'EXIT',_} = (catch erlang:fun_info(F, blurf)),
%% Module fun.
- ?line FF = fun ?MODULE:t_fun_info/1,
- ?line try FF(blurf) of
+ FF = fun ?MODULE:t_fun_info/1,
+ try FF(blurf) of
FFAny ->
- io:format("should fail; returned ~p\n", [FFAny]),
- ?line ?t:fail()
+ ct:fail("should fail; returned ~p\n", [FFAny])
catch
error:function_clause -> ok
end,
- ?line {module,?MODULE} = erlang:fun_info(FF, module),
- ?line {name,t_fun_info} = erlang:fun_info(FF, name),
- ?line {arity,1} = erlang:fun_info(FF, arity),
- ?line {env,[]} = erlang:fun_info(FF, env),
- ?line verify_undef(FF, index),
- ?line verify_undef(FF, uniq),
- ?line verify_undef(FF, new_index),
- ?line verify_undef(FF, new_uniq),
- ?line verify_undef(FF, refc),
- ?line {'EXIT',_} = (catch erlang:fun_info(FF, blurf)),
+ {module,?MODULE} = erlang:fun_info(FF, module),
+ {name,t_fun_info} = erlang:fun_info(FF, name),
+ {arity,1} = erlang:fun_info(FF, arity),
+ {env,[]} = erlang:fun_info(FF, env),
+ verify_undef(FF, index),
+ verify_undef(FF, uniq),
+ verify_undef(FF, new_index),
+ verify_undef(FF, new_uniq),
+ verify_undef(FF, refc),
+ {'EXIT',_} = (catch erlang:fun_info(FF, blurf)),
%% Not fun.
- ?line bad_info(abc),
- ?line bad_info(42),
- ?line bad_info({fun erlang:list_to_integer/1}),
- ?line bad_info([42]),
- ?line bad_info([]),
- ?line bad_info(self()),
- ?line bad_info(<<>>),
- ?line bad_info(<<1,2>>),
+ bad_info(abc),
+ bad_info(42),
+ bad_info({fun erlang:list_to_integer/1}),
+ bad_info([42]),
+ bad_info([]),
+ bad_info(self()),
+ bad_info(<<>>),
+ bad_info(<<1,2>>),
ok.
t_fun_info_mfa(Config) when is_list(Config) ->
@@ -847,8 +807,7 @@ t_fun_info_mfa(Config) when is_list(Config) ->
bad_info(Term) ->
try erlang:fun_info(Term, module) of
Any ->
- io:format("should fail; returned ~p\n", [Any]),
- ?t:fail()
+ ict:fail("should fail; returned ~p\n", [Any])
catch
error:badarg -> ok
end.
@@ -859,7 +818,7 @@ verify_undef(Fun, Tag) ->
verify_not_undef(Fun, Tag) ->
case erlang:fun_info(Fun, Tag) of
{Tag,undefined} ->
- ?t:fail();
+ ct:fail("tag ~w not defined in fun_info", [Tag]);
{Tag,_} -> ok
end.
@@ -884,15 +843,15 @@ spawn_call(Node, AFun) ->
Pid ! {AFun,AFun,AFun},
Res = receive
{result,R} -> R;
- Other -> ?t:fail({bad_message,Other})
+ Other -> ct:fail({bad_message,Other})
after 10000 ->
- ?t:fail(timeout_waiting_for_result)
+ ct:fail(timeout_waiting_for_result)
end,
receive
{'EXIT',Pid,normal} -> ok;
- Other2 -> ?t:fail({bad_message_waiting_for_exit,Other2})
+ Other2 -> ct:fail({bad_message_waiting_for_exit,Other2})
after 10000 ->
- ?t:fail(timeout_waiting_for_exit)
+ ct:fail(timeout_waiting_for_exit)
end,
Res.
@@ -911,6 +870,3 @@ wait_until(Fun) ->
true -> ok;
_ -> receive after 100 -> wait_until(Fun) end
end.
-
-% stop_node(Node) ->
-% test_server:stop_node(Node).
diff --git a/erts/emulator/test/fun_r13_SUITE.erl b/erts/emulator/test/fun_r13_SUITE.erl
index 7ab5e65cb3..d66026705b 100644
--- a/erts/emulator/test/fun_r13_SUITE.erl
+++ b/erts/emulator/test/fun_r13_SUITE.erl
@@ -21,77 +21,53 @@
-module(fun_r13_SUITE).
-compile(r13).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,dist_old_release/1]).
+-export([all/0, suite/0,
+ dist_old_release/1]).
--define(default_timeout, ?t:minutes(1)).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
all() ->
[dist_old_release].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(_Case, Config) ->
- ?line Dog = test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
dist_old_release(Config) when is_list(Config) ->
- case ?t:is_release_available("r12b") of
- true -> do_dist_old(Config);
- false -> {skip,"No R12B found"}
+ case test_server:is_release_available("r12b") of
+ true -> do_dist_old(Config);
+ false -> {skip,"No R12B found"}
end.
do_dist_old(Config) when is_list(Config) ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
+ Pa = filename:dirname(code:which(?MODULE)),
Name = fun_dist_r12,
- ?line {ok,Node} = ?t:start_node(Name, peer,
- [{args,"-pa "++Pa},
- {erl,[{release,"r12b"}]}]),
-
- ?line Pid = spawn_link(Node,
- fun() ->
- receive
- Fun when is_function(Fun) ->
- R12BFun = fun(H) -> cons(H, [b,c]) end,
- Fun(Fun, R12BFun)
- end
- end),
+ {ok,Node} = test_server:start_node(Name, peer,
+ [{args,"-pa "++Pa},
+ {erl,[{release,"r12b"}]}]),
+
+ Pid = spawn_link(Node,
+ fun() ->
+ receive
+ Fun when is_function(Fun) ->
+ R12BFun = fun(H) -> cons(H, [b,c]) end,
+ Fun(Fun, R12BFun)
+ end
+ end),
Self = self(),
Fun = fun(F, R12BFun) ->
- {pid,Self} = erlang:fun_info(F, pid),
- {module,?MODULE} = erlang:fun_info(F, module),
- Self ! {ok,F,R12BFun}
- end,
- ?line Pid ! Fun,
- ?line receive
- {ok,Fun,R12BFun} ->
- ?line [a,b,c] = R12BFun(a);
- Other ->
- ?line ?t:fail({bad_message,Other})
- end,
+ {pid,Self} = erlang:fun_info(F, pid),
+ {module,?MODULE} = erlang:fun_info(F, module),
+ Self ! {ok,F,R12BFun}
+ end,
+ Pid ! Fun,
+ receive
+ {ok,Fun,R12BFun} ->
+ [a,b,c] = R12BFun(a);
+ Other ->
+ ct:fail({bad_message,Other})
+ end,
+ true = test_server:stop_node(Node),
ok.
cons(H, T) ->
diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl
index 1e155e7b09..8e5f0b05a1 100644
--- a/erts/emulator/test/gc_SUITE.erl
+++ b/erts/emulator/test/gc_SUITE.erl
@@ -22,45 +22,27 @@
-module(gc_SUITE).
--include_lib("test_server/include/test_server.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
-
--define(default_timeout, ?t:minutes(10)).
+-include_lib("common_test/include/ct.hrl").
+-export([all/0, suite/0]).
-export([grow_heap/1, grow_stack/1, grow_stack_heap/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
all() ->
[grow_heap, grow_stack, grow_stack_heap].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-grow_heap(doc) -> ["Produce a growing list of elements, ",
- "for X calls, then drop one item per call",
- "until the list is empty."];
+%% Produce a growing list of elements,
+%% for X calls, then drop one item per call
+%% until the list is empty.
grow_heap(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:minutes(40)),
+ ct:timetrap({minutes, 40}),
ok = grow_heap1(256),
ok = grow_heap1(512),
ok = grow_heap1(1024),
ok = grow_heap1(2048),
- test_server:timetrap_cancel(Dog),
ok.
grow_heap1(Len) ->
@@ -86,14 +68,13 @@ grow_heap1([_|List], MaxLen, CurLen, down) ->
-grow_stack(doc) -> ["Increase and decrease stack size, and ",
- "drop off some garbage from time to time."];
+%% Increase and decrease stack size, and
+%% drop off some garbage from time to time.
grow_stack(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:minutes(80)),
+ ct:timetrap({minutes, 80}),
show_heap("before:"),
grow_stack1(200, 0),
show_heap("after:"),
- test_server:timetrap_cancel(Dog),
ok.
grow_stack1(0, _) ->
@@ -110,14 +91,12 @@ grow_stack1(Recs, CurRecs) ->
%% Let's see how BEAM handles this one...
-grow_stack_heap(doc) -> ["While growing the heap, bounces the size ",
- "of the stack, and while reducing the heap",
- "bounces the stack usage."];
+%% While growing the heap, bounces the size of the
+%% stack, and while reducing the heap, bounces the stack usage.
grow_stack_heap(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:minutes(40)),
+ ct:timetrap({minutes, 40}),
grow_stack_heap1(16),
grow_stack_heap1(32),
- test_server:timetrap_cancel(Dog),
ok.
grow_stack_heap1(MaxLen) ->
diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl
index b3a85c6423..6ad4456e6b 100644
--- a/erts/emulator/test/guard_SUITE.erl
+++ b/erts/emulator/test/guard_SUITE.erl
@@ -20,12 +20,12 @@
-module(guard_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, bad_arith/1, bad_tuple/1,
+-export([all/0, suite/0,
+ bad_arith/1, bad_tuple/1,
test_heap_guards/1, guard_bifs/1,
type_tests/1,guard_bif_binary_part/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init/3]).
-import(lists, [member/2]).
@@ -36,27 +36,12 @@ all() ->
[bad_arith, bad_tuple, test_heap_guards, guard_bifs,
type_tests, guard_bif_binary_part].
-groups() ->
- [].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly.";
+%% Test that a bad arithmetic operation in a guard works correctly.
bad_arith(Config) when is_list(Config) ->
- ?line 5 = bad_arith1(2, 3),
- ?line 10 = bad_arith1(1, infinity),
- ?line 10 = bad_arith1(infinity, 1),
+ 5 = bad_arith1(2, 3),
+ 10 = bad_arith1(1, infinity),
+ 10 = bad_arith1(infinity, 1),
ok.
bad_arith1(T1, T2) when T1+T2 < 10 ->
@@ -64,12 +49,12 @@ bad_arith1(T1, T2) when T1+T2 < 10 ->
bad_arith1(_, _) ->
10.
-bad_tuple(doc) -> "Test that bad arguments to element/2 are handled correctly.";
+%% Test that bad arguments to element/2 are handled correctly.
bad_tuple(Config) when is_list(Config) ->
- ?line error = bad_tuple1(a),
- ?line error = bad_tuple1({a, b}),
- ?line x = bad_tuple1({x, b}),
- ?line y = bad_tuple1({a, b, y}),
+ error = bad_tuple1(a),
+ error = bad_tuple1({a, b}),
+ x = bad_tuple1({x, b}),
+ y = bad_tuple1({a, b, y}),
ok.
bad_tuple1(T) when element(1, T) == x ->
@@ -79,26 +64,25 @@ bad_tuple1(T) when element(3, T) == y ->
bad_tuple1(_) ->
error.
-test_heap_guards(doc) -> "";
test_heap_guards(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(2)),
+ ct:timetrap({minutes, 2}),
- ?line process_flag(trap_exit, true),
- ?line Tuple = {a, tuple, is, built, here, xxx},
- ?line List = [a, list, is, built, here],
+ process_flag(trap_exit, true),
+ Tuple = {a, tuple, is, built, here, xxx},
+ List = [a, list, is, built, here],
- ?line 'try'(fun a_case/1, [Tuple], [Tuple]),
- ?line 'try'(fun a_case/1, [List], [List, List]),
- ?line 'try'(fun a_case/1, [a], [a]),
+ 'try'(fun a_case/1, [Tuple], [Tuple]),
+ 'try'(fun a_case/1, [List], [List, List]),
+ 'try'(fun a_case/1, [a], [a]),
- ?line 'try'(fun an_if/1, [Tuple], [Tuple]),
- ?line 'try'(fun an_if/1, [List], [List, List]),
- ?line 'try'(fun an_if/1, [a], [a]),
+ 'try'(fun an_if/1, [Tuple], [Tuple]),
+ 'try'(fun an_if/1, [List], [List, List]),
+ 'try'(fun an_if/1, [a], [a]),
- ?line 'try'(fun receive_test/1, [Tuple], [Tuple]),
- ?line 'try'(fun receive_test/1, [List], [List, List]),
- ?line 'try'(fun receive_test/1, [a], [a]),
- ?line test_server:timetrap_cancel(Dog).
+ 'try'(fun receive_test/1, [Tuple], [Tuple]),
+ 'try'(fun receive_test/1, [List], [List, List]),
+ 'try'(fun receive_test/1, [a], [a]),
+ ok.
a_case(V) ->
case V of
@@ -143,12 +127,11 @@ a_receive() ->
Pid = spawn_link(?MODULE, init, [Fun,Args,list_to_tuple(Filler)]),
receive
{'EXIT', Pid, {result, Result}} ->
- ?line 'try'(Iter-1, Fun, Args, Result, [0|Filler]);
+ 'try'(Iter-1, Fun, Args, Result, [0|Filler]);
{result, Other} ->
- ?line io:format("Expected ~p; got ~p~n", [Result, Other]),
- ?line test_server:fail();
+ ct:fail("Expected ~p; got ~p~n", [Result, Other]);
Other ->
- ?line test_server:fail({unexpected_message, Other})
+ ct:fail({unexpected_message, Other})
end.
init(Fun, Args, Filler) ->
@@ -165,15 +148,14 @@ mask_error({'EXIT',{Err,_}}) ->
mask_error(Else) ->
Else.
-guard_bif_binary_part(doc) ->
- ["Test the binary_part/2,3 guard BIF's extensively"];
+%% Test the binary_part/2,3 guard BIF's extensively
guard_bif_binary_part(Config) when is_list(Config) ->
%% Overflow tests that need to be unoptimized
- ?line badarg =
+ badarg =
?MASK_ERROR(
binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
-16#7FFFFFFFFFFFFFFF-1})),
- ?line badarg =
+ badarg =
?MASK_ERROR(
binary_part(<<1,2,3>>,{16#FFFFFFFFFFFFFFFF,
16#7FFFFFFFFFFFFFFF})),
@@ -198,66 +180,66 @@ guard_bif_binary_part(Config) when is_list(Config) ->
do_binary_part_guard() ->
- ?line 1 = bptest(<<1,2,3>>),
- ?line 2 = bptest(<<2,1,3>>),
- ?line error = bptest(<<1>>),
- ?line error = bptest(<<>>),
- ?line error = bptest(apa),
- ?line 3 = bptest(<<2,3,3>>),
+ 1 = bptest(<<1,2,3>>),
+ 2 = bptest(<<2,1,3>>),
+ error = bptest(<<1>>),
+ error = bptest(<<>>),
+ error = bptest(apa),
+ 3 = bptest(<<2,3,3>>),
% With one variable (pos)
- ?line 1 = bptest(<<1,2,3>>,1),
- ?line 2 = bptest(<<2,1,3>>,1),
- ?line error = bptest(<<1>>,1),
- ?line error = bptest(<<>>,1),
- ?line error = bptest(apa,1),
- ?line 3 = bptest(<<2,3,3>>,1),
+ 1 = bptest(<<1,2,3>>,1),
+ 2 = bptest(<<2,1,3>>,1),
+ error = bptest(<<1>>,1),
+ error = bptest(<<>>,1),
+ error = bptest(apa,1),
+ 3 = bptest(<<2,3,3>>,1),
% With one variable (length)
- ?line 1 = bptesty(<<1,2,3>>,1),
- ?line 2 = bptesty(<<2,1,3>>,1),
- ?line error = bptesty(<<1>>,1),
- ?line error = bptesty(<<>>,1),
- ?line error = bptesty(apa,1),
- ?line 3 = bptesty(<<2,3,3>>,2),
+ 1 = bptesty(<<1,2,3>>,1),
+ 2 = bptesty(<<2,1,3>>,1),
+ error = bptesty(<<1>>,1),
+ error = bptesty(<<>>,1),
+ error = bptesty(apa,1),
+ 3 = bptesty(<<2,3,3>>,2),
% With one variable (whole tuple)
- ?line 1 = bptestx(<<1,2,3>>,{1,1}),
- ?line 2 = bptestx(<<2,1,3>>,{1,1}),
- ?line error = bptestx(<<1>>,{1,1}),
- ?line error = bptestx(<<>>,{1,1}),
- ?line error = bptestx(apa,{1,1}),
- ?line 3 = bptestx(<<2,3,3>>,{1,2}),
+ 1 = bptestx(<<1,2,3>>,{1,1}),
+ 2 = bptestx(<<2,1,3>>,{1,1}),
+ error = bptestx(<<1>>,{1,1}),
+ error = bptestx(<<>>,{1,1}),
+ error = bptestx(apa,{1,1}),
+ 3 = bptestx(<<2,3,3>>,{1,2}),
% With two variables
- ?line 1 = bptest(<<1,2,3>>,1,1),
- ?line 2 = bptest(<<2,1,3>>,1,1),
- ?line error = bptest(<<1>>,1,1),
- ?line error = bptest(<<>>,1,1),
- ?line error = bptest(apa,1,1),
- ?line 3 = bptest(<<2,3,3>>,1,2),
+ 1 = bptest(<<1,2,3>>,1,1),
+ 2 = bptest(<<2,1,3>>,1,1),
+ error = bptest(<<1>>,1,1),
+ error = bptest(<<>>,1,1),
+ error = bptest(apa,1,1),
+ 3 = bptest(<<2,3,3>>,1,2),
% Direct (autoimported) call, these will be evaluated by the compiler...
- ?line <<2>> = binary_part(<<1,2,3>>,1,1),
- ?line <<1>> = binary_part(<<2,1,3>>,1,1),
+ <<2>> = binary_part(<<1,2,3>>,1,1),
+ <<1>> = binary_part(<<2,1,3>>,1,1),
% Compiler warnings due to constant evaluation expected (3)
- ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)),
- ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)),
- ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)),
- ?line <<3,3>> = binary_part(<<2,3,3>>,1,2),
+ badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)),
+ badarg = ?MASK_ERROR(binary_part(<<>>,1,1)),
+ badarg = ?MASK_ERROR(binary_part(apa,1,1)),
+ <<3,3>> = binary_part(<<2,3,3>>,1,2),
% Direct call through apply
- ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]),
- ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]),
+ <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]),
+ <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]),
% Compiler warnings due to constant evaluation expected (3)
- ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])),
- ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])),
- ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])),
- ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]),
+ badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])),
+ badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])),
+ badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])),
+ <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]),
% Constant propagation
- ?line Bin = <<1,2,3>>,
- ?line ok = if
+ Bin = <<1,2,3>>,
+ ok = if
binary_part(Bin,1,1) =:= <<2>> ->
ok;
%% Compiler warning, clause cannot match (expected)
true ->
error
end,
- ?line ok = if
+ ok = if
binary_part(Bin,{1,1}) =:= <<2>> ->
ok;
%% Compiler warning, clause cannot match (expected)
@@ -323,91 +305,91 @@ bptest(_,_,_) ->
error.
-guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments).";
+%% Test all guard bifs with nasty (but legal arguments).
guard_bifs(Config) when is_list(Config) ->
- ?line Big = -237849247829874297658726487367328971246284736473821617265433,
- ?line Float = 387924.874,
+ Big = -237849247829874297658726487367328971246284736473821617265433,
+ Float = 387924.874,
%% Succeding use of guard bifs.
- ?line try_gbif('abs/1', Big, -Big),
- ?line try_gbif('float/1', Big, float(Big)),
- ?line try_gbif('float/1', Big, float(id(Big))),
- ?line try_gbif('trunc/1', Float, 387924.0),
- ?line try_gbif('round/1', Float, 387925.0),
- ?line try_gbif('length/1', [], 0),
+ try_gbif('abs/1', Big, -Big),
+ try_gbif('float/1', Big, float(Big)),
+ try_gbif('float/1', Big, float(id(Big))),
+ try_gbif('trunc/1', Float, 387924.0),
+ try_gbif('round/1', Float, 387925.0),
+ try_gbif('length/1', [], 0),
- ?line try_gbif('length/1', [a], 1),
- ?line try_gbif('length/1', [a, b], 2),
- ?line try_gbif('length/1', lists:seq(0, 31), 32),
+ try_gbif('length/1', [a], 1),
+ try_gbif('length/1', [a, b], 2),
+ try_gbif('length/1', lists:seq(0, 31), 32),
- ?line try_gbif('hd/1', [a], a),
- ?line try_gbif('hd/1', [a, b], a),
+ try_gbif('hd/1', [a], a),
+ try_gbif('hd/1', [a, b], a),
- ?line try_gbif('tl/1', [a], []),
- ?line try_gbif('tl/1', [a, b], [b]),
- ?line try_gbif('tl/1', [a, b, c], [b, c]),
+ try_gbif('tl/1', [a], []),
+ try_gbif('tl/1', [a, b], [b]),
+ try_gbif('tl/1', [a, b, c], [b, c]),
- ?line try_gbif('size/1', {}, 0),
- ?line try_gbif('size/1', {a}, 1),
- ?line try_gbif('size/1', {a, b}, 2),
- ?line try_gbif('size/1', {a, b, c}, 3),
- ?line try_gbif('size/1', list_to_binary([]), 0),
- ?line try_gbif('size/1', list_to_binary([1]), 1),
- ?line try_gbif('size/1', list_to_binary([1, 2]), 2),
- ?line try_gbif('size/1', list_to_binary([1, 2, 3]), 3),
+ try_gbif('size/1', {}, 0),
+ try_gbif('size/1', {a}, 1),
+ try_gbif('size/1', {a, b}, 2),
+ try_gbif('size/1', {a, b, c}, 3),
+ try_gbif('size/1', list_to_binary([]), 0),
+ try_gbif('size/1', list_to_binary([1]), 1),
+ try_gbif('size/1', list_to_binary([1, 2]), 2),
+ try_gbif('size/1', list_to_binary([1, 2, 3]), 3),
- ?line try_gbif('bit_size/1', <<0:7>>, 7),
+ try_gbif('bit_size/1', <<0:7>>, 7),
- ?line try_gbif('element/2', {x}, {1, x}),
- ?line try_gbif('element/2', {x, y}, {1, x}),
- ?line try_gbif('element/2', {x, y}, {2, y}),
+ try_gbif('element/2', {x}, {1, x}),
+ try_gbif('element/2', {x, y}, {1, x}),
+ try_gbif('element/2', {x, y}, {2, y}),
- ?line try_gbif('self/0', 0, self()),
- ?line try_gbif('node/0', 0, node()),
- ?line try_gbif('node/1', self(), node()),
+ try_gbif('self/0', 0, self()),
+ try_gbif('node/0', 0, node()),
+ try_gbif('node/1', self(), node()),
%% Failing use of guard bifs.
- ?line try_fail_gbif('abs/1', Big, 1),
- ?line try_fail_gbif('abs/1', [], 1),
+ try_fail_gbif('abs/1', Big, 1),
+ try_fail_gbif('abs/1', [], 1),
- ?line try_fail_gbif('float/1', Big, 42),
- ?line try_fail_gbif('float/1', [], 42),
+ try_fail_gbif('float/1', Big, 42),
+ try_fail_gbif('float/1', [], 42),
- ?line try_fail_gbif('trunc/1', Float, 0.0),
- ?line try_fail_gbif('trunc/1', [], 0.0),
+ try_fail_gbif('trunc/1', Float, 0.0),
+ try_fail_gbif('trunc/1', [], 0.0),
- ?line try_fail_gbif('round/1', Float, 1.0),
- ?line try_fail_gbif('round/1', [], a),
+ try_fail_gbif('round/1', Float, 1.0),
+ try_fail_gbif('round/1', [], a),
- ?line try_fail_gbif('length/1', [], 1),
- ?line try_fail_gbif('length/1', [a], 0),
- ?line try_fail_gbif('length/1', a, 0),
- ?line try_fail_gbif('length/1', {a}, 0),
+ try_fail_gbif('length/1', [], 1),
+ try_fail_gbif('length/1', [a], 0),
+ try_fail_gbif('length/1', a, 0),
+ try_fail_gbif('length/1', {a}, 0),
- ?line try_fail_gbif('hd/1', [], 0),
- ?line try_fail_gbif('hd/1', [a], x),
- ?line try_fail_gbif('hd/1', x, x),
+ try_fail_gbif('hd/1', [], 0),
+ try_fail_gbif('hd/1', [a], x),
+ try_fail_gbif('hd/1', x, x),
- ?line try_fail_gbif('tl/1', [], 0),
- ?line try_fail_gbif('tl/1', [a], x),
- ?line try_fail_gbif('tl/1', x, x),
+ try_fail_gbif('tl/1', [], 0),
+ try_fail_gbif('tl/1', [a], x),
+ try_fail_gbif('tl/1', x, x),
- ?line try_fail_gbif('size/1', {}, 1),
- ?line try_fail_gbif('size/1', [], 0),
- ?line try_fail_gbif('size/1', [a], 1),
- ?line try_fail_gbif('size/1', fun() -> 1 end, 0),
- ?line try_fail_gbif('size/1', fun() -> 1 end, 1),
+ try_fail_gbif('size/1', {}, 1),
+ try_fail_gbif('size/1', [], 0),
+ try_fail_gbif('size/1', [a], 1),
+ try_fail_gbif('size/1', fun() -> 1 end, 0),
+ try_fail_gbif('size/1', fun() -> 1 end, 1),
- ?line try_fail_gbif('element/2', {}, {1, x}),
- ?line try_fail_gbif('element/2', {x}, {1, y}),
- ?line try_fail_gbif('element/2', [], {1, z}),
+ try_fail_gbif('element/2', {}, {1, x}),
+ try_fail_gbif('element/2', {x}, {1, y}),
+ try_fail_gbif('element/2', [], {1, z}),
- ?line try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")),
- ?line try_fail_gbif('node/0', 0, xxxx),
- ?line try_fail_gbif('node/1', self(), xxx),
- ?line try_fail_gbif('node/1', yyy, xxx),
+ try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")),
+ try_fail_gbif('node/0', 0, xxxx),
+ try_fail_gbif('node/1', self(), xxx),
+ try_fail_gbif('node/1', yyy, xxx),
ok.
try_gbif(Id, X, Y) ->
@@ -415,9 +397,7 @@ try_gbif(Id, X, Y) ->
{Id, X, Y} ->
io:format("guard_bif(~p, ~p, ~p) -- ok", [Id, X, Y]);
Other ->
- ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
- [Id, X, Y, Other]),
- ?line test_server:fail()
+ ct:fail("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", [Id, X, Y, Other])
end.
try_fail_gbif(Id, X, Y) ->
@@ -425,9 +405,7 @@ try_fail_gbif(Id, X, Y) ->
{'EXIT',{function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} ->
io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]);
Other ->
- ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n",
- [Id, X, Y, Other]),
- ?line test_server:fail()
+ ct:fail("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", [Id, X, Y, Other])
end.
guard_bif('abs/1', X, Y) when abs(X) == Y ->
@@ -457,22 +435,20 @@ guard_bif('node/0', X, Y) when node() == Y ->
guard_bif('node/1', X, Y) when node(X) == Y ->
{'node/1', X, Y}.
-type_tests(doc) -> "Test the type tests.";
+%% Test the type tests.
type_tests(Config) when is_list(Config) ->
- ?line Types = all_types(),
- ?line Tests = type_test_desc(),
- ?line put(errors, 0),
- ?line put(violations, 0),
- ?line type_tests(Tests, Types),
- ?line case {get(errors), get(violations)} of
+ Types = all_types(),
+ Tests = type_test_desc(),
+ put(errors, 0),
+ put(violations, 0),
+ type_tests(Tests, Types),
+ case {get(errors), get(violations)} of
{0, 0} ->
ok;
{0, N} ->
{comment, integer_to_list(N) ++ " standard violation(s)"};
{Errors, Violations} ->
- io:format("~p sub test(s) failed, ~p violation(s)",
- [Errors, Violations]),
- ?line test_server:fail()
+ ct:fail("~p sub test(s) failed, ~p violation(s)", [Errors, Violations])
end.
type_tests([{Test, AllowedTypes}| T], AllTypes) ->
@@ -499,7 +475,7 @@ type_tests(Test, [Type|T], Allowed) ->
when is_list(Loc) ->
ok;
{'EXIT',Other} ->
- ?line test_server:fail({unexpected_error_reason,Other});
+ ct:fail({unexpected_error_reason,Other});
tuple when is_function(Value) ->
io:format("Standard violation: Test ~p(~p) should fail",
[Test, Value]),
diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl
index 2ea49467b8..be254f5543 100644
--- a/erts/emulator/test/hash_SUITE.erl
+++ b/erts/emulator/test/hash_SUITE.erl
@@ -50,7 +50,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
-ifdef(debug).
@@ -70,86 +70,43 @@ config(priv_dir,_) ->
".".
-else.
%% When run in test server.
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
test_basic/1,test_cmp/1,test_range/1,test_spread/1,
test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1,
- test_hash_zero/1,
- end_per_testcase/2,init_per_testcase/2]).
-init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(test_server:minutes(10)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-suite() -> [{ct_hooks,[ts_install_cth]}].
+ test_hash_zero/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 10}}].
all() ->
[test_basic, test_cmp, test_range, test_spread,
test_phash2, otp_5292, bit_level_binaries, otp_7127,
- test_hash_zero
- ].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
+ test_hash_zero].
-test_basic(suite) ->
- [];
-test_basic(doc) ->
- ["Tests basic functionality of erlang:phash and that the "
- "hashes has not changed (neither hash nor phash)"];
+%% Tests basic functionality of erlang:phash and that the
+%% hashes has not changed (neither hash nor phash)
test_basic(Config) when is_list(Config) ->
basic_test().
-test_cmp(suite) ->
- [];
-test_cmp(doc) ->
- ["Compares integer hashes made by erlang:phash with those of a reference "
- "implementation"];
+%% Compares integer hashes made by erlang:phash with those of a reference implementation
test_cmp(Config) when is_list(Config) ->
cmp_test(10000).
-test_range(suite) ->
- [];
-test_range(doc) ->
- ["Tests ranges on erlang:phash from 1 to 2^32"];
+%% Tests ranges on erlang:phash from 1 to 2^32
test_range(Config) when is_list(Config) ->
range_test().
-test_spread(suite) ->
- [];
-test_spread(doc) ->
- ["Tests that the hashes are spread ok"];
+%% Tests that the hashes are spread ok
test_spread(Config) when is_list(Config) ->
spread_test(10).
-test_phash2(suite) ->
- [];
-test_phash2(doc) ->
- ["Tests phash2"];
+%% Tests phash2
test_phash2(Config) when is_list(Config) ->
phash2_test().
-otp_5292(suite) ->
- [];
-otp_5292(doc) ->
- ["Tests hash, phash and phash2 regarding integers."];
+%% Tests hash, phash and phash2 regarding integers.
otp_5292(Config) when is_list(Config) ->
otp_5292_test().
@@ -157,10 +114,7 @@ otp_5292(Config) when is_list(Config) ->
bit_level_binaries(Config) when is_list(Config) ->
bit_level_binaries_do().
-otp_7127(suite) ->
- [];
-otp_7127(doc) ->
- ["Tests phash2/1."];
+%% Tests phash2/1.
otp_7127(Config) when is_list(Config) ->
otp_7127_test().
@@ -223,11 +177,10 @@ basic_test() ->
range_test() ->
- random:seed(),
F = fun(From,From,_FF) ->
ok;
(From,To,FF) ->
- R = random:uniform(16#FFFFFFFFFFFFFFFF),
+ R = rand:uniform(16#FFFFFFFFFFFFFFFF),
X = erlang:phash(R, From),
Y = erlang:phash(R, 16#100000000) - 1,
Z = (Y rem From) + 1,
@@ -265,14 +218,13 @@ spread_test(N) ->
cmp_test(N) ->
- % No need to save seed, the error indicates what number caused it.
- random:seed(),
do_cmp_hashes(N,8).
+
do_cmp_hashes(0,_) ->
ok;
do_cmp_hashes(N,Steps) ->
- R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF),
- R = case random:uniform(2) of
+ R0 = rand:uniform(1 bsl Steps - 1) + rand:uniform(16#FFFFFFFF),
+ R = case rand:uniform(2) of
1 ->
R0;
_ ->
diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl
index 4ac8c272db..45f0bdc4da 100644
--- a/erts/emulator/test/hibernate_SUITE.erl
+++ b/erts/emulator/test/hibernate_SUITE.erl
@@ -20,47 +20,25 @@
-module(hibernate_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
+-export([all/0, suite/0,
basic/1,dynamic_call/1,min_heap_size/1,bad_args/1,
- messages_in_queue/1,undefined_mfa/1,no_heap/1,wake_up_and_bif_trap/1]).
+ messages_in_queue/1,undefined_mfa/1,no_heap/1,
+ wake_up_and_bif_trap/1]).
%% Used by test cases.
--export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2, no_heap_loop/0,characters_to_list_trap/1]).
+-export([basic_hibernator/1,dynamic_call_hibernator/2,messages_in_queue_restart/2,
+ no_heap_loop/0,characters_to_list_trap/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 3}}].
all() ->
[basic, dynamic_call, min_heap_size, bad_args, messages_in_queue,
undefined_mfa, no_heap, wake_up_and_bif_trap].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:minutes(3)),
- [{watchdog,Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
%%%
%%% Testing the basic functionality of erlang:hibernate/3.
%%%
@@ -69,9 +47,9 @@ basic(Config) when is_list(Config) ->
Ref = make_ref(),
Info = {self(),Ref},
ExpectedHeapSz = erts_debug:size([Info]),
- ?line Child = spawn_link(fun() -> basic_hibernator(Info) end),
- ?line hibernate_wake_up(100, ExpectedHeapSz, Child),
- ?line Child ! please_quit_now,
+ Child = spawn_link(fun() -> basic_hibernator(Info) end),
+ hibernate_wake_up(100, ExpectedHeapSz, Child),
+ Child ! please_quit_now,
ok.
hibernate_wake_up(0, _, _) -> ok;
@@ -85,35 +63,35 @@ hibernate_wake_up(N, ExpectedHeapSz, Child) ->
end;
1 -> ok
end,
- ?line Child ! {hibernate,self()},
- ?line wait_until(fun () ->
+ Child ! {hibernate,self()},
+ wait_until(fun () ->
{current_function,{erlang,hibernate,3}} ==
process_info(Child, current_function)
end),
- ?line {message_queue_len,0} = process_info(Child, message_queue_len),
- ?line {status,waiting} = process_info(Child, status),
- ?line {heap_size,ExpectedHeapSz} = process_info(Child, heap_size),
+ {message_queue_len,0} = process_info(Child, message_queue_len),
+ {status,waiting} = process_info(Child, status),
+ {heap_size,ExpectedHeapSz} = process_info(Child, heap_size),
io:format("Before hibernation: ~p After hibernation: ~p\n",
[Before,ExpectedHeapSz]),
- ?line Child ! {whats_up,self()},
- ?line receive
- {all_fine,X,Child,_Ref} ->
- if
- N =:= 1 -> io:format("~p\n", [X]);
- true -> ok
- end,
- {backtrace,Bin} = process_info(Child, backtrace),
- if
- size(Bin) > 1000 ->
- io:format("~s\n", [binary_to_list(Bin)]),
- ?line ?t:fail(stack_is_growing);
- true ->
- hibernate_wake_up(N-1, ExpectedHeapSz, Child)
- end;
- Other ->
- ?line io:format("~p\n", [Other]),
- ?line ?t:fail(unexpected_message)
- end.
+ Child ! {whats_up,self()},
+ receive
+ {all_fine,X,Child,_Ref} ->
+ if
+ N =:= 1 -> io:format("~p\n", [X]);
+ true -> ok
+ end,
+ {backtrace,Bin} = process_info(Child, backtrace),
+ if
+ size(Bin) > 1000 ->
+ io:format("~s\n", [binary_to_list(Bin)]),
+ ct:fail(stack_is_growing);
+ true ->
+ hibernate_wake_up(N-1, ExpectedHeapSz, Child)
+ end;
+ Other ->
+ io:format("~p\n", [Other]),
+ ct:fail(unexpected_message)
+ end.
basic_hibernator(Info) ->
{catchlevel,0} = process_info(self(), catchlevel),
@@ -165,9 +143,9 @@ dynamic_call(Config) when is_list(Config) ->
Ref = make_ref(),
Info = {self(),Ref},
ExpectedHeapSz = erts_debug:size([Info]),
- ?line Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end),
- ?line hibernate_wake_up(100, ExpectedHeapSz, Child),
- ?line Child ! please_quit_now,
+ Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end),
+ hibernate_wake_up(100, ExpectedHeapSz, Child),
+ Child ! please_quit_now,
ok.
dynamic_call_hibernator(Info, Function) ->
@@ -195,34 +173,32 @@ min_heap_size(Config) when is_list(Config) ->
end.
min_heap_size_1(Config) when is_list(Config) ->
- ?line erlang:trace(new, true, [call]),
+ erlang:trace(new, true, [call]),
MFA = {?MODULE,min_hibernator,1},
- ?line 1 = erlang:trace_pattern(MFA, true, [local]),
+ 1 = erlang:trace_pattern(MFA, true, [local]),
Ref = make_ref(),
Info = {self(),Ref},
- ?line Child = spawn_opt(fun() -> min_hibernator(Info) end,
+ Child = spawn_opt(fun() -> min_hibernator(Info) end,
[{min_heap_size,15000},link]),
receive
- {trace,Child,call,{?MODULE,min_hibernator,_}} ->
- ?line 1 = erlang:trace_pattern(MFA, false, [local]),
- ?line erlang:trace(new, false, [call])
+ {trace,Child,call,{?MODULE,min_hibernator,_}} ->
+ 1 = erlang:trace_pattern(MFA, false, [local]),
+ erlang:trace(new, false, [call])
end,
{heap_size,HeapSz} = process_info(Child, heap_size),
io:format("Heap size: ~p\n", [HeapSz]),
- ?line if
- HeapSz < 20 -> ok
- end,
- ?line Child ! wake_up,
+ if
+ HeapSz < 20 -> ok
+ end,
+ Child ! wake_up,
receive
{heap_size,AfterSize} ->
io:format("Heap size after wakeup: ~p\n", [AfterSize]),
- ?line
- if
- AfterSize >= 15000 -> ok
- end;
+ if
+ AfterSize >= 15000 -> ok
+ end;
Other ->
- io:format("Unexpected: ~p\n", [Other]),
- ?line ?t:fail()
+ ct:fail("Unexpected: ~p\n", [Other])
end.
min_hibernator({Parent,_Ref}) ->
@@ -239,23 +215,23 @@ min_hibernator_recv(Parent) ->
%%%
bad_args(Config) when is_list(Config) ->
- ?line bad_args(?MODULE, {name,glurf}, [0]),
- ?line {'EXIT',{system_limit,_}} =
+ bad_args(?MODULE, {name,glurf}, [0]),
+ {'EXIT',{system_limit,_}} =
(catch erlang:hibernate(x, y, lists:duplicate(5122, xxx))),
- ?line bad_args(42, name, [0]),
- ?line bad_args(xx, 42, [1]),
- ?line bad_args(xx, 42, glurf),
- ?line bad_args(xx, 42, {}),
- ?line bad_args({}, name, [2]),
- ?line bad_args({1}, name, [3]),
- ?line bad_args({1,2,3}, name, [4]),
- ?line bad_args({1,2,3}, name, [5]),
- ?line bad_args({1,2,3,4}, name, [6]),
- ?line bad_args({1,2,3,4,5,6}, name,[7]),
- ?line bad_args({1,2,3,4,5}, name, [8]),
- ?line bad_args({1,2}, name, [9]),
- ?line bad_args([1,2], name, [9]),
- ?line bad_args(55.0, name, [9]),
+ bad_args(42, name, [0]),
+ bad_args(xx, 42, [1]),
+ bad_args(xx, 42, glurf),
+ bad_args(xx, 42, {}),
+ bad_args({}, name, [2]),
+ bad_args({1}, name, [3]),
+ bad_args({1,2,3}, name, [4]),
+ bad_args({1,2,3}, name, [5]),
+ bad_args({1,2,3,4}, name, [6]),
+ bad_args({1,2,3,4,5,6}, name,[7]),
+ bad_args({1,2,3,4,5}, name, [8]),
+ bad_args({1,2}, name, [9]),
+ bad_args([1,2], name, [9]),
+ bad_args(55.0, name, [9]),
ok.
bad_args(Mod, Name, Args) ->
@@ -266,7 +242,7 @@ bad_args(Mod, Name, Args) ->
io:format("erlang:hibernate(~p, ~p, ~p) -> ~p\n", [Mod,Name,Args,Res]);
Other ->
io:format("erlang:hibernate(~p, ~p, ~p) -> ~p\n", [Mod,Name,Args,Res]),
- ?t:fail({bad_result,Other})
+ ct:fail({bad_result,Other})
end.
@@ -283,8 +259,8 @@ messages_in_queue(Config) when is_list(Config) ->
receive
done -> ok;
Other ->
- ?line io:format("~p\n", [Other]),
- ?line ?t:fail(unexpected_message)
+ io:format("~p\n", [Other]),
+ ct:fail(unexpected_message)
end.
messages_in_queue_1(Parent, ExpectedMsg) ->
@@ -296,13 +272,13 @@ messages_in_queue_1(Parent, ExpectedMsg) ->
[Parent,ExpectedMsg]).
messages_in_queue_restart(Parent, ExpectedMessage) ->
- ?line receive
- ExpectedMessage ->
- Parent ! done;
- Other ->
- io:format("~p\n", [Other]),
- ?t:fail(unexpected_message)
- end,
+ receive
+ ExpectedMessage ->
+ Parent ! done;
+ Other ->
+ io:format("~p\n", [Other]),
+ ct:fail(unexpected_message)
+ end,
ok.
@@ -312,36 +288,36 @@ messages_in_queue_restart(Parent, ExpectedMessage) ->
%%%
undefined_mfa(Config) when is_list(Config) ->
- ?line process_flag(trap_exit, true),
- ?line Pid = spawn_link(fun() ->
+ process_flag(trap_exit, true),
+ Pid = spawn_link(fun() ->
%% Will be a call_only instruction.
erlang:hibernate(?MODULE, blarf, []) end),
- ?line Pid ! {a,message},
- ?line receive
- {'EXIT',Pid,{undef,Undef}} ->
- io:format("~p\n", [Undef]),
- ok;
- Other ->
- ?line io:format("~p\n", [Other]),
- ?line ?t:fail(unexpected_message)
- end,
+ Pid ! {a,message},
+ receive
+ {'EXIT',Pid,{undef,Undef}} ->
+ io:format("~p\n", [Undef]),
+ ok;
+ Other ->
+ io:format("~p\n", [Other]),
+ ct:fail(unexpected_message)
+ end,
undefined_mfa_1().
undefined_mfa_1() ->
- ?line Pid = spawn_link(fun() ->
+ Pid = spawn_link(fun() ->
%% Force a call_last instruction by calling bar()
%% (if that is not obvious).
bar(),
erlang:hibernate(?MODULE, blarf, [])
end),
- ?line Pid ! {another,message},
- ?line receive
+ Pid ! {another,message},
+ receive
{'EXIT',Pid,{undef,Undef}} ->
io:format("~p\n", [Undef]),
ok;
Other ->
- ?line io:format("~p\n", [Other]),
- ?line ?t:fail(unexpected_message)
+ io:format("~p\n", [Other]),
+ ct:fail(unexpected_message)
end,
ok.
@@ -352,23 +328,17 @@ bar() ->
%% No heap
%%
-no_heap(doc) -> [];
-no_heap(suite) -> [];
no_heap(Config) when is_list(Config) ->
- ?line H = spawn_link(fun () -> clean_dict(), no_heap_loop() end),
- ?line lists:foreach(fun (_) ->
- wait_until(fun () -> is_hibernated(H) end),
- ?line [{heap_size,1},
- {total_heap_size,1}]
- = process_info(H,
- [heap_size,
- total_heap_size]),
- receive after 10 -> ok end,
- H ! again
- end,
- lists:seq(1, 100)),
- ?line unlink(H),
- ?line exit(H, bye).
+ H = spawn_link(fun () -> clean_dict(), no_heap_loop() end),
+ lists:foreach(fun (_) ->
+ wait_until(fun () -> is_hibernated(H) end),
+ [{heap_size,1}, {total_heap_size,1}]
+ = process_info(H, [heap_size, total_heap_size]),
+ receive after 10 -> ok end,
+ H ! again
+ end, lists:seq(1, 100)),
+ unlink(H),
+ exit(H, bye).
no_heap_loop() ->
flush(),
@@ -382,19 +352,17 @@ clean_dict() ->
%% Wake up and then immediatly bif trap with a lengthy computation.
%%
-wake_up_and_bif_trap(doc) -> [];
-wake_up_and_bif_trap(suite) -> [];
wake_up_and_bif_trap(Config) when is_list(Config) ->
- ?line Self = self(),
- ?line Pid = spawn_link(fun() -> erlang:hibernate(?MODULE, characters_to_list_trap, [Self]) end),
- ?line Pid ! wakeup,
- ?line receive
+ Self = self(),
+ Pid = spawn_link(fun() -> erlang:hibernate(?MODULE, characters_to_list_trap, [Self]) end),
+ Pid ! wakeup,
+ receive
{ok, Pid0} when Pid0 =:= Pid -> ok
after 5000 ->
- ?line ?t:fail(process_blocked)
+ ct:fail(process_blocked)
end,
- ?line unlink(Pid),
- ?line exit(Pid, bye).
+ unlink(Pid),
+ exit(Pid, bye).
%% Lengthy computation that traps (in characters_to_list_trap_3).
characters_to_list_trap(Parent) ->
diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl
index 13f34cd10f..7373303a39 100644
--- a/erts/emulator/test/ignore_cores.erl
+++ b/erts/emulator/test/ignore_cores.erl
@@ -28,7 +28,7 @@
-module(ignore_cores).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]).
@@ -53,7 +53,7 @@ init(Config) ->
fini(Config) ->
#ignore_cores{org_cwd = OrgCWD,
org_path = OrgPath,
- org_pwd_env = OrgPWD} = ?config(ignore_cores, Config),
+ org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config),
ok = file:set_cwd(OrgCWD),
true = code:set_path(OrgPath),
case OrgPWD of
@@ -70,10 +70,10 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite),
is_list(Config) ->
#ignore_cores{org_cwd = OrgCWD,
org_path = OrgPath,
- org_pwd_env = OrgPWD} = ?config(ignore_cores, Config),
+ org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config),
Path = lists:map(fun (".") -> OrgCWD; (Dir) -> Dir end, OrgPath),
true = code:set_path(Path),
- PrivDir = ?config(priv_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
IgnDir = filename:join([PrivDir,
atom_to_list(Suite)
++ "_"
@@ -94,7 +94,7 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite),
end,
ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>),
%% cores are dumped in /cores on MacOS X
- CoresDir = case {?t:os_type(), filelib:is_dir("/cores")} of
+ CoresDir = case {test_server:os_type(), filelib:is_dir("/cores")} of
{{unix,darwin}, true} ->
filelib:fold_files("/cores",
"^core.*$",
@@ -119,7 +119,7 @@ restore(Config) ->
org_path = OrgPath,
org_pwd_env = OrgPWD,
ign_dir = IgnDir,
- cores_dir = CoresDir} = ?config(ignore_cores, Config),
+ cores_dir = CoresDir} = proplists:get_value(ignore_cores, Config),
try
case CoresDir of
false ->
@@ -155,5 +155,5 @@ restore(Config) ->
dir(Config) ->
- #ignore_cores{ign_dir = Dir} = ?config(ignore_cores, Config),
+ #ignore_cores{ign_dir = Dir} = proplists:get_value(ignore_cores, Config),
Dir.
diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl
index 9e930822cf..1f64a6a8e5 100644
--- a/erts/emulator/test/list_bif_SUITE.erl
+++ b/erts/emulator/test/list_bif_SUITE.erl
@@ -19,149 +19,108 @@
%%
-module(list_bif_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2]).
+-export([all/0, suite/0]).
-export([hd_test/1,tl_test/1,t_length/1,t_list_to_pid/1,
t_list_to_float/1,t_list_to_integer/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
+
all() ->
[hd_test, tl_test, t_length, t_list_to_pid,
t_list_to_float, t_list_to_integer].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(_Case, Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(60)),
- [{watchdog,Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog = ?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-t_list_to_integer(suite) ->
- [];
-t_list_to_integer(doc) ->
- ["tests list_to_integer and string:to_integer"];
+%% Tests list_to_integer and string:to_integer
t_list_to_integer(Config) when is_list(Config) ->
- ?line {'EXIT',{badarg,_}} = (catch list_to_integer("12373281903728109372810937209817320981321ABC")),
- ?line 12373281903728109372810937209817320981321 = (catch list_to_integer("12373281903728109372810937209817320981321")),
- ?line 12373 = (catch list_to_integer("12373")),
- ?line -12373 = (catch list_to_integer("-12373")),
- ?line 12373 = (catch list_to_integer("+12373")),
- ?line {'EXIT',{badarg,_}} = ( catch list_to_integer(abc)),
- ?line {'EXIT',{badarg,_}} = (catch list_to_integer("")),
- ?line {12373281903728109372810937209817320981321,"ABC"} = string:to_integer("12373281903728109372810937209817320981321ABC"),
- ?line {-12373281903728109372810937209817320981321,"ABC"} = string:to_integer("-12373281903728109372810937209817320981321ABC"),
- ?line {12,[345]} = string:to_integer([$1,$2,345]),
- ?line {12,[a]} = string:to_integer([$1,$2,a]),
- ?line {error,no_integer} = string:to_integer([$A]),
- ?line {error,not_a_list} = string:to_integer($A),
+ {'EXIT',{badarg,_}} = (catch list_to_integer("12373281903728109372810937209817320981321ABC")),
+ 12373281903728109372810937209817320981321 = (catch list_to_integer("12373281903728109372810937209817320981321")),
+ 12373 = (catch list_to_integer("12373")),
+ -12373 = (catch list_to_integer("-12373")),
+ 12373 = (catch list_to_integer("+12373")),
+ {'EXIT',{badarg,_}} = ( catch list_to_integer(abc)),
+ {'EXIT',{badarg,_}} = (catch list_to_integer("")),
+ {12373281903728109372810937209817320981321,"ABC"} = string:to_integer("12373281903728109372810937209817320981321ABC"),
+ {-12373281903728109372810937209817320981321,"ABC"} = string:to_integer("-12373281903728109372810937209817320981321ABC"),
+ {12,[345]} = string:to_integer([$1,$2,345]),
+ {12,[a]} = string:to_integer([$1,$2,a]),
+ {error,no_integer} = string:to_integer([$A]),
+ {error,not_a_list} = string:to_integer($A),
ok.
%% Test hd/1 with correct and incorrect arguments.
hd_test(Config) when is_list(Config) ->
- ?line $h = hd(id("hejsan")),
- ?line case catch hd(id($h)) of
- {'EXIT', {badarg, _}} -> ok;
- Res ->
- Str=io_lib:format("hd/1 with incorrect args "++
- "succeeded.~nResult: ~p", [Res]),
- test_server:fail(Str)
- end,
+ $h = hd(id("hejsan")),
+ case catch hd(id($h)) of
+ {'EXIT', {badarg, _}} -> ok;
+ Res ->
+ ct:fail("hd/1 with incorrect args succeeded.~nResult: ~p", [Res])
+ end,
ok.
%% Test tl/1 with correct and incorrect arguments.
tl_test(Config) when is_list(Config) ->
- ?line "ejsan" = tl(id("hejsan")),
- ?line case catch tl(id(104)) of
- {'EXIT', {badarg, _}} ->
- ok;
- Res ->
- Str=io_lib:format("tl/1 with incorrect args "++
- "succeeded.~nResult: ~p", [Res]),
- test_server:fail(Str)
- end,
+ "ejsan" = tl(id("hejsan")),
+ case catch tl(id(104)) of
+ {'EXIT', {badarg, _}} ->
+ ok;
+ Res ->
+ ct:fail("tl/1 with incorrect args succeeded.~nResult: ~p", [Res])
+ end,
ok.
%% Test length/1 with correct and incorrect arguments.
t_length(Config) when is_list(Config) ->
- ?line 0 = length(""),
- ?line 0 = length([]),
- ?line 1 = length([1]),
- ?line 2 = length([1,a]),
- ?line 2 = length("ab"),
- ?line 3 = length("abc"),
- ?line 4 = length(id([x|"abc"])),
- ?line 6 = length("hejsan"),
- ?line {'EXIT',{badarg,_}} = (catch length(id([a,b|c]))),
- ?line case catch length({tuple}) of
- {'EXIT', {badarg, _}} ->
- ok;
- Res ->
- Str = io_lib:format("length/1 with incorrect args "++
- "succeeded.~nResult: ~p", [Res]),
- ?line test_server:fail(Str)
- end,
+ 0 = length(""),
+ 0 = length([]),
+ 1 = length([1]),
+ 2 = length([1,a]),
+ 2 = length("ab"),
+ 3 = length("abc"),
+ 4 = length(id([x|"abc"])),
+ 6 = length("hejsan"),
+ {'EXIT',{badarg,_}} = (catch length(id([a,b|c]))),
+ case catch length({tuple}) of
+ {'EXIT', {badarg, _}} ->
+ ok;
+ Res ->
+ ct:fail("length/1 with incorrect args succeeded.~nResult: ~p", [Res])
+ end,
ok.
%% Test list_to_pid/1 with correct and incorrect arguments.
t_list_to_pid(Config) when is_list(Config) ->
- ?line Me = self(),
- ?line MyListedPid = pid_to_list(Me),
- ?line Me = list_to_pid(MyListedPid),
- ?line case catch list_to_pid(id("Incorrect list")) of
- {'EXIT', {badarg, _}} ->
- ok;
- Res ->
- Str=io_lib:format("list_to_pid/1 with incorrect "++
- "arg succeeded.~nResult: ~p",
- [Res]),
- test_server:fail(Str)
- end,
+ Me = self(),
+ MyListedPid = pid_to_list(Me),
+ Me = list_to_pid(MyListedPid),
+ case catch list_to_pid(id("Incorrect list")) of
+ {'EXIT', {badarg, _}} ->
+ ok;
+ Res ->
+ ct:fail("list_to_pid/1 with incorrect arg succeeded.~nResult: ~p", [Res])
+ end,
ok.
%% Test list_to_float/1 with correct and incorrect arguments.
t_list_to_float(Config) when is_list(Config) ->
- ?line 5.89000 = list_to_float(id("5.89")),
- ?line 5.89898 = list_to_float(id("5.89898")),
- ?line case catch list_to_float(id("58")) of
- {'EXIT', {badarg, _}} -> ok;
- Res ->
- Str=io_lib:format("list_to_float with incorrect "++
- "arg succeeded.~nResult: ~p",
- [Res]),
- test_server:fail(Str)
- end,
+ 5.89000 = list_to_float(id("5.89")),
+ 5.89898 = list_to_float(id("5.89898")),
+ case catch list_to_float(id("58")) of
+ {'EXIT', {badarg, _}} -> ok;
+ Res ->
+ ct:fail("list_to_float with incorrect arg succeeded.~nResult: ~p", [Res])
+ end,
ok.
id(I) -> I.
-
-
diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index 886ae7d516..956b82335c 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -17,72 +17,70 @@
%% %CopyrightEnd%
%%
-module(map_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2
- ]).
-
--export([
- t_build_and_match_literals/1, t_build_and_match_literals_large/1,
- t_update_literals/1, t_update_literals_large/1,
- t_match_and_update_literals/1, t_match_and_update_literals_large/1,
- t_update_map_expressions/1,
- t_update_assoc/1, t_update_assoc_large/1,
- t_update_exact/1, t_update_exact_large/1,
- t_guard_bifs/1,
- t_guard_sequence/1, t_guard_sequence_large/1,
- t_guard_update/1, t_guard_update_large/1,
- t_guard_receive/1, t_guard_receive_large/1,
- t_guard_fun/1,
- t_update_deep/1,
- t_list_comprehension/1,
- t_map_sort_literals/1,
- t_map_equal/1,
- t_map_compare/1,
- t_map_size/1,
- t_is_map/1,
-
- %% Specific Map BIFs
- t_bif_map_get/1,
- t_bif_map_find/1,
- t_bif_map_is_key/1,
- t_bif_map_keys/1,
- t_bif_map_merge/1,
- t_bif_map_new/1,
- t_bif_map_put/1,
- t_bif_map_remove/1,
- t_bif_map_update/1,
- t_bif_map_values/1,
- t_bif_map_to_list/1,
- t_bif_map_from_list/1,
-
- %% erlang
- t_erlang_hash/1,
- t_map_encode_decode/1,
-
- %% non specific BIF related
- t_bif_build_and_check/1,
- t_bif_merge_and_check/1,
-
- %% maps module not bifs
- t_maps_fold/1,
- t_maps_map/1,
- t_maps_size/1,
- t_maps_without/1,
-
- %% misc
- t_hashmap_balance/1,
- t_erts_internal_order/1,
- t_erts_internal_hash/1,
- t_pdict/1,
- t_ets/1,
- t_dets/1,
- t_tracing/1,
-
- %% instruction-level tests
- t_has_map_fields/1,
- y_regs/1,
- badmap_17/1
- ]).
+-export([all/0, suite/0]).
+-compile({nowarn_deprecated_function, {erlang,hash,2}}).
+
+-export([t_build_and_match_literals/1, t_build_and_match_literals_large/1,
+ t_update_literals/1, t_update_literals_large/1,
+ t_match_and_update_literals/1, t_match_and_update_literals_large/1,
+ t_update_map_expressions/1,
+ t_update_assoc/1, t_update_assoc_large/1,
+ t_update_exact/1, t_update_exact_large/1,
+ t_guard_bifs/1,
+ t_guard_sequence/1, t_guard_sequence_large/1,
+ t_guard_update/1, t_guard_update_large/1,
+ t_guard_receive/1, t_guard_receive_large/1,
+ t_guard_fun/1,
+ t_update_deep/1,
+ t_list_comprehension/1,
+ t_map_sort_literals/1,
+ t_map_equal/1,
+ t_map_compare/1,
+ t_map_size/1,
+ t_is_map/1,
+
+ %% Specific Map BIFs
+ t_bif_map_get/1,
+ t_bif_map_find/1,
+ t_bif_map_is_key/1,
+ t_bif_map_keys/1,
+ t_bif_map_merge/1,
+ t_bif_map_new/1,
+ t_bif_map_put/1,
+ t_bif_map_remove/1,
+ t_bif_map_update/1,
+ t_bif_map_values/1,
+ t_bif_map_to_list/1,
+ t_bif_map_from_list/1,
+
+ %% erlang
+ t_erlang_hash/1,
+ t_map_encode_decode/1,
+ t_gc_rare_map_overflow/1,
+
+ %% non specific BIF related
+ t_bif_build_and_check/1,
+ t_bif_merge_and_check/1,
+
+ %% maps module not bifs
+ t_maps_fold/1,
+ t_maps_map/1,
+ t_maps_size/1,
+ t_maps_without/1,
+
+ %% misc
+ t_hashmap_balance/1,
+ t_erts_internal_order/1,
+ t_erts_internal_hash/1,
+ t_pdict/1,
+ t_ets/1,
+ t_dets/1,
+ t_tracing/1,
+
+ %% instruction-level tests
+ t_has_map_fields/1,
+ y_regs/1,
+ badmap_17/1]).
-include_lib("stdlib/include/ms_transform.hrl").
@@ -95,64 +93,55 @@
suite() -> [].
-all() -> [
- t_build_and_match_literals, t_build_and_match_literals_large,
- t_update_literals, t_update_literals_large,
- t_match_and_update_literals, t_match_and_update_literals_large,
- t_update_map_expressions,
- t_update_assoc, t_update_assoc_large,
- t_update_exact, t_update_exact_large,
- t_guard_bifs,
- t_guard_sequence, t_guard_sequence_large,
- t_guard_update, t_guard_update_large,
- t_guard_receive, t_guard_receive_large,
- t_guard_fun, t_list_comprehension,
- t_update_deep,
- t_map_equal, t_map_compare,
- t_map_sort_literals,
-
- %% Specific Map BIFs
- t_bif_map_get,t_bif_map_find,t_bif_map_is_key,
- t_bif_map_keys, t_bif_map_merge, t_bif_map_new,
- t_bif_map_put,
- t_bif_map_remove, t_bif_map_update,
- t_bif_map_values,
- t_bif_map_to_list, t_bif_map_from_list,
-
- %% erlang
- t_erlang_hash, t_map_encode_decode,
- t_map_size, t_is_map,
-
- %% non specific BIF related
- t_bif_build_and_check,
- t_bif_merge_and_check,
-
- %% maps module
- t_maps_fold, t_maps_map,
- t_maps_size, t_maps_without,
-
-
- %% Other functions
- t_hashmap_balance,
- t_erts_internal_order,
- t_erts_internal_hash,
- t_pdict,
- t_ets,
- t_tracing,
-
- %% instruction-level tests
- t_has_map_fields,
- y_regs,
- badmap_17
- ].
-
-groups() -> [].
-
-init_per_suite(Config) -> Config.
-end_per_suite(_Config) -> ok.
-
-init_per_group(_GroupName, Config) -> Config.
-end_per_group(_GroupName, Config) -> Config.
+all() -> [t_build_and_match_literals, t_build_and_match_literals_large,
+ t_update_literals, t_update_literals_large,
+ t_match_and_update_literals, t_match_and_update_literals_large,
+ t_update_map_expressions,
+ t_update_assoc, t_update_assoc_large,
+ t_update_exact, t_update_exact_large,
+ t_guard_bifs,
+ t_guard_sequence, t_guard_sequence_large,
+ t_guard_update, t_guard_update_large,
+ t_guard_receive, t_guard_receive_large,
+ t_guard_fun, t_list_comprehension,
+ t_update_deep,
+ t_map_equal, t_map_compare,
+ t_map_sort_literals,
+
+ %% Specific Map BIFs
+ t_bif_map_get,t_bif_map_find,t_bif_map_is_key,
+ t_bif_map_keys, t_bif_map_merge, t_bif_map_new,
+ t_bif_map_put,
+ t_bif_map_remove, t_bif_map_update,
+ t_bif_map_values,
+ t_bif_map_to_list, t_bif_map_from_list,
+
+ %% erlang
+ t_erlang_hash, t_map_encode_decode,
+ t_gc_rare_map_overflow,
+ t_map_size, t_is_map,
+
+ %% non specific BIF related
+ t_bif_build_and_check,
+ t_bif_merge_and_check,
+
+ %% maps module
+ t_maps_fold, t_maps_map,
+ t_maps_size, t_maps_without,
+
+
+ %% Other functions
+ t_hashmap_balance,
+ t_erts_internal_order,
+ t_erts_internal_hash,
+ t_pdict,
+ t_ets,
+ t_tracing,
+
+ %% instruction-level tests
+ t_has_map_fields,
+ y_regs,
+ badmap_17].
%% tests
@@ -1509,11 +1498,8 @@ t_map_equal(Config) when is_list(Config) ->
t_map_compare(Config) when is_list(Config) ->
- Seed = {erlang:monotonic_time(),
- erlang:time_offset(),
- erlang:unique_integer()},
- io:format("seed = ~p\n", [Seed]),
- random:seed(Seed),
+ rand:seed(exsplus),
+ io:format("seed = ~p\n", [rand:export_seed()]),
repeat(100, fun(_) -> float_int_compare() end, []),
repeat(100, fun(_) -> recursive_compare() end, []),
ok.
@@ -1531,7 +1517,7 @@ float_int_compare() ->
numeric_keys(N) ->
lists:foldl(fun(_,Acc) ->
- Int = random:uniform(N*4) - N*2,
+ Int = rand:uniform(N*4) - N*2,
Float = float(Int),
[Int, Float, Float * 0.99, Float * 1.01 | Acc]
end,
@@ -1562,7 +1548,7 @@ do_compare([Gen1, Gen2]) ->
%% Change one key from int to float (or vice versa) and check compare
ML1 = maps:to_list(M1),
- {K1,V1} = lists:nth(random:uniform(length(ML1)), ML1),
+ {K1,V1} = lists:nth(rand:uniform(length(ML1)), ML1),
case K1 of
I when is_integer(I) ->
case maps:find(float(I),M1) of
@@ -1653,9 +1639,9 @@ cmp_others(T1, T2, _) ->
map_gen(Pairs, Size) ->
{_,L} = lists:foldl(fun(_, {Keys, Acc}) ->
- KI = random:uniform(size(Keys)),
+ KI = rand:uniform(size(Keys)),
K = element(KI,Keys),
- KV = element(random:uniform(size(K)), K),
+ KV = element(rand:uniform(size(K)), K),
{erlang:delete_element(KI,Keys), [KV | Acc]}
end,
{Pairs, []},
@@ -1695,20 +1681,19 @@ term_gen_recursive(Leafs, Flags, Depth) ->
MaxDepth = 10,
Rnd = case {Flags, Depth} of
{_, MaxDepth} -> % Only leafs
- random:uniform(size(Leafs)) + 3;
+ rand:uniform(size(Leafs)) + 3;
{0, 0} -> % Only containers
- random:uniform(3);
+ rand:uniform(3);
{0,_} -> % Anything
- random:uniform(size(Leafs)+3)
+ rand:uniform(size(Leafs)+3)
end,
case Rnd of
1 -> % Make map
- Size = random:uniform(size(Leafs)),
+ Size = rand:uniform(size(Leafs)),
lists:foldl(fun(_, {Acc1,Acc2}) ->
{K1,K2} = term_gen_recursive(Leafs, Flags,
Depth+1),
{V1,V2} = term_gen_recursive(Leafs, Flags, Depth+1),
- %%ok = check_keys(K1,K2, 0),
{maps:put(K1,V1, Acc1), maps:put(K2,V2, Acc2)}
end,
{maps:new(), maps:new()},
@@ -1718,7 +1703,7 @@ term_gen_recursive(Leafs, Flags, Depth) ->
{Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1),
{[Car1 | Cdr1], [Car2 | Cdr2]};
3 -> % Make tuple
- Size = random:uniform(size(Leafs)),
+ Size = rand:uniform(size(Leafs)),
L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end,
lists:seq(1,Size)),
{L1, L2} = lists:unzip(L),
@@ -1727,7 +1712,7 @@ term_gen_recursive(Leafs, Flags, Depth) ->
N -> % Make leaf
case element(N-3, Leafs) of
I when is_integer(I) ->
- case random:uniform(4) of
+ case rand:uniform(4) of
1 -> {I, float(I)};
2 -> {float(I), I};
_ -> {I,I}
@@ -1736,26 +1721,6 @@ term_gen_recursive(Leafs, Flags, Depth) ->
end
end.
-check_keys(K1, K2, _) when K1 =:= K2 ->
- case erlang:phash3(K1) =:= erlang:phash3(K2) of
- true -> ok;
- false ->
- io:format("Same keys with different hash values !!!\nK1 = ~p\nK2 = ~p\n", [K1,K2]),
- error
- end;
-check_keys(K1, K2, 0) ->
- case {erlang:phash3(K1), erlang:phash3(K2)} of
- {H,H} -> check_keys(K1, K2, 1);
- {_,_} -> ok
- end;
-check_keys(K1, K2, L) when L < 10 ->
- case {erlang:phash3([L|K1]), erlang:phash3([L|K2])} of
- {H,H} -> check_keys(K1, K2, L+1);
- {_,_} -> ok
- end;
-check_keys(K1, K2, L) ->
- io:format("Same hash value at level ~p !!!\nK1 = ~p\nK2 = ~p\n", [L,K1,K2]),
- error.
%% BIFs
t_bif_map_get(Config) when is_list(Config) ->
@@ -2181,7 +2146,9 @@ t_map_encode_decode(Config) when is_list(Config) ->
{<<>>, sc9}, {3.14158, sc10},
{[3.14158], sc11}, {more_atoms, sc12},
{{more_tuples}, sc13}, {self(), sc14},
- {{},{}},{[],[]}
+ {{},{}},{[],[]},
+ {map_s, #{a=>a, 2=>b, 3=>c}},
+ {map_l, maps:from_list([{I,I}||I <- lists:seq(1,74)])}
],
ok = map_encode_decode_and_match(Pairs,[],#{}),
@@ -2245,9 +2212,30 @@ t_map_encode_decode(Config) when is_list(Config) ->
%% bad size (too small) .. should fail just truncate it .. weird.
%% possibly change external format so truncated will be #{a:=1}
- #{ a:=b } =
- erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>),
-
+ #{ a:=b } = erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>),
+
+ %% specific fannerl (opensource app) binary_to_term error in 18.1
+
+ #{bias := {1,1,0},
+ bit_fail := 0,
+ connections := #{{2,9} := _,
+ {8,14} := _,
+ {2,12} := _,
+ {5,7} := _,
+ {11,16} := _,
+ {11,15} := _},
+ layers := {5,7,3},
+ network_type := fann_nettype_layer,
+ num_input := 5,
+ num_layers := 3,
+ num_output := 3,
+ rprop_delta_max := _,
+ rprop_delta_min := _,
+ total_connections := 66,
+ total_neurons := 17,
+ train_error_function := fann_errorfunc_tanh,
+ train_stop_function := fann_stopfunc_mse,
+ training_algorithm := fann_train_rprop} = erlang:binary_to_term(fannerl()),
ok.
map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) ->
@@ -2573,7 +2561,7 @@ hashmap_balance(KeyFun) ->
F = fun(I, {M0,Max0}) ->
Key = KeyFun(I),
M1 = M0#{Key => Key},
- Max1 = case erts_internal:map_type(M1) of
+ Max1 = case erts_internal:term_type(M1) of
hashmap ->
Nodes = hashmap_nodes(M1),
Avg = maps:size(M1) * 0.4,
@@ -2966,3 +2954,189 @@ do_badmap_17(Config) ->
%% Use this function to avoid compile-time evaluation of an expression.
id(I) -> I.
+
+
+%% OTP-13146
+%% Provoke major GC with a lot of "fat" maps on external format in msg queue
+%% causing heap fragments to be allocated.
+t_gc_rare_map_overflow(Config) when is_list(Config) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ {ok, Node} = test_server:start_node(gc_rare_map_overflow, slave, [{args, "-pa \""++Pa++"\""}]),
+ erts_debug:set_internal_state(available_internal_state, true),
+ try
+ Echo = spawn_link(Node, fun Loop() -> receive {From,Msg} -> From ! Msg
+ end,
+ Loop()
+ end),
+ FatMap = fatmap(34),
+ false = (flatmap =:= erts_internal:term_type(FatMap)),
+
+ t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> erlang:garbage_collect() end),
+
+ %% Repeat test for minor gc:
+ t_gc_rare_map_overflow_do(Echo, FatMap, fun() -> minor_collect() end),
+
+ unlink(Echo),
+
+ %% Test fatmap in exit signal
+ Exiter = spawn_link(Node, fun Loop() -> receive {_From,Msg} ->
+ "not_a_map" = Msg % badmatch!
+ end,
+ Loop()
+ end),
+ process_flag(trap_exit, true),
+ Exiter ! {self(), FatMap},
+ {'EXIT', Exiter, {{badmatch,FatMap}, _}} = receive M -> M end,
+ ok
+
+ after
+ process_flag(trap_exit, false),
+ erts_debug:set_internal_state(available_internal_state, false),
+ test_server:stop_node(Node)
+ end.
+
+t_gc_rare_map_overflow_do(Echo, FatMap, GcFun) ->
+ Master = self(),
+ true = receive _M -> false after 0 -> true end, % assert empty msg queue
+ Echo ! {Master, token},
+ repeat(1000, fun(_) -> Echo ! {Master, FatMap} end, void),
+
+ timer:sleep(100), % Wait for maps to arrive in our msg queue
+ token = receive Tok -> Tok end, % and provoke move from outer to inner msg queue
+
+ %% Do GC that will "overflow" and create heap frags due to all the fat maps
+ GcFun(),
+
+ %% Now check that all maps in msg queueu are intact
+ %% Will crash emulator in OTP-18.1
+ repeat(1000, fun(_) -> FatMap = receive FM -> FM end end, void),
+ ok.
+
+minor_collect() ->
+ Before = minor_gcs(),
+ erts_debug:set_internal_state(force_gc, self()),
+ erlang:yield(),
+ After = minor_gcs(),
+ io:format("minor_gcs: ~p -> ~p\n", [Before, After]).
+
+minor_gcs() ->
+ {garbage_collection, Info} = process_info(self(), garbage_collection),
+ {minor_gcs, GCS} = lists:keyfind(minor_gcs, 1, Info),
+ GCS.
+
+%% Generate a map with N (or N+1) keys that has an abnormal heap demand.
+%% Done by finding keys that collide in the first 32-bit hash.
+fatmap(N) ->
+ %%erts_debug:set_internal_state(available_internal_state, true),
+ Table = ets:new(void, [bag, private]),
+
+ Seed0 = rand:seed_s(exsplus, {4711, 3141592, 2718281}),
+ Seed1 = fatmap_populate(Table, Seed0, (1 bsl 16)),
+ Keys = fatmap_generate(Table, Seed1, N, []),
+ ets:delete(Table),
+ maps:from_list([{K,K} || K <- Keys]).
+
+fatmap_populate(_, Seed, 0) -> Seed;
+fatmap_populate(Table, Seed, N) ->
+ {I, NextSeed} = rand:uniform_s(1 bsl 48, Seed),
+ Hash = internal_hash(I),
+ ets:insert(Table, [{Hash, I}]),
+ fatmap_populate(Table, NextSeed, N-1).
+
+
+fatmap_generate(_, _, N, Acc) when N =< 0 ->
+ Acc;
+fatmap_generate(Table, Seed, N0, Acc0) ->
+ {I, NextSeed} = rand:uniform_s(1 bsl 48, Seed),
+ Hash = internal_hash(I),
+ case ets:member(Table, Hash) of
+ true ->
+ NewKeys = [I | ets:lookup_element(Table, Hash, 2)],
+ Acc1 = lists:usort(Acc0 ++ NewKeys),
+ N1 = N0 - (length(Acc1) - length(Acc0)),
+ fatmap_generate(Table, NextSeed, N1, Acc1);
+ false ->
+ fatmap_generate(Table, NextSeed, N0, Acc0)
+ end.
+
+internal_hash(Term) ->
+ erts_debug:get_internal_state({internal_hash, Term}).
+
+
+%% map external_format (fannerl).
+fannerl() ->
+ <<131,116,0,0,0,28,100,0,13,108,101,97,114,110,105,110,103,95,114,
+ 97,116,101,70,63,230,102,102,96,0,0,0,100,0,17,108,101,97,114,110,105,110,
+ 103,95,109,111,109,101,110,116,117,109,70,0,0,0,0,0,0,0,0,100,0,
+ 18,116,114,97,105,110,105,110,103,95,97,108,103,111,114,105,116,104,109,100,0,
+ 16,102,97,110,110,95,116,114,97,105,110,95,114,112,114,111,112,
+ 100,0,17,109,101,97,110,95,115,113,117,97,114,101,95,101,114,114,111,114,70,
+ 0,0,0,0,0,0,0,0,100,0,8,98,105,116,95,102,97,105,108,97,0,100,0,20,
+ 116,114,97,105,110,95,101,114,114,111,114,95,102,117,110,99,116,105,111,
+ 110,100,0,19,102,97,110,110,95,101,114,114,111,114,102,117,110,99,
+ 95,116,97,110,104,100,0,9,110,117,109,95,105,110,112,117,116,97,5,100,0,10,110,
+ 117,109,95,111,117,116,112,117,116,97,3,100,0,13,116,111,116,97,108,
+ 95,110,101,117,114,111,110,115,97,17,100,0,17,116,111,116,97,108,95,99,111,110,
+ 110,101,99,116,105,111,110,115,97,66,100,0,12,110,101,116,119,111,114,107,
+ 95,116,121,112,101,100,0,18,102,97,110,110,95,110,101,116,116,121,112,101,
+ 95,108,97,121,101,114,100,0,15,99,111,110,110,101,99,116,105,111,110,95,
+ 114,97,116,101,70,63,240,0,0,0,0,0,0,100,0,10,110,117,109,95,108,97,121,101,
+ 114,115,97,3,100,0,19,116,114,97,105,110,95,115,116,111,112,95,102,117,110,
+ 99,116,105,111,110,100,0,17,102,97,110,110,95,115,116,111,112,102,117,110,
+ 99,95,109,115,101,100,0,15,113,117,105,99,107,112,114,111,112,95,100,101,99,
+ 97,121,70,191,26,54,226,224,0,0,0,100,0,12,113,117,105,99,107,112,114,
+ 111,112,95,109,117,70,63,252,0,0,0,0,0,0,100,0,21,114,112,114,111,112,95,105,
+ 110,99,114,101,97,115,101,95,102,97,99,116,111,114,70,63,243,51,51,
+ 64,0,0,0,100,0,21,114,112,114,111,112,95,100,101,99,114,101,97,115,101,
+ 95,102,97,99,116,111,114,70,63,224,0,0,0,0,0,0,100,0,15,114,112,114,111,112,
+ 95,100,101,108,116,97,95,109,105,110,70,0,0,0,0,0,0,0,0,100,0,15,114,112,114,
+ 111,112,95,100,101,108,116,97,95,109,97,120,70,64,73,0,0,0,0,0,0,100,0,
+ 16,114,112,114,111,112,95,100,101,108,116,97,95,122,101,114,111,70,63,185,153,
+ 153,160,0,0,0,100,0,26,115,97,114,112,114,111,112,95,119,101,105,103,
+ 104,116,95,100,101,99,97,121,95,115,104,105,102,116,70,192,26,147,116,192,0,0,0,
+ 100,0,35,115,97,114,112,114,111,112,95,115,116,101,112,95,101,114,
+ 114,111,114,95,116,104,114,101,115,104,111,108,100,95,102,97,99,116,111,114,70,
+ 63,185,153,153,160,0,0,0,100,0,24,115,97,114,112,114,111,112,95,115,
+ 116,101,112,95,101,114,114,111,114,95,115,104,105,102,116,70,63,246,40,245,
+ 192,0,0,0,100,0,19,115,97,114,112,114,111,112,95,116,101,109,112,101,114,
+ 97,116,117,114,101,70,63,142,184,81,224,0,0,0,100,0,6,108,97,121,101,114,115,
+ 104,3,97,5,97,7,97,3,100,0,4,98,105,97,115,104,3,97,1,97,1,97,0,100,0,11,
+ 99,111,110,110,101,99,116,105,111,110,115,116,0,0,0,66,104,2,97,0,97,6,70,
+ 191,179,51,44,64,0,0,0,104,2,97,1,97,6,70,63,178,130,90,32,0,0,0,104,2,97,2,
+ 97,6,70,63,82,90,88,0,0,0,0,104,2,97,3,97,6,70,63,162,91,63,192,0,0,0,104,2,
+ 97,4,97,6,70,191,151,70,169,0,0,0,0,104,2,97,5,97,6,70,191,117,52,222,0,0,0,
+ 0,104,2,97,0,97,7,70,63,152,240,139,0,0,0,0,104,2,97,1,97,7,70,191,166,31,
+ 187,160,0,0,0,104,2,97,2,97,7,70,191,150,70,63,0,0,0,0,104,2,97,3,97,7,70,
+ 63,152,181,126,128,0,0,0,104,2,97,4,97,7,70,63,151,187,162,128,0,0,0,104,2,
+ 97,5,97,7,70,191,143,161,101,0,0,0,0,104,2,97,0,97,8,70,191,153,102,36,128,0,
+ 0,0,104,2,97,1,97,8,70,63,160,139,250,64,0,0,0,104,2,97,2,97,8,70,63,164,62,
+ 196,64,0,0,0,104,2,97,3,97,8,70,191,178,78,209,192,0,0,0,104,2,97,4,97,8,70,
+ 191,185,19,76,224,0,0,0,104,2,97,5,97,8,70,63,183,142,196,96,0,0,0,104,2,97,0,
+ 97,9,70,63,150,104,248,0,0,0,0,104,2,97,1,97,9,70,191,164,4,100,224,0,0,0,
+ 104,2,97,2,97,9,70,191,169,42,42,224,0,0,0,104,2,97,3,97,9,70,63,145,54,78,128,0,
+ 0,0,104,2,97,4,97,9,70,63,126,243,134,0,0,0,0,104,2,97,5,97,9,70,63,177,
+ 203,25,96,0,0,0,104,2,97,0,97,10,70,63,172,104,47,64,0,0,0,104,2,97,1,97,10,
+ 70,63,161,242,193,64,0,0,0,104,2,97,2,97,10,70,63,175,208,241,192,0,0,0,104,2,
+ 97,3,97,10,70,191,129,202,161,0,0,0,0,104,2,97,4,97,10,70,63,178,151,55,32,0,0,0,
+ 104,2,97,5,97,10,70,63,137,155,94,0,0,0,0,104,2,97,0,97,11,70,191,179,
+ 106,160,0,0,0,0,104,2,97,1,97,11,70,63,184,253,164,96,0,0,0,104,2,97,2,97,11,
+ 70,191,143,30,157,0,0,0,0,104,2,97,3,97,11,70,63,153,225,140,128,0,0,0,104,
+ 2,97,4,97,11,70,63,161,35,85,192,0,0,0,104,2,97,5,97,11,70,63,175,200,55,192,
+ 0,0,0,104,2,97,0,97,12,70,191,180,116,132,96,0,0,0,104,2,97,1,97,12,70,191,
+ 165,151,152,0,0,0,0,104,2,97,2,97,12,70,191,180,197,91,160,0,0,0,104,2,97,3,97,12,
+ 70,191,91,30,160,0,0,0,0,104,2,97,4,97,12,70,63,180,251,45,32,0,0,0,
+ 104,2,97,5,97,12,70,63,165,134,77,64,0,0,0,104,2,97,6,97,14,70,63,181,56,242,96,
+ 0,0,0,104,2,97,7,97,14,70,191,165,239,234,224,0,0,0,104,2,97,8,97,14,
+ 70,191,154,65,216,128,0,0,0,104,2,97,9,97,14,70,63,150,250,236,0,0,0,0,104,2,97,
+ 10,97,14,70,191,141,105,108,0,0,0,0,104,2,97,11,97,14,70,191,152,40,
+ 165,0,0,0,0,104,2,97,12,97,14,70,63,141,159,46,0,0,0,0,104,2,97,13,97,14,70,
+ 191,183,172,137,32,0,0,0,104,2,97,6,97,15,70,63,163,26,123,192,0,0,0,104,
+ 2,97,7,97,15,70,63,176,184,106,32,0,0,0,104,2,97,8,97,15,70,63,152,234,144,
+ 0,0,0,0,104,2,97,9,97,15,70,191,172,58,70,160,0,0,0,104,2,97,10,97,15,70,
+ 63,161,211,211,192,0,0,0,104,2,97,11,97,15,70,191,148,171,120,128,0,0,0,104,
+ 2,97,12,97,15,70,63,180,117,214,224,0,0,0,104,2,97,13,97,15,70,191,104,
+ 230,216,0,0,0,0,104,2,97,6,97,16,70,63,178,53,103,96,0,0,0,104,2,97,7,97,16,
+ 70,63,170,230,232,64,0,0,0,104,2,97,8,97,16,70,191,183,45,100,192,0,0,0,
+ 104,2,97,9,97,16,70,63,184,100,97,32,0,0,0,104,2,97,10,97,16,70,63,169,174,
+ 254,64,0,0,0,104,2,97,11,97,16,70,191,119,121,234,0,0,0,0,104,2,97,12,97,
+ 16,70,63,149,12,170,128,0,0,0,104,2,97,13,97,16,70,191,144,193,191,0,0,0,0>>.
diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl
index 3f986ca2ed..baa6eb8fe0 100644
--- a/erts/emulator/test/match_spec_SUITE.erl
+++ b/erts/emulator/test/match_spec_SUITE.erl
@@ -20,8 +20,7 @@
-module(match_spec_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, not_run/1]).
+-export([all/0, suite/0, not_run/1]).
-export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1,
trace_control_word/1, silent/1, silent_no_ms/1, silent_test/1,
ms_trace2/1, ms_trace3/1, boxed_and_small/1,
@@ -39,20 +38,11 @@
% This test suite assumes that tracing in general works. What we test is
% the match spec functionality.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([init_per_testcase/2, end_per_testcase/2]).
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:seconds(30)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 30}}].
all() ->
case test_server:is_native(match_spec_SUITE) of
@@ -69,106 +59,87 @@ all() ->
true -> [not_run]
end.
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
not_run(Config) when is_list(Config) ->
{skipped, "Native Code"}.
-test_1(doc) ->
- [""];
-test_1(suite) -> [];
test_1(Config) when is_list(Config) ->
- ?line tr(fun() -> ?MODULE:f1(a) end,
- {?MODULE, f1, 1},
- [],
- [{call, {?MODULE, f1, [a]}}]),
-
- ?line tr(fun() -> ?MODULE:f2(a, a) end,
- {?MODULE, f2, 2},
- [{['$1','$1'],[{is_atom, '$1'}],[]}],
- [{call, {?MODULE, f2, [a, a]}}]),
-
- ?line tr(fun() -> ?MODULE:f2(a, a) end,
- {?MODULE, f2, 2},
- [{['$1','$1'],[{is_atom, '$1'}],[{message, false}]}],
- []),
-
- ?line tr(fun() -> ?MODULE:f2(a, a) end,
- {?MODULE, f2, 2},
- [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}]}],
- [{call, {?MODULE, f2, [a, a]}, 4711}]),
+ tr(fun() -> ?MODULE:f1(a) end,
+ {?MODULE, f1, 1},
+ [],
+ [{call, {?MODULE, f1, [a]}}]),
+
+ tr(fun() -> ?MODULE:f2(a, a) end,
+ {?MODULE, f2, 2},
+ [{['$1','$1'],[{is_atom, '$1'}],[]}],
+ [{call, {?MODULE, f2, [a, a]}}]),
+
+ tr(fun() -> ?MODULE:f2(a, a) end,
+ {?MODULE, f2, 2},
+ [{['$1','$1'],[{is_atom, '$1'}],[{message, false}]}],
+ []),
+
+ tr(fun() -> ?MODULE:f2(a, a) end,
+ {?MODULE, f2, 2},
+ [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}]}],
+ [{call, {?MODULE, f2, [a, a]}, 4711}]),
Ref = make_ref(),
- ?line tr(fun() -> ?MODULE:f2(Ref, Ref) end,
- {?MODULE, f2, 2},
- [{[Ref,'$1'],[{is_reference, '$1'}],[{message, 4711}]}],
- [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]),
- ?line tr(fun() -> ?MODULE:f2(Ref, Ref) end,
- {?MODULE, f2, 2},
- [{['$1',Ref],[{is_reference, '$1'}],[{message, 4711}]}],
- [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]),
-
- ?line tr(fun() -> ?MODULE:f2(a, a) end,
- {?MODULE, f2, 2},
- [{['$0','$0'],[{is_atom, '$0'}],[{message, 4711}]}],
- [{call, {?MODULE, f2, [a, a]}, 4711}]),
-
- ?line tr(fun() -> ?MODULE:f2(a, b) end,
- {?MODULE, f2, 2},
- [{['_','_'],[],[]}],
- [{call, {?MODULE, f2, [a, b]}}]),
-
- ?line tr(fun() -> ?MODULE:f2(a, b) end,
- {?MODULE, f2, 2},
- [{['_','_'],[],[{message, '$_'}]}],
- [{call, {?MODULE, f2, [a, b]}, [a, b]}]),
-
- ?line tr(fun() -> ?MODULE:f2(a, '$_') end,
- {?MODULE, f2, 2},
- [{['$1','$_'],[{is_atom, '$1'}],[]}],
- [{call, {?MODULE, f2, [a, '$_']}}]),
-
- ?line tr(fun() -> ?MODULE:f1({a}) end,
- {?MODULE, f1, 1},
- [{['$1'],[{'==', '$1', {const, {a}}}],[]}],
- [{call, {?MODULE, f1, [{a}]}}]),
-
- ?line tr(fun() -> ?MODULE:f1({a}) end,
- {?MODULE, f1, 1},
- [{['$1'],[{'==', '$1', {{a}}}],[]}],
- [{call, {?MODULE, f1, [{a}]}}]),
-
-%% Undocumented, currently.
- ?line tr(fun() -> ?MODULE:f2(a, a) end,
- {?MODULE, f2, 2},
- [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711},
- {message, true}]}],
- [{call, {?MODULE, f2, [a, a]}}]),
-
- ?line tr(fun() -> ?MODULE:f2(a, a) end,
- {?MODULE, f2, 2},
- [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711},
- {message, false}]}],
- []),
-
- ?line tr(fun() -> ?MODULE:f2(a, a) end,
- {?MODULE, f2, 2},
- [{['$1','$1'],[{is_atom, '$1'}],[kakalorum]}],
- [{call, {?MODULE, f2, [a, a]}}]),
+ tr(fun() -> ?MODULE:f2(Ref, Ref) end,
+ {?MODULE, f2, 2},
+ [{[Ref,'$1'],[{is_reference, '$1'}],[{message, 4711}]}],
+ [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]),
+ tr(fun() -> ?MODULE:f2(Ref, Ref) end,
+ {?MODULE, f2, 2},
+ [{['$1',Ref],[{is_reference, '$1'}],[{message, 4711}]}],
+ [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]),
+
+ tr(fun() -> ?MODULE:f2(a, a) end,
+ {?MODULE, f2, 2},
+ [{['$0','$0'],[{is_atom, '$0'}],[{message, 4711}]}],
+ [{call, {?MODULE, f2, [a, a]}, 4711}]),
+
+ tr(fun() -> ?MODULE:f2(a, b) end,
+ {?MODULE, f2, 2},
+ [{['_','_'],[],[]}],
+ [{call, {?MODULE, f2, [a, b]}}]),
+
+ tr(fun() -> ?MODULE:f2(a, b) end,
+ {?MODULE, f2, 2},
+ [{['_','_'],[],[{message, '$_'}]}],
+ [{call, {?MODULE, f2, [a, b]}, [a, b]}]),
+
+ tr(fun() -> ?MODULE:f2(a, '$_') end,
+ {?MODULE, f2, 2},
+ [{['$1','$_'],[{is_atom, '$1'}],[]}],
+ [{call, {?MODULE, f2, [a, '$_']}}]),
+
+ tr(fun() -> ?MODULE:f1({a}) end,
+ {?MODULE, f1, 1},
+ [{['$1'],[{'==', '$1', {const, {a}}}],[]}],
+ [{call, {?MODULE, f1, [{a}]}}]),
+
+ tr(fun() -> ?MODULE:f1({a}) end,
+ {?MODULE, f1, 1},
+ [{['$1'],[{'==', '$1', {{a}}}],[]}],
+ [{call, {?MODULE, f1, [{a}]}}]),
+
+ %% Undocumented, currently.
+ tr(fun() -> ?MODULE:f2(a, a) end,
+ {?MODULE, f2, 2},
+ [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711},
+ {message, true}]}],
+ [{call, {?MODULE, f2, [a, a]}}]),
+
+ tr(fun() -> ?MODULE:f2(a, a) end,
+ {?MODULE, f2, 2},
+ [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711},
+ {message, false}]}],
+ []),
+
+ tr(fun() -> ?MODULE:f2(a, a) end,
+ {?MODULE, f2, 2},
+ [{['$1','$1'],[{is_atom, '$1'}],[kakalorum]}],
+ [{call, {?MODULE, f2, [a, a]}}]),
%% Verify that 'process_dump' can handle a matchstate on the stack.
tr(fun() -> fbinmatch(<<0>>, 0) end,
@@ -176,56 +147,49 @@ test_1(Config) when is_list(Config) ->
[{['_'],[],[{message, {process_dump}}]}],
[fun({trace, _, call, {?MODULE, f1, [0]}, _Bin}) -> true end]),
-% Error cases
- ?line errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]),
-
+ % Error cases
+ errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]),
ok.
-test_2(doc) ->
- [""];
-test_2(suite) -> [];
test_2(Config) when is_list(Config) ->
- ?line tr(fun() -> ?MODULE:f2(a, a) end,
- {?MODULE, f2, 2},
- [{['$1','$1'],[{is_atom, '$1'}],[{return_trace}]}],
- [{call, {?MODULE, f2, [a, a]}},
- {return_from, {?MODULE, f2, 2}, {a, a}}]),
+ tr(fun() -> ?MODULE:f2(a, a) end,
+ {?MODULE, f2, 2},
+ [{['$1','$1'],[{is_atom, '$1'}],[{return_trace}]}],
+ [{call, {?MODULE, f2, [a, a]}},
+ {return_from, {?MODULE, f2, 2}, {a, a}}]),
ok.
-test_3(doc) ->
- ["Test the enable_trace/2 and caller/0 PAM instructions"];
-test_3(suite) -> [];
+%% Test the enable_trace/2 and caller/0 PAM instructions
test_3(Config) when is_list(Config) ->
- ?line Fun1 = fun() ->
+ Fun1 = fun() ->
register(fnoppelklopfer,self()),
?MODULE:f2(a, b),
?MODULE:f2(a, b)
end,
- ?line P1 = spawn(?MODULE, runner, [self(), Fun1]),
- ?line Pat = [{['$1','$1'],[],[{message,
- [{enable_trace, P1, call},{caller}]}]},
- {['_','_'],[],[{message,
- [{disable_trace, fnoppelklopfer, call}]}]}],
- ?line Fun2 = fun() -> ?MODULE:f3(a, a) end,
- ?line P2 = spawn(?MODULE, runner, [self(), Fun2]),
- ?line erlang:trace(P2, true, [call]),
- ?line erlang:trace_pattern({?MODULE, f2, 2}, Pat),
- ?line collect(P2, [{trace, P2, call, {?MODULE, f2, [a, a]}, [true,
+ P1 = spawn(?MODULE, runner, [self(), Fun1]),
+ Pat = [{['$1','$1'],[],[{message,
+ [{enable_trace, P1, call},{caller}]}]},
+ {['_','_'],[],[{message,
+ [{disable_trace, fnoppelklopfer, call}]}]}],
+ Fun2 = fun() -> ?MODULE:f3(a, a) end,
+ P2 = spawn(?MODULE, runner, [self(), Fun2]),
+ erlang:trace(P2, true, [call]),
+ erlang:trace_pattern({?MODULE, f2, 2}, Pat),
+ collect(P2, [{trace, P2, call, {?MODULE, f2, [a, a]}, [true,
{?MODULE,f3,2}]}]),
- ?line collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]),
- ?line ok.
+ collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]),
+ ok.
-otp_9422(doc) -> [];
otp_9422(Config) when is_list(Config) ->
Laps = 10000,
- ?line Fun1 = fun() -> otp_9422_tracee() end,
- ?line P1 = spawn_link(?MODULE, loop_runner, [self(), Fun1, Laps]),
+ Fun1 = fun() -> otp_9422_tracee() end,
+ P1 = spawn_link(?MODULE, loop_runner, [self(), Fun1, Laps]),
io:format("spawned ~p as tracee\n", [P1]),
- ?line erlang:trace(P1, true, [call, silent]),
+ erlang:trace(P1, true, [call, silent]),
- ?line Fun2 = fun() -> otp_9422_trace_changer() end,
- ?line P2 = spawn_link(?MODULE, loop_runner, [self(), Fun2, Laps]),
+ Fun2 = fun() -> otp_9422_trace_changer() end,
+ P2 = spawn_link(?MODULE, loop_runner, [self(), Fun2, Laps]),
io:format("spawned ~p as trace_changer\n", [P2]),
start_collect(P1),
@@ -244,9 +208,9 @@ otp_9422_tracee() ->
otp_9422_trace_changer() ->
Pat1 = [{[a], [], [{enable_trace, arity}]}],
- ?line erlang:trace_pattern({?MODULE, f1, 1}, Pat1),
+ erlang:trace_pattern({?MODULE, f1, 1}, Pat1),
Pat2 = [{[b], [], [{disable_trace, arity}]}],
- ?line erlang:trace_pattern({?MODULE, f1, 1}, Pat2).
+ erlang:trace_pattern({?MODULE, f1, 1}, Pat2).
@@ -261,261 +225,227 @@ bad_match_spec_bin(Config) when is_list(Config) ->
-trace_control_word(doc) ->
- ["Test the erlang:system_info(trace_control_word) and ",
- "erlang:system_flag(trace_control_word, Value) BIFs, ",
- "as well as the get_tcw/0 and set_tcw/1 PAM instructions"];
-trace_control_word(suite) -> [];
+%% Test the erlang:system_info(trace_control_word) and
+%% erlang:system_flag(trace_control_word, Value) BIFs,
+%% as well as the get_tcw/0 and set_tcw/1 PAM instructions
trace_control_word(Config) when is_list(Config) ->
- ?line 32 = Bits = tcw_bits(),
- ?line High = 1 bsl (Bits - 1),
- ?line erlang:system_flag(trace_control_word, 17),
- ?line tr(fun() -> ?MODULE:f1(a) end,
- {?MODULE, f1, 1},
- [{'_',[{'=:=', {get_tcw}, 17}],[]}],
- [{call, {?MODULE, f1, [a]}}]),
- ?line tr(fun() -> ?MODULE:f1(a) end,
- {?MODULE, f1, 1},
- [{'_',[{'=:=', {get_tcw}, 18}],[]}],
- []),
- ?line erlang:system_flag(trace_control_word, High),
- ?line tr(fun() -> ?MODULE:f1(a) end,
- {?MODULE, f1, 1},
- [{'_',[{'=:=', {get_tcw}, High}],[]}],
- [{call, {?MODULE, f1, [a]}}]),
- ?line erlang:system_flag(trace_control_word, 0),
- ?line tr(fun() ->
- ?MODULE:f1(a),
- ?MODULE:f1(start),
- ?MODULE:f1(b),
- ?MODULE:f1(c),
- ?MODULE:f1(high),
- ?MODULE:f1(d),
- ?MODULE:f1(stop),
- ?MODULE:f1(e)
- end,
- {?MODULE, f1, 1},
- [{[start],
- [],
- [{message, {set_tcw, 17}}]},
- {[stop],
- [],
- [{message, {set_tcw, 0}}]},
- {[high],
- [],
- [{message, {set_tcw, High}}]},
- {['_'],
- [{'>', {get_tcw}, 0}],
- [{set_tcw, {'+', 1, {get_tcw}}}, {message, {get_tcw}}] }],
- [{call, {?MODULE, f1, [start]}, 0},
- {call, {?MODULE, f1, [b]}, 18},
- {call, {?MODULE, f1, [c]}, 19},
- {call, {?MODULE, f1, [high]}, 19},
- {call, {?MODULE, f1, [d]}, High + 1},
- {call, {?MODULE, f1, [stop]}, High + 1}]),
- ?line 0 = erlang:system_info(trace_control_word),
+ 32 = Bits = tcw_bits(),
+ High = 1 bsl (Bits - 1),
+ erlang:system_flag(trace_control_word, 17),
+ tr(fun() -> ?MODULE:f1(a) end,
+ {?MODULE, f1, 1},
+ [{'_',[{'=:=', {get_tcw}, 17}],[]}],
+ [{call, {?MODULE, f1, [a]}}]),
+ tr(fun() -> ?MODULE:f1(a) end,
+ {?MODULE, f1, 1},
+ [{'_',[{'=:=', {get_tcw}, 18}],[]}],
+ []),
+ erlang:system_flag(trace_control_word, High),
+ tr(fun() -> ?MODULE:f1(a) end,
+ {?MODULE, f1, 1},
+ [{'_',[{'=:=', {get_tcw}, High}],[]}],
+ [{call, {?MODULE, f1, [a]}}]),
+ erlang:system_flag(trace_control_word, 0),
+ tr(fun() ->
+ ?MODULE:f1(a),
+ ?MODULE:f1(start),
+ ?MODULE:f1(b),
+ ?MODULE:f1(c),
+ ?MODULE:f1(high),
+ ?MODULE:f1(d),
+ ?MODULE:f1(stop),
+ ?MODULE:f1(e)
+ end,
+ {?MODULE, f1, 1},
+ [{[start],
+ [],
+ [{message, {set_tcw, 17}}]},
+ {[stop],
+ [],
+ [{message, {set_tcw, 0}}]},
+ {[high],
+ [],
+ [{message, {set_tcw, High}}]},
+ {['_'],
+ [{'>', {get_tcw}, 0}],
+ [{set_tcw, {'+', 1, {get_tcw}}}, {message, {get_tcw}}] }],
+ [{call, {?MODULE, f1, [start]}, 0},
+ {call, {?MODULE, f1, [b]}, 18},
+ {call, {?MODULE, f1, [c]}, 19},
+ {call, {?MODULE, f1, [high]}, 19},
+ {call, {?MODULE, f1, [d]}, High + 1},
+ {call, {?MODULE, f1, [stop]}, High + 1}]),
+ 0 = erlang:system_info(trace_control_word),
ok.
tcw_bits() ->
- ?line tcw_bits(erlang:system_flag(trace_control_word, 0), 0, 0).
+ tcw_bits(erlang:system_flag(trace_control_word, 0), 0, 0).
tcw_bits(Save, Prev, Bits) ->
- ?line Curr = 1 bsl Bits,
- ?line case catch erlang:system_flag(trace_control_word, Curr) of
- {'EXIT' , {badarg, _}} ->
- ?line Prev = erlang:system_flag(trace_control_word, Save),
- Bits;
- Prev ->
- ?line Curr = erlang:system_info(trace_control_word),
- tcw_bits(Save, Curr, Bits+1)
- end.
-
-
-
-silent(doc) ->
- ["Test the erlang:trace(_, _, [silent]) flag ",
- "as well as the silent/0 PAM instruction"];
-silent(suite) -> [];
+ Curr = 1 bsl Bits,
+ case catch erlang:system_flag(trace_control_word, Curr) of
+ {'EXIT' , {badarg, _}} ->
+ Prev = erlang:system_flag(trace_control_word, Save),
+ Bits;
+ Prev ->
+ Curr = erlang:system_info(trace_control_word),
+ tcw_bits(Save, Curr, Bits+1)
+ end.
+
+
+%% Test the erlang:trace(_, _, [silent]) flag
+%% as well as the silent/0 PAM instruction
silent(Config) when is_list(Config) ->
%% Global call trace
- ?line tr(fun() ->
- ?MODULE:f1(a), % No trace - not active
- ?MODULE:f1(miss), % No trace - no activation
- ?MODULE:f1(b), % No trace - still not active
- ?MODULE:f1(start), % Trace - activation
- ?MODULE:f1(c), % Trace - active
- f1(d), % No trace - local call
- ?MODULE:f1(miss), % Trace - no inactivation
- ?MODULE:f1(e), % Trace - still active
- ?MODULE:f1(stop), % No trace - inactivation
- ?MODULE:f1(f) % No trace - not active
- end,
- {?MODULE, f1, 1},
- [call, silent],
- [{[start],
- [],
- [{silent, false}, {message, start}]},
- {[stop],
- [],
- [{silent, true}, {message, stop}]},
- {[miss],
- [],
- [{silent, neither_true_nor_false}, {message, miss}]},
- {['$1'],
- [],
- [{message, '$1'}] }],
- [global],
- [{call, {?MODULE, f1, [start]}, start},
- {call, {?MODULE, f1, [c]}, c},
- {call, {?MODULE, f1, [miss]}, miss},
- {call, {?MODULE, f1, [e]}, e} ]),
+ tr(fun() ->
+ ?MODULE:f1(a), % No trace - not active
+ ?MODULE:f1(miss), % No trace - no activation
+ ?MODULE:f1(b), % No trace - still not active
+ ?MODULE:f1(start), % Trace - activation
+ ?MODULE:f1(c), % Trace - active
+ f1(d), % No trace - local call
+ ?MODULE:f1(miss), % Trace - no inactivation
+ ?MODULE:f1(e), % Trace - still active
+ ?MODULE:f1(stop), % No trace - inactivation
+ ?MODULE:f1(f) % No trace - not active
+ end,
+ {?MODULE, f1, 1},
+ [call, silent],
+ [{[start],
+ [],
+ [{silent, false}, {message, start}]},
+ {[stop],
+ [],
+ [{silent, true}, {message, stop}]},
+ {[miss],
+ [],
+ [{silent, neither_true_nor_false}, {message, miss}]},
+ {['$1'],
+ [],
+ [{message, '$1'}] }],
+ [global],
+ [{call, {?MODULE, f1, [start]}, start},
+ {call, {?MODULE, f1, [c]}, c},
+ {call, {?MODULE, f1, [miss]}, miss},
+ {call, {?MODULE, f1, [e]}, e} ]),
%% Local call trace
- ?line tr(fun() ->
- ?MODULE:f1(a), % No trace - not active
- f1(b), % No trace - not active
- ?MODULE:f1(start), % Trace - activation
- ?MODULE:f1(c), % Trace - active
- f1(d), % Trace - active
- f1(stop), % No trace - inactivation
- ?MODULE:f1(e), % No trace - not active
- f1(f) % No trace - not active
- end,
- {?MODULE, f1, 1},
- [call, silent],
- [{[start],
- [],
- [{silent, false}, {message, start}]},
- {[stop],
- [],
- [{silent, true}, {message, stop}]},
- {['$1'],
- [],
- [{message, '$1'}] }],
- [local],
- [{call, {?MODULE, f1, [start]}, start},
- {call, {?MODULE, f1, [c]}, c},
- {call, {?MODULE, f1, [d]}, d} ]),
+ tr(fun() ->
+ ?MODULE:f1(a), % No trace - not active
+ f1(b), % No trace - not active
+ ?MODULE:f1(start), % Trace - activation
+ ?MODULE:f1(c), % Trace - active
+ f1(d), % Trace - active
+ f1(stop), % No trace - inactivation
+ ?MODULE:f1(e), % No trace - not active
+ f1(f) % No trace - not active
+ end,
+ {?MODULE, f1, 1},
+ [call, silent],
+ [{[start],
+ [],
+ [{silent, false}, {message, start}]},
+ {[stop],
+ [],
+ [{silent, true}, {message, stop}]},
+ {['$1'],
+ [],
+ [{message, '$1'}] }],
+ [local],
+ [{call, {?MODULE, f1, [start]}, start},
+ {call, {?MODULE, f1, [c]}, c},
+ {call, {?MODULE, f1, [d]}, d} ]),
ok.
-silent_no_ms(doc) ->
- ["Test the erlang:trace(_, _, [silent]) flag without match specs"];
-silent_no_ms(suite) -> [];
+%% Test the erlang:trace(_, _, [silent]) flag without match specs
silent_no_ms(Config) when is_list(Config) ->
%% Global call trace
%%
%% Trace f2/2 and erlang:integer_to_list/1 without match spec
%% and use match spec on f1/1 to control silent flag.
- ?line tr(
- fun () ->
- ?MODULE:f1(a),
- ?MODULE:f2(b, c),
- _ = erlang:integer_to_list(id(1)),
- ?MODULE:f3(d, e),
- ?MODULE:f1(start),
- ?MODULE:f2(f, g),
- _ = erlang:integer_to_list(id(2)),
- ?MODULE:f3(h, i),
- ?MODULE:f1(stop),
- ?MODULE:f2(j, k),
- _ = erlang:integer_to_list(id(3)),
- ?MODULE:f3(l, m)
- end,
- fun (Tracee) ->
- ?line 1 =
- erlang:trace(Tracee, true,
- [call,silent,return_to]),
- ?line 1 =
- erlang:trace_pattern(
- {?MODULE,f2,2},
- [],
- [global]),
- ?line 1 =
- erlang:trace_pattern(
- {erlang,integer_to_list,1},
- [],
- [global]),
- ?line 1 =
- erlang:trace_pattern(
- {?MODULE,f1,1},
- [{[start],[],[{silent,false}]},
- {[stop],[],[{silent,true}]}],
- [global]),
- %%
- %% Expected: (no return_to for global call trace)
- %%
- ?line
- [{trace,Tracee,call,{?MODULE,f1,[start]}},
- {trace,Tracee,call,{?MODULE,f2,[f,g]}},
- {trace,Tracee,call,{erlang,integer_to_list,[2]}},
- {trace,Tracee,call,{?MODULE,f2,[h,i]}}]
- end),
+ tr(
+ fun () ->
+ ?MODULE:f1(a),
+ ?MODULE:f2(b, c),
+ _ = erlang:integer_to_list(id(1)),
+ ?MODULE:f3(d, e),
+ ?MODULE:f1(start),
+ ?MODULE:f2(f, g),
+ _ = erlang:integer_to_list(id(2)),
+ ?MODULE:f3(h, i),
+ ?MODULE:f1(stop),
+ ?MODULE:f2(j, k),
+ _ = erlang:integer_to_list(id(3)),
+ ?MODULE:f3(l, m)
+ end,
+ fun (Tracee) ->
+ 1 = erlang:trace(Tracee, true, [call,silent,return_to]),
+ 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [global]),
+ 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]),
+ 1 = erlang:trace_pattern(
+ {?MODULE,f1,1},
+ [{[start],[],[{silent,false}]},
+ {[stop],[],[{silent,true}]}],
+ [global]),
+ %%
+ %% Expected: (no return_to for global call trace)
+ %%
+ [{trace,Tracee,call,{?MODULE,f1,[start]}},
+ {trace,Tracee,call,{?MODULE,f2,[f,g]}},
+ {trace,Tracee,call,{erlang,integer_to_list,[2]}},
+ {trace,Tracee,call,{?MODULE,f2,[h,i]}}]
+ end),
%% Local call trace
%%
%% Trace f2/2 and erlang:integer_to_list/1 without match spec
%% and use match spec on f1/1 to control silent flag.
- ?line tr(
- fun () ->
- ?MODULE:f1(a),
- ?MODULE:f2(b, c),
- _ = erlang:integer_to_list(id(1)),
- ?MODULE:f3(d, e),
- ?MODULE:f1(start),
- ?MODULE:f2(f, g),
- _ = erlang:integer_to_list(id(2)),
- ?MODULE:f3(h, i),
- ?MODULE:f1(stop),
- ?MODULE:f2(j, k),
- _ = erlang:integer_to_list(id(3)),
- ?MODULE:f3(l, m)
- end,
- fun (Tracee) ->
- ?line 1 =
- erlang:trace(Tracee, true,
- [call,silent,return_to]),
- ?line 1 =
- erlang:trace_pattern(
- {?MODULE,f2,2},
- [],
- [local]),
- ?line 1 =
- erlang:trace_pattern(
- {erlang,integer_to_list,1},
- [],
- [local]),
- ?line 1 =
- erlang:trace_pattern(
- {?MODULE,f1,1},
- [{[start],[],[{silent,false}]},
- {[stop],[],[{silent,true}]}],
- [local]),
- %%
- %% Expected:
- %%
- ?line
- [{trace,Tracee,call,{?MODULE,f1,[start]}},
- {trace,Tracee,return_to,
- {?MODULE,'-silent_no_ms/1-fun-2-',0}},
- {trace,Tracee,call,{?MODULE,f2,[f,g]}},
- {trace,Tracee,return_to,
- {?MODULE,'-silent_no_ms/1-fun-2-',0}},
- {trace,Tracee,call,{erlang,integer_to_list,[2]}},
- {trace,Tracee,return_to,
- {?MODULE,'-silent_no_ms/1-fun-2-',0}},
- {trace,Tracee,call,{?MODULE,f2,[h,i]}},
- {trace,Tracee,return_to,{?MODULE,f3,2}}]
- end).
-
-silent_test(doc) ->
- ["Test that match_spec_test does not activate silent"];
+ tr(
+ fun () ->
+ ?MODULE:f1(a),
+ ?MODULE:f2(b, c),
+ _ = erlang:integer_to_list(id(1)),
+ ?MODULE:f3(d, e),
+ ?MODULE:f1(start),
+ ?MODULE:f2(f, g),
+ _ = erlang:integer_to_list(id(2)),
+ ?MODULE:f3(h, i),
+ ?MODULE:f1(stop),
+ ?MODULE:f2(j, k),
+ _ = erlang:integer_to_list(id(3)),
+ ?MODULE:f3(l, m)
+ end,
+ fun (Tracee) ->
+ 1 = erlang:trace(Tracee, true, [call,silent,return_to]),
+ 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]),
+ 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [local]),
+ 1 = erlang:trace_pattern(
+ {?MODULE,f1,1},
+ [{[start],[],[{silent,false}]},
+ {[stop],[],[{silent,true}]}],
+ [local]),
+ %%
+ %% Expected:
+ %%
+ [{trace,Tracee,call,{?MODULE,f1,[start]}},
+ {trace,Tracee,return_to,
+ {?MODULE,'-silent_no_ms/1-fun-2-',0}},
+ {trace,Tracee,call,{?MODULE,f2,[f,g]}},
+ {trace,Tracee,return_to,
+ {?MODULE,'-silent_no_ms/1-fun-2-',0}},
+ {trace,Tracee,call,{erlang,integer_to_list,[2]}},
+ {trace,Tracee,return_to,
+ {?MODULE,'-silent_no_ms/1-fun-2-',0}},
+ {trace,Tracee,call,{?MODULE,f2,[h,i]}},
+ {trace,Tracee,return_to,{?MODULE,f3,2}}]
+ end).
+
+%% Test that match_spec_test does not activate silent
silent_test(_Config) ->
{flags,[]} = erlang:trace_info(self(),flags),
erlang:match_spec_test([],[{'_',[],[{silent,true}]}],trace),
{flags,[]} = erlang:trace_info(self(),flags).
-ms_trace2(doc) ->
- ["Test the match spec functions {trace/2}"];
-ms_trace2(suite) -> [];
+%% Test the match spec functions {trace/2}
ms_trace2(Config) when is_list(Config) ->
Tracer = self(),
%% Meta trace init
@@ -523,75 +453,58 @@ ms_trace2(Config) when is_list(Config) ->
%% Trace global f1/1, local f2/2, global erlang:integer_to_list/1
%% without match spec. Use match spec functions
%% {trace/2} to control trace through fn/2,3.
- ?line tr(
- fun () ->
- ?MODULE:f1(a),
- ?MODULE:f2(b, c),
- _ = erlang:integer_to_list(id(1)),
- ?MODULE:f3(d, e),
- fn([all], [call,return_to,{tracer,Tracer}]),
- ?MODULE:f1(f),
- f2(g, h),
- f1(i),
- _ = erlang:integer_to_list(id(2)),
- ?MODULE:f3(j, k),
- fn([call,return_to], []),
- ?MODULE:f1(l),
- ?MODULE:f2(m, n),
- _ = erlang:integer_to_list(id(3)),
- ?MODULE:f3(o, p)
- end,
- fun (Tracee) ->
- ?line 1 =
- erlang:trace(Tracee, false, [all]),
- ?line 1 =
- erlang:trace_pattern(
- {?MODULE,f1,1},
- [],
- [global]),
- ?line 1 =
- erlang:trace_pattern(
- {?MODULE,f2,2},
- [],
- [local]),
- ?line 1 =
- erlang:trace_pattern(
- {erlang,integer_to_list,1},
- [],
- [global]),
- ?line 3 =
- erlang:trace_pattern(
- {?MODULE,fn,'_'},
- [{['$1','$2'],[],
- [{trace,'$1','$2'},{message,ms_trace2}]}],
- [meta]),
- %%
- %% Expected: (no return_to for global call trace)
- %%
- ?line Origin = {match_spec_SUITE,'-ms_trace2/1-fun-0-',1},
- ?line
- [{trace_ts,Tracee,call,
- {?MODULE,fn,
- [[all],[call,return_to,{tracer,Tracer}]]},
- ms_trace2},
- {trace,Tracee,call,{?MODULE,f1,[f]}},
- {trace,Tracee,call,{?MODULE,f2,[g,h]}},
- {trace,Tracee,return_to,Origin},
- {trace,Tracee,call,{erlang,integer_to_list,[2]}},
- {trace,Tracee,call,{?MODULE,f2,[j,k]}},
- {trace,Tracee,return_to,{?MODULE,f3,2}},
- {trace_ts,Tracee,call,
- {?MODULE,fn,
- [[call,return_to],[]]},
- ms_trace2}]
- end),
+ tr(
+ fun () ->
+ ?MODULE:f1(a),
+ ?MODULE:f2(b, c),
+ _ = erlang:integer_to_list(id(1)),
+ ?MODULE:f3(d, e),
+ fn([all], [call,return_to,{tracer,Tracer}]),
+ ?MODULE:f1(f),
+ f2(g, h),
+ f1(i),
+ _ = erlang:integer_to_list(id(2)),
+ ?MODULE:f3(j, k),
+ fn([call,return_to], []),
+ ?MODULE:f1(l),
+ ?MODULE:f2(m, n),
+ _ = erlang:integer_to_list(id(3)),
+ ?MODULE:f3(o, p)
+ end,
+ fun (Tracee) ->
+ 1 = erlang:trace(Tracee, false, [all]),
+ 1 = erlang:trace_pattern( {?MODULE,f1,1}, [], [global]),
+ 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]),
+ 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]),
+ 3 = erlang:trace_pattern(
+ {?MODULE,fn,'_'},
+ [{['$1','$2'],[],
+ [{trace,'$1','$2'},{message,ms_trace2}]}],
+ [meta]),
+ %%
+ %% Expected: (no return_to for global call trace)
+ %%
+ Origin = {match_spec_SUITE,'-ms_trace2/1-fun-0-',1},
+ [{trace_ts,Tracee,call,
+ {?MODULE,fn,
+ [[all],[call,return_to,{tracer,Tracer}]]},
+ ms_trace2},
+ {trace,Tracee,call,{?MODULE,f1,[f]}},
+ {trace,Tracee,call,{?MODULE,f2,[g,h]}},
+ {trace,Tracee,return_to,Origin},
+ {trace,Tracee,call,{erlang,integer_to_list,[2]}},
+ {trace,Tracee,call,{?MODULE,f2,[j,k]}},
+ {trace,Tracee,return_to,{?MODULE,f3,2}},
+ {trace_ts,Tracee,call,
+ {?MODULE,fn,
+ [[call,return_to],[]]},
+ ms_trace2}]
+ end),
ok.
-ms_trace3(doc) ->
- ["Test the match spec functions {trace/3}"];
-ms_trace3(suite) -> [];
+%% Test the match spec functions {trace/3}
ms_trace3(Config) when is_list(Config) ->
TraceeName = 'match_spec_SUITE:ms_trace3',
Tracer = self(),
@@ -602,134 +515,115 @@ ms_trace3(Config) when is_list(Config) ->
%% {trace/2} to control trace through fn/2,3.
Tag = make_ref(),
Controller =
- spawn_link(
- fun () ->
- receive
- {Tracee,Tag,start} ->
- fn(TraceeName, [all],
- [call,return_to,send,'receive',
- {tracer,Tracer}]),
- Tracee ! {self(),Tag,started},
- receive {Tracee,Tag,stop_1} -> ok end,
- fn(Tracee, [call,return_to], []),
- Tracee ! {self(),Tag,stopped_1},
- receive {Tracee,Tag,stop_2} -> ok end,
- fn(Tracee, [all], []),
- Tracee ! {self(),Tag,stopped_2}
- end
- end),
- ?line tr(
- fun () -> %% Action
- register(TraceeName, self()),
- ?MODULE:f1(a),
- ?MODULE:f2(b, c),
- _ = erlang:integer_to_list(id(1)),
- ?MODULE:f3(d, e),
- Controller ! {self(),Tag,start},
- receive {Controller,Tag,started} -> ok end,
- ?MODULE:f1(f),
- f2(g, h),
- f1(i),
- _ = erlang:integer_to_list(id(2)),
- ?MODULE:f3(j, k),
- Controller ! {self(),Tag,stop_1},
- receive {Controller,Tag,stopped_1} -> ok end,
- ?MODULE:f1(l),
- ?MODULE:f2(m, n),
- _ = erlang:integer_to_list(id(3)),
- ?MODULE:f3(o, p),
- Controller ! {self(),Tag,stop_2},
- receive {Controller,Tag,stopped_2} -> ok end,
- ?MODULE:f1(q),
- ?MODULE:f2(r, s),
- _ = erlang:integer_to_list(id(4)),
- ?MODULE:f3(t, u)
- end,
-
- fun (Tracee) -> %% Startup
- ?line 1 =
- erlang:trace(Tracee, false, [all]),
- ?line 1 =
- erlang:trace_pattern(
- {?MODULE,f1,1},
- [],
- [global]),
- ?line 1 =
- erlang:trace_pattern(
- {?MODULE,f2,2},
- [],
- [local]),
- ?line 1 =
- erlang:trace_pattern(
- {erlang,integer_to_list,1},
- [],
- [global]),
- ?line 3 =
- erlang:trace_pattern(
- {?MODULE,fn,'_'},
- [{['$1','$2','$3'],[],
- [{trace,'$1','$2','$3'},{message,Tag}]}],
- [meta]),
- %%
- %% Expected: (no return_to for global call trace)
- %%
- ?line Origin = {match_spec_SUITE,'-ms_trace3/1-fun-1-',2},
- ?line
- [{trace_ts,Controller,call,
- {?MODULE,fn,[TraceeName,[all],
- [call,return_to,send,'receive',
- {tracer,Tracer}]]},
- Tag},
- {trace,Tracee,'receive',{Controller,Tag,started}},
- {trace,Tracee,call,{?MODULE,f1,[f]}},
- {trace,Tracee,call,{?MODULE,f2,[g,h]}},
- {trace,Tracee,return_to,Origin},
- {trace,Tracee,call,{erlang,integer_to_list,[2]}},
- {trace,Tracee,call,{?MODULE,f2,[j,k]}},
- {trace,Tracee,return_to,{?MODULE,f3,2}},
- {trace,Tracee,send,{Tracee,Tag,stop_1},Controller},
- {trace_ts,Controller,call,
- {?MODULE,fn,[Tracee,[call,return_to],[]]},
- Tag},
- {trace_ts,Controller,call,
- {?MODULE,fn,[Tracee,[all],[]]},
- Tag}]
- end),
+ spawn_link(
+ fun () ->
+ receive
+ {Tracee,Tag,start} ->
+ fn(TraceeName, [all],
+ [call,return_to,send,'receive',
+ {tracer,Tracer}]),
+ Tracee ! {self(),Tag,started},
+ receive {Tracee,Tag,stop_1} -> ok end,
+ fn(Tracee, [call,return_to], []),
+ Tracee ! {self(),Tag,stopped_1},
+ receive {Tracee,Tag,stop_2} -> ok end,
+ fn(Tracee, [all], []),
+ Tracee ! {self(),Tag,stopped_2}
+ end
+ end),
+ tr(
+ fun () -> %% Action
+ register(TraceeName, self()),
+ ?MODULE:f1(a),
+ ?MODULE:f2(b, c),
+ _ = erlang:integer_to_list(id(1)),
+ ?MODULE:f3(d, e),
+ Controller ! {self(),Tag,start},
+ receive {Controller,Tag,started} -> ok end,
+ ?MODULE:f1(f),
+ f2(g, h),
+ f1(i),
+ _ = erlang:integer_to_list(id(2)),
+ ?MODULE:f3(j, k),
+ Controller ! {self(),Tag,stop_1},
+ receive {Controller,Tag,stopped_1} -> ok end,
+ ?MODULE:f1(l),
+ ?MODULE:f2(m, n),
+ _ = erlang:integer_to_list(id(3)),
+ ?MODULE:f3(o, p),
+ Controller ! {self(),Tag,stop_2},
+ receive {Controller,Tag,stopped_2} -> ok end,
+ ?MODULE:f1(q),
+ ?MODULE:f2(r, s),
+ _ = erlang:integer_to_list(id(4)),
+ ?MODULE:f3(t, u)
+ end,
+
+ fun (Tracee) -> %% Startup
+ 1 = erlang:trace(Tracee, false, [all]),
+ 1 = erlang:trace_pattern( {?MODULE,f1,1}, [], [global]),
+ 1 = erlang:trace_pattern( {?MODULE,f2,2}, [], [local]),
+ 1 = erlang:trace_pattern( {erlang,integer_to_list,1}, [], [global]),
+ 3 = erlang:trace_pattern(
+ {?MODULE,fn,'_'},
+ [{['$1','$2','$3'],[],
+ [{trace,'$1','$2','$3'},{message,Tag}]}],
+ [meta]),
+ %%
+ %% Expected: (no return_to for global call trace)
+ %%
+ Origin = {match_spec_SUITE,'-ms_trace3/1-fun-1-',2},
+ [{trace_ts,Controller,call,
+ {?MODULE,fn,[TraceeName,[all],
+ [call,return_to,send,'receive',
+ {tracer,Tracer}]]},
+ Tag},
+ {trace,Tracee,'receive',{Controller,Tag,started}},
+ {trace,Tracee,call,{?MODULE,f1,[f]}},
+ {trace,Tracee,call,{?MODULE,f2,[g,h]}},
+ {trace,Tracee,return_to,Origin},
+ {trace,Tracee,call,{erlang,integer_to_list,[2]}},
+ {trace,Tracee,call,{?MODULE,f2,[j,k]}},
+ {trace,Tracee,return_to,{?MODULE,f3,2}},
+ {trace,Tracee,send,{Tracee,Tag,stop_1},Controller},
+ {trace_ts,Controller,call,
+ {?MODULE,fn,[Tracee,[call,return_to],[]]},
+ Tag},
+ {trace_ts,Controller,call,
+ {?MODULE,fn,[Tracee,[all],[]]},
+ Tag}]
+ end),
ok.
-destructive_in_test_bif(doc) ->
- ["Test that destructive operations in test bif does not really happen"];
-destructive_in_test_bif(suite) -> [];
+%% Test that destructive operations in test bif does not really happen
destructive_in_test_bif(Config) when is_list(Config) ->
- ?line {ok,OldToken,_,_} = erlang:match_spec_test
+ {ok,OldToken,_,_} = erlang:match_spec_test
([],
[{'_',[],[{message,{get_seq_token}}]}],trace),
- ?line {ok,_,_,_} = erlang:match_spec_test
+ {ok,_,_,_} = erlang:match_spec_test
([],
[{'_',[],[{message,{set_seq_token, label, 1}}]}],
trace),
- ?line {ok,OldToken,_,_} = erlang:match_spec_test
+ {ok,OldToken,_,_} = erlang:match_spec_test
([],
[{'_',[],[{message,{get_seq_token}}]}],trace),
- ?line {ok, OldTCW,_,_} = erlang:match_spec_test
+ {ok, OldTCW,_,_} = erlang:match_spec_test
([],[{'_',[],[{message,{get_tcw}}]}],trace),
- ?line {ok,OldTCW,_,_} = erlang:match_spec_test
+ {ok,OldTCW,_,_} = erlang:match_spec_test
([],
[{'_',[],[{message,{set_tcw, OldTCW+1}}]}],
trace),
- ?line {ok, OldTCW,_,_} = erlang:match_spec_test
+ {ok, OldTCW,_,_} = erlang:match_spec_test
([],[{'_',[],[{message,{get_tcw}}]}],trace),
ok.
-boxed_and_small(doc) ->
- ["Test that the comparision between boxed and small does not crash emulator"];
-boxed_and_small(suite) -> [];
+%% Test that the comparision between boxed and small does not crash emulator
boxed_and_small(Config) when is_list(Config) ->
- ?line {ok, Node} = start_node(match_spec_suite_other),
- ?line ok = rpc:call(Node,?MODULE,do_boxed_and_small,[]),
- ?line stop_node(Node),
+ {ok, Node} = start_node(match_spec_suite_other),
+ ok = rpc:call(Node,?MODULE,do_boxed_and_small,[]),
+ stop_node(Node),
ok.
do_boxed_and_small() ->
@@ -739,13 +633,11 @@ do_boxed_and_small() ->
{ok, false, _, _} = erlang:match_spec_test({0,3},[{{make_ref(),'_'},[],['$_']}],table),
ok.
-faulty_seq_trace(doc) ->
- ["Test that faulty seq_trace_call does not crash emulator"];
-faulty_seq_trace(suite) -> [];
+%% Test that faulty seq_trace_call does not crash emulator
faulty_seq_trace(Config) when is_list(Config) ->
- ?line {ok, Node} = start_node(match_spec_suite_other),
- ?line ok = rpc:call(Node,?MODULE,do_faulty_seq_trace,[]),
- ?line stop_node(Node),
+ {ok, Node} = start_node(match_spec_suite_other),
+ ok = rpc:call(Node,?MODULE,do_faulty_seq_trace,[]),
+ stop_node(Node),
ok.
do_faulty_seq_trace() ->
@@ -757,63 +649,58 @@ errchk(Pat) ->
{'EXIT', {badarg, _}} ->
ok;
Other ->
- test_server:fail({noerror, Other})
+ ct:fail({noerror, Other})
end.
-unary_minus(suite) ->
- [];
-unary_minus(doc) ->
- ["Checks that unary minus works"];
+%% Checks that unary minus works
unary_minus(Config) when is_list(Config) ->
- ?line {ok,true,[],[]} = erlang:match_spec_test
+ {ok,true,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'<',{'-','$1'},-4}],
[true]}],
table),
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'<',{'-','$1'},-6}],
[true]}],
table),
- ?line {ok,true,[],[]} = erlang:match_spec_test
+ {ok,true,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'=:=',{'-','$1',2},3}],
[true]}],
table),
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(hej,
[{'$1',
[{'=/=',{'-','$1'},0}],
[true]}],
table),
ok.
-unary_plus(suite) ->
- [];
-unary_plus(doc) ->
- ["Checks that unary plus works"];
+
+%% Checks that unary plus works
unary_plus(Config) when is_list(Config) ->
- ?line {ok,true,[],[]} = erlang:match_spec_test
+ {ok,true,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'<',{'+','$1'},6}],
[true]}],
table),
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'<',{'+','$1'},4}],
[true]}],
table),
- ?line {ok,true,[],[]} = erlang:match_spec_test
+ {ok,true,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'=:=',{'+','$1',2},7}],
[true]}],
table),
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(hej,
[{'$1',
[{'=/=',{'+','$1'},0}],
@@ -824,53 +711,50 @@ unary_plus(Config) when is_list(Config) ->
-guard_exceptions(suite) ->
- [];
-guard_exceptions(doc) ->
- ["Checks that exceptions in guards are handled correctly"];
+%% Checks that exceptions in guards are handled correctly
guard_exceptions(Config) when is_list(Config) ->
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'or',{is_integer,'$1'},{'or','$1','$1'}}],
[true]}],
table),
- ?line {ok,true,[],[]} = erlang:match_spec_test
+ {ok,true,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'orelse',{is_integer,'$1'},
{'or','$1','$1'}}],
[true]}],
table),
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'orelse',{'or','$1',true},
{is_integer,'$1'}}],
[true]}],
table),
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'or',{is_integer,'$1'},
{'orelse','$1',true}}],
[true]}],
table),
- ?line {ok,true,[],[]} = erlang:match_spec_test
+ {ok,true,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'or',{is_integer,'$1'},
{'orelse',true,'$1'}}],
[true]}],
table),
- ?line {ok,true,[],[]} = erlang:match_spec_test
+ {ok,true,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'or',{is_integer,'$1'},
{'andalso',false,'$1'}}],
[true]}],
table),
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'or',{is_integer,'$1'},
@@ -878,7 +762,7 @@ guard_exceptions(Config) when is_list(Config) ->
[true]}],
table),
- ?line {ok,false,[],[]} = erlang:match_spec_test
+ {ok,false,[],[]} = erlang:match_spec_test
(5,
[{'$1',
[{'or',{is_integer,'$1'},
@@ -888,19 +772,16 @@ guard_exceptions(Config) when is_list(Config) ->
ok.
-fpe(suite) ->
- [];
-fpe(doc) ->
- ["Checks floating point exceptions in match-specs"];
+%% Checks floating point exceptions in match-specs
fpe(Config) when is_list(Config) ->
MS = [{{'$1'},[],[{'/','$1',0}]}],
case catch (['EXIT','EXIT'] =
ets:match_spec_run([{1},{2}],ets:match_spec_compile(MS))) of
- {'EXIT',_} -> test_server:fail({error,
- "Floating point exceptions faulty"});
+ {'EXIT',_} -> ct:fail({error, "Floating point exceptions faulty"});
_ -> ok
end.
+%% Test maps in match-specs
maps(Config) when is_list(Config) ->
{ok,#{},[],[]} = erlang:match_spec_test(#{}, [{'_',[],['$_']}], table),
{ok,#{},[],[]} = erlang:match_spec_test(#{}, [{#{},[],['$_']}], table),
@@ -980,11 +861,11 @@ moving_labels(Config) when is_list(Config) ->
%% point at their correct target.
%%
Ms = [{{'$1','$2'},[],[{{ok,{'andalso','$1','$2'},[1,2,3]}}]}],
- ?line {ok,{ok,false,[1,2,3]},[],[]} =
+ {ok,{ok,false,[1,2,3]},[],[]} =
erlang:match_spec_test({true,false}, Ms, table),
Ms2 = [{{'$1','$2'},[],[{{ok,{'orelse','$1','$2'},[1,2,3]}}]}],
- ?line {ok,{ok,true,[1,2,3]},[],[]} =
+ {ok,{ok,true,[1,2,3]},[],[]} =
erlang:match_spec_test({true,false}, Ms2, table),
ok.
@@ -995,13 +876,13 @@ tr(Fun, MFA, Pat, Expected) ->
tr(Fun, MFA, TraceFlags, Pat, PatFlags, Expected0) ->
tr(Fun,
fun(P) ->
- erlang:trace(P, true, TraceFlags),
- erlang:trace_pattern(MFA, Pat, PatFlags),
- lists:map(
- fun(X) when is_function(X,1) -> X;
- (X) -> list_to_tuple([trace, P | tuple_to_list(X)])
- end,
- Expected0)
+ erlang:trace(P, true, TraceFlags),
+ erlang:trace_pattern(MFA, Pat, PatFlags),
+ lists:map(
+ fun(X) when is_function(X,1) -> X;
+ (X) -> list_to_tuple([trace, P | tuple_to_list(X)])
+ end,
+ Expected0)
end).
tr(RunFun, ControlFun) ->
@@ -1016,51 +897,51 @@ collect(P, TMs) ->
collect([]) ->
receive
M ->
- ?t:format("Got unexpected: ~p~n", [M]),
+ io:format("Got unexpected: ~p~n", [M]),
flush({got_unexpected,M})
after 17 ->
ok
end;
collect([TM | TMs]) ->
- ?t:format( "Expecting: ~p~n", [TM]),
+ io:format( "Expecting: ~p~n", [TM]),
receive
- M0 ->
- M = case element(1, M0) of
- trace_ts ->
- list_to_tuple(lists:reverse(
- tl(lists:reverse(tuple_to_list(M0)))));
- _ -> M0
- end,
- case is_function(TM,1) of
- true ->
- case (catch TM(M)) of
- true ->
- ?t:format("Got: ~p~n", [M]),
- collect(TMs);
- _ ->
- ?t:format("Got unexpected: ~p~n", [M]),
- flush({got_unexpected,M})
- end;
-
- false ->
- case M of
- TM ->
- ?t:format("Got: ~p~n", [M]),
- collect(TMs);
- _ ->
- ?t:format("Got unexpected: ~p~n", [M]),
- flush({got_unexpected,M})
- end
- end
+ M0 ->
+ M = case element(1, M0) of
+ trace_ts ->
+ list_to_tuple(lists:reverse(
+ tl(lists:reverse(tuple_to_list(M0)))));
+ _ -> M0
+ end,
+ case is_function(TM,1) of
+ true ->
+ case (catch TM(M)) of
+ true ->
+ io:format("Got: ~p~n", [M]),
+ collect(TMs);
+ _ ->
+ io:format("Got unexpected: ~p~n", [M]),
+ flush({got_unexpected,M})
+ end;
+
+ false ->
+ case M of
+ TM ->
+ io:format("Got: ~p~n", [M]),
+ collect(TMs);
+ _ ->
+ io:format("Got unexpected: ~p~n", [M]),
+ flush({got_unexpected,M})
+ end
+ end
end.
flush(Reason) ->
receive
- M ->
- ?t:format("In queue: ~p~n", [M]),
- flush(Reason)
+ M ->
+ io:format("In queue: ~p~n", [M]),
+ flush(Reason)
after 17 ->
- ?t:fail(Reason)
+ ct:fail(Reason)
end.
start_collect(P) ->
@@ -1071,33 +952,33 @@ stop_collect(P) ->
stop_collect(P, Order) ->
P ! {Order, self()},
receive
- {gone, P} ->
- ok
+ {gone, P} ->
+ ok
end.
runner(Collector, Fun) ->
receive
- {go, Collector} ->
- go
+ {go, Collector} ->
+ go
end,
Fun(),
receive
- {done, Collector} ->
- Collector ! {gone, self()}
+ {done, Collector} ->
+ Collector ! {gone, self()}
end.
loop_runner(Collector, Fun, Laps) ->
receive
- {go, Collector} ->
- go
+ {go, Collector} ->
+ go
end,
loop_runner_cont(Collector, Fun, 0, Laps).
loop_runner_cont(Collector, _Fun, Laps, Laps) ->
receive
- {done, Collector} -> ok;
- {abort, Collector} -> ok
+ {done, Collector} -> ok;
+ {abort, Collector} -> ok
end,
io:format("loop_runner ~p exit after ~p laps\n", [self(), Laps]),
Collector ! {gone, self()};
@@ -1105,11 +986,11 @@ loop_runner_cont(Collector, _Fun, Laps, Laps) ->
loop_runner_cont(Collector, Fun, N, Laps) ->
Fun(),
receive
- {abort, Collector} ->
- io:format("loop_runner ~p aborted after ~p of ~p laps\n", [self(), N+1, Laps]),
- Collector ! {gone, self()}
+ {abort, Collector} ->
+ io:format("loop_runner ~p aborted after ~p of ~p laps\n", [self(), N+1, Laps]),
+ Collector ! {gone, self()}
after 0 ->
- loop_runner_cont(Collector, Fun, N+1, Laps)
+ loop_runner_cont(Collector, Fun, N+1, Laps)
end.
@@ -1141,7 +1022,7 @@ start_node(Name) ->
Pa = filename:dirname(code:which(?MODULE)),
Cookie = atom_to_list(erlang:get_cookie()),
test_server:start_node(Name, slave,
- [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]).
+ [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]).
stop_node(Node) ->
test_server:stop_node(Node).
diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl
new file mode 100644
index 0000000000..12c42d24aa
--- /dev/null
+++ b/erts/emulator/test/message_queue_data_SUITE.erl
@@ -0,0 +1,213 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(message_queue_data_SUITE).
+
+-export([all/0, suite/0]).
+-export([basic/1, process_info_messages/1]).
+
+-export([basic_test/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
+
+all() ->
+ [basic, process_info_messages].
+
+%%
+%%
+%% Test cases
+%%
+%%
+
+basic(Config) when is_list(Config) ->
+
+ basic_test(erlang:system_info(message_queue_data)),
+
+ {ok, Node1} = start_node(Config, "+xmqd off_heap"),
+ ok = rpc:call(Node1, ?MODULE, basic_test, [off_heap]),
+ stop_node(Node1),
+
+ {ok, Node2} = start_node(Config, "+xmqd on_heap"),
+ ok = rpc:call(Node2, ?MODULE, basic_test, [on_heap]),
+ stop_node(Node2),
+
+ {ok, Node3} = start_node(Config, "+xmqd mixed"),
+ ok = rpc:call(Node3, ?MODULE, basic_test, [mixed]),
+ stop_node(Node3),
+
+ ok.
+
+is_valid_mqd_value(off_heap) ->
+ true;
+is_valid_mqd_value(on_heap) ->
+ true;
+is_valid_mqd_value(mixed) ->
+ true;
+is_valid_mqd_value(_) ->
+ false.
+
+
+basic_test(Default) ->
+
+ Default = erlang:system_info(message_queue_data),
+ true = is_valid_mqd_value(Default),
+
+ {message_queue_data, Default} = process_info(self(), message_queue_data),
+ Default = process_flag(message_queue_data, off_heap),
+ {message_queue_data, off_heap} = process_info(self(), message_queue_data),
+ off_heap = process_flag(message_queue_data, on_heap),
+ {message_queue_data, on_heap} = process_info(self(), message_queue_data),
+ on_heap = process_flag(message_queue_data, mixed),
+ {message_queue_data, mixed} = process_info(self(), message_queue_data),
+ mixed = process_flag(message_queue_data, Default),
+ {'EXIT', _} = (catch process_flag(message_queue_data, blupp)),
+
+ P1 = spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link]),
+ {message_queue_data, Default} = process_info(P1, message_queue_data),
+ unlink(P1),
+ exit(P1, bye),
+
+ P2 = spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link, {message_queue_data, off_heap}]),
+ {message_queue_data, off_heap} = process_info(P2, message_queue_data),
+ unlink(P2),
+ exit(P2, bye),
+
+ P3 = spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link, {message_queue_data, on_heap}]),
+ {message_queue_data, on_heap} = process_info(P3, message_queue_data),
+ unlink(P3),
+ exit(P3, bye),
+
+ P4 = spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link, {message_queue_data, mixed}]),
+ {message_queue_data, mixed} = process_info(P4, message_queue_data),
+ unlink(P4),
+ exit(P4, bye),
+
+ {'EXIT', _} = (catch spawn_opt(fun () -> receive after infinity -> ok end end,
+ [link, {message_queue_data, blapp}])),
+
+ ok.
+
+process_info_messages(Config) when is_list(Config) ->
+ Tester = self(),
+ P1 = spawn_opt(fun () ->
+ receive after 500 -> ok end,
+ mixed = process_flag(message_queue_data, off_heap),
+ Tester ! first,
+ receive after 500 -> ok end,
+ off_heap = process_flag(message_queue_data, on_heap),
+ Tester ! second,
+ receive after 500 -> ok end,
+ on_heap = process_flag(message_queue_data, mixed),
+ Tester ! third,
+ receive after 500 -> ok end,
+ mixed = process_flag(message_queue_data, off_heap),
+ Tester ! fourth,
+
+ receive after infinity -> ok end
+ end,
+ [link, {message_queue_data, mixed}]),
+
+ P1 ! "A",
+ receive first -> ok end,
+ P1 ! "B",
+ receive second -> ok end,
+ P1 ! "C",
+ receive third -> ok end,
+ P1 ! "D",
+ receive fourth -> ok end,
+ P1 ! "E",
+
+ {messages, ["A", "B", "C", "D", "E"]} = process_info(P1, messages),
+
+ P2 = spawn_opt(fun () ->
+ receive after 500 -> ok end,
+ mixed = process_flag(message_queue_data, off_heap),
+ Tester ! first,
+ receive after 500 -> ok end,
+ off_heap = process_flag(message_queue_data, on_heap),
+ Tester ! second,
+ receive after 500 -> ok end,
+ on_heap = process_flag(message_queue_data, mixed),
+ Tester ! third,
+ receive after 500 -> ok end,
+ mixed = process_flag(message_queue_data, off_heap),
+ Tester ! fourth,
+ receive after 500 -> ok end,
+
+ Tester ! process_info(self(), messages),
+
+ receive M1 -> M1 = "A" end,
+ receive M2 -> M2 = "B" end,
+ receive M3 -> M3 = "C" end,
+ receive M4 -> M4 = "D" end,
+ receive M5 -> M5 = "E" end,
+
+ Tester ! self()
+ end,
+ [link, {message_queue_data, mixed}]),
+
+ P2 ! "A",
+ receive first -> ok end,
+ P2 ! "B",
+ receive second -> ok end,
+ P2 ! "C",
+ receive third -> ok end,
+ P2 ! "D",
+ receive fourth -> ok end,
+ P2 ! "E",
+
+ receive
+ Msg ->
+ {messages, ["A", "B", "C", "D", "E"]} = Msg
+ end,
+
+ receive P2 -> ok end,
+
+ ok.
+
+%%
+%%
+%% helpers
+%%
+%%
+
+start_node(Config) ->
+ start_node(Config, []).
+start_node(Config, Opts) when is_list(Config), is_list(Opts) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ Name = list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive]))),
+ test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
+
+stop_node(Node) ->
+ test_server:stop_node(Node).
diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl
index 7c2101ca05..f8208c5866 100644
--- a/erts/emulator/test/module_info_SUITE.erl
+++ b/erts/emulator/test/module_info_SUITE.erl
@@ -20,11 +20,9 @@
-module(module_info_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
+-export([all/0, suite/0,
exports/1,functions/1,deleted/1,native/1,info/1]).
%%-compile(native).
@@ -32,46 +30,23 @@
%% Helper.
-export([native_proj/1,native_filter/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 3}}].
all() ->
modules().
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
modules() ->
[exports, functions, deleted, native, info].
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:minutes(3)),
- [{watchdog,Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
%% Should return all functions exported from this module. (local)
all_exported() ->
All = add_arity(modules()),
- lists:sort([{all,0},{suite,0},{groups,0},
- {init_per_suite,1},{end_per_suite,1},
- {init_per_group,2},{end_per_group,2},
- {init_per_testcase,2},{end_per_testcase,2},
- {module_info,0},{module_info,1},{native_proj,1},
- {native_filter,1}|All]).
+ lists:sort([{all,0},{suite,0},
+ {module_info,0},{module_info,1},
+ {native_proj,1},
+ {native_filter,1}|All]).
%% Should return all functions in this module. (local)
all_functions() ->
@@ -95,7 +70,7 @@ functions(Config) when is_list(Config) ->
%% Test that deleted modules cause badarg
deleted(Config) when is_list(Config) ->
- Data = ?config(data_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
File = filename:join(Data, "module_info_test"),
{ok,module_info_test,Code} = compile:file(File, [binary]),
{module,module_info_test} = erlang:load_module(module_info_test, Code),
diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl
index 4db17969c0..82e3a36c1e 100644
--- a/erts/emulator/test/monitor_SUITE.erl
+++ b/erts/emulator/test/monitor_SUITE.erl
@@ -20,21 +20,20 @@
-module(monitor_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- case_1/1, case_1a/1, case_2/1, case_2a/1, mon_e_1/1, demon_e_1/1, demon_1/1,
- demon_2/1, demon_3/1, demonitor_flush/1,
- local_remove_monitor/1, remote_remove_monitor/1, mon_1/1, mon_2/1,
- large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1,
- monitor_time_offset/1]).
-
--export([init_per_testcase/2, end_per_testcase/2]).
+-export([all/0, suite/0, groups/0,
+ case_1/1, case_1a/1, case_2/1, case_2a/1, mon_e_1/1, demon_e_1/1, demon_1/1,
+ demon_2/1, demon_3/1, demonitor_flush/1,
+ local_remove_monitor/1, remote_remove_monitor/1, mon_1/1, mon_2/1,
+ large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1,
+ monitor_time_offset/1]).
-export([y2/1, g/1, g0/0, g1/0, large_exit_sub/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 15}}].
all() ->
[case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1,
@@ -47,132 +46,103 @@ groups() ->
[{remove_monitor, [],
[local_remove_monitor, remote_remove_monitor]}].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(15)),
- [{watchdog, Dog},{testcase, Func}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-case_1(doc) ->
- "A monitors B, B kills A and then exits (yielded core dump)";
-case_1(suite) -> [];
+%% A monitors B, B kills A and then exits (yielded core dump)
case_1(Config) when is_list(Config) ->
- ?line process_flag(trap_exit, true),
- ?line spawn_link(?MODULE, g0, []),
- ?line receive _ -> ok end,
+ process_flag(trap_exit, true),
+ spawn_link(?MODULE, g0, []),
+ receive _ -> ok end,
ok.
-case_1a(doc) ->
- "A monitors B, B kills A and then exits (yielded core dump)";
+%% A monitors B, B kills A and then exits (yielded core dump)
case_1a(Config) when is_list(Config) ->
- ?line process_flag(trap_exit, true),
- ?line spawn_link(?MODULE, g1, []),
- ?line receive _ -> ok end,
+ process_flag(trap_exit, true),
+ spawn_link(?MODULE, g1, []),
+ receive _ -> ok end,
ok.
g0() ->
- ?line B = spawn(?MODULE, g, [self()]),
- ?line erlang:monitor(process, B),
- ?line B ! ok,
- ?line receive ok -> ok end,
+ B = spawn(?MODULE, g, [self()]),
+ erlang:monitor(process, B),
+ B ! ok,
+ receive ok -> ok end,
ok.
g1() ->
- ?line {B,_} = spawn_monitor(?MODULE, g, [self()]),
- ?line B ! ok,
- ?line receive ok -> ok end,
+ {B,_} = spawn_monitor(?MODULE, g, [self()]),
+ B ! ok,
+ receive ok -> ok end,
ok.
g(Parent) ->
- ?line receive ok -> ok end,
- ?line exit(Parent, foo),
- ?line ok.
+ receive ok -> ok end,
+ exit(Parent, foo),
+ ok.
-case_2(doc) ->
- "A monitors B, B demonitors A (yielded core dump)";
+%% A monitors B, B demonitors A (yielded core dump)
case_2(Config) when is_list(Config) ->
- ?line B = spawn(?MODULE, y2, [self()]),
- ?line R = erlang:monitor(process, B),
- ?line B ! R,
- ?line receive
- {'EXIT', _} -> ok;
- Other ->
- test_server:fail({rec, Other})
- end,
- ?line expect_down(R, B, normal),
+ B = spawn(?MODULE, y2, [self()]),
+ R = erlang:monitor(process, B),
+ B ! R,
+ receive
+ {'EXIT', _} -> ok;
+ Other ->
+ ct:fail({rec, Other})
+ end,
+ expect_down(R, B, normal),
ok.
-case_2a(doc) ->
- "A monitors B, B demonitors A (yielded core dump)";
+%% A monitors B, B demonitors A (yielded core dump)
case_2a(Config) when is_list(Config) ->
- ?line {B,R} = spawn_monitor(?MODULE, y2, [self()]),
- ?line B ! R,
- ?line receive
- {'EXIT', _} -> ok;
- Other ->
- test_server:fail({rec, Other})
- end,
- ?line expect_down(R, B, normal),
+ {B,R} = spawn_monitor(?MODULE, y2, [self()]),
+ B ! R,
+ receive
+ {'EXIT', _} -> ok;
+ Other ->
+ ct:fail({rec, Other})
+ end,
+ expect_down(R, B, normal),
ok.
y2(Parent) ->
- ?line R = receive T -> T end,
- ?line Parent ! (catch erlang:demonitor(R)),
+ R = receive T -> T end,
+ Parent ! (catch erlang:demonitor(R)),
ok.
expect_down(Ref, P) ->
receive
- {'DOWN', Ref, process, P, Reason} ->
- Reason;
- Other ->
- test_server:fail({rec, Other})
+ {'DOWN', Ref, process, P, Reason} ->
+ Reason;
+ Other ->
+ ct:fail({rec, Other})
end.
expect_down(Ref, P, Reason) ->
receive
- {'DOWN', Ref, process, P, Reason} ->
- ok;
- Other ->
- test_server:fail({rec, Other})
+ {'DOWN', Ref, process, P, Reason} ->
+ ok;
+ Other ->
+ ct:fail({rec, Other})
end.
expect_no_msg() ->
receive
- Msg ->
- test_server:fail({msg, Msg})
+ Msg ->
+ ct:fail({msg, Msg})
after 0 ->
- ok
+ ok
end.
%%% Error cases for monitor/2
-mon_e_1(doc) ->
- "Error cases for monitor/2";
-mon_e_1(suite) -> [];
mon_e_1(Config) when is_list(Config) ->
- ?line {ok, N} = test_server:start_node(hej, slave, []),
- ?line mon_error(plutt, self()),
- ?line mon_error(process, [bingo]),
- ?line mon_error(process, {rex, N, junk}),
- ?line mon_error(process, 1),
+ {ok, N} = test_server:start_node(hej, slave, []),
+ mon_error(plutt, self()),
+ mon_error(process, [bingo]),
+ mon_error(process, {rex, N, junk}),
+ mon_error(process, 1),
- ?line true = test_server:stop_node(N),
+ true = test_server:stop_node(N),
ok.
%%% We would also like to have a test case that tries to monitor something
@@ -185,155 +155,142 @@ mon_e_1(Config) when is_list(Config) ->
mon_error(Type, Item) ->
case catch erlang:monitor(Type, Item) of
- {'EXIT', _} ->
- ok;
- Other ->
- test_server:fail({err, Other})
+ {'EXIT', _} ->
+ ok;
+ Other ->
+ ct:fail({err, Other})
end.
%%% Error cases for demonitor/1
-demon_e_1(doc) ->
- "Error cases for demonitor/1";
-demon_e_1(suite) -> [];
demon_e_1(Config) when is_list(Config) ->
- ?line {ok, N} = test_server:start_node(hej, slave, []),
- ?line demon_error(plutt, badarg),
- ?line demon_error(1, badarg),
+ {ok, N} = test_server:start_node(hej, slave, []),
+ demon_error(plutt, badarg),
+ demon_error(1, badarg),
%% Demonitor with ref created at other node
- ?line R1 = rpc:call(N, erlang, make_ref, []),
- ?line demon_error(R1, badarg),
+ R1 = rpc:call(N, erlang, make_ref, []),
+ demon_error(R1, badarg),
%% Demonitor with ref created at wrong monitor link end
- ?line P0 = self(),
- ?line P2 = spawn(
- fun() ->
- P0 ! {self(), ref, erlang:monitor(process,P0)},
- receive {P0, stop} -> ok end
- end ),
- ?line receive
- {P2, ref, R2} ->
- ?line demon_error(R2, badarg),
- ?line P2 ! {self(), stop};
- Other2 ->
- test_server:fail({rec, Other2})
- end,
-
- ?line true = test_server:stop_node(N),
+ P0 = self(),
+ P2 = spawn(
+ fun() ->
+ P0 ! {self(), ref, erlang:monitor(process,P0)},
+ receive {P0, stop} -> ok end
+ end ),
+ receive
+ {P2, ref, R2} ->
+ demon_error(R2, badarg),
+ P2 ! {self(), stop};
+ Other2 ->
+ ct:fail({rec, Other2})
+ end,
+
+ true = test_server:stop_node(N),
ok.
demon_error(Ref, Reason) ->
case catch erlang:demonitor(Ref) of
- {'EXIT', {Reason, _}} ->
- ok;
- Other ->
- test_server:fail({err, Other})
+ {'EXIT', {Reason, _}} ->
+ ok;
+ Other ->
+ ct:fail({err, Other})
end.
%%% No-op cases for demonitor/1
-demon_1(doc) ->
- "demonitor/1";
-demon_1(suite) -> [];
demon_1(Config) when is_list(Config) ->
- ?line true = erlang:demonitor(make_ref()),
+ true = erlang:demonitor(make_ref()),
ok.
%%% Cases for demonitor/1
-demon_2(doc) ->
- "Cases for demonitor/1";
-demon_2(suite) -> [];
demon_2(Config) when is_list(Config) ->
- ?line R1 = erlang:monitor(process, self()),
- ?line true = erlang:demonitor(R1),
+ R1 = erlang:monitor(process, self()),
+ true = erlang:demonitor(R1),
%% Extra demonitor
- ?line true = erlang:demonitor(R1),
- ?line expect_no_msg(),
+ true = erlang:demonitor(R1),
+ expect_no_msg(),
%% Normal 'DOWN'
- ?line P2 = spawn(timer, sleep, [1]),
- ?line R2 = erlang:monitor(process, P2),
- ?line case expect_down(R2, P2) of
- normal -> ?line ok;
- noproc -> ?line ok;
- BadReason -> ?line ?t:fail({bad_reason, BadReason})
- end,
-
-%% OTP-5772
-% %% 'DOWN' before demonitor
-% ?line P3 = spawn(timer, sleep, [100000]),
-% ?line R3 = erlang:monitor(process, P3),
-% ?line exit(P3, frop),
-% ?line erlang:demonitor(R3),
-% ?line expect_down(R3, P3, frop),
+ P2 = spawn(timer, sleep, [1]),
+ R2 = erlang:monitor(process, P2),
+ case expect_down(R2, P2) of
+ normal -> ok;
+ noproc -> ok;
+ BadReason -> ct:fail({bad_reason, BadReason})
+ end,
+
+ %% OTP-5772
+ % %% 'DOWN' before demonitor
+ % P3 = spawn(timer, sleep, [100000]),
+ % R3 = erlang:monitor(process, P3),
+ % exit(P3, frop),
+ % erlang:demonitor(R3),
+ % expect_down(R3, P3, frop),
%% Demonitor before 'DOWN'
- ?line P4 = spawn(timer, sleep, [100000]),
- ?line R4 = erlang:monitor(process, P4),
- ?line erlang:demonitor(R4),
- ?line exit(P4, frop),
- ?line expect_no_msg(),
+ P4 = spawn(timer, sleep, [100000]),
+ R4 = erlang:monitor(process, P4),
+ erlang:demonitor(R4),
+ exit(P4, frop),
+ expect_no_msg(),
ok.
-demon_3(doc) ->
- "Distributed case for demonitor/1 (OTP-3499)";
-demon_3(suite) -> [];
+%% Distributed case for demonitor/1 (OTP-3499)
demon_3(Config) when is_list(Config) ->
- ?line {ok, N} = test_server:start_node(hej, slave, []),
+ {ok, N} = test_server:start_node(hej, slave, []),
%% 'DOWN' before demonitor
- ?line P2 = spawn(N, timer, sleep, [100000]),
- ?line R2 = erlang:monitor(process, P2),
- ?line true = test_server:stop_node(N),
- ?line true = erlang:demonitor(R2),
- ?line expect_down(R2, P2, noconnection),
+ P2 = spawn(N, timer, sleep, [100000]),
+ R2 = erlang:monitor(process, P2),
+ true = test_server:stop_node(N),
+ true = erlang:demonitor(R2),
+ expect_down(R2, P2, noconnection),
- ?line {ok, N2} = test_server:start_node(hej, slave, []),
+ {ok, N2} = test_server:start_node(hej, slave, []),
%% Demonitor before 'DOWN'
- ?line P3 = spawn(N2, timer, sleep, [100000]),
- ?line R3 = erlang:monitor(process, P3),
- ?line true = erlang:demonitor(R3),
- ?line true = test_server:stop_node(N2),
- ?line expect_no_msg(),
+ P3 = spawn(N2, timer, sleep, [100000]),
+ R3 = erlang:monitor(process, P3),
+ true = erlang:demonitor(R3),
+ true = test_server:stop_node(N2),
+ expect_no_msg(),
ok.
-demonitor_flush(suite) -> [];
-demonitor_flush(doc) -> [];
demonitor_flush(Config) when is_list(Config) ->
- ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), flush)),
- ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), [flus])),
- ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(x, [flush])),
- ?line {ok, N} = test_server:start_node(demonitor_flush, slave, []),
- ?line ok = demonitor_flush_test(N),
- ?line true = test_server:stop_node(N),
- ?line ok = demonitor_flush_test(node()).
-
+ {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), flush)),
+ {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), [flus])),
+ {'EXIT', {badarg, _}} = (catch erlang:demonitor(x, [flush])),
+ {ok, N} = test_server:start_node(demonitor_flush, slave, []),
+ ok = demonitor_flush_test(N),
+ true = test_server:stop_node(N),
+ ok = demonitor_flush_test(node()).
+
demonitor_flush_test(Node) ->
- ?line P = spawn(Node, timer, sleep, [100000]),
- ?line M1 = erlang:monitor(process, P),
- ?line M2 = erlang:monitor(process, P),
- ?line M3 = erlang:monitor(process, P),
- ?line M4 = erlang:monitor(process, P),
- ?line true = erlang:demonitor(M1, [flush, flush]),
- ?line exit(P, bang),
- ?line receive {'DOWN', M2, process, P, bang} -> ok end,
- ?line receive after 100 -> ok end,
- ?line true = erlang:demonitor(M3, [flush]),
- ?line true = erlang:demonitor(M4, []),
- ?line receive {'DOWN', M4, process, P, bang} -> ok end,
- ?line receive
- {'DOWN', M, _, _, _} =DM when M == M1,
- M == M3 ->
- ?line ?t:fail({unexpected_down_message, DM})
- after 100 ->
- ?line ok
- end.
+ P = spawn(Node, timer, sleep, [100000]),
+ M1 = erlang:monitor(process, P),
+ M2 = erlang:monitor(process, P),
+ M3 = erlang:monitor(process, P),
+ M4 = erlang:monitor(process, P),
+ true = erlang:demonitor(M1, [flush, flush]),
+ exit(P, bang),
+ receive {'DOWN', M2, process, P, bang} -> ok end,
+ receive after 100 -> ok end,
+ true = erlang:demonitor(M3, [flush]),
+ true = erlang:demonitor(M4, []),
+ receive {'DOWN', M4, process, P, bang} -> ok end,
+ receive
+ {'DOWN', M, _, _, _} =DM when M == M1,
+ M == M3 ->
+ ct:fail({unexpected_down_message, DM})
+ after 100 ->
+ ok
+ end.
-define(RM_MON_GROUPS, 100).
-define(RM_MON_GPROCS, 100).
@@ -341,33 +298,33 @@ demonitor_flush_test(Node) ->
local_remove_monitor(Config) when is_list(Config) ->
Gs = generate(fun () -> start_remove_monitor_group(node()) end,
- ?RM_MON_GROUPS),
+ ?RM_MON_GROUPS),
{True, False} = lists:foldl(fun (G, {T, F}) ->
- receive
- {rm_mon_res, G, {GT, GF}} ->
- {T+GT, F+GF}
- end
- end,
- {0, 0},
- Gs),
+ receive
+ {rm_mon_res, G, {GT, GF}} ->
+ {T+GT, F+GF}
+ end
+ end,
+ {0, 0},
+ Gs),
erlang:display({local_remove_monitor, True, False}),
{comment,
"True = "++integer_to_list(True)++"; False = "++integer_to_list(False)}.
-
+
remote_remove_monitor(Config) when is_list(Config) ->
- ?line {ok, N} = test_server:start_node(demonitor_flush, slave, []),
+ {ok, N} = test_server:start_node(demonitor_flush, slave, []),
Gs = generate(fun () -> start_remove_monitor_group(node()) end,
- ?RM_MON_GROUPS),
+ ?RM_MON_GROUPS),
{True, False} = lists:foldl(fun (G, {T, F}) ->
- receive
- {rm_mon_res, G, {GT, GF}} ->
- {T+GT, F+GF}
- end
- end,
- {0, 0},
- Gs),
+ receive
+ {rm_mon_res, G, {GT, GF}} ->
+ {T+GT, F+GF}
+ end
+ end,
+ {0, 0},
+ Gs),
erlang:display({remote_remove_monitor, True, False}),
- ?line true = test_server:stop_node(N),
+ true = test_server:stop_node(N),
{comment,
"True = "++integer_to_list(True)++"; False = "++integer_to_list(False)}.
@@ -375,161 +332,153 @@ start_remove_monitor_group(Node) ->
Master = self(),
spawn_link(
fun () ->
- Ms = generate(fun () ->
- P = spawn(Node, fun () -> ok end),
- erlang:monitor(process, P)
- end, ?RM_MON_GPROCS),
- Res = lists:foldl(fun (M, {T, F}) ->
- case erlang:demonitor(M, [info]) of
- true ->
- receive
- {'DOWN', M, _, _, _} ->
- exit(down_msg_found)
- after 0 ->
- ok
- end,
- {T+1, F};
- false ->
- receive
- {'DOWN', M, _, _, _} ->
- ok
- after 0 ->
- exit(no_down_msg_found)
- end,
- {T, F+1}
- end
- end,
- {0,0},
- Ms),
- Master ! {rm_mon_res, self(), Res}
+ Ms = generate(fun () ->
+ P = spawn(Node, fun () -> ok end),
+ erlang:monitor(process, P)
+ end, ?RM_MON_GPROCS),
+ Res = lists:foldl(fun (M, {T, F}) ->
+ case erlang:demonitor(M, [info]) of
+ true ->
+ receive
+ {'DOWN', M, _, _, _} ->
+ exit(down_msg_found)
+ after 0 ->
+ ok
+ end,
+ {T+1, F};
+ false ->
+ receive
+ {'DOWN', M, _, _, _} ->
+ ok
+ after 0 ->
+ exit(no_down_msg_found)
+ end,
+ {T, F+1}
+ end
+ end,
+ {0,0},
+ Ms),
+ Master ! {rm_mon_res, self(), Res}
end).
-
-
+
+
%%% Cases for monitor/2
-mon_1(doc) ->
- "Cases for monitor/2";
-mon_1(suite) -> [];
mon_1(Config) when is_list(Config) ->
%% Normal case
- ?line P2 = spawn(timer, sleep, [1]),
- ?line R2 = erlang:monitor(process, P2),
- ?line case expect_down(R2, P2) of
- normal -> ?line ok;
- noproc -> ?line ok;
- BadReason -> ?line ?t:fail({bad_reason, BadReason})
- end,
- ?line {P2A,R2A} = spawn_monitor(timer, sleep, [1]),
- ?line expect_down(R2A, P2A, normal),
+ P2 = spawn(timer, sleep, [1]),
+ R2 = erlang:monitor(process, P2),
+ case expect_down(R2, P2) of
+ normal -> ok;
+ noproc -> ok;
+ BadReason -> ct:fail({bad_reason, BadReason})
+ end,
+ {P2A,R2A} = spawn_monitor(timer, sleep, [1]),
+ expect_down(R2A, P2A, normal),
%% 'DOWN' with other reason
- ?line P3 = spawn(timer, sleep, [100000]),
- ?line R3 = erlang:monitor(process, P3),
- ?line exit(P3, frop),
- ?line expect_down(R3, P3, frop),
- ?line {P3A,R3A} = spawn_monitor(timer, sleep, [100000]),
- ?line exit(P3A, frop),
- ?line expect_down(R3A, P3A, frop),
+ P3 = spawn(timer, sleep, [100000]),
+ R3 = erlang:monitor(process, P3),
+ exit(P3, frop),
+ expect_down(R3, P3, frop),
+ {P3A,R3A} = spawn_monitor(timer, sleep, [100000]),
+ exit(P3A, frop),
+ expect_down(R3A, P3A, frop),
%% Monitor fails because process is dead
- ?line R4 = erlang:monitor(process, P3),
- ?line expect_down(R4, P3, noproc),
+ R4 = erlang:monitor(process, P3),
+ expect_down(R4, P3, noproc),
%% Normal case (named process)
- ?line P5 = start_jeeves(jeeves),
- ?line R5 = erlang:monitor(process, jeeves),
- ?line tell_jeeves(P5, stop),
- ?line expect_down(R5, {jeeves, node()}, normal),
+ P5 = start_jeeves(jeeves),
+ R5 = erlang:monitor(process, jeeves),
+ tell_jeeves(P5, stop),
+ expect_down(R5, {jeeves, node()}, normal),
%% 'DOWN' with other reason and node explicit activation
- ?line P6 = start_jeeves(jeeves),
- ?line R6 = erlang:monitor(process, {jeeves, node()}),
- ?line tell_jeeves(P6, {exit, frop}),
- ?line expect_down(R6, {jeeves, node()}, frop),
+ P6 = start_jeeves(jeeves),
+ R6 = erlang:monitor(process, {jeeves, node()}),
+ tell_jeeves(P6, {exit, frop}),
+ expect_down(R6, {jeeves, node()}, frop),
%% Monitor (named process) fails because process is dead
- ?line R7 = erlang:monitor(process, {jeeves, node()}),
- ?line expect_down(R7, {jeeves, node()}, noproc),
+ R7 = erlang:monitor(process, {jeeves, node()}),
+ expect_down(R7, {jeeves, node()}, noproc),
ok.
-mon_2(doc) ->
- "Distributed cases for monitor/2";
-mon_2(suite) -> [];
+%% Distributed cases for monitor/2
mon_2(Config) when is_list(Config) ->
- ?line {ok, N1} = test_server:start_node(hej1, slave, []),
+ {ok, N1} = test_server:start_node(hej1, slave, []),
%% Normal case
- ?line P2 = spawn(N1, timer, sleep, [4000]),
- ?line R2 = erlang:monitor(process, P2),
- ?line expect_down(R2, P2, normal),
+ P2 = spawn(N1, timer, sleep, [4000]),
+ R2 = erlang:monitor(process, P2),
+ expect_down(R2, P2, normal),
%% 'DOWN' with other reason
- ?line P3 = spawn(N1, timer, sleep, [100000]),
- ?line R3 = erlang:monitor(process, P3),
- ?line exit(P3, frop),
- ?line expect_down(R3, P3, frop),
+ P3 = spawn(N1, timer, sleep, [100000]),
+ R3 = erlang:monitor(process, P3),
+ exit(P3, frop),
+ expect_down(R3, P3, frop),
%% Monitor fails because process is dead
- ?line R4 = erlang:monitor(process, P3),
- ?line expect_down(R4, P3, noproc),
+ R4 = erlang:monitor(process, P3),
+ expect_down(R4, P3, noproc),
%% Other node goes down
- ?line P5 = spawn(N1, timer, sleep, [100000]),
- ?line R5 = erlang:monitor(process, P5),
+ P5 = spawn(N1, timer, sleep, [100000]),
+ R5 = erlang:monitor(process, P5),
- ?line true = test_server:stop_node(N1),
+ true = test_server:stop_node(N1),
- ?line expect_down(R5, P5, noconnection),
+ expect_down(R5, P5, noconnection),
%% Monitor fails because other node is dead
- ?line P6 = spawn(N1, timer, sleep, [100000]),
- ?line R6 = erlang:monitor(process, P6),
- ?line R6_Reason = expect_down(R6, P6),
- ?line true = (R6_Reason == noconnection) orelse (R6_Reason == noproc),
+ P6 = spawn(N1, timer, sleep, [100000]),
+ R6 = erlang:monitor(process, P6),
+ R6_Reason = expect_down(R6, P6),
+ true = (R6_Reason == noconnection) orelse (R6_Reason == noproc),
%% Start a new node that can load code in this module
- ?line PA = filename:dirname(code:which(?MODULE)),
- ?line {ok, N2} = test_server:start_node
- (hej2, slave, [{args, "-pa " ++ PA}]),
+ PA = filename:dirname(code:which(?MODULE)),
+ {ok, N2} = test_server:start_node
+ (hej2, slave, [{args, "-pa " ++ PA}]),
%% Normal case (named process)
- ?line P7 = start_jeeves({jeeves, N2}),
- ?line R7 = erlang:monitor(process, {jeeves, N2}),
- ?line tell_jeeves(P7, stop),
- ?line expect_down(R7, {jeeves, N2}, normal),
+ P7 = start_jeeves({jeeves, N2}),
+ R7 = erlang:monitor(process, {jeeves, N2}),
+ tell_jeeves(P7, stop),
+ expect_down(R7, {jeeves, N2}, normal),
%% 'DOWN' with other reason (named process)
- ?line P8 = start_jeeves({jeeves, N2}),
- ?line R8 = erlang:monitor(process, {jeeves, N2}),
- ?line tell_jeeves(P8, {exit, frop}),
- ?line expect_down(R8, {jeeves, N2}, frop),
+ P8 = start_jeeves({jeeves, N2}),
+ R8 = erlang:monitor(process, {jeeves, N2}),
+ tell_jeeves(P8, {exit, frop}),
+ expect_down(R8, {jeeves, N2}, frop),
%% Monitor (named process) fails because process is dead
- ?line R9 = erlang:monitor(process, {jeeves, N2}),
- ?line expect_down(R9, {jeeves, N2}, noproc),
+ R9 = erlang:monitor(process, {jeeves, N2}),
+ expect_down(R9, {jeeves, N2}, noproc),
%% Other node goes down (named process)
- ?line _P10 = start_jeeves({jeeves, N2}),
- ?line R10 = erlang:monitor(process, {jeeves, N2}),
+ _P10 = start_jeeves({jeeves, N2}),
+ R10 = erlang:monitor(process, {jeeves, N2}),
- ?line true = test_server:stop_node(N2),
+ true = test_server:stop_node(N2),
- ?line expect_down(R10, {jeeves, N2}, noconnection),
+ expect_down(R10, {jeeves, N2}, noconnection),
%% Monitor (named process) fails because other node is dead
- ?line R11 = erlang:monitor(process, {jeeves, N2}),
- ?line expect_down(R11, {jeeves, N2}, noconnection),
+ R11 = erlang:monitor(process, {jeeves, N2}),
+ expect_down(R11, {jeeves, N2}, noconnection),
ok.
%%% Large exit reason. Crashed first attempt to release R5B.
-large_exit(doc) ->
- "Large exit reason";
-large_exit(suite) -> [];
large_exit(Config) when is_list(Config) ->
- ?line f(100),
+ f(100),
ok.
f(0) ->
@@ -539,23 +488,23 @@ f(N) ->
f(N-1).
f() ->
- ?line S0 = {big, tuple, with, [list, 4563784278]},
- ?line S = {S0, term_to_binary(S0)},
- ?line P = spawn(?MODULE, large_exit_sub, [S]),
- ?line R = erlang:monitor(process, P),
- ?line P ! hej,
+ S0 = {big, tuple, with, [list, 4563784278]},
+ S = {S0, term_to_binary(S0)},
+ P = spawn(?MODULE, large_exit_sub, [S]),
+ R = erlang:monitor(process, P),
+ P ! hej,
receive
- {'DOWN', R, process, P, X} ->
- ?line io:format(" -> ~p~n", [X]),
- if
- X == S ->
- ok;
- true ->
- test_server:fail({X, S})
- end;
- Other ->
- ?line io:format(" -> ~p~n", [Other]),
- exit({answer, Other})
+ {'DOWN', R, process, P, X} ->
+ io:format(" -> ~p~n", [X]),
+ if
+ X == S ->
+ ok;
+ true ->
+ ct:fail({X, S})
+ end;
+ Other ->
+ io:format(" -> ~p~n", [Other]),
+ exit({answer, Other})
end.
large_exit_sub(S) ->
@@ -566,105 +515,99 @@ large_exit_sub(S) ->
%%% by using erlang:process_info(self(), monitors)
%%% and erlang:process_info(self(), monitored_by)
-list_cleanup(doc) ->
- "Testing of monitor link list cleanup by using " ++
- "erlang:process_info/2";
-list_cleanup(suite) -> [];
list_cleanup(Config) when is_list(Config) ->
- ?line P0 = self(),
- ?line M = node(),
- ?line PA = filename:dirname(code:which(?MODULE)),
- ?line true = register(master_bertie, self()),
+ P0 = self(),
+ M = node(),
+ PA = filename:dirname(code:which(?MODULE)),
+ true = register(master_bertie, self()),
%% Normal local case, monitor and demonitor
- ?line P1 = start_jeeves(jeeves),
- ?line {[], []} = monitors(),
- ?line expect_jeeves(P1, monitors, {monitors, {[], []}}),
- ?line R1a = erlang:monitor(process, P1),
- ?line {[{process, P1}], []} = monitors(),
- ?line expect_jeeves(P1, monitors, {monitors, {[], [P0]}}),
- ?line true = erlang:demonitor(R1a),
- ?line expect_no_msg(),
- ?line {[], []} = monitors(),
- ?line expect_jeeves(P1, monitors, {monitors, {[], []}}),
+ P1 = start_jeeves(jeeves),
+ {[], []} = monitors(),
+ expect_jeeves(P1, monitors, {monitors, {[], []}}),
+ R1a = erlang:monitor(process, P1),
+ {[{process, P1}], []} = monitors(),
+ expect_jeeves(P1, monitors, {monitors, {[], [P0]}}),
+ true = erlang:demonitor(R1a),
+ expect_no_msg(),
+ {[], []} = monitors(),
+ expect_jeeves(P1, monitors, {monitors, {[], []}}),
%% Remonitor named and try again, now exiting the monitored process
- ?line R1b = erlang:monitor(process, jeeves),
- ?line {[{process, {jeeves, M}}], []} = monitors(),
- ?line expect_jeeves(P1, monitors, {monitors, {[], [P0]}}),
- ?line tell_jeeves(P1, stop),
- ?line expect_down(R1b, {jeeves, node()}, normal),
- ?line {[], []} = monitors(),
+ R1b = erlang:monitor(process, jeeves),
+ {[{process, {jeeves, M}}], []} = monitors(),
+ expect_jeeves(P1, monitors, {monitors, {[], [P0]}}),
+ tell_jeeves(P1, stop),
+ expect_down(R1b, {jeeves, node()}, normal),
+ {[], []} = monitors(),
%% Slightly weird local case - the monitoring process crashes
- ?line P2 = start_jeeves(jeeves),
- ?line {[], []} = monitors(),
- ?line expect_jeeves(P2, monitors, {monitors, {[], []}}),
- ?line {monitor_process, _R2} =
- ask_jeeves(P2, {monitor_process, master_bertie}),
- ?line {[], [P2]} = monitors(),
- ?line expect_jeeves(P2, monitors,
- {monitors, {[{process, {master_bertie, node()}}], []}}),
- ?line tell_jeeves(P2, {exit, frop}),
+ P2 = start_jeeves(jeeves),
+ {[], []} = monitors(),
+ expect_jeeves(P2, monitors, {monitors, {[], []}}),
+ {monitor_process, _R2} =
+ ask_jeeves(P2, {monitor_process, master_bertie}),
+ {[], [P2]} = monitors(),
+ expect_jeeves(P2, monitors,
+ {monitors, {[{process, {master_bertie, node()}}], []}}),
+ tell_jeeves(P2, {exit, frop}),
timer:sleep(2000),
- ?line {[], []} = monitors(),
+ {[], []} = monitors(),
%% Start a new node that can load code in this module
- ?line {ok, J} = test_server:start_node
- (jeeves, slave, [{args, "-pa " ++ PA}]),
+ {ok, J} = test_server:start_node
+ (jeeves, slave, [{args, "-pa " ++ PA}]),
%% Normal remote case, monitor and demonitor
- ?line P3 = start_jeeves({jeeves, J}),
- ?line {[], []} = monitors(),
- ?line expect_jeeves(P3, monitors, {monitors, {[], []}}),
- ?line R3a = erlang:monitor(process, P3),
- ?line {[{process, P3}], []} = monitors(),
- ?line expect_jeeves(P3, monitors, {monitors, {[], [P0]}}),
- ?line true = erlang:demonitor(R3a),
- ?line expect_no_msg(),
- ?line {[], []} = monitors(),
- ?line expect_jeeves(P3, monitors, {monitors, {[], []}}),
+ P3 = start_jeeves({jeeves, J}),
+ {[], []} = monitors(),
+ expect_jeeves(P3, monitors, {monitors, {[], []}}),
+ R3a = erlang:monitor(process, P3),
+ {[{process, P3}], []} = monitors(),
+ expect_jeeves(P3, monitors, {monitors, {[], [P0]}}),
+ true = erlang:demonitor(R3a),
+ expect_no_msg(),
+ {[], []} = monitors(),
+ expect_jeeves(P3, monitors, {monitors, {[], []}}),
%% Remonitor named and try again, now exiting the monitored process
- ?line R3b = erlang:monitor(process, {jeeves, J}),
- ?line {[{process, {jeeves, J}}], []} = monitors(),
- ?line expect_jeeves(P3, monitors, {monitors, {[], [P0]}}),
- ?line tell_jeeves(P3, stop),
- ?line expect_down(R3b, {jeeves, J}, normal),
- ?line {[], []} = monitors(),
+ R3b = erlang:monitor(process, {jeeves, J}),
+ {[{process, {jeeves, J}}], []} = monitors(),
+ expect_jeeves(P3, monitors, {monitors, {[], [P0]}}),
+ tell_jeeves(P3, stop),
+ expect_down(R3b, {jeeves, J}, normal),
+ {[], []} = monitors(),
%% Slightly weird remote case - the monitoring process crashes
- ?line P4 = start_jeeves({jeeves, J}),
- ?line {[], []} = monitors(),
- ?line expect_jeeves(P4, monitors, {monitors, {[], []}}),
- ?line {monitor_process, _R4} =
- ask_jeeves(P4, {monitor_process, {master_bertie, M}}),
- ?line {[], [P4]} = monitors(),
- ?line expect_jeeves(P4, monitors,
- {monitors, {[{process, {master_bertie, M}}], []}} ),
- ?line tell_jeeves(P4, {exit, frop}),
+ P4 = start_jeeves({jeeves, J}),
+ {[], []} = monitors(),
+ expect_jeeves(P4, monitors, {monitors, {[], []}}),
+ {monitor_process, _R4} =
+ ask_jeeves(P4, {monitor_process, {master_bertie, M}}),
+ {[], [P4]} = monitors(),
+ expect_jeeves(P4, monitors,
+ {monitors, {[{process, {master_bertie, M}}], []}} ),
+ tell_jeeves(P4, {exit, frop}),
timer:sleep(2000),
- ?line {[], []} = monitors(),
-
+ {[], []} = monitors(),
+
%% Now, the monitoring remote node crashes
- ?line P5 = start_jeeves({jeeves, J}),
- ?line {[], []} = monitors(),
- ?line expect_jeeves(P5, monitors, {monitors, {[], []}}),
- ?line {monitor_process, _R5} =
- ask_jeeves(P5, {monitor_process, P0}),
- ?line {[], [P5]} = monitors(),
- ?line expect_jeeves(P5, monitors,
- {monitors, {[{process, P0}], []}} ),
- ?line test_server:stop_node(J),
+ P5 = start_jeeves({jeeves, J}),
+ {[], []} = monitors(),
+ expect_jeeves(P5, monitors, {monitors, {[], []}}),
+ {monitor_process, _R5} =
+ ask_jeeves(P5, {monitor_process, P0}),
+ {[], [P5]} = monitors(),
+ expect_jeeves(P5, monitors,
+ {monitors, {[{process, P0}], []}} ),
+ test_server:stop_node(J),
timer:sleep(4000),
- ?line {[], []} = monitors(),
-
- ?line true = unregister(master_bertie),
+ {[], []} = monitors(),
+
+ true = unregister(master_bertie),
ok.
-
+
%%% Mixed internal and external monitors
-mixer(doc) ->
- "Test mixing of internal and external monitors.";
mixer(Config) when is_list(Config) ->
PA = filename:dirname(code:which(?MODULE)),
NN = [j0,j1,j2],
@@ -748,115 +691,112 @@ mixer(Config) when is_list(Config) ->
[test_server:stop_node(K) || K <- NL0],
ok.
-named_down(doc) -> ["Test that DOWN message for a named monitor isn't"
- " delivered until name has been unregistered"];
-named_down(suite) -> [];
+%% Test that DOWN message for a named monitor isn't
+%% delivered until name has been unregistered
named_down(Config) when is_list(Config) ->
- ?line Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-named_down-"
- ++ integer_to_list(erlang:system_time(seconds))
- ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))),
- ?line Prio = process_flag(priority,high),
+ Name = list_to_atom(atom_to_list(?MODULE)
+ ++ "-named_down-"
+ ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))),
+ Prio = process_flag(priority,high),
%% Spawn a bunch of high prio cpu bound processes to prevent
%% normal prio processes from terminating during the next
%% 500 ms...
- ?line Self = self(),
- ?line spawn_opt(fun () ->
- WFun = fun
- (F, hej) -> F(F, hopp);
- (F, hopp) -> F(F, hej)
- end,
- NoSchedulers = erlang:system_info(schedulers_online),
- lists:foreach(fun (_) ->
- spawn_opt(fun () ->
- WFun(WFun,
- hej)
- end,
- [{priority,high},
- link])
- end,
- lists:seq(1, NoSchedulers)),
- receive after 500 -> ok end,
- unlink(Self),
- exit(bang)
- end,
- [{priority,high}, link]),
- ?line NamedProc = spawn_link(fun () ->
- receive after infinity -> ok end
- end),
- ?line true = register(Name, NamedProc),
- ?line unlink(NamedProc),
- ?line exit(NamedProc, bang),
- ?line Mon = erlang:monitor(process, Name),
- ?line receive {'DOWN',Mon, _, _, _} -> ok end,
- ?line true = register(Name, self()),
- ?line true = unregister(Name),
- ?line process_flag(priority,Prio),
+ Self = self(),
+ spawn_opt(fun () ->
+ WFun = fun
+ (F, hej) -> F(F, hopp);
+(F, hopp) -> F(F, hej)
+ end,
+ NoSchedulers = erlang:system_info(schedulers_online),
+ lists:foreach(fun (_) ->
+ spawn_opt(fun () ->
+ WFun(WFun,
+ hej)
+ end,
+ [{priority,high},
+ link])
+ end,
+ lists:seq(1, NoSchedulers)),
+ receive after 500 -> ok end,
+ unlink(Self),
+ exit(bang)
+ end,
+ [{priority,high}, link]),
+ NamedProc = spawn_link(fun () ->
+ receive after infinity -> ok end
+ end),
+ true = register(Name, NamedProc),
+ unlink(NamedProc),
+ exit(NamedProc, bang),
+ Mon = erlang:monitor(process, Name),
+ receive {'DOWN',Mon, _, _, _} -> ok end,
+ true = register(Name, self()),
+ true = unregister(Name),
+ process_flag(priority,Prio),
ok.
-otp_5827(doc) -> [];
-otp_5827(suite) -> [];
otp_5827(Config) when is_list(Config) ->
%% Make a pid with the same nodename but with another creation
- ?line [CreEnd | RPTail]
- = lists:reverse(binary_to_list(term_to_binary(self()))),
- ?line NewCreEnd = case CreEnd of
- 0 -> 1;
- 1 -> 2;
- _ -> CreEnd - 1
- end,
- ?line OtherCreationPid
- = binary_to_term(list_to_binary(lists:reverse([NewCreEnd | RPTail]))),
+ [CreEnd | RPTail]
+ = lists:reverse(binary_to_list(term_to_binary(self()))),
+ NewCreEnd = case CreEnd of
+ 0 -> 1;
+ 1 -> 2;
+ _ -> CreEnd - 1
+ end,
+ OtherCreationPid
+ = binary_to_term(list_to_binary(lists:reverse([NewCreEnd | RPTail]))),
%% If the bug is present erlang:monitor(process, OtherCreationPid)
%% will hang...
- ?line Parent = self(),
- ?line Ok = make_ref(),
- ?line spawn(fun () ->
- Mon = erlang:monitor(process, OtherCreationPid),
- % Should get the DOWN message right away
- receive
- {'DOWN', Mon, process, OtherCreationPid, noproc} ->
- Parent ! Ok
- end
- end),
- ?line receive
- Ok ->
- ?line ok
- after 1000 ->
- ?line ?t:fail("erlang:monitor/2 hangs")
- end.
+ Parent = self(),
+ Ok = make_ref(),
+ spawn(fun () ->
+ Mon = erlang:monitor(process, OtherCreationPid),
+ % Should get the DOWN message right away
+ receive
+ {'DOWN', Mon, process, OtherCreationPid, noproc} ->
+ Parent ! Ok
+ end
+ end),
+ receive
+ Ok ->
+ ok
+ after 1000 ->
+ ct:fail("erlang:monitor/2 hangs")
+ end.
monitor_time_offset(Config) when is_list(Config) ->
{ok, Node} = start_node(Config, "+C single_time_warp"),
Me = self(),
PMs = lists:map(fun (_) ->
- Pid = spawn(Node,
- fun () ->
- check_monitor_time_offset(Me)
- end),
- {Pid, erlang:monitor(process, Pid)}
- end,
- lists:seq(1, 100)),
+ Pid = spawn(Node,
+ fun () ->
+ check_monitor_time_offset(Me)
+ end),
+ {Pid, erlang:monitor(process, Pid)}
+ end,
+ lists:seq(1, 100)),
lists:foreach(fun ({P, _M}) ->
- P ! check_no_change_message
- end, PMs),
+ P ! check_no_change_message
+ end, PMs),
lists:foreach(fun ({P, M}) ->
- receive
- {no_change_message_received, P} ->
- ok;
- {'DOWN', M, process, P, Reason} ->
- ?t:fail(Reason)
- end
- end, PMs),
+ receive
+ {no_change_message_received, P} ->
+ ok;
+ {'DOWN', M, process, P, Reason} ->
+ ct:fail(Reason)
+ end
+ end, PMs),
preliminary = rpc:call(Node, erlang, system_flag, [time_offset, finalize]),
lists:foreach(fun ({P, M}) ->
- receive
- {change_messages_received, P} ->
- erlang:demonitor(M, [flush]);
- {'DOWN', M, process, P, Reason} ->
- ?t:fail(Reason)
- end
- end, PMs),
+ receive
+ {change_messages_received, P} ->
+ erlang:demonitor(M, [flush]);
+ {'DOWN', M, process, P, Reason} ->
+ ct:fail(Reason)
+ end
+ end, PMs),
stop_node(Node),
ok.
@@ -867,42 +807,42 @@ check_monitor_time_offset(Leader) ->
Mon4 = erlang:monitor(time_offset, clock_service),
erlang:demonitor(Mon2, [flush]),
-
+
Mon5 = erlang:monitor(time_offset, clock_service),
Mon6 = erlang:monitor(time_offset, clock_service),
Mon7 = erlang:monitor(time_offset, clock_service),
receive check_no_change_message -> ok end,
receive
- {'CHANGE', _, time_offset, clock_service, _} ->
- exit(unexpected_change_message_received)
+ {'CHANGE', _, time_offset, clock_service, _} ->
+ exit(unexpected_change_message_received)
after 0 ->
- Leader ! {no_change_message_received, self()}
+ Leader ! {no_change_message_received, self()}
end,
receive after 100 -> ok end,
erlang:demonitor(Mon4, [flush]),
receive
- {'CHANGE', Mon3, time_offset, clock_service, _} ->
- ok
+ {'CHANGE', Mon3, time_offset, clock_service, _} ->
+ ok
end,
receive
- {'CHANGE', Mon6, time_offset, clock_service, _} ->
- ok
+ {'CHANGE', Mon6, time_offset, clock_service, _} ->
+ ok
end,
erlang:demonitor(Mon5, [flush]),
receive
- {'CHANGE', Mon7, time_offset, clock_service, _} ->
- ok
+ {'CHANGE', Mon7, time_offset, clock_service, _} ->
+ ok
end,
receive
- {'CHANGE', Mon1, time_offset, clock_service, _} ->
- ok
+ {'CHANGE', Mon1, time_offset, clock_service, _} ->
+ ok
end,
receive
- {'CHANGE', _, time_offset, clock_service, _} ->
- exit(unexpected_change_message_received)
+ {'CHANGE', _, time_offset, clock_service, _} ->
+ exit(unexpected_change_message_received)
after 1000 ->
- ok
+ ok
end,
Leader ! {change_messages_received, self()}.
@@ -916,17 +856,17 @@ wait_for_m(Monitors, MonitoredBy, N) ->
{monitors,M0} = process_info(self(),monitors),
{monitored_by,MB0} = process_info(self(),monitored_by),
case lists:sort(M0) of
- Monitors ->
- case lists:sort(MB0) of
- MonitoredBy ->
- ok;
- _ ->
- receive after 100 -> ok end,
- wait_for_m(Monitors,MonitoredBy,N-1)
- end;
- _ ->
- receive after 100 -> ok end,
- wait_for_m(Monitors,MonitoredBy,N-1)
+ Monitors ->
+ case lists:sort(MB0) of
+ MonitoredBy ->
+ ok;
+ _ ->
+ receive after 100 -> ok end,
+ wait_for_m(Monitors,MonitoredBy,N-1)
+ end;
+ _ ->
+ receive after 100 -> ok end,
+ wait_for_m(Monitors,MonitoredBy,N-1)
end.
% All permutations of a list...
@@ -950,32 +890,32 @@ jeeves(Parent, Name, Ref)
when is_pid(Parent), (is_atom(Name) or (Name =:= [])), is_reference(Ref) ->
%%io:format("monitor_SUITE:jeeves(~p, ~p)~n", [Parent, Name]),
case Name of
- Atom when is_atom(Atom) ->
- register(Name, self());
- [] ->
- ok
+ Atom when is_atom(Atom) ->
+ register(Name, self());
+ [] ->
+ ok
end,
Parent ! {self(), Ref},
jeeves_loop(Parent).
jeeves_loop(Parent) ->
receive
- {Parent, monitors} ->
- Parent ! {self(), {monitors, monitors()}},
- jeeves_loop(Parent);
- {Parent, {monitor_process, P}} ->
- Parent ! {self(), {monitor_process,
- catch erlang:monitor(process, P) }},
- jeeves_loop(Parent);
- {Parent, {demonitor, Ref}} ->
- Parent ! {self(), {demonitor, catch erlang:demonitor(Ref)}},
- jeeves_loop(Parent);
- {Parent, stop} ->
- ok;
- {Parent, {exit, Reason}} ->
- exit(Reason);
- Other ->
- io:format("~p:jeeves_loop received ~p~n", [?MODULE, Other])
+ {Parent, monitors} ->
+ Parent ! {self(), {monitors, monitors()}},
+ jeeves_loop(Parent);
+ {Parent, {monitor_process, P}} ->
+ Parent ! {self(), {monitor_process,
+ catch erlang:monitor(process, P) }},
+ jeeves_loop(Parent);
+ {Parent, {demonitor, Ref}} ->
+ Parent ! {self(), {demonitor, catch erlang:demonitor(Ref)}},
+ jeeves_loop(Parent);
+ {Parent, stop} ->
+ ok;
+ {Parent, {exit, Reason}} ->
+ exit(Reason);
+ Other ->
+ io:format("~p:jeeves_loop received ~p~n", [?MODULE, Other])
end.
@@ -985,10 +925,10 @@ start_jeeves({Name, Node})
Ref = make_ref(),
Pid = spawn(Node, fun() -> jeeves(Parent, Name, Ref) end),
receive
- {Pid, Ref} ->
- ok;
- Other ->
- test_server:fail({rec, Other})
+ {Pid, Ref} ->
+ ok;
+ Other ->
+ ct:fail({rec, Other})
end,
Pid;
start_jeeves(Name) when is_atom(Name) ->
@@ -1002,20 +942,20 @@ tell_jeeves(Pid, What) when is_pid(Pid) ->
ask_jeeves(Pid, Request) when is_pid(Pid) ->
Pid ! {self(), Request},
receive
- {Pid, Response} ->
- Response;
- Other ->
- test_server:fail({rec, Other})
+ {Pid, Response} ->
+ Response;
+ Other ->
+ ct:fail({rec, Other})
end.
expect_jeeves(Pid, Request, Response) when is_pid(Pid) ->
Pid ! {self(), Request},
receive
- {Pid, Response} ->
- ok;
- Other ->
- test_server:fail({rec, Other})
+ {Pid, Response} ->
+ ok;
+ Other ->
+ ct:fail({rec, Other})
end.
@@ -1036,20 +976,20 @@ start_node(Config) ->
start_node(Config, "").
start_node(Config, Args) ->
- TestCase = ?config(testcase, Config),
+ TestCase = proplists:get_value(testcase, Config),
PA = filename:dirname(code:which(?MODULE)),
ESTime = erlang:monotonic_time(1) + erlang:time_offset(1),
Unique = erlang:unique_integer([positive]),
Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(TestCase)
- ++ "-"
- ++ integer_to_list(ESTime)
- ++ "-"
- ++ integer_to_list(Unique)),
+ ++ "-"
+ ++ atom_to_list(TestCase)
+ ++ "-"
+ ++ integer_to_list(ESTime)
+ ++ "-"
+ ++ integer_to_list(Unique)),
test_server:start_node(Name,
- slave,
- [{args, "-pa " ++ PA ++ " " ++ Args}]).
+ slave,
+ [{args, "-pa " ++ PA ++ " " ++ Args}]).
stop_node(Node) ->
test_server:stop_node(Node).
diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl
index 87dace4721..a17b11f3bf 100644
--- a/erts/emulator/test/mtx_SUITE.erl
+++ b/erts/emulator/test/mtx_SUITE.erl
@@ -29,9 +29,8 @@
-include_lib("common_test/include/ct.hrl").
--export([all/0,suite/0,groups/0,
- init_per_group/2,end_per_group/2, init_per_suite/1,
- end_per_suite/1, init_per_testcase/2, end_per_testcase/2]).
+-export([all/0,suite/0, init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2]).
-export([long_rwlock/1,
hammer_ets_rwlock/1,
@@ -56,8 +55,30 @@
hammer_sched_freqread_tryrwlock/1,
hammer_sched_freqread_tryrwlock_check/1]).
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 15}}].
+
+all() ->
+ [long_rwlock, hammer_rwlock_check, hammer_rwlock,
+ hammer_tryrwlock_check, hammer_tryrwlock,
+ hammer_ets_rwlock, hammer_sched_long_rwlock_check,
+ hammer_sched_long_rwlock,
+ hammer_sched_long_freqread_rwlock_check,
+ hammer_sched_long_freqread_rwlock,
+ hammer_sched_long_tryrwlock_check,
+ hammer_sched_long_tryrwlock,
+ hammer_sched_long_freqread_tryrwlock_check,
+ hammer_sched_long_freqread_tryrwlock,
+ hammer_sched_rwlock_check, hammer_sched_rwlock,
+ hammer_sched_freqread_rwlock_check,
+ hammer_sched_freqread_rwlock,
+ hammer_sched_tryrwlock_check, hammer_sched_tryrwlock,
+ hammer_sched_freqread_tryrwlock_check,
+ hammer_sched_freqread_tryrwlock].
+
init_per_suite(Config) when is_list(Config) ->
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
Lib = filename:join([DataDir, atom_to_list(?MODULE)]),
case {erlang:load_nif(Lib, none),erlang:system_info(threads)} of
{{error,_},false} ->
@@ -71,15 +92,13 @@ end_per_suite(Config) when is_list(Config) ->
Config.
init_per_testcase(_Case, Config) ->
- Dog = ?t:timetrap(?t:minutes(15)),
%% Wait for deallocations to complete since we measure
%% runtime in test cases.
wait_deallocations(),
- [{watchdog, Dog}|Config].
+ Config.
end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
+ ok.
wait_deallocations() ->
try
@@ -90,45 +109,15 @@ wait_deallocations() ->
wait_deallocations()
end.
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [long_rwlock, hammer_rwlock_check, hammer_rwlock,
- hammer_tryrwlock_check, hammer_tryrwlock,
- hammer_ets_rwlock, hammer_sched_long_rwlock_check,
- hammer_sched_long_rwlock,
- hammer_sched_long_freqread_rwlock_check,
- hammer_sched_long_freqread_rwlock,
- hammer_sched_long_tryrwlock_check,
- hammer_sched_long_tryrwlock,
- hammer_sched_long_freqread_tryrwlock_check,
- hammer_sched_long_freqread_tryrwlock,
- hammer_sched_rwlock_check, hammer_sched_rwlock,
- hammer_sched_freqread_rwlock_check,
- hammer_sched_freqread_rwlock,
- hammer_sched_tryrwlock_check, hammer_sched_tryrwlock,
- hammer_sched_freqread_tryrwlock_check,
- hammer_sched_freqread_tryrwlock].
-
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
long_rwlock(Config) when is_list(Config) ->
statistics(runtime),
LLRes = long_rw_test(),
{_, RunTime} = statistics(runtime),
%% A very short run time is expected, since
%% threads in the test mostly wait
- ?t:format("RunTime=~p~n", [RunTime]),
- ?line true = RunTime < 400,
- ?line RunTimeStr = "Run-time during test was "++integer_to_list(RunTime)++" ms.",
+ io:format("RunTime=~p~n", [RunTime]),
+ true = RunTime < 400,
+ RunTimeStr = "Run-time during test was "++integer_to_list(RunTime)++" ms.",
case LLRes of
ok ->
{comment, RunTimeStr};
@@ -198,100 +187,100 @@ hammer_sched_long_freqread_tryrwlock_check(Config) when is_list(Config) ->
hammer_sched_rwlock_test(FreqRead, LockCheck, Blocking, WaitLocked, WaitUnlocked) ->
case create_rwlock(FreqRead, LockCheck) of
- enotsup ->
- {skipped, "Not supported."};
- RWLock ->
- Onln = erlang:system_info(schedulers_online),
- NWPs = case Onln div 3 of
- 1 -> case Onln < 4 of
- true -> 1;
- false -> 2
- end;
- X -> X
- end,
- NRPs = Onln - NWPs,
- NoLockOps = ((((50000000 div Onln)
- div case {Blocking, WaitLocked} of
- {false, 0} -> 1;
- _ -> 10
- end)
- div (case WaitLocked == 0 of
- true -> 1;
- false -> WaitLocked*250
- end))
- div handicap()),
- ?t:format("NoLockOps=~p~n", [NoLockOps]),
- Sleep = case Blocking of
- true -> NoLockOps;
- false -> NoLockOps div 10
- end,
- WPs = lists:map(
- fun (Sched) ->
- spawn_opt(
- fun () ->
- io:format("Writer on scheduler ~p.~n",
- [Sched]),
- Sched = erlang:system_info(scheduler_id),
- receive go -> gone end,
- hammer_sched_rwlock_proc(RWLock,
- Blocking,
- true,
- WaitLocked,
- WaitUnlocked,
- NoLockOps,
- Sleep),
- Sched = erlang:system_info(scheduler_id)
- end,
- [link, {scheduler, Sched}])
- end,
- lists:seq(1, NWPs)),
- RPs = lists:map(
- fun (Sched) ->
- spawn_opt(
- fun () ->
- io:format("Reader on scheduler ~p.~n",
- [Sched]),
- Sched = erlang:system_info(scheduler_id),
- receive go -> gone end,
- hammer_sched_rwlock_proc(RWLock,
- Blocking,
- false,
- WaitLocked,
- WaitUnlocked,
- NoLockOps,
- Sleep),
- Sched = erlang:system_info(scheduler_id)
- end,
- [link, {scheduler, Sched}])
- end,
- lists:seq(NWPs + 1, NWPs + NRPs)),
- Procs = WPs ++ RPs,
- case {Blocking, WaitLocked} of
- {_, 0} -> ok;
- {false, _} -> ok;
- _ -> statistics(runtime)
- end,
- lists:foreach(fun (P) -> P ! go end, Procs),
- lists:foreach(fun (P) ->
- M = erlang:monitor(process, P),
- receive
- {'DOWN', M, process, P, _} ->
- ok
- end
- end,
- Procs),
- case {Blocking, WaitLocked} of
- {_, 0} -> ok;
- {false, _} -> ok;
- _ ->
- {_, RunTime} = statistics(runtime),
- ?t:format("RunTime=~p~n", [RunTime]),
- ?line true = RunTime < 700,
- {comment,
- "Run-time during test was "
- ++ integer_to_list(RunTime)
- ++ " ms."}
- end
+ enotsup ->
+ {skipped, "Not supported."};
+ RWLock ->
+ Onln = erlang:system_info(schedulers_online),
+ NWPs = case Onln div 3 of
+ 1 -> case Onln < 4 of
+ true -> 1;
+ false -> 2
+ end;
+ X -> X
+ end,
+ NRPs = Onln - NWPs,
+ NoLockOps = ((((50000000 div Onln)
+ div case {Blocking, WaitLocked} of
+ {false, 0} -> 1;
+ _ -> 10
+ end)
+ div (case WaitLocked == 0 of
+ true -> 1;
+ false -> WaitLocked*250
+ end))
+ div handicap()),
+ io:format("NoLockOps=~p~n", [NoLockOps]),
+ Sleep = case Blocking of
+ true -> NoLockOps;
+ false -> NoLockOps div 10
+ end,
+ WPs = lists:map(
+ fun (Sched) ->
+ spawn_opt(
+ fun () ->
+ io:format("Writer on scheduler ~p.~n",
+ [Sched]),
+ Sched = erlang:system_info(scheduler_id),
+ receive go -> gone end,
+ hammer_sched_rwlock_proc(RWLock,
+ Blocking,
+ true,
+ WaitLocked,
+ WaitUnlocked,
+ NoLockOps,
+ Sleep),
+ Sched = erlang:system_info(scheduler_id)
+ end,
+ [link, {scheduler, Sched}])
+ end,
+ lists:seq(1, NWPs)),
+ RPs = lists:map(
+ fun (Sched) ->
+ spawn_opt(
+ fun () ->
+ io:format("Reader on scheduler ~p.~n",
+ [Sched]),
+ Sched = erlang:system_info(scheduler_id),
+ receive go -> gone end,
+ hammer_sched_rwlock_proc(RWLock,
+ Blocking,
+ false,
+ WaitLocked,
+ WaitUnlocked,
+ NoLockOps,
+ Sleep),
+ Sched = erlang:system_info(scheduler_id)
+ end,
+ [link, {scheduler, Sched}])
+ end,
+ lists:seq(NWPs + 1, NWPs + NRPs)),
+ Procs = WPs ++ RPs,
+ case {Blocking, WaitLocked} of
+ {_, 0} -> ok;
+ {false, _} -> ok;
+ _ -> statistics(runtime)
+ end,
+ lists:foreach(fun (P) -> P ! go end, Procs),
+ lists:foreach(fun (P) ->
+ M = erlang:monitor(process, P),
+ receive
+ {'DOWN', M, process, P, _} ->
+ ok
+ end
+ end,
+ Procs),
+ case {Blocking, WaitLocked} of
+ {_, 0} -> ok;
+ {false, _} -> ok;
+ _ ->
+ {_, RunTime} = statistics(runtime),
+ io:format("RunTime=~p~n", [RunTime]),
+ true = RunTime < 700,
+ {comment,
+ "Run-time during test was "
+ ++ integer_to_list(RunTime)
+ ++ " ms."}
+ end
end.
hammer_sched_rwlock_proc(_RWLock,
@@ -343,9 +332,9 @@ hammer_ets_rwlock(Config) when is_list(Config) ->
3 -> {2000, 50};
_ -> {200, 50}
end,
- ?t:format("Procs=~p~nOps=~p~n", [Procs, Ops]),
+ io:format("Procs=~p~nOps=~p~n", [Procs, Ops]),
lists:foreach(fun (XOpts) ->
- ?t:format("Running with extra opts: ~p", [XOpts]),
+ io:format("Running with extra opts: ~p", [XOpts]),
hammer_ets_rwlock_test(XOpts, true, 2, Ops,
Procs, false)
end,
@@ -408,65 +397,65 @@ hammer_ets_rwlock_init(_T, _N) ->
hammer_ets_rwlock_test(XOpts, UW, C, N, NP, SC) ->
receive after 100 -> ok end,
{TP, TM} = spawn_monitor(
- fun () ->
- _L = repeat_list(
- fun () ->
- Caller = self(),
- T = fun () ->
- Parent = self(),
- hammer_ets_rwlock_put_data(),
- T=ets:new(x, [public | XOpts]),
- hammer_ets_rwlock_init(T, 0),
- Ps0 = repeat_list(
- fun () ->
- spawn_link(
- fun () ->
- hammer_ets_rwlock_put_data(),
- receive go -> ok end,
- hammer_ets_rwlock_ops(T, UW, N, C, C, N),
- Parent ! {done, self()},
- receive after infinity -> ok end
- end)
- end,
- NP - case SC of
- false -> 0;
- _ -> 1
- end),
- Ps = case SC of
- false -> Ps0;
- _ -> [spawn_link(fun () ->
- hammer_ets_rwlock_put_data(),
- receive go -> ok end,
- hammer_ets_rwlock_ops(T, UW, N, SC, SC, N),
- Parent ! {done, self()},
- receive after infinity -> ok end
- end) | Ps0]
- end,
- Start = erlang:monotonic_time(),
- lists:foreach(fun (P) -> P ! go end, Ps),
- lists:foreach(fun (P) -> receive {done, P} -> ok end end, Ps),
- Stop = erlang:monotonic_time(),
- lists:foreach(fun (P) ->
- unlink(P),
- exit(P, bang),
- M = erlang:monitor(process, P),
- receive
- {'DOWN', M, process, P, _} -> ok
- end
- end, Ps),
- Res = (Stop-Start)/erlang:convert_time_unit(1,seconds,native),
- Caller ! {?MODULE, self(), Res}
- end,
- TP = spawn_link(T),
- receive
- {?MODULE, TP, Res} ->
- Res
- end
- end,
- ?HAMMER_ETS_RWLOCK_REPEAT_TIMES)
- end),
+ fun () ->
+ _L = repeat_list(
+ fun () ->
+ Caller = self(),
+ T = fun () ->
+ Parent = self(),
+ hammer_ets_rwlock_put_data(),
+ T=ets:new(x, [public | XOpts]),
+ hammer_ets_rwlock_init(T, 0),
+ Ps0 = repeat_list(
+ fun () ->
+ spawn_link(
+ fun () ->
+ hammer_ets_rwlock_put_data(),
+ receive go -> ok end,
+ hammer_ets_rwlock_ops(T, UW, N, C, C, N),
+ Parent ! {done, self()},
+ receive after infinity -> ok end
+ end)
+ end,
+ NP - case SC of
+ false -> 0;
+ _ -> 1
+ end),
+ Ps = case SC of
+ false -> Ps0;
+ _ -> [spawn_link(fun () ->
+ hammer_ets_rwlock_put_data(),
+ receive go -> ok end,
+ hammer_ets_rwlock_ops(T, UW, N, SC, SC, N),
+ Parent ! {done, self()},
+ receive after infinity -> ok end
+ end) | Ps0]
+ end,
+ Start = erlang:monotonic_time(),
+ lists:foreach(fun (P) -> P ! go end, Ps),
+ lists:foreach(fun (P) -> receive {done, P} -> ok end end, Ps),
+ Stop = erlang:monotonic_time(),
+ lists:foreach(fun (P) ->
+ unlink(P),
+ exit(P, bang),
+ M = erlang:monitor(process, P),
+ receive
+ {'DOWN', M, process, P, _} -> ok
+ end
+ end, Ps),
+ Res = (Stop-Start)/erlang:convert_time_unit(1,seconds,native),
+ Caller ! {?MODULE, self(), Res}
+ end,
+ TP = spawn_link(T),
+ receive
+ {?MODULE, TP, Res} ->
+ Res
+ end
+ end,
+ ?HAMMER_ETS_RWLOCK_REPEAT_TIMES)
+ end),
receive
- {'DOWN', TM, process, TP, _} -> ok
+ {'DOWN', TM, process, TP, _} -> ok
end.
repeat_list(Fun, N) ->
@@ -480,18 +469,17 @@ repeat_list(Fun, N, Acc) ->
handicap() ->
X0 = case catch (erlang:system_info(logical_processors_available) >=
- erlang:system_info(schedulers_online)) of
- true -> 1;
- _ -> 2
- end,
+ erlang:system_info(schedulers_online)) of
+ true -> 1;
+ _ -> 2
+ end,
case erlang:system_info(build_type) of
- opt ->
- X0;
- ReallySlow when ReallySlow == debug;
- ReallySlow == valgrind;
- ReallySlow == purify ->
- X0*3;
- _Slow ->
- X0*2
+ opt ->
+ X0;
+ ReallySlow when ReallySlow == debug;
+ ReallySlow == valgrind;
+ ReallySlow == purify ->
+ X0*3;
+ _Slow ->
+ X0*2
end.
-
diff --git a/erts/emulator/test/multi_load_SUITE.erl b/erts/emulator/test/multi_load_SUITE.erl
new file mode 100644
index 0000000000..784b239116
--- /dev/null
+++ b/erts/emulator/test/multi_load_SUITE.erl
@@ -0,0 +1,196 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(multi_load_SUITE).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ many/1,on_load/1,errors/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [many,on_load,errors].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+many(_Config) ->
+ Ms = make_modules(100, fun many_module/1),
+
+ io:put_chars("Light load\n"
+ "=========="),
+ many_measure(Ms),
+
+ _ = [spawn_link(fun many_worker/0) || _ <- lists:seq(1, 8)],
+ erlang:yield(),
+ io:put_chars("Heavy load\n"
+ "=========="),
+ many_measure(Ms),
+
+ ok.
+
+many_module(M) ->
+ ["-module("++M++").",
+ "-compile(export_all).",
+ "f1() -> ok.",
+ "f2() -> ok.",
+ "f3() -> ok.",
+ "f4() -> ok."].
+
+many_measure(Ms) ->
+ many_purge(Ms),
+ MsPrep1 = prepare_modules(Ms),
+ Us1 = ms(fun() -> many_load_seq(MsPrep1) end),
+ many_try_call(Ms),
+ many_purge(Ms),
+ MsPrep2 = prepare_modules(Ms),
+ Us2 = ms(fun() -> many_load_par(MsPrep2) end),
+ many_try_call(Ms),
+ io:format("# modules: ~9w\n"
+ "Sequential: ~9w µs\n"
+ "Parallel: ~9w µs\n"
+ "Ratio: ~9w\n",
+ [length(Ms),Us1,Us2,round(Us1/Us2)]),
+ ok.
+
+many_load_seq(Ms) ->
+ [erlang:finish_loading([M]) || M <- Ms],
+ ok.
+
+many_load_par(Ms) ->
+ erlang:finish_loading(Ms).
+
+many_purge(Ms) ->
+ _ = [catch erlang:purge_module(M) || {M,_} <- Ms],
+ ok.
+
+many_try_call(Ms) ->
+ _ = [begin
+ ok = M:f1(),
+ ok = M:f2(),
+ ok = M:f3(),
+ ok = M:f4()
+ end || {M,_} <- Ms],
+ ok.
+
+many_worker() ->
+ many_worker(lists:seq(1, 100)).
+
+many_worker(L) ->
+ N0 = length(L),
+ N1 = N0 * N0 * N0,
+ N2 = N1 div (N0 * N0),
+ N3 = N2 + 10,
+ _ = N3 - 10,
+ many_worker(L).
+
+
+on_load(_Config) ->
+ On = make_modules(2, fun on_load_module/1),
+ OnPrep = prepare_modules(On),
+ {'EXIT',{system_limit,_}} = (catch erlang:finish_loading(OnPrep)),
+
+ Normal = make_modules(1, fun on_load_normal/1),
+ Mixed = Normal ++ tl(On),
+ MixedPrep = prepare_modules(Mixed),
+ {'EXIT',{system_limit,_}} = (catch erlang:finish_loading(MixedPrep)),
+
+ [false,true] = [erlang:has_prepared_code_on_load(Code) ||
+ Code <- MixedPrep],
+ {'EXIT',{badarg,_}} = (catch erlang:has_prepared_code_on_load(<<1,2,3>>)),
+ Magic = ets:match_spec_compile([{'_',[true],['$_']}]),
+ {'EXIT',{badarg,_}} = (catch erlang:has_prepared_code_on_load(Magic)),
+
+ SingleOnPrep = tl(OnPrep),
+ {on_load,[OnLoadMod]} = erlang:finish_loading(SingleOnPrep),
+ ok = erlang:call_on_load_function(OnLoadMod),
+
+ ok.
+
+on_load_module(M) ->
+ ["-module("++M++").",
+ "-on_load(f/0).",
+ "f() -> ok."].
+
+on_load_normal(M) ->
+ ["-module("++M++")."].
+
+
+errors(_Config) ->
+ finish_loading_badarg(x),
+ finish_loading_badarg([x|y]),
+ finish_loading_badarg([x]),
+ finish_loading_badarg([<<>>]),
+
+ Mods = make_modules(2, fun errors_module/1),
+ Ms = lists:sort([M || {M,_} <- Mods]),
+ Prep = prepare_modules(Mods),
+ {duplicated,Dups} = erlang:finish_loading(Prep ++ Prep),
+ Ms = lists:sort(Dups),
+ ok.
+
+finish_loading_badarg(Arg) ->
+ {'EXIT',{badarg,[{erlang,finish_loading,[Arg],_}|_]}} =
+ (catch erlang:finish_loading(Arg)).
+
+errors_module(M) ->
+ ["-module("++M++").",
+ "-export([f/0]).",
+ "f() -> ok."].
+
+%%%
+%%% Common utilities
+%%%
+
+ms(Fun) ->
+ {Ms,ok} = timer:tc(Fun),
+ Ms.
+
+make_modules(0, _) ->
+ [];
+make_modules(N, Fun) ->
+ U = erlang:unique_integer([positive]),
+ M0 = "m__" ++ integer_to_list(N) ++ "_" ++ integer_to_list(U),
+ Contents = Fun(M0),
+ Forms = [make_form(S) || S <- Contents],
+ {ok,M,Code} = compile:forms(Forms),
+ [{M,Code}|make_modules(N-1, Fun)].
+
+make_form(S) ->
+ {ok,Toks,_} = erl_scan:string(S),
+ {ok,Form} = erl_parse:parse_form(Toks),
+ Form.
+
+prepare_modules(Ms) ->
+ [erlang:prepare_loading(M, Code) || {M,Code} <- Ms].
diff --git a/erts/emulator/test/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl
index 7cfa837ee5..c13e19f857 100644
--- a/erts/emulator/test/nested_SUITE.erl
+++ b/erts/emulator/test/nested_SUITE.erl
@@ -20,90 +20,74 @@
-module(nested_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]).
+-export([all/0, suite/0,
+ case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 10}}].
all() ->
[case_in_case, case_in_after, catch_in_catch,
bif_in_bif].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
case_in_case(suite) -> [];
case_in_case(Config) when is_list(Config) ->
- ?line done = search_any([a], [{a, 1}]),
- ?line done = search_any([x], [{a, 1}]),
+ done = search_any([a], [{a, 1}]),
+ done = search_any([x], [{a, 1}]),
ok.
search_any([Key|Rest], List) ->
- ?line case case lists:keysearch(Key, 1, List) of
- {value, _} ->
- true;
- _ ->
- false
- end of
- true ->
- ok;
- false ->
- error;
- Other ->
- test_server:fail({other_result, Other})
- end,
- ?line search_any(Rest, List);
+ case case lists:keysearch(Key, 1, List) of
+ {value, _} ->
+ true;
+ _ ->
+ false
+ end of
+ true ->
+ ok;
+ false ->
+ error;
+ Other ->
+ ct:fail({other_result, Other})
+ end,
+ search_any(Rest, List);
search_any([], _) ->
done.
case_in_after(suite) -> [];
case_in_after(Config) when is_list(Config) ->
receive
- after case {x, y, z} of
- {x, y, z} -> 0
- end ->
- ok
- end,
+ after case {x, y, z} of
+ {x, y, z} -> 0
+ end ->
+ ok
+ end,
ok.
-catch_in_catch(doc) -> "Test a catch within a catch in the same function.";
-catch_in_catch(suite) -> [];
+%% Test a catch within a catch in the same function.
catch_in_catch(Config) when is_list(Config) ->
- ?line {outer, inner_exit} = catcher(),
+ {outer, inner_exit} = catcher(),
ok.
catcher() ->
case (catch
- case (catch ?MODULE:non_existing()) of % bogus function
- {'EXIT', _} ->
- inner_exit;
- Res1 ->
- {inner, Res1}
- end) of
- {'EXIT', _} ->
- outer_exit;
- Res2 ->
- {outer, Res2}
+ case (catch ?MODULE:non_existing()) of % bogus function
+ {'EXIT', _} ->
+ inner_exit;
+ Res1 ->
+ {inner, Res1}
+ end) of
+ {'EXIT', _} ->
+ outer_exit;
+ Res2 ->
+ {outer, Res2}
end.
-bif_in_bif(doc) -> "Test a BIF call within a BIF call.";
-bif_in_bif(suite) -> [];
+%% Test a BIF call within a BIF call.
bif_in_bif(Config) when is_list(Config) ->
Self = self(),
put(pid, Self),
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index af2b955184..84f5699890 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -22,14 +22,13 @@
%%-define(line_trace,true).
-define(CHECK(Exp,Got), check(Exp,Got,?LINE)).
-%%-define(CHECK(Exp,Got), ?line Exp = Got).
+%%-define(CHECK(Exp,Got), Exp = Got).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1,
+-export([all/0, suite/0,
+ init_per_testcase/2, end_per_testcase/2,
+ basic/1, reload/1, upgrade/1, heap_frag/1,
types/1, many_args/1, binaries/1, get_string/1, get_atom/1,
maps/1,
api_macros/1,
@@ -42,8 +41,8 @@
otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1,
dirty_nif_exception/1, call_dirty_nif_exception/1, nif_schedule/1,
nif_exception/1, call_nif_exception/1,
- nif_nan_and_inf/1, nif_atom_too_long/1
- ]).
+ nif_nan_and_inf/1, nif_atom_too_long/1,
+ nif_monotonic_time/1, nif_time_offset/1, nif_convert_time_unit/1]).
-export([many_args_100/100]).
@@ -72,182 +71,160 @@ all() ->
otp_9828,
otp_9668, consume_timeslice,
nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception,
- nif_exception, nif_nan_and_inf, nif_atom_too_long
+ nif_exception, nif_nan_and_inf, nif_atom_too_long,
+ nif_monotonic_time, nif_time_offset, nif_convert_time_unit
].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
init_per_testcase(_Case, Config) ->
-% ?line Dog = ?t:timetrap(?t:seconds(60*60*24)),
Config.
end_per_testcase(_Func, _Config) ->
- %%Dog = ?config(watchdog, Config),
- %%?t:timetrap_cancel(Dog),
P1 = code:purge(nif_mod),
Del = code:delete(nif_mod),
P2 = code:purge(nif_mod),
io:format("fin purged=~p, deleted=~p and then purged=~p\n",[P1,Del,P2]).
-basic(doc) -> ["Basic smoke test of load_nif and a simple NIF call"];
-basic(suite) -> [];
+%% Basic smoke test of load_nif and a simple NIF call
basic(Config) when is_list(Config) ->
ensure_lib_loaded(Config),
- ?line true = (lib_version() =/= undefined),
- ?line [{load,1,1,101},{lib_version,1,2,102}] = call_history(),
- ?line [] = call_history(),
- ?line true = lists:member(?MODULE, erlang:system_info(taints)),
+ true = (lib_version() =/= undefined),
+ [{load,1,1,101},{lib_version,1,2,102}] = call_history(),
+ [] = call_history(),
+ true = lists:member(?MODULE, erlang:system_info(taints)),
ok.
-reload(doc) -> ["Test reload callback in nif lib"];
-reload(suite) -> [];
+%% Test reload callback in nif lib
reload(Config) when is_list(Config) ->
TmpMem = tmpmem(),
ensure_lib_loaded(Config),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "nif_mod"),
- ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]),
- ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "nif_mod"),
+ {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]),
+ {module,nif_mod} = erlang:load_module(nif_mod,Bin),
- ?line ok = nif_mod:load_nif_lib(Config, 1),
+ ok = nif_mod:load_nif_lib(Config, 1),
- ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
- ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(),
+ hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
+ [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(),
- ?line ok = nif_mod:load_nif_lib(Config, 2),
- ?line 2 = nif_mod:lib_version(),
- ?line [{reload,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(),
+ ok = nif_mod:load_nif_lib(Config, 2),
+ 2 = nif_mod:lib_version(),
+ [{reload,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(),
- ?line ok = nif_mod:load_nif_lib(Config, 1),
- ?line 1 = nif_mod:lib_version(),
- ?line [{reload,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(),
+ ok = nif_mod:load_nif_lib(Config, 1),
+ 1 = nif_mod:lib_version(),
+ [{reload,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(),
- ?line true = erlang:delete_module(nif_mod),
- ?line [] = nif_mod_call_history(),
+ true = erlang:delete_module(nif_mod),
+ [] = nif_mod_call_history(),
- %%?line false= check_process_code(Pid, nif_mod),
- ?line true = erlang:purge_module(nif_mod),
- ?line [{unload,1,3,103}] = nif_mod_call_history(),
+ %%false= check_process_code(Pid, nif_mod),
+ true = erlang:purge_module(nif_mod),
+ [{unload,1,3,103}] = nif_mod_call_history(),
- ?line true = lists:member(?MODULE, erlang:system_info(taints)),
- ?line true = lists:member(nif_mod, erlang:system_info(taints)),
- ?line verify_tmpmem(TmpMem),
+ true = lists:member(?MODULE, erlang:system_info(taints)),
+ true = lists:member(nif_mod, erlang:system_info(taints)),
+ verify_tmpmem(TmpMem),
ok.
-upgrade(doc) -> ["Test upgrade callback in nif lib"];
-upgrade(suite) -> [];
+%% Test upgrade callback in nif lib
upgrade(Config) when is_list(Config) ->
TmpMem = tmpmem(),
ensure_lib_loaded(Config),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "nif_mod"),
- ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]),
- ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "nif_mod"),
+ {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]),
+ {module,nif_mod} = erlang:load_module(nif_mod,Bin),
- ?line ok = nif_mod:load_nif_lib(Config, 1),
- ?line {Pid,MRef} = nif_mod:start(),
- ?line 1 = call(Pid,lib_version),
+ ok = nif_mod:load_nif_lib(Config, 1),
+ {Pid,MRef} = nif_mod:start(),
+ 1 = call(Pid,lib_version),
- ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
- ?line [{load,1,1,101},{lib_version,1,2,102},{get_priv_data_ptr,1,3,103}] = nif_mod_call_history(),
+ hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
+ [{load,1,1,101},{lib_version,1,2,102},{get_priv_data_ptr,1,3,103}] = nif_mod_call_history(),
%% Module upgrade with same lib-version
- ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin),
- ?line undefined = nif_mod:lib_version(),
- ?line 1 = call(Pid,lib_version),
- ?line [{lib_version,1,4,104}] = nif_mod_call_history(),
+ {module,nif_mod} = erlang:load_module(nif_mod,Bin),
+ undefined = nif_mod:lib_version(),
+ 1 = call(Pid,lib_version),
+ [{lib_version,1,4,104}] = nif_mod_call_history(),
- ?line ok = nif_mod:load_nif_lib(Config, 1),
- ?line 1 = nif_mod:lib_version(),
- ?line [{upgrade,1,5,105},{lib_version,1,6,106}] = nif_mod_call_history(),
+ ok = nif_mod:load_nif_lib(Config, 1),
+ 1 = nif_mod:lib_version(),
+ [{upgrade,1,5,105},{lib_version,1,6,106}] = nif_mod_call_history(),
- ?line upgraded = call(Pid,upgrade),
- ?line false = check_process_code(Pid, nif_mod),
- ?line true = erlang:purge_module(nif_mod),
- ?line [{unload,1,7,107}] = nif_mod_call_history(),
+ upgraded = call(Pid,upgrade),
+ false = check_process_code(Pid, nif_mod),
+ true = erlang:purge_module(nif_mod),
+ [{unload,1,7,107}] = nif_mod_call_history(),
- ?line 1 = nif_mod:lib_version(),
- ?line [{lib_version,1,8,108}] = nif_mod_call_history(),
+ 1 = nif_mod:lib_version(),
+ [{lib_version,1,8,108}] = nif_mod_call_history(),
- ?line true = erlang:delete_module(nif_mod),
- ?line [] = nif_mod_call_history(),
+ true = erlang:delete_module(nif_mod),
+ [] = nif_mod_call_history(),
- ?line Pid ! die,
- ?line {'DOWN', MRef, process, Pid, normal} = receive_any(),
- ?line false = check_process_code(Pid, nif_mod),
- ?line true = erlang:purge_module(nif_mod),
- ?line [{unload,1,9,109}] = nif_mod_call_history(),
+ Pid ! die,
+ {'DOWN', MRef, process, Pid, normal} = receive_any(),
+ false = check_process_code(Pid, nif_mod),
+ true = erlang:purge_module(nif_mod),
+ [{unload,1,9,109}] = nif_mod_call_history(),
%% Module upgrade with different lib version
- ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin),
- ?line undefined = nif_mod:lib_version(),
- ?line {Pid2,MRef2} = nif_mod:start(),
- ?line undefined = call(Pid2,lib_version),
-
- ?line ok = nif_mod:load_nif_lib(Config, 1),
- ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
- ?line 1 = call(Pid2,lib_version),
- ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102},{lib_version,1,3,103}] = nif_mod_call_history(),
-
- ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin),
- ?line undefined = nif_mod:lib_version(),
- ?line [] = nif_mod_call_history(),
- ?line 1 = call(Pid2,lib_version),
- ?line [{lib_version,1,4,104}] = nif_mod_call_history(),
-
- ?line ok = nif_mod:load_nif_lib(Config, 2),
- ?line 2 = nif_mod:lib_version(),
- ?line [{upgrade,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(),
-
- ?line 1 = call(Pid2,lib_version),
- ?line [{lib_version,1,5,105}] = nif_mod_call_history(),
-
- ?line upgraded = call(Pid2,upgrade),
- ?line false = check_process_code(Pid2, nif_mod),
- ?line true = erlang:purge_module(nif_mod),
- ?line [{unload,1,6,106}] = nif_mod_call_history(),
-
- ?line 2 = nif_mod:lib_version(),
- ?line [{lib_version,2,3,203}] = nif_mod_call_history(),
-
- ?line true = erlang:delete_module(nif_mod),
- ?line [] = nif_mod_call_history(),
-
- ?line Pid2 ! die,
- ?line {'DOWN', MRef2, process, Pid2, normal} = receive_any(),
- ?line false= check_process_code(Pid2, nif_mod),
- ?line true = erlang:purge_module(nif_mod),
- ?line [{unload,2,4,204}] = nif_mod_call_history(),
-
- ?line true = lists:member(?MODULE, erlang:system_info(taints)),
- ?line true = lists:member(nif_mod, erlang:system_info(taints)),
- ?line verify_tmpmem(TmpMem),
+ {module,nif_mod} = erlang:load_module(nif_mod,Bin),
+ undefined = nif_mod:lib_version(),
+ {Pid2,MRef2} = nif_mod:start(),
+ undefined = call(Pid2,lib_version),
+
+ ok = nif_mod:load_nif_lib(Config, 1),
+ hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
+ 1 = call(Pid2,lib_version),
+ [{load,1,1,101},{get_priv_data_ptr,1,2,102},{lib_version,1,3,103}] = nif_mod_call_history(),
+
+ {module,nif_mod} = erlang:load_module(nif_mod,Bin),
+ undefined = nif_mod:lib_version(),
+ [] = nif_mod_call_history(),
+ 1 = call(Pid2,lib_version),
+ [{lib_version,1,4,104}] = nif_mod_call_history(),
+
+ ok = nif_mod:load_nif_lib(Config, 2),
+ 2 = nif_mod:lib_version(),
+ [{upgrade,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(),
+
+ 1 = call(Pid2,lib_version),
+ [{lib_version,1,5,105}] = nif_mod_call_history(),
+
+ upgraded = call(Pid2,upgrade),
+ false = check_process_code(Pid2, nif_mod),
+ true = erlang:purge_module(nif_mod),
+ [{unload,1,6,106}] = nif_mod_call_history(),
+
+ 2 = nif_mod:lib_version(),
+ [{lib_version,2,3,203}] = nif_mod_call_history(),
+
+ true = erlang:delete_module(nif_mod),
+ [] = nif_mod_call_history(),
+
+ Pid2 ! die,
+ {'DOWN', MRef2, process, Pid2, normal} = receive_any(),
+ false= check_process_code(Pid2, nif_mod),
+ true = erlang:purge_module(nif_mod),
+ [{unload,2,4,204}] = nif_mod_call_history(),
+
+ true = lists:member(?MODULE, erlang:system_info(taints)),
+ true = lists:member(nif_mod, erlang:system_info(taints)),
+ verify_tmpmem(TmpMem),
ok.
-heap_frag(doc) -> ["Test NIF building heap fragments"];
-heap_frag(suite) -> [];
+%% Test NIF building heap fragments
heap_frag(Config) when is_list(Config) ->
TmpMem = tmpmem(),
ensure_lib_loaded(Config),
heap_frag_do(1,1000000),
- ?line verify_tmpmem(TmpMem),
+ verify_tmpmem(TmpMem),
ok.
heap_frag_do(N, Max) when N > Max ->
@@ -258,12 +235,11 @@ heap_frag_do(N, Max) ->
L = list_seq(N),
heap_frag_do(((N*5) div 4) + 1, Max).
-types(doc) -> ["Type tests"];
-types(suite) -> [];
+%% Type tests
types(Config) when is_list(Config) ->
TmpMem = tmpmem(),
ensure_lib_loaded(Config),
- ?line ok = type_test(),
+ ok = type_test(),
lists:foreach(fun(Tpl) ->
Lst = erlang:tuple_to_list(Tpl),
Lst = tuple_2_list(Tpl)
@@ -288,18 +264,18 @@ types(Config) when is_list(Config) ->
R1 = echo_int(I),
%%io:format("echo_int(~p) -> ~p\n", [I, R1]),
R2 = my_echo_int(I, Limits),
- ?line R1 = R2,
- ?line true = (R1 =:= R2),
- ?line true = (R1 == R2)
+ R1 = R2,
+ true = (R1 =:= R2),
+ true = (R1 == R2)
end, int_list()),
- ?line verify_tmpmem(TmpMem),
- ?line true = (compare(-1294536544000, -1178704800000) < 0),
- ?line true = (compare(-1178704800000, -1294536544000) > 0),
- ?line true = (compare(-295147905179352825856, -36893488147419103232) < 0),
- ?line true = (compare(-36893488147419103232, -295147905179352825856) > 0),
- ?line true = (compare(-29514790517935282585612345678, -36893488147419103232) < 0),
- ?line true = (compare(-36893488147419103232, -29514790517935282585612345678) > 0),
+ verify_tmpmem(TmpMem),
+ true = (compare(-1294536544000, -1178704800000) < 0),
+ true = (compare(-1178704800000, -1294536544000) > 0),
+ true = (compare(-295147905179352825856, -36893488147419103232) < 0),
+ true = (compare(-36893488147419103232, -295147905179352825856) > 0),
+ true = (compare(-29514790517935282585612345678, -36893488147419103232) < 0),
+ true = (compare(-36893488147419103232, -29514790517935282585612345678) > 0),
ok.
int_list() ->
@@ -327,15 +303,15 @@ eq_cmp(A,B) ->
eq_cmp_do({A,B},{A,B}).
eq_cmp_do(A,B) ->
- %%?t:format("compare ~p and ~p\n",[A,B]),
+ %%io:format("compare ~p and ~p\n",[A,B]),
Eq = (A =:= B),
- ?line Eq = is_identical(A,B),
- ?line Cmp = if
+ Eq = is_identical(A,B),
+ Cmp = if
A < B -> -1;
A == B -> 0;
A > B -> 1
end,
- ?line Cmp = case compare(A,B) of
+ Cmp = case compare(A,B) of
C when is_integer(C), C < 0 -> -1;
0 -> 0;
C when is_integer(C) -> 1
@@ -343,47 +319,45 @@ eq_cmp_do(A,B) ->
ok.
-many_args(doc) -> ["Test NIF with many arguments"];
-many_args(suite) -> [];
+%% Test NIF with many arguments
many_args(Config) when is_list(Config) ->
TmpMem = tmpmem(),
- ?line ensure_lib_loaded(Config ,1),
- ?line ok = apply(?MODULE,many_args_100,lists:seq(1,100)),
- ?line ok = many_args_100(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100),
- ?line verify_tmpmem(TmpMem),
+ ensure_lib_loaded(Config ,1),
+ ok = apply(?MODULE,many_args_100,lists:seq(1,100)),
+ ok = many_args_100(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100),
+ verify_tmpmem(TmpMem),
ok.
-binaries(doc) -> ["Test NIF binary handling."];
-binaries(suite) -> [];
+%% Test NIF binary handling.
binaries(Config) when is_list(Config) ->
TmpMem = tmpmem(),
- ?line ensure_lib_loaded(Config, 1),
- ?line RefcBin = list_to_binary(lists:seq(1,255)),
- ?line RefcBin = clone_bin(RefcBin),
- ?line HeapBin = list_to_binary(lists:seq(1,20)),
- ?line HeapBin = clone_bin(HeapBin),
- ?line <<_:8,Sub1:6/binary,_/binary>> = RefcBin,
- ?line <<_:8,Sub2:6/binary,_/binary>> = HeapBin,
- ?line Sub1 = Sub2,
- ?line Sub1 = clone_bin(Sub1),
- ?line Sub2 = clone_bin(Sub2),
- ?line <<_:9,Sub3:6/binary,_/bitstring>> = RefcBin,
- ?line <<_:9,Sub4:6/binary,_/bitstring>> = HeapBin,
- ?line Sub3 = Sub4,
- ?line Sub3 = clone_bin(Sub3),
- ?line Sub4 = clone_bin(Sub4),
+ ensure_lib_loaded(Config, 1),
+ RefcBin = list_to_binary(lists:seq(1,255)),
+ RefcBin = clone_bin(RefcBin),
+ HeapBin = list_to_binary(lists:seq(1,20)),
+ HeapBin = clone_bin(HeapBin),
+ <<_:8,Sub1:6/binary,_/binary>> = RefcBin,
+ <<_:8,Sub2:6/binary,_/binary>> = HeapBin,
+ Sub1 = Sub2,
+ Sub1 = clone_bin(Sub1),
+ Sub2 = clone_bin(Sub2),
+ <<_:9,Sub3:6/binary,_/bitstring>> = RefcBin,
+ <<_:9,Sub4:6/binary,_/bitstring>> = HeapBin,
+ Sub3 = Sub4,
+ Sub3 = clone_bin(Sub3),
+ Sub4 = clone_bin(Sub4),
%% When NIFs get bitstring support
- %%?line <<_:8,Sub5:27/bitstring,_/bitstring>> = RefcBin,
- %%?line <<_:8,Sub6:27/bitstring,_/bitstring>> = HeapBin,
- %%?line Sub5 = Sub6,
- %%?line Sub5 = clone_bin(Sub5),
- %%?line Sub6 = clone_bin(Sub6),
- %%?line <<_:9,Sub7:27/bitstring,_/bitstring>> = RefcBin,
- %%?line <<_:9,Sub8:27/bitstring,_/bitstring>> = HeapBin,
- %%?line Sub7 = Sub8,
- %%?line Sub7 = clone_bin(Sub7),
- %%?line Sub8 = clone_bin(Sub8),
- %%?line <<>> = clone_bin(<<>>),
+ %%<<_:8,Sub5:27/bitstring,_/bitstring>> = RefcBin,
+ %%<<_:8,Sub6:27/bitstring,_/bitstring>> = HeapBin,
+ %%Sub5 = Sub6,
+ %%Sub5 = clone_bin(Sub5),
+ %%Sub6 = clone_bin(Sub6),
+ %%<<_:9,Sub7:27/bitstring,_/bitstring>> = RefcBin,
+ %%<<_:9,Sub8:27/bitstring,_/bitstring>> = HeapBin,
+ %%Sub7 = Sub8,
+ %%Sub7 = clone_bin(Sub7),
+ %%Sub8 = clone_bin(Sub8),
+ %%<<>> = clone_bin(<<>>),
<<_:8,SubBinA:200/binary,_/binary>> = RefcBin,
<<_:9,SubBinB:200/binary,_/bitstring>> = RefcBin,
@@ -396,56 +370,53 @@ binaries(Config) when is_list(Config) ->
test_make_sub_bin(SubBinC),
test_make_sub_bin(SubBinD),
- ?line verify_tmpmem(TmpMem),
+ verify_tmpmem(TmpMem),
ok.
test_make_sub_bin(Bin) ->
Size = byte_size(Bin),
Rest10 = Size - 10,
Rest1 = Size - 1,
- ?line Bin = make_sub_bin(Bin, 0, Size),
+ Bin = make_sub_bin(Bin, 0, Size),
<<_:10/binary,Sub0:Rest10/binary>> = Bin,
- ?line Sub0 = make_sub_bin(Bin, 10, Rest10),
+ Sub0 = make_sub_bin(Bin, 10, Rest10),
<<Sub1:10/binary,_/binary>> = Bin,
- ?line Sub1 = make_sub_bin(Bin, 0, 10),
+ Sub1 = make_sub_bin(Bin, 0, 10),
<<_:7/binary,Sub2:10/binary,_/binary>> = Bin,
- ?line Sub2 = make_sub_bin(Bin, 7, 10),
- ?line <<>> = make_sub_bin(Bin, 0, 0),
- ?line <<>> = make_sub_bin(Bin, 10, 0),
- ?line <<>> = make_sub_bin(Bin, Rest1, 0),
- ?line <<>> = make_sub_bin(Bin, Size, 0),
+ Sub2 = make_sub_bin(Bin, 7, 10),
+ <<>> = make_sub_bin(Bin, 0, 0),
+ <<>> = make_sub_bin(Bin, 10, 0),
+ <<>> = make_sub_bin(Bin, Rest1, 0),
+ <<>> = make_sub_bin(Bin, Size, 0),
ok.
-get_string(doc) -> ["Test enif_get_string"];
-get_string(suite) -> [];
+%% Test enif_get_string
get_string(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
- ?line {7, <<"hejsan",0,_:3/binary>>} = string_to_bin("hejsan",10),
- ?line {7, <<"hejsan",0,_>>} = string_to_bin("hejsan",8),
- ?line {7, <<"hejsan",0>>} = string_to_bin("hejsan",7),
- ?line {-6, <<"hejsa",0>>} = string_to_bin("hejsan",6),
- ?line {-5, <<"hejs",0>>} = string_to_bin("hejsan",5),
- ?line {-1, <<0>>} = string_to_bin("hejsan",1),
- ?line {0, <<>>} = string_to_bin("hejsan",0),
- ?line {1, <<0>>} = string_to_bin("",1),
- ?line {0, <<>>} = string_to_bin("",0),
+ ensure_lib_loaded(Config, 1),
+ {7, <<"hejsan",0,_:3/binary>>} = string_to_bin("hejsan",10),
+ {7, <<"hejsan",0,_>>} = string_to_bin("hejsan",8),
+ {7, <<"hejsan",0>>} = string_to_bin("hejsan",7),
+ {-6, <<"hejsa",0>>} = string_to_bin("hejsan",6),
+ {-5, <<"hejs",0>>} = string_to_bin("hejsan",5),
+ {-1, <<0>>} = string_to_bin("hejsan",1),
+ {0, <<>>} = string_to_bin("hejsan",0),
+ {1, <<0>>} = string_to_bin("",1),
+ {0, <<>>} = string_to_bin("",0),
ok.
-get_atom(doc) -> ["Test enif_get_atom"];
-get_atom(suite) -> [];
+%% Test enif_get_atom
get_atom(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
- ?line {7, <<"hejsan",0,_:3/binary>>} = atom_to_bin(hejsan,10),
- ?line {7, <<"hejsan",0,_>>} = atom_to_bin(hejsan,8),
- ?line {7, <<"hejsan",0>>} = atom_to_bin(hejsan,7),
- ?line {0, <<_:6/binary>>} = atom_to_bin(hejsan,6),
- ?line {0, <<>>} = atom_to_bin(hejsan,0),
- ?line {1, <<0>>} = atom_to_bin('',1),
- ?line {0, <<>>} = atom_to_bin('',0),
+ ensure_lib_loaded(Config, 1),
+ {7, <<"hejsan",0,_:3/binary>>} = atom_to_bin(hejsan,10),
+ {7, <<"hejsan",0,_>>} = atom_to_bin(hejsan,8),
+ {7, <<"hejsan",0>>} = atom_to_bin(hejsan,7),
+ {0, <<_:6/binary>>} = atom_to_bin(hejsan,6),
+ {0, <<>>} = atom_to_bin(hejsan,0),
+ {1, <<0>>} = atom_to_bin('',1),
+ {0, <<>>} = atom_to_bin('',0),
ok.
-maps(doc) -> ["Test NIF maps handling."];
-maps(suite) -> [];
+%% Test NIF maps handling.
maps(Config) when is_list(Config) ->
TmpMem = tmpmem(),
Pairs = [{adam, "bert"}] ++
@@ -492,31 +463,28 @@ maps(Config) when is_list(Config) ->
ok.
-api_macros(doc) -> ["Test macros enif_make_list<N> and enif_make_tuple<N>"];
-api_macros(suite) -> [];
+%% Test macros enif_make_list<N> and enif_make_tuple<N>
api_macros(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
+ ensure_lib_loaded(Config, 1),
Expected = {[lists:seq(1,N) || N <- lists:seq(1,9)],
[list_to_tuple(lists:seq(1,N)) || N <- lists:seq(1,9)]
},
- ?line Expected = macros(list_to_tuple(lists:seq(1,9))),
+ Expected = macros(list_to_tuple(lists:seq(1,9))),
ok.
-from_array(doc) -> ["enif_make_[tuple|list]_from_array"];
-from_array(suite) -> [];
+%% enif_make_[tuple|list]_from_array
from_array(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
+ ensure_lib_loaded(Config, 1),
lists:foreach(fun(Tpl) ->
Lst = tuple_to_list(Tpl),
- ?line {Lst,Tpl} = tuple_2_list_and_tuple(Tpl)
+ {Lst,Tpl} = tuple_2_list_and_tuple(Tpl)
end,
[{}, {1,2,3}, {[4,5],[],{},{6,7}}, {{}}, {[]}]),
ok.
-iolist_as_binary(doc) -> ["enif_inspect_iolist_as_binary"];
-iolist_as_binary(suite) -> [];
+%% enif_inspect_iolist_as_binary
iolist_as_binary(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
+ ensure_lib_loaded(Config, 1),
TmpMem = tmpmem(),
List = [<<"hejsan">>, <<>>, [], [17], [<<>>],
[127,128,255,0],
@@ -525,18 +493,17 @@ iolist_as_binary(Config) when is_list(Config) ->
lists:foreach(fun(IoL) ->
B1 = erlang:iolist_to_binary(IoL),
- ?line B2 = iolist_2_bin(IoL),
- ?line B1 = B2
+ B2 = iolist_2_bin(IoL),
+ B1 = B2
end,
List),
- ?line verify_tmpmem(TmpMem),
+ verify_tmpmem(TmpMem),
ok.
-resource(doc) -> ["Test memory managed objects, aka 'resources'"];
-resource(suite) -> [];
+%% Test memory managed objects, aka 'resources'
resource(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
- ?line Type = get_resource_type(0),
+ ensure_lib_loaded(Config, 1),
+ Type = get_resource_type(0),
resource_hugo(Type),
resource_otto(Type),
resource_new(Type),
@@ -546,76 +513,75 @@ resource(Config) when is_list(Config) ->
resource_hugo(Type) ->
DtorCall = resource_hugo_do(Type),
erlang:garbage_collect(),
- ?line DtorCall = last_resource_dtor_call(),
+ DtorCall = last_resource_dtor_call(),
ok.
resource_hugo_do(Type) ->
HugoBin = <<"Hugo Hacker">>,
- ?line HugoPtr = alloc_resource(Type, HugoBin),
- ?line Hugo = make_resource(HugoPtr),
- ?line <<>> = Hugo,
+ HugoPtr = alloc_resource(Type, HugoBin),
+ Hugo = make_resource(HugoPtr),
+ <<>> = Hugo,
release_resource(HugoPtr),
erlang:garbage_collect(),
- ?line {HugoPtr,HugoBin} = get_resource(Type,Hugo),
+ {HugoPtr,HugoBin} = get_resource(Type,Hugo),
Pid = spawn_link(fun() ->
- receive {Pid, Type, Resource, Ptr, Bin} ->
- Pid ! {self(), got_it},
- receive {Pid, check_it} ->
- ?line {Ptr,Bin} = get_resource(Type,Resource),
- Pid ! {self(), ok}
- end
- end
- end),
+ receive {Pid, Type, Resource, Ptr, Bin} ->
+ Pid ! {self(), got_it},
+ receive {Pid, check_it} ->
+ {Ptr,Bin} = get_resource(Type,Resource),
+ Pid ! {self(), ok}
+ end
+ end
+ end),
Pid ! {self(), Type, Hugo, HugoPtr, HugoBin},
- ?line {Pid, got_it} = receive_any(),
+ {Pid, got_it} = receive_any(),
erlang:garbage_collect(), % just to make our ProcBin move in memory
Pid ! {self(), check_it},
- ?line {Pid, ok} = receive_any(),
- ?line [] = last_resource_dtor_call(),
- ?line {HugoPtr,HugoBin} = get_resource(Type,Hugo),
+ {Pid, ok} = receive_any(),
+ [] = last_resource_dtor_call(),
+ {HugoPtr,HugoBin} = get_resource(Type,Hugo),
{HugoPtr, HugoBin, 1}.
resource_otto(Type) ->
{OttoPtr, OttoBin} = resource_otto_do(Type),
erlang:garbage_collect(),
- ?line [] = last_resource_dtor_call(),
+ [] = last_resource_dtor_call(),
release_resource(OttoPtr),
- ?line {OttoPtr,OttoBin,1} = last_resource_dtor_call(),
+ {OttoPtr,OttoBin,1} = last_resource_dtor_call(),
ok.
resource_otto_do(Type) ->
OttoBin = <<"Otto Ordonnans">>,
- ?line OttoPtr = alloc_resource(Type, OttoBin),
- ?line Otto = make_resource(OttoPtr),
- ?line <<>> = Otto,
+ OttoPtr = alloc_resource(Type, OttoBin),
+ Otto = make_resource(OttoPtr),
+ <<>> = Otto,
%% forget resource term but keep referenced by NIF
{OttoPtr, OttoBin}.
resource_new(Type) ->
- ?line {PtrB,BinB} = resource_new_do1(Type),
+ {PtrB,BinB} = resource_new_do1(Type),
erlang:garbage_collect(),
- ?line {PtrB,BinB,1} = last_resource_dtor_call(),
+ {PtrB,BinB,1} = last_resource_dtor_call(),
ok.
resource_new_do1(Type) ->
- ?line {{PtrA,BinA}, {ResB,PtrB,BinB}} = resource_new_do2(Type),
+ {{PtrA,BinA}, {ResB,PtrB,BinB}} = resource_new_do2(Type),
erlang:garbage_collect(),
- ?line {PtrA,BinA,1} = last_resource_dtor_call(),
- ?line {PtrB,BinB} = get_resource(Type, ResB),
+ {PtrA,BinA,1} = last_resource_dtor_call(),
+ {PtrB,BinB} = get_resource(Type, ResB),
%% forget ResB and make it garbage
{PtrB,BinB}.
resource_new_do2(Type) ->
BinA = <<"NewA">>,
BinB = <<"NewB">>,
- ?line ResA = make_new_resource(Type, BinA),
- ?line ResB = make_new_resource(Type, BinB),
- ?line <<>> = ResA,
- ?line <<>> = ResB,
- ?line {PtrA,BinA} = get_resource(Type, ResA),
- ?line {PtrB,BinB} = get_resource(Type, ResB),
- ?line true = (PtrA =/= PtrB),
- ?line [] = last_resource_dtor_call(),
+ ResA = make_new_resource(Type, BinA),
+ ResB = make_new_resource(Type, BinB),
+ <<>> = ResA,
+ <<>> = ResB,
+ {PtrA,BinA} = get_resource(Type, ResA),
+ {PtrB,BinB} = get_resource(Type, ResB),
+ true = (PtrA =/= PtrB),
%% forget ResA and make it garbage
{{PtrA,BinA}, {ResB,PtrB,BinB}}.
@@ -624,22 +590,21 @@ resource_neg(TypeA) ->
catch exit(42), % dummy exception to purge saved stacktraces from earlier exception
erlang:garbage_collect(),
- ?line {_,_,2} = last_resource_dtor_call(),
+ {_,_,2} = last_resource_dtor_call(),
ok.
resource_neg_do(TypeA) ->
TypeB = get_resource_type(1),
ResA = make_new_resource(TypeA, <<"Arnold">>),
ResB= make_new_resource(TypeB, <<"Bobo">>),
- ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeA, ResB)),
- ?line {'EXIT',{badarg,_}} = (catch get_resource(TypeB, ResA)),
+ {'EXIT',{badarg,_}} = (catch get_resource(TypeA, ResB)),
+ {'EXIT',{badarg,_}} = (catch get_resource(TypeB, ResA)),
ok.
-resource_binary(doc) -> ["Test enif_make_resource_binary"];
-resource_binary(suite) -> [];
+%% Test enif_make_resource_binary
resource_binary(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
- ?line {Ptr,Bin} = resource_binary_do(),
+ ensure_lib_loaded(Config, 1),
+ {Ptr,Bin} = resource_binary_do(),
erlang:garbage_collect(),
Last = last_resource_dtor_call(),
?CHECK({Ptr,Bin,1}, Last),
@@ -647,58 +612,57 @@ resource_binary(Config) when is_list(Config) ->
resource_binary_do() ->
Bin = <<"Hej Hopp i lingonskogen">>,
- ?line {Ptr,ResBin1} = make_new_resource_binary(Bin),
- ?line ResBin1 = Bin,
- ?line ResInfo = {Ptr,_} = get_resource(binary_resource_type,ResBin1),
+ {Ptr,ResBin1} = make_new_resource_binary(Bin),
+ ResBin1 = Bin,
+ ResInfo = {Ptr,_} = get_resource(binary_resource_type,ResBin1),
Papa = self(),
Forwarder = spawn_link(fun() -> forwarder(Papa) end),
io:format("sending to forwarder pid=~p\n",[Forwarder]),
Forwarder ! ResBin1,
ResBin2 = receive_any(),
- ?line ResBin2 = ResBin1,
- ?line ResInfo = get_resource(binary_resource_type,ResBin2),
+ ResBin2 = ResBin1,
+ ResInfo = get_resource(binary_resource_type,ResBin2),
Forwarder ! terminate,
- ?line {Forwarder, 1} = receive_any(),
+ {Forwarder, 1} = receive_any(),
erlang:garbage_collect(),
- ?line ResInfo = get_resource(binary_resource_type,ResBin1),
- ?line ResInfo = get_resource(binary_resource_type,ResBin2),
+ ResInfo = get_resource(binary_resource_type,ResBin1),
+ ResInfo = get_resource(binary_resource_type,ResBin2),
ResInfo.
-define(RT_CREATE,1).
-define(RT_TAKEOVER,2).
-resource_takeover(doc) -> ["Test resource takeover by module reload and upgrade"];
-resource_takeover(suite) -> [];
+%% Test resource takeover by module reload and upgrade
resource_takeover(Config) when is_list(Config) ->
TmpMem = tmpmem(),
ensure_lib_loaded(Config),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "nif_mod"),
- ?line {ok,nif_mod,ModBin} = compile:file(File, [binary,return_errors]),
- ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin),
-
- ?line ok = nif_mod:load_nif_lib(Config, 1,
- [{resource_type, 0, ?RT_CREATE, "resource_type_A",resource_dtor_A,
- ?RT_CREATE},
- {resource_type, 1, ?RT_CREATE, "resource_type_null_A",null,
- ?RT_CREATE},
- {resource_type, 2, ?RT_CREATE bor ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A,
- ?RT_CREATE},
- {resource_type, 3, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B,
- ?RT_CREATE},
- {resource_type, 4, ?RT_CREATE, "resource_type_null_goneX",null,
- ?RT_CREATE},
- {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A,
- ?RT_TAKEOVER}
- ]),
-
- ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
- ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "nif_mod"),
+ {ok,nif_mod,ModBin} = compile:file(File, [binary,return_errors]),
+ {module,nif_mod} = erlang:load_module(nif_mod,ModBin),
- ?line {Holder, _MRef} = spawn_opt(fun resource_holder/0, [link, monitor]),
+ ok = nif_mod:load_nif_lib(Config, 1,
+ [{resource_type, 0, ?RT_CREATE, "resource_type_A",resource_dtor_A,
+ ?RT_CREATE},
+ {resource_type, 1, ?RT_CREATE, "resource_type_null_A",null,
+ ?RT_CREATE},
+ {resource_type, 2, ?RT_CREATE bor ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A,
+ ?RT_CREATE},
+ {resource_type, 3, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B,
+ ?RT_CREATE},
+ {resource_type, 4, ?RT_CREATE, "resource_type_null_goneX",null,
+ ?RT_CREATE},
+ {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A,
+ ?RT_TAKEOVER}
+ ]),
+
+ hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
+ [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(),
+
+ {Holder, _MRef} = spawn_opt(fun resource_holder/0, [link, monitor]),
{A1,BinA1} = make_resource(0,Holder,"A1"),
{A2,BinA2} = make_resource(0,Holder,"A2"),
@@ -718,91 +682,91 @@ resource_takeover(Config) when is_list(Config) ->
{NGX1,_BinNGX1} = make_resource(4,Holder,"NGX1"),
{NGX2,_BinNGX2} = make_resource(4,Holder,"NGX2"),
- ?line [] = nif_mod_call_history(),
+ [] = nif_mod_call_history(),
- ?line ok = forget_resource(A1),
- ?line [{{resource_dtor_A_v1,BinA1},1,3,103}] = nif_mod_call_history(),
+ ok = forget_resource(A1),
+ [{{resource_dtor_A_v1,BinA1},1,3,103}] = nif_mod_call_history(),
- ?line ok = forget_resource(NA1),
- ?line [] = nif_mod_call_history(), % no dtor
+ ok = forget_resource(NA1),
+ [] = nif_mod_call_history(), % no dtor
- ?line ok = forget_resource(AN1),
+ ok = forget_resource(AN1),
?CHECK([{{resource_dtor_A_v1,BinAN1},1,4,104}] , nif_mod_call_history()),
- ?line ok = forget_resource(BGX1),
+ ok = forget_resource(BGX1),
?CHECK([{{resource_dtor_B_v1,BinBGX1},1,5,105}], nif_mod_call_history()),
- ?line ok = forget_resource(NGX1),
+ ok = forget_resource(NGX1),
?CHECK([], nif_mod_call_history()), % no dtor
- ?line ok = nif_mod:load_nif_lib(Config, 2,
- [{resource_type, 0, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A,
- ?RT_TAKEOVER},
- {resource_type, 1, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A,
- ?RT_TAKEOVER},
- {resource_type, 2, ?RT_TAKEOVER, "resource_type_A_null",null,
- ?RT_TAKEOVER},
- {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A,
- ?RT_TAKEOVER},
- {resource_type, null, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B,
- ?RT_CREATE},
- {resource_type, null, ?RT_CREATE, "resource_type_null_goneX",null,
- ?RT_CREATE},
- {resource_type, 3, ?RT_CREATE, "resource_type_B_goneY",resource_dtor_B,
- ?RT_CREATE},
- {resource_type, 4, ?RT_CREATE, "resource_type_null_goneY",null,
- ?RT_CREATE}
- ]),
+ ok = nif_mod:load_nif_lib(Config, 2,
+ [{resource_type, 0, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A,
+ ?RT_TAKEOVER},
+ {resource_type, 1, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A,
+ ?RT_TAKEOVER},
+ {resource_type, 2, ?RT_TAKEOVER, "resource_type_A_null",null,
+ ?RT_TAKEOVER},
+ {resource_type, null, ?RT_TAKEOVER, "Pink unicorn", resource_dtor_A,
+ ?RT_TAKEOVER},
+ {resource_type, null, ?RT_CREATE, "resource_type_B_goneX",resource_dtor_B,
+ ?RT_CREATE},
+ {resource_type, null, ?RT_CREATE, "resource_type_null_goneX",null,
+ ?RT_CREATE},
+ {resource_type, 3, ?RT_CREATE, "resource_type_B_goneY",resource_dtor_B,
+ ?RT_CREATE},
+ {resource_type, 4, ?RT_CREATE, "resource_type_null_goneY",null,
+ ?RT_CREATE}
+ ]),
?CHECK([{reload,2,1,201}], nif_mod_call_history()),
- ?line BinA2 = read_resource(0,A2),
- ?line ok = forget_resource(A2),
+ BinA2 = read_resource(0,A2),
+ ok = forget_resource(A2),
?CHECK([{{resource_dtor_A_v2,BinA2},2,2,202}], nif_mod_call_history()),
- ?line ok = forget_resource(NA2),
+ ok = forget_resource(NA2),
?CHECK([{{resource_dtor_A_v2,BinNA2},2,3,203}], nif_mod_call_history()),
- ?line ok = forget_resource(AN2),
+ ok = forget_resource(AN2),
?CHECK([], nif_mod_call_history()), % no dtor
- ?line ok = forget_resource(BGX2), % calling dtor in orphan library v1 still loaded
+ ok = forget_resource(BGX2), % calling dtor in orphan library v1 still loaded
?CHECK([{{resource_dtor_B_v1,BinBGX2},1,6,106}], nif_mod_call_history()),
% How to test that lib v1 is closed here?
- ?line ok = forget_resource(NGX2),
+ ok = forget_resource(NGX2),
?CHECK([], nif_mod_call_history()), % no dtor
{BGY1,BinBGY1} = make_resource(3,Holder,"BGY1"),
{NGY1,_BinNGY1} = make_resource(4,Holder,"NGY1"),
%% Module upgrade with same lib-version
- ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin),
- ?line undefined = nif_mod:lib_version(),
- ?line ok = nif_mod:load_nif_lib(Config, 2,
- [{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_B,
- ?RT_TAKEOVER},
- {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null,
- ?RT_TAKEOVER},
- {resource_type, 1, ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A,
- ?RT_TAKEOVER},
- {resource_type, null, ?RT_TAKEOVER, "Pink elephant", resource_dtor_A,
- ?RT_TAKEOVER},
- {resource_type, 3, ?RT_CREATE, "resource_type_B_goneZ",resource_dtor_B,
- ?RT_CREATE},
- {resource_type, 4, ?RT_CREATE, "resource_type_null_goneZ",null,
- ?RT_CREATE}
- ]),
-
- ?line 2 = nif_mod:lib_version(),
+ {module,nif_mod} = erlang:load_module(nif_mod,ModBin),
+ undefined = nif_mod:lib_version(),
+ ok = nif_mod:load_nif_lib(Config, 2,
+ [{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_B,
+ ?RT_TAKEOVER},
+ {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null,
+ ?RT_TAKEOVER},
+ {resource_type, 1, ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A,
+ ?RT_TAKEOVER},
+ {resource_type, null, ?RT_TAKEOVER, "Pink elephant", resource_dtor_A,
+ ?RT_TAKEOVER},
+ {resource_type, 3, ?RT_CREATE, "resource_type_B_goneZ",resource_dtor_B,
+ ?RT_CREATE},
+ {resource_type, 4, ?RT_CREATE, "resource_type_null_goneZ",null,
+ ?RT_CREATE}
+ ]),
+
+ 2 = nif_mod:lib_version(),
?CHECK([{upgrade,2,4,204},{lib_version,2,5,205}], nif_mod_call_history()),
- ?line ok = forget_resource(A3),
+ ok = forget_resource(A3),
?CHECK([{{resource_dtor_B_v2,BinA3},2,6,206}], nif_mod_call_history()),
- ?line ok = forget_resource(NA3),
+ ok = forget_resource(NA3),
?CHECK([], nif_mod_call_history()),
- ?line ok = forget_resource(AN3),
+ ok = forget_resource(AN3),
?CHECK([{{resource_dtor_A_v2,BinAN3},2,7,207}], nif_mod_call_history()),
{A4,BinA4} = make_resource(2,Holder, "A4"),
@@ -812,19 +776,19 @@ resource_takeover(Config) when is_list(Config) ->
{BGZ1,BinBGZ1} = make_resource(3,Holder,"BGZ1"),
{NGZ1,_BinNGZ1} = make_resource(4,Holder,"NGZ1"),
- ?line false = code:purge(nif_mod),
- ?line [] = nif_mod_call_history(),
+ false = code:purge(nif_mod),
+ [] = nif_mod_call_history(),
- ?line ok = forget_resource(NGY1),
- ?line [] = nif_mod_call_history(),
+ ok = forget_resource(NGY1),
+ [] = nif_mod_call_history(),
- ?line ok = forget_resource(BGY1), % calling dtor in orphan library v2 still loaded
- ?line [{{resource_dtor_B_v2,BinBGY1},2,8,208},{unload,2,9,209}] = nif_mod_call_history(),
+ ok = forget_resource(BGY1), % calling dtor in orphan library v2 still loaded
+ [{{resource_dtor_B_v2,BinBGY1},2,8,208},{unload,2,9,209}] = nif_mod_call_history(),
%% Module upgrade with other lib-version
- ?line {module,nif_mod} = erlang:load_module(nif_mod,ModBin),
- ?line undefined = nif_mod:lib_version(),
- ?line ok = nif_mod:load_nif_lib(Config, 1,
+ {module,nif_mod} = erlang:load_module(nif_mod,ModBin),
+ undefined = nif_mod:lib_version(),
+ ok = nif_mod:load_nif_lib(Config, 1,
[{resource_type, 2, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A,
?RT_TAKEOVER},
{resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",resource_dtor_A,
@@ -835,28 +799,28 @@ resource_takeover(Config) when is_list(Config) ->
?RT_TAKEOVER}
]),
- ?line 1 = nif_mod:lib_version(),
- ?line [{upgrade,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(),
+ 1 = nif_mod:lib_version(),
+ [{upgrade,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(),
- %%?line false= check_process_code(Pid, nif_mod),
- ?line false = code:purge(nif_mod),
+ %%false= check_process_code(Pid, nif_mod),
+ false = code:purge(nif_mod),
%% no unload here as we still have instances with destructors
- ?line [] = nif_mod_call_history(),
+ [] = nif_mod_call_history(),
- ?line ok = forget_resource(BGZ1), % calling dtor in orphan library v2 still loaded
- ?line [{{resource_dtor_B_v2,BinBGZ1},2,10,210},{unload,2,11,211}] = nif_mod_call_history(),
+ ok = forget_resource(BGZ1), % calling dtor in orphan library v2 still loaded
+ [{{resource_dtor_B_v2,BinBGZ1},2,10,210},{unload,2,11,211}] = nif_mod_call_history(),
- ?line ok = forget_resource(NGZ1),
- ?line [] = nif_mod_call_history(),
+ ok = forget_resource(NGZ1),
+ [] = nif_mod_call_history(),
- ?line ok = forget_resource(A4),
- ?line [{{resource_dtor_A_v1,BinA4},1,3,103}] = nif_mod_call_history(),
+ ok = forget_resource(A4),
+ [{{resource_dtor_A_v1,BinA4},1,3,103}] = nif_mod_call_history(),
- ?line ok = forget_resource(NA4),
- ?line [{{resource_dtor_A_v1,BinNA4},1,4,104}] = nif_mod_call_history(),
+ ok = forget_resource(NA4),
+ [{{resource_dtor_A_v1,BinNA4},1,4,104}] = nif_mod_call_history(),
- ?line ok = forget_resource(AN4),
- ?line [] = nif_mod_call_history(),
+ ok = forget_resource(AN4),
+ [] = nif_mod_call_history(),
%%
@@ -978,8 +942,8 @@ resource_takeover(Config) when is_list(Config) ->
{return, 0} % SUCCESS
]),
- ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
- ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(),
+ hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()),
+ [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(),
{NA7,BinNA7} = make_resource(0, Holder, "NA7"),
{AN7,BinAN7} = make_resource(1, Holder, "AN7"),
@@ -990,15 +954,15 @@ resource_takeover(Config) when is_list(Config) ->
ok = forget_resource(AN7),
[] = nif_mod_call_history(),
- ?line true = lists:member(?MODULE, erlang:system_info(taints)),
- ?line true = lists:member(nif_mod, erlang:system_info(taints)),
- ?line verify_tmpmem(TmpMem),
+ true = lists:member(?MODULE, erlang:system_info(taints)),
+ true = lists:member(nif_mod, erlang:system_info(taints)),
+ verify_tmpmem(TmpMem),
ok.
make_resource(Type,Holder,Str) when is_list(Str) ->
Bin = list_to_binary(Str),
A1 = make_resource_do(Type,Holder,Bin),
- ?line Bin = read_resource(Type,A1),
+ Bin = read_resource(Type,A1),
{A1,Bin}.
make_resource_do(Type, Holder, Bin) ->
@@ -1025,7 +989,7 @@ resource_holder(List) ->
%%io:format("resource_holder got ~p with list = ~p\n", [Msg,List]),
case Msg of
{Pid, make, Type, Bin} ->
- ?line Resource = nif_mod:make_new_resource(Type, Bin),
+ Resource = nif_mod:make_new_resource(Type, Bin),
Id = {make_ref(),Bin},
Pid ! {self(), make_ok, Id},
resource_holder([{Id,Resource} | List]);
@@ -1047,7 +1011,7 @@ resource_holder(Pid,Reply,List) ->
resource_holder(List).
-threading(doc) -> ["Test the threading API functions (reuse tests from driver API)"];
+%% Test the threading API functions (reuse tests from driver API)
threading(Config) when is_list(Config) ->
case erlang:system_info(threads) of
true -> threading_do(Config);
@@ -1055,53 +1019,53 @@ threading(Config) when is_list(Config) ->
end.
threading_do(Config) ->
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "tester"),
- ?line {ok,tester,ModBin} = compile:file(File, [binary,return_errors]),
- ?line {module,tester} = erlang:load_module(tester,ModBin),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "tester"),
+ {ok,tester,ModBin} = compile:file(File, [binary,return_errors]),
+ {module,tester} = erlang:load_module(tester,ModBin),
- ?line ok = tester:load_nif_lib(Config, "basic"),
- ?line ok = tester:run(),
+ ok = tester:load_nif_lib(Config, "basic"),
+ ok = tester:run(),
- ?line ok = tester:load_nif_lib(Config, "rwlock"),
- ?line ok = tester:run(),
+ ok = tester:load_nif_lib(Config, "rwlock"),
+ ok = tester:run(),
- ?line ok = tester:load_nif_lib(Config, "tsd"),
- ?line ok = tester:run().
+ ok = tester:load_nif_lib(Config, "tsd"),
+ ok = tester:run().
-send(doc) -> ["Test NIF message sending"];
+%% Test NIF message sending
send(Config) when is_list(Config) ->
ensure_lib_loaded(Config),
N = 1500,
List = lists:seq(1,N),
- ?line {ok,1} = send_list_seq(N, self),
- ?line {ok,1} = send_list_seq(N, self()),
- ?line List = receive_any(),
- ?line List = receive_any(),
+ {ok,1} = send_list_seq(N, self),
+ {ok,1} = send_list_seq(N, self()),
+ List = receive_any(),
+ List = receive_any(),
Papa = self(),
- spawn_link(fun() -> ?line {ok,1} = send_list_seq(N, Papa) end),
- ?line List = receive_any(),
+ spawn_link(fun() -> {ok,1} = send_list_seq(N, Papa) end),
+ List = receive_any(),
- ?line {ok, 1, BlobS} = send_new_blob(self(), other_term()),
- ?line BlobR = receive_any(),
+ {ok, 1, BlobS} = send_new_blob(self(), other_term()),
+ BlobR = receive_any(),
io:format("Sent ~p\nGot ~p\n", [BlobS, BlobR]),
- ?line BlobR = BlobS,
+ BlobR = BlobS,
%% send to dead pid
{DeadPid, DeadMon} = spawn_monitor(fun() -> void end),
- ?line {'DOWN', DeadMon, process, DeadPid, normal} = receive_any(),
+ {'DOWN', DeadMon, process, DeadPid, normal} = receive_any(),
{ok,0} = send_list_seq(7, DeadPid),
ok.
-send2(doc) -> ["More NIF message sending"];
+%% More NIF message sending
send2(Config) when is_list(Config) ->
ensure_lib_loaded(Config),
send2_do1(fun send_blob_dbg/2),
ok.
-send_threaded(doc) -> ["Send msg from user thread"];
+%% Send msg from user thread
send_threaded(Config) when is_list(Config) ->
case erlang:system_info(smp_support) of
true ->
@@ -1122,44 +1086,44 @@ send2_do1(SendBlobF) ->
io:format("sending to forwarder pid=~p\n",[Forwarder]),
send2_do2(SendBlobF, Forwarder),
Forwarder ! terminate,
- ?line {Forwarder, 4} = receive_any(),
+ {Forwarder, 4} = receive_any(),
ok.
send2_do2(SendBlobF, To) ->
MsgEnv = alloc_msgenv(),
repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
- ?line {ok,1,Blob0} = SendBlobF(MsgEnv, To),
- ?line Blob1 = receive_any(),
- ?line Blob1 = Blob0,
+ {ok,1,Blob0} = SendBlobF(MsgEnv, To),
+ Blob1 = receive_any(),
+ Blob1 = Blob0,
clear_msgenv(MsgEnv),
repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
- ?line {ok,1,Blob2} = SendBlobF(MsgEnv, To),
- ?line Blob3 = receive_any(),
- ?line Blob3 = Blob2,
+ {ok,1,Blob2} = SendBlobF(MsgEnv, To),
+ Blob3 = receive_any(),
+ Blob3 = Blob2,
clear_msgenv(MsgEnv),
repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
clear_msgenv(MsgEnv),
repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
- ?line {ok,1,Blob4} = SendBlobF(MsgEnv, To),
- ?line Blob5 = receive_any(),
- ?line Blob5 = Blob4,
+ {ok,1,Blob4} = SendBlobF(MsgEnv, To),
+ Blob5 = receive_any(),
+ Blob5 = Blob4,
clear_msgenv(MsgEnv),
clear_msgenv(MsgEnv),
repeat(50, fun(_) -> grow_blob(MsgEnv,other_term()) end, []),
- ?line {ok,1,Blob6} = SendBlobF(MsgEnv, To),
- ?line Blob7 = receive_any(),
- ?line Blob7 = Blob6,
+ {ok,1,Blob6} = SendBlobF(MsgEnv, To),
+ Blob7 = receive_any(),
+ Blob7 = Blob6,
ok.
send_blob_thread_and_join(MsgEnv, To) ->
- ?line {ok,Blob} = send_blob_thread_dbg(MsgEnv, To, no_join),
- ?line {ok,SendRes} = join_send_thread(MsgEnv),
+ {ok,Blob} = send_blob_thread_dbg(MsgEnv, To, no_join),
+ {ok,SendRes} = join_send_thread(MsgEnv),
{ok,SendRes,Blob}.
send_blob_dbg(MsgEnv, To) ->
@@ -1187,21 +1151,18 @@ forwarder(To, N) ->
other_term() ->
{fun(X,Y) -> X*Y end, make_ref()}.
-send3(doc) -> ["Message sending stress test"];
+%% Message sending stress test
send3(Config) when is_list(Config) ->
%% Let a number of processes send random message blobs between each other
%% using enif_send. Kill and spawn new ones randomly to keep a ~constant
%% number of workers running.
- Seed = {erlang:monotonic_time(),
- erlang:time_offset(),
- erlang:unique_integer()},
- io:format("seed: ~p\n",[Seed]),
- random:seed(Seed),
+ rand:seed(exsplus),
+ io:format("seed: ~p\n",[rand:export_seed()]),
ets:new(nif_SUITE,[named_table,public]),
- ?line true = ets:insert(nif_SUITE,{send3,0,0,0,0}),
+ true = ets:insert(nif_SUITE,{send3,0,0,0,0}),
timer:send_after(10000, timeout), % Run for 10 seconds
SpawnCnt = send3_controller(0, [], [], 20),
- ?line [{_,Rcv,SndOk,SndFail,Balance}] = ets:lookup(nif_SUITE,send3),
+ [{_,Rcv,SndOk,SndFail,Balance}] = ets:lookup(nif_SUITE,send3),
io:format("spawns=~p received=~p, sent=~p send-failure=~p balance=~p\n",
[SpawnCnt,Rcv,SndOk,SndFail,Balance]),
ets:delete(nif_SUITE).
@@ -1229,13 +1190,13 @@ send3_controller(SpawnCnt0, Mons0, Pids0, Tick) ->
after Tick ->
Max = 20,
N = length(Pids0),
- PidN = random:uniform(Max),
+ PidN = rand:uniform(Max),
%%io:format("N=~p PidN=~p Pids0=~p\n", [N,PidN,Pids0]),
case PidN > N of
true ->
{NewPid,Mon} = spawn_opt(fun send3_proc/0, [link,monitor]),
lists:foreach(fun(P) -> P ! {is_born,NewPid} end, Pids0),
- ?line Balance = ets:lookup_element(nif_SUITE,send3,5),
+ Balance = ets:lookup_element(nif_SUITE,send3,5),
Inject = (Balance =< 0),
case Inject of
true -> ok;
@@ -1261,7 +1222,7 @@ send3_proc(Pids0, Counters={Rcv,SndOk,SndFail}, State0) ->
receive
{pids, Pids1, Inject} ->
%%io:format("~p: got ~p Inject=~p\n", [self(), Pids1, Inject]),
- ?line Pids0 = [self()],
+ Pids0 = [self()],
Pids2 = [self() | Pids1],
case Inject of
true -> send3_proc_send(Pids2, Counters, State0);
@@ -1293,7 +1254,7 @@ send3_proc(Pids0, Counters={Rcv,SndOk,SndFail}, State0) ->
end.
send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) ->
- To = lists:nth(random:uniform(length(Pids)),Pids),
+ To = lists:nth(rand:uniform(length(Pids)),Pids),
Blob = send3_make_blob(),
State1 = send3_new_state(State0,Blob),
case send3_send(To, Blob) of
@@ -1305,12 +1266,12 @@ send3_proc_send(Pids, {Rcv,SndOk,SndFail}, State0) ->
send3_make_blob() ->
- case random:uniform(20)-1 of
+ case rand:uniform(20)-1 of
0 -> {term,[]};
N ->
MsgEnv = alloc_msgenv(),
repeat(N bsr 1,
- fun(_) -> grow_blob(MsgEnv,other_term(),random:uniform(1 bsl 20))
+ fun(_) -> grow_blob(MsgEnv,other_term(),rand:uniform(1 bsl 20))
end, void),
case (N band 1) of
0 -> {term,copy_blob(MsgEnv)};
@@ -1320,7 +1281,7 @@ send3_make_blob() ->
send3_send(Pid, Msg) ->
%% 90% enif_send and 10% normal bang
- case random:uniform(10) of
+ case rand:uniform(10) of
1 -> send3_send_bang(Pid,Msg);
_ -> send3_send_nif(Pid,Msg)
end.
@@ -1341,103 +1302,103 @@ send3_send_bang(Pid, {msgenv,MsgEnv}) ->
true.
send3_new_state(State, Blob) ->
- case random:uniform(5+2) of
+ case rand:uniform(5+2) of
N when N =< 5-> setelement(N, State, Blob);
_ -> State % Don't store blob
end.
-neg(doc) -> ["Negative testing of load_nif"];
+%% Negative testing of load_nif
neg(Config) when is_list(Config) ->
TmpMem = tmpmem(),
- ?line {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)),
- ?line {error,{load_failed,_}} = erlang:load_nif("pink_unicorn", 0),
+ {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)),
+ {error,{load_failed,_}} = erlang:load_nif("pink_unicorn", 0),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "nif_mod"),
- ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]),
- ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "nif_mod"),
+ {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]),
+ {module,nif_mod} = erlang:load_module(nif_mod,Bin),
- ?line {error,{bad_lib,_}} = nif_mod:load_nif_lib(Config, no_init),
- ?line verify_tmpmem(TmpMem),
- ?line ok.
+ {error,{bad_lib,_}} = nif_mod:load_nif_lib(Config, no_init),
+ verify_tmpmem(TmpMem),
+ ok.
-is_checks(doc) -> ["Test all enif_is functions"];
+%% Test all enif_is functions
is_checks(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
- ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ ensure_lib_loaded(Config, 1),
+ ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
{hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 12),
- ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
{hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -12),
- ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
{hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551617),
- ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
{hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551617),
- ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
{hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 99.146),
- ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
{hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -99.146),
- ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
{hejsan, "hejsan", [$h,"ejs",<<"an">>]}, 18446744073709551616.2e2),
- ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
+ ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
{hejsan, "hejsan", [$h,"ejs",<<"an">>]}, -18446744073709551616.2e2),
try
- ?line check_is_exception(),
- ?line throw(expected_badarg)
+ check_is_exception(),
+ throw(expected_badarg)
catch
error:badarg ->
- ?line ok
+ ok
end.
-get_length(doc) -> ["Test all enif_get_length functions"];
+%% Test all enif_get_length functions
get_length(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
- ?line ok = length_test(hejsan, "hejsan", [], [], not_a_list).
+ ensure_lib_loaded(Config, 1),
+ ok = length_test(hejsan, "hejsan", [], [], not_a_list, [1,2|3]).
ensure_lib_loaded(Config) ->
ensure_lib_loaded(Config, 1).
ensure_lib_loaded(Config, Ver) ->
- ?line case lib_version() of
+ case lib_version() of
undefined ->
- ?line Path = ?config(data_dir, Config),
- ?line Lib = "nif_SUITE." ++ integer_to_list(Ver),
- ?line ok = erlang:load_nif(filename:join(Path,Lib), []);
+ Path = proplists:get_value(data_dir, Config),
+ Lib = "nif_SUITE." ++ integer_to_list(Ver),
+ ok = erlang:load_nif(filename:join(Path,Lib), []);
Ver when is_integer(Ver) ->
ok
end.
make_atom(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
+ ensure_lib_loaded(Config, 1),
An0Atom = an0atom,
An0Atom0 = 'an\000atom\000',
- ?line Atoms = make_atoms(),
- ?line 7 = size(Atoms),
- ?line Atoms = {An0Atom,An0Atom,An0Atom,An0Atom0,An0Atom,An0Atom,An0Atom0}.
+ Atoms = make_atoms(),
+ 7 = size(Atoms),
+ Atoms = {An0Atom,An0Atom,An0Atom,An0Atom0,An0Atom,An0Atom,An0Atom0}.
make_string(Config) when is_list(Config) ->
- ?line ensure_lib_loaded(Config, 1),
- ?line Strings = make_strings(),
- ?line 5 = size(Strings),
+ ensure_lib_loaded(Config, 1),
+ Strings = make_strings(),
+ 5 = size(Strings),
A0String = "a0string",
A0String0 = [$a,0,$s,$t,$r,$i,$n,$g,0],
AStringWithAccents = [$E,$r,$l,$a,$n,$g,$ ,16#e4,$r,$ ,$e,$t,$t,$ ,$g,$e,$n,$e,$r,$e,$l,$l,$t,$ ,$p,$r,$o,$g,$r,$a,$m,$s,$p,$r,16#e5,$k],
- ?line Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}.
+ Strings = {A0String,A0String,A0String,A0String0, AStringWithAccents}.
reverse_list_test(Config) ->
- ?line ensure_lib_loaded(Config, 1),
+ ensure_lib_loaded(Config, 1),
List = lists:seq(1,100),
RevList = lists:reverse(List),
- ?line RevList = reverse_list(List),
- ?line badarg = reverse_list(foo).
+ RevList = reverse_list(List),
+ badarg = reverse_list(foo).
-otp_9668(doc) -> ["Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment"];
+%% Memory leak of tmp-buffer when inspecting iolist or unaligned binary in unbound environment
otp_9668(Config) ->
ensure_lib_loaded(Config, 1),
TmpMem = tmpmem(),
@@ -1447,13 +1408,12 @@ otp_9668(Config) ->
<<_:5/bitstring,UnalignedBin:10/binary,_/bitstring>> = <<"Abuse me as unaligned">>,
otp_9668_nif(UnalignedBin),
- ?line verify_tmpmem(TmpMem),
+ verify_tmpmem(TmpMem),
ok.
-otp_9828(doc) -> ["Copy of writable binary"];
+%% Copy of writable binary
otp_9828(Config) ->
ensure_lib_loaded(Config, 1),
-
otp_9828_loop(<<"I'm alive!">>, 1000).
otp_9828_loop(Bin, 0) ->
@@ -1472,68 +1432,68 @@ consume_timeslice(Config) when is_list(Config) ->
Done = make_ref(),
DummyMFA = {?MODULE,dummy_call,1},
P = spawn(fun () ->
- receive Go -> ok end,
- {reductions, R1} = process_info(self(), reductions),
- 1 = consume_timeslice_nif(100, false),
- dummy_call(111),
- 0 = consume_timeslice_nif(90, false),
- dummy_call(222),
- 1 = consume_timeslice_nif(10, false),
- dummy_call(333),
- 0 = consume_timeslice_nif(25, false),
- 0 = consume_timeslice_nif(25, false),
- 0 = consume_timeslice_nif(25, false),
- 1 = consume_timeslice_nif(25, false),
- 0 = consume_timeslice_nif(25, false),
-
- ok = case consume_timeslice_nif(1, true) of
- Cnt when Cnt > 70, Cnt < 80 -> ok;
- Other -> Other
- end,
- dummy_call(444),
-
- {reductions, R2} = process_info(self(), reductions),
- Me ! {RedDiff, R2 - R1},
- exit(Done)
- end),
+ receive Go -> ok end,
+ {reductions, R1} = process_info(self(), reductions),
+ 1 = consume_timeslice_nif(100, false),
+ dummy_call(111),
+ 0 = consume_timeslice_nif(90, false),
+ dummy_call(222),
+ 1 = consume_timeslice_nif(10, false),
+ dummy_call(333),
+ 0 = consume_timeslice_nif(25, false),
+ 0 = consume_timeslice_nif(25, false),
+ 0 = consume_timeslice_nif(25, false),
+ 1 = consume_timeslice_nif(25, false),
+ 0 = consume_timeslice_nif(25, false),
+
+ ok = case consume_timeslice_nif(1, true) of
+ Cnt when Cnt > 70, Cnt < 80 -> ok;
+ Other -> Other
+ end,
+ dummy_call(444),
+
+ {reductions, R2} = process_info(self(), reductions),
+ Me ! {RedDiff, R2 - R1},
+ exit(Done)
+ end),
erlang:yield(),
erlang:trace_pattern(DummyMFA, [], [local]),
- ?line 1 = erlang:trace(P, true, [call, running, procs, {tracer, self()}]),
+ 1 = erlang:trace(P, true, [call, running, procs, {tracer, self()}]),
P ! Go,
%% receive Go -> ok end,
- ?line {trace, P, in, _} = next_tmsg(P),
+ {trace, P, in, _} = next_tmsg(P),
%% consume_timeslice_nif(100),
%% dummy_call(111)
- ?line {trace, P, out, _} = next_tmsg(P),
- ?line {trace, P, in, _} = next_tmsg(P),
- ?line {trace, P, call, {?MODULE,dummy_call,[111]}} = next_tmsg(P),
+ {trace, P, out, _} = next_tmsg(P),
+ {trace, P, in, _} = next_tmsg(P),
+ {trace, P, call, {?MODULE,dummy_call,[111]}} = next_tmsg(P),
%% consume_timeslice_nif(90),
%% dummy_call(222)
- ?line {trace, P, call, {?MODULE,dummy_call,[222]}} = next_tmsg(P),
+ {trace, P, call, {?MODULE,dummy_call,[222]}} = next_tmsg(P),
%% consume_timeslice_nif(10),
%% dummy_call(333)
- ?line {trace, P, out, _} = next_tmsg(P),
- ?line {trace, P, in, _} = next_tmsg(P),
- ?line {trace, P, call, {?MODULE,dummy_call,[333]}} = next_tmsg(P),
+ {trace, P, out, _} = next_tmsg(P),
+ {trace, P, in, _} = next_tmsg(P),
+ {trace, P, call, {?MODULE,dummy_call,[333]}} = next_tmsg(P),
%% 25,25,25,25, 25
- ?line {trace, P, out, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P),
- ?line {trace, P, in, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P),
+ {trace, P, out, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P),
+ {trace, P, in, {?MODULE,consume_timeslice_nif,2}} = next_tmsg(P),
%% consume_timeslice(1,true)
%% dummy_call(444)
- ?line {trace, P, out, DummyMFA} = next_tmsg(P),
- ?line {trace, P, in, DummyMFA} = next_tmsg(P),
- ?line {trace, P, call, {?MODULE,dummy_call,[444]}} = next_tmsg(P),
+ {trace, P, out, DummyMFA} = next_tmsg(P),
+ {trace, P, in, DummyMFA} = next_tmsg(P),
+ {trace, P, call, {?MODULE,dummy_call,[444]}} = next_tmsg(P),
%% exit(Done)
- ?line {trace, P, exit, Done} = next_tmsg(P),
+ {trace, P, exit, Done} = next_tmsg(P),
ExpReds = (100 + 90 + 10 + 25*5 + 75) * CONTEXT_REDS div 100,
receive
@@ -1541,7 +1501,7 @@ consume_timeslice(Config) when is_list(Config) ->
io:format("Reductions = ~p~n", [Reductions]),
ok;
{RedDiff, Reductions} ->
- ?t:fail({unexpected_reduction_count, Reductions})
+ ct:fail({unexpected_reduction_count, Reductions})
end,
none = next_msg(P),
@@ -1598,38 +1558,38 @@ dirty_nif_send(Config) when is_list(Config) ->
dirty_nif_exception(Config) when is_list(Config) ->
try erlang:system_info(dirty_cpu_schedulers) of
- N when is_integer(N) ->
- ensure_lib_loaded(Config),
- try
- %% this checks that the expected exception occurs when the
- %% dirty NIF returns the result of enif_make_badarg
- %% directly
- call_dirty_nif_exception(1),
- ?t:fail(expected_badarg)
- catch
- error:badarg ->
- [{?MODULE,call_dirty_nif_exception,[1],_}|_] =
- erlang:get_stacktrace(),
- ok
- end,
- try
- %% this checks that the expected exception occurs when the
- %% dirty NIF calls enif_make_badarg at some point but then
- %% returns a value that isn't an exception
- call_dirty_nif_exception(0),
- ?t:fail(expected_badarg)
- catch
- error:badarg ->
- [{?MODULE,call_dirty_nif_exception,[0],_}|_] =
- erlang:get_stacktrace(),
- ok
- end,
- %% this checks that a dirty NIF can raise various terms as
- %% exceptions
- ok = nif_raise_exceptions(call_dirty_nif_exception)
+ N when is_integer(N) ->
+ ensure_lib_loaded(Config),
+ try
+ %% this checks that the expected exception occurs when the
+ %% dirty NIF returns the result of enif_make_badarg
+ %% directly
+ call_dirty_nif_exception(1),
+ ct:fail(expected_badarg)
+ catch
+ error:badarg ->
+ [{?MODULE,call_dirty_nif_exception,[1],_}|_] =
+ erlang:get_stacktrace(),
+ ok
+ end,
+ try
+ %% this checks that the expected exception occurs when the
+ %% dirty NIF calls enif_make_badarg at some point but then
+ %% returns a value that isn't an exception
+ call_dirty_nif_exception(0),
+ ct:fail(expected_badarg)
+ catch
+ error:badarg ->
+ [{?MODULE,call_dirty_nif_exception,[0],_}|_] =
+ erlang:get_stacktrace(),
+ ok
+ end,
+ %% this checks that a dirty NIF can raise various terms as
+ %% exceptions
+ ok = nif_raise_exceptions(call_dirty_nif_exception)
catch
- error:badarg ->
- {skipped,"No dirty scheduler support"}
+ error:badarg ->
+ {skipped,"No dirty scheduler support"}
end.
nif_exception(Config) when is_list(Config) ->
@@ -1639,7 +1599,7 @@ nif_exception(Config) when is_list(Config) ->
%% calls enif_make_badarg at some point but then tries to return a
%% value that isn't an exception
call_nif_exception(0),
- ?t:fail(expected_badarg)
+ ct:fail(expected_badarg)
catch
error:badarg ->
ok
@@ -1652,21 +1612,21 @@ nif_nan_and_inf(Config) when is_list(Config) ->
ensure_lib_loaded(Config),
try
call_nif_nan_or_inf(nan),
- ?t:fail(expected_badarg)
+ ct:fail(expected_badarg)
catch
error:badarg ->
ok
end,
try
call_nif_nan_or_inf(inf),
- ?t:fail(expected_badarg)
+ ct:fail(expected_badarg)
catch
error:badarg ->
ok
end,
try
call_nif_nan_or_inf(tuple),
- ?t:fail(expected_badarg)
+ ct:fail(expected_badarg)
catch
error:badarg ->
ok
@@ -1676,14 +1636,14 @@ nif_atom_too_long(Config) when is_list(Config) ->
ensure_lib_loaded(Config),
try
call_nif_atom_too_long(all),
- ?t:fail(expected_badarg)
+ ct:fail(expected_badarg)
catch
error:badarg ->
ok
end,
try
call_nif_atom_too_long(len),
- ?t:fail(expected_badarg)
+ ct:fail(expected_badarg)
catch
error:badarg ->
ok
@@ -1691,19 +1651,19 @@ nif_atom_too_long(Config) when is_list(Config) ->
next_msg(_Pid) ->
receive
- M -> M
+ M -> M
after 100 ->
- none
+ none
end.
next_tmsg(Pid) ->
receive TMsg when is_tuple(TMsg),
- element(1, TMsg) == trace,
- element(2, TMsg) == Pid ->
- TMsg
- after 100 ->
- none
- end.
+ element(1, TMsg) == trace,
+ element(2, TMsg) == Pid ->
+ TMsg
+ after 100 ->
+ none
+ end.
dummy_call(_) ->
ok.
@@ -1713,7 +1673,9 @@ tmpmem() ->
false -> undefined;
MemInfo ->
MSBCS = lists:foldl(
- fun ({instance, _, L}, Acc) ->
+ fun ({instance, 0, _}, Acc) ->
+ Acc; % Ignore instance 0
+ ({instance, _, L}, Acc) ->
{value,{_,MBCS}} = lists:keysearch(mbcs, 1, L),
{value,{_,SBCS}} = lists:keysearch(sbcs, 1, L),
[MBCS,SBCS | Acc]
@@ -1741,9 +1703,7 @@ verify_tmpmem(MemInfo) ->
ok
end;
Other ->
- io:format("Expected: ~p", [MemInfo]),
- io:format("Actual: ~p", [Other]),
- ?t:fail()
+ ct:fail("Expected: ~p\nActual: ~p", [MemInfo, Other])
end.
call(Pid,Cmd) ->
@@ -1771,17 +1731,159 @@ check(Exp,Got,Line) ->
nif_raise_exceptions(NifFunc) ->
ExcTerms = [{error, test}, "a string", <<"a binary">>,
- 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]],
+ 42, [1,2,3,4,5], [{p,1},{p,2},{p,3}]],
lists:foldl(fun(Term, ok) ->
- try
- erlang:apply(?MODULE,NifFunc,[Term]),
- ?t:fail({expected,Term})
- catch
- error:Term ->
- [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(),
- ok
- end
- end, ok, ExcTerms).
+ try
+ erlang:apply(?MODULE,NifFunc,[Term]),
+ ct:fail({expected,Term})
+ catch
+ error:Term ->
+ [{?MODULE,NifFunc,[Term],_}|_] = erlang:get_stacktrace(),
+ ok
+ end
+ end, ok, ExcTerms).
+
+-define(ERL_NIF_TIME_ERROR, -9223372036854775808).
+-define(TIME_UNITS, [seconds, milli_seconds, micro_seconds, nano_seconds]).
+
+nif_monotonic_time(Config) ->
+ ?ERL_NIF_TIME_ERROR = monotonic_time(invalid_time_unit),
+ mtime_loop(1000000).
+
+mtime_loop(0) ->
+ ok;
+mtime_loop(N) ->
+ chk_mtime(?TIME_UNITS),
+ mtime_loop(N-1).
+
+chk_mtime([]) ->
+ ok;
+chk_mtime([TU|TUs]) ->
+ A = erlang:monotonic_time(TU),
+ B = monotonic_time(TU),
+ C = erlang:monotonic_time(TU),
+ try
+ true = A =< B,
+ true = B =< C
+ catch
+ _ : _ ->
+ ct:fail({monotonic_time_missmatch, TU, A, B, C})
+ end,
+ chk_mtime(TUs).
+
+nif_time_offset(Config) ->
+ ?ERL_NIF_TIME_ERROR = time_offset(invalid_time_unit),
+ toffs_loop(1000000).
+
+toffs_loop(0) ->
+ ok;
+toffs_loop(N) ->
+ chk_toffs(?TIME_UNITS),
+ toffs_loop(N-1).
+
+chk_toffs([]) ->
+ ok;
+chk_toffs([TU|TUs]) ->
+ TO = erlang:time_offset(TU),
+ NifTO = time_offset(TU),
+ case TO =:= NifTO of
+ true ->
+ ok;
+ false ->
+ case erlang:system_info(time_warp_mode) of
+ no_time_warp ->
+ ct:fail({time_offset_mismatch, TU, TO, NifTO});
+ _ ->
+ %% Most frequent time offset change
+ %% is currently only every 15:th
+ %% second so this should currently
+ %% work...
+ NTO = erlang:time_offset(TU),
+ case NifTO =:= NTO of
+ true ->
+ ok;
+ false ->
+ ct:fail({time_offset_mismatch, TU, TO, NifTO, NTO})
+ end
+ end
+ end,
+ chk_toffs(TUs).
+
+nif_convert_time_unit(Config) ->
+ ?ERL_NIF_TIME_ERROR = convert_time_unit(0, seconds, invalid_time_unit),
+ ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, seconds),
+ ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, invalid_time_unit),
+ lists:foreach(fun (Offset) ->
+ lists:foreach(fun (Diff) ->
+ chk_ctu(Diff+(Offset*1000*1000*1000))
+ end,
+ [999999999999,
+ 99999999999,
+ 9999999999,
+ 999999999,
+ 99999999,
+ 9999999,
+ 999999,
+ 99999,
+ 999,
+ 99,
+ 9,
+ 1,
+ 11,
+ 101,
+ 1001,
+ 10001,
+ 100001,
+ 1000001,
+ 10000001,
+ 100000001,
+ 1000000001,
+ 100000000001,
+ 1000000000001,
+ 5,
+ 50,
+ 500,
+ 5000,
+ 50000,
+ 500000,
+ 5000000,
+ 50000000,
+ 500000000,
+ 5000000000,
+ 50000000000,
+ 500000000000])
+ end,
+ [-4711, -1000, -475, -5, -4, -3, -2, -1, 0,
+ 1, 2, 3, 4, 5, 475, 1000, 4711]),
+ ctu_loop(1000000).
+
+ctu_loop(0) ->
+ ok;
+ctu_loop(N) ->
+ chk_ctu(erlang:monotonic_time(nano_seconds)),
+ ctu_loop(N-1).
+
+chk_ctu(Time) ->
+ chk_ctu(Time, ?TIME_UNITS).
+
+chk_ctu(_Time, []) ->
+ ok;
+chk_ctu(Time, [FromTU|FromTUs]) ->
+ chk_ctu(Time, FromTU, ?TIME_UNITS),
+ chk_ctu(Time, FromTUs).
+
+chk_ctu(_Time, _FromTU, []) ->
+ ok;
+chk_ctu(Time, FromTU, [ToTU|ToTUs]) ->
+ T = erlang:convert_time_unit(Time, nano_seconds, FromTU),
+ TE = erlang:convert_time_unit(T, FromTU, ToTU),
+ TN = convert_time_unit(T, FromTU, ToTU),
+ case TE =:= TN of
+ false ->
+ ct:fail({conversion_mismatch, FromTU, T, ToTU, TE, TN});
+ true ->
+ chk_ctu(Time, FromTU, ToTUs)
+ end.
%% The NIFs:
lib_version() -> undefined.
@@ -1810,7 +1912,7 @@ last_resource_dtor_call() -> ?nif_stub.
make_new_resource(_,_) -> ?nif_stub.
check_is(_,_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
check_is_exception() -> ?nif_stub.
-length_test(_,_,_,_,_) -> ?nif_stub.
+length_test(_,_,_,_,_,_) -> ?nif_stub.
make_atoms() -> ?nif_stub.
make_strings() -> ?nif_stub.
make_new_resource_binary(_) -> ?nif_stub.
@@ -1852,6 +1954,11 @@ make_map_remove_nif(_,_) -> ?nif_stub.
maps_from_list_nif(_) -> ?nif_stub.
sorted_list_from_maps_nif(_) -> ?nif_stub.
+%% Time
+monotonic_time(_) -> ?nif_stub.
+time_offset(_) -> ?nif_stub.
+convert_time_unit(_,_,_) -> ?nif_stub.
+
nif_stub_error(Line) ->
exit({nif_not_loaded,module,?MODULE,line,Line}).
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index 98e1efe18f..1acb270d1f 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -34,6 +34,10 @@ static ERL_NIF_TERM atom_self;
static ERL_NIF_TERM atom_ok;
static ERL_NIF_TERM atom_join;
static ERL_NIF_TERM atom_binary_resource_type;
+static ERL_NIF_TERM atom_seconds;
+static ERL_NIF_TERM atom_milli_seconds;
+static ERL_NIF_TERM atom_micro_seconds;
+static ERL_NIF_TERM atom_nano_seconds;
typedef struct
@@ -138,6 +142,10 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
atom_ok = enif_make_atom(env,"ok");
atom_join = enif_make_atom(env,"join");
atom_binary_resource_type = enif_make_atom(env,"binary_resource_type");
+ atom_seconds = enif_make_atom(env,"seconds");
+ atom_milli_seconds = enif_make_atom(env,"milli_seconds");
+ atom_micro_seconds = enif_make_atom(env,"micro_seconds");
+ atom_nano_seconds = enif_make_atom(env,"nano_seconds");
*priv_data = data;
return 0;
@@ -906,6 +914,7 @@ static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_T
* argv[2] empty list
* argv[3] not an atom
* argv[4] not a list
+ * argv[5] improper list
*/
static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
@@ -926,6 +935,9 @@ static ERL_NIF_TERM length_test(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
if (enif_get_list_length(env, argv[4], &len))
return enif_make_badarg(env);
+ if (enif_get_list_length(env, argv[5], &len))
+ return enif_make_badarg(env);
+
return enif_make_atom(env, "ok");
}
@@ -1885,6 +1897,87 @@ static ERL_NIF_TERM sorted_list_from_maps_nif(ErlNifEnv* env, int argc, const ER
return enif_make_tuple2(env, list_f, list_b);
}
+
+static ERL_NIF_TERM monotonic_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifTimeUnit time_unit;
+
+ if (argc != 1)
+ return atom_false;
+
+ if (enif_compare(argv[0], atom_seconds) == 0)
+ time_unit = ERL_NIF_SEC;
+ else if (enif_compare(argv[0], atom_milli_seconds) == 0)
+ time_unit = ERL_NIF_MSEC;
+ else if (enif_compare(argv[0], atom_micro_seconds) == 0)
+ time_unit = ERL_NIF_USEC;
+ else if (enif_compare(argv[0], atom_nano_seconds) == 0)
+ time_unit = ERL_NIF_NSEC;
+ else
+ time_unit = 4711; /* invalid time unit */
+
+ return enif_make_int64(env, enif_monotonic_time(time_unit));
+}
+
+static ERL_NIF_TERM time_offset(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifTimeUnit time_unit;
+
+ if (argc != 1)
+ return atom_false;
+
+ if (enif_compare(argv[0], atom_seconds) == 0)
+ time_unit = ERL_NIF_SEC;
+ else if (enif_compare(argv[0], atom_milli_seconds) == 0)
+ time_unit = ERL_NIF_MSEC;
+ else if (enif_compare(argv[0], atom_micro_seconds) == 0)
+ time_unit = ERL_NIF_USEC;
+ else if (enif_compare(argv[0], atom_nano_seconds) == 0)
+ time_unit = ERL_NIF_NSEC;
+ else
+ time_unit = 4711; /* invalid time unit */
+ return enif_make_int64(env, enif_time_offset(time_unit));
+}
+
+static ERL_NIF_TERM convert_time_unit(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifSInt64 i64;
+ ErlNifTime val;
+ ErlNifTimeUnit from, to;
+
+ if (argc != 3)
+ return atom_false;
+
+ if (!enif_get_int64(env, argv[0], &i64))
+ return enif_make_badarg(env);
+
+ val = (ErlNifTime) i64;
+
+ if (enif_compare(argv[1], atom_seconds) == 0)
+ from = ERL_NIF_SEC;
+ else if (enif_compare(argv[1], atom_milli_seconds) == 0)
+ from = ERL_NIF_MSEC;
+ else if (enif_compare(argv[1], atom_micro_seconds) == 0)
+ from = ERL_NIF_USEC;
+ else if (enif_compare(argv[1], atom_nano_seconds) == 0)
+ from = ERL_NIF_NSEC;
+ else
+ from = 4711; /* invalid time unit */
+
+ if (enif_compare(argv[2], atom_seconds) == 0)
+ to = ERL_NIF_SEC;
+ else if (enif_compare(argv[2], atom_milli_seconds) == 0)
+ to = ERL_NIF_MSEC;
+ else if (enif_compare(argv[2], atom_micro_seconds) == 0)
+ to = ERL_NIF_USEC;
+ else if (enif_compare(argv[2], atom_nano_seconds) == 0)
+ to = ERL_NIF_NSEC;
+ else
+ to = 4711; /* invalid time unit */
+
+ return enif_make_int64(env, enif_convert_time_unit(val, from, to));
+}
+
static ErlNifFunc nif_funcs[] =
{
{"lib_version", 0, lib_version},
@@ -1913,7 +2006,7 @@ static ErlNifFunc nif_funcs[] =
{"make_new_resource", 2, make_new_resource},
{"check_is", 11, check_is},
{"check_is_exception", 0, check_is_exception},
- {"length_test", 5, length_test},
+ {"length_test", 6, length_test},
{"make_atoms", 0, make_atoms},
{"make_strings", 0, make_strings},
{"make_new_resource", 2, make_new_resource},
@@ -1954,7 +2047,10 @@ static ErlNifFunc nif_funcs[] =
{"make_map_update_nif", 3, make_map_update_nif},
{"make_map_remove_nif", 2, make_map_remove_nif},
{"maps_from_list_nif", 1, maps_from_list_nif},
- {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif}
+ {"sorted_list_from_maps_nif", 1, sorted_list_from_maps_nif},
+ {"monotonic_time", 1, monotonic_time},
+ {"time_offset", 1, time_offset},
+ {"convert_time_unit", 3, convert_time_unit}
};
ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload)
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c
index 9c78c0e04d..f7e729e2b6 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c
@@ -240,7 +240,7 @@ static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ADD_CALL("get_priv_data_ptr");
- return enif_make_ulong(env, (unsigned long)priv_data(env));
+ return enif_make_uint64(env, (ErlNifUInt64)priv_data(env));
}
static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl
index e65d4577c7..b6de046388 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.erl
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl
@@ -20,7 +20,7 @@
-module(nif_mod).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([load_nif_lib/2, load_nif_lib/3, start/0, lib_version/0, call_history/0,
get_priv_data_ptr/0, make_new_resource/2, get_resource/2]).
@@ -33,7 +33,7 @@ load_nif_lib(Config, Ver) ->
load_nif_lib(Config, Ver, []).
load_nif_lib(Config, Ver, LoadInfo) ->
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
erlang:load_nif(filename:join(Path,libname(Ver)), LoadInfo).
libname(no_init) -> libname(3);
diff --git a/erts/emulator/test/nif_SUITE_data/tester.erl b/erts/emulator/test/nif_SUITE_data/tester.erl
index b393e29b82..f955f99c9a 100644
--- a/erts/emulator/test/nif_SUITE_data/tester.erl
+++ b/erts/emulator/test/nif_SUITE_data/tester.erl
@@ -1,12 +1,11 @@
-module(tester).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([load_nif_lib/2, run/0]).
-
load_nif_lib(Config, LibName) ->
- ?line Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
erlang:load_nif(filename:join(Path,LibName), []).
run() ->
diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl
index fecaad5232..71400142af 100644
--- a/erts/emulator/test/node_container_SUITE.erl
+++ b/erts/emulator/test/node_container_SUITE.erl
@@ -30,35 +30,34 @@
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-%-compile(export_all).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, init_per_testcase/2,
- end_per_testcase/2,
- node_container_refc_check/1]).
+-export([all/0, suite/0, init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2,
+ node_container_refc_check/1]).
-export([term_to_binary_to_term_eq/1,
- round_trip_eq/1,
- cmp/1,
- ref_eq/1,
- node_table_gc/1,
- dist_link_refc/1,
- dist_monitor_refc/1,
- node_controller_refc/1,
- ets_refc/1,
- match_spec_refc/1,
- timer_refc/1,
- otp_4715/1,
- pid_wrap/1,
- port_wrap/1,
- bad_nc/1,
- unique_pid/1,
- iter_max_procs/1]).
-
--define(DEFAULT_TIMEOUT, ?t:minutes(10)).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+ round_trip_eq/1,
+ cmp/1,
+ ref_eq/1,
+ node_table_gc/1,
+ dist_link_refc/1,
+ dist_monitor_refc/1,
+ node_controller_refc/1,
+ ets_refc/1,
+ match_spec_refc/1,
+ timer_refc/1,
+ otp_4715/1,
+ pid_wrap/1,
+ port_wrap/1,
+ bad_nc/1,
+ unique_pid/1,
+ iter_max_procs/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 10}}].
+
all() ->
[term_to_binary_to_term_eq, round_trip_eq, cmp, ref_eq,
@@ -67,9 +66,6 @@ all() ->
timer_refc, otp_4715, pid_wrap, port_wrap, bad_nc,
unique_pid, iter_max_procs].
-groups() ->
- [].
-
init_per_suite(Config) ->
Config.
@@ -78,36 +74,26 @@ end_per_suite(_Config) ->
erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value
available_internal_state(false).
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
available_internal_state(Bool) when Bool == true; Bool == false ->
case {Bool,
- (catch erts_debug:get_internal_state(available_internal_state))} of
- {true, true} ->
- true;
- {false, true} ->
- erts_debug:set_internal_state(available_internal_state, false),
- true;
- {true, _} ->
- erts_debug:set_internal_state(available_internal_state, true),
- false;
- {false, _} ->
- false
+ (catch erts_debug:get_internal_state(available_internal_state))} of
+ {true, true} ->
+ true;
+ {false, true} ->
+ erts_debug:set_internal_state(available_internal_state, false),
+ true;
+ {true, _} ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ false;
+ {false, _} ->
+ false
end.
init_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
available_internal_state(true),
- [{watchdog, Dog}|Config].
+ Config.
end_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
ok.
%%%
@@ -119,111 +105,103 @@ end_per_testcase(_Case, Config) when is_list(Config) ->
%%
%% Test case: term_to_binary_to_term_eq
%%
-term_to_binary_to_term_eq(doc) ->
- ["Tests that node container terms that are converted to external format "
- "and back stay equal to themselves."];
-term_to_binary_to_term_eq(suite) -> [];
+%% Tests that node container terms that are converted to external format
+%% and back stay equal to themselves.
term_to_binary_to_term_eq(Config) when is_list(Config) ->
- ?line ThisNode = {node(), erlang:system_info(creation)},
+ ThisNode = {node(), erlang:system_info(creation)},
% Get local node containers
- ?line LPid = self(),
- ?line LXPid = mk_pid(ThisNode, 32767, 8191),
- ?line LPort = hd(erlang:ports()),
- ?line LXPort = mk_port(ThisNode, 268435455),
- ?line LLRef = make_ref(),
- ?line LHLRef = mk_ref(ThisNode, [47, 11]),
- ?line LSRef = mk_ref(ThisNode, [4711]),
+ LPid = self(),
+ LXPid = mk_pid(ThisNode, 32767, 8191),
+ LPort = hd(erlang:ports()),
+ LXPort = mk_port(ThisNode, 268435455),
+ LLRef = make_ref(),
+ LHLRef = mk_ref(ThisNode, [47, 11]),
+ LSRef = mk_ref(ThisNode, [4711]),
% Test local nc:s
- ?line LPid = binary_to_term(term_to_binary(LPid)),
- ?line LXPid = binary_to_term(term_to_binary(LXPid)),
- ?line LPort = binary_to_term(term_to_binary(LPort)),
- ?line LXPort = binary_to_term(term_to_binary(LXPort)),
- ?line LLRef = binary_to_term(term_to_binary(LLRef)),
- ?line LHLRef = binary_to_term(term_to_binary(LHLRef)),
- ?line LSRef = binary_to_term(term_to_binary(LSRef)),
+ LPid = binary_to_term(term_to_binary(LPid)),
+ LXPid = binary_to_term(term_to_binary(LXPid)),
+ LPort = binary_to_term(term_to_binary(LPort)),
+ LXPort = binary_to_term(term_to_binary(LXPort)),
+ LLRef = binary_to_term(term_to_binary(LLRef)),
+ LHLRef = binary_to_term(term_to_binary(LHLRef)),
+ LSRef = binary_to_term(term_to_binary(LSRef)),
% Get remote node containers
- ?line RNode = {get_nodename(), 3},
- ?line RPid = mk_pid(RNode, 4711, 1),
- ?line RXPid = mk_pid(RNode, 32767, 8191),
- ?line RPort = mk_port(RNode, 4711),
- ?line RXPort = mk_port(RNode, 268435455),
- ?line RLRef = mk_ref(RNode, [4711, 4711, 4711]),
- ?line RHLRef = mk_ref(RNode, [4711, 4711]),
- ?line RSRef = mk_ref(RNode, [4711]),
+ RNode = {get_nodename(), 3},
+ RPid = mk_pid(RNode, 4711, 1),
+ RXPid = mk_pid(RNode, 32767, 8191),
+ RPort = mk_port(RNode, 4711),
+ RXPort = mk_port(RNode, 268435455),
+ RLRef = mk_ref(RNode, [4711, 4711, 4711]),
+ RHLRef = mk_ref(RNode, [4711, 4711]),
+ RSRef = mk_ref(RNode, [4711]),
% Test remote nc:s
- ?line RPid = binary_to_term(term_to_binary(RPid)),
- ?line RXPid = binary_to_term(term_to_binary(RXPid)),
- ?line RPort = binary_to_term(term_to_binary(RPort)),
- ?line RXPort = binary_to_term(term_to_binary(RXPort)),
- ?line RLRef = binary_to_term(term_to_binary(RLRef)),
- ?line RHLRef = binary_to_term(term_to_binary(RHLRef)),
- ?line RSRef = binary_to_term(term_to_binary(RSRef)),
- ?line nc_refc_check(node()),
- ?line ok.
+ RPid = binary_to_term(term_to_binary(RPid)),
+ RXPid = binary_to_term(term_to_binary(RXPid)),
+ RPort = binary_to_term(term_to_binary(RPort)),
+ RXPort = binary_to_term(term_to_binary(RXPort)),
+ RLRef = binary_to_term(term_to_binary(RLRef)),
+ RHLRef = binary_to_term(term_to_binary(RHLRef)),
+ RSRef = binary_to_term(term_to_binary(RSRef)),
+ nc_refc_check(node()),
+ ok.
%%
%% Test case: round_trip_eq
%%
-round_trip_eq(doc) ->
- ["Tests that node containers that are sent beteen nodes stay equal to "
- "themselves."];
-round_trip_eq(suite) -> [];
+%% Tests that node containers that are sent beteen nodes stay equal to themselves.
round_trip_eq(Config) when is_list(Config) ->
- ?line ThisNode = {node(), erlang:system_info(creation)},
- ?line NodeFirstName = get_nodefirstname(),
- ?line ?line {ok, Node} = start_node(NodeFirstName),
- ?line Self = self(),
- ?line RPid = spawn_link(Node,
- fun () ->
- receive
- {Self, Data} ->
- Self ! {self(), Data}
- end
- end),
- ?line SentPid = self(),
- ?line SentXPid = mk_pid(ThisNode, 17471, 8190),
- ?line SentPort = hd(erlang:ports()),
- ?line SentXPort = mk_port(ThisNode, 268435451),
- ?line SentLRef = make_ref(),
- ?line SentHLRef = mk_ref(ThisNode, [4711, 17]),
- ?line SentSRef = mk_ref(ThisNode, [4711]),
- ?line RPid ! {Self, {SentPid,
- SentXPid,
- SentPort,
- SentXPort,
- SentLRef,
- SentHLRef,
- SentSRef}},
+ ThisNode = {node(), erlang:system_info(creation)},
+ NodeFirstName = get_nodefirstname(),
+ {ok, Node} = start_node(NodeFirstName),
+ Self = self(),
+ RPid = spawn_link(Node,
+ fun () ->
+ receive
+ {Self, Data} ->
+ Self ! {self(), Data}
+ end
+ end),
+ SentPid = self(),
+ SentXPid = mk_pid(ThisNode, 17471, 8190),
+ SentPort = hd(erlang:ports()),
+ SentXPort = mk_port(ThisNode, 268435451),
+ SentLRef = make_ref(),
+ SentHLRef = mk_ref(ThisNode, [4711, 17]),
+ SentSRef = mk_ref(ThisNode, [4711]),
+ RPid ! {Self, {SentPid,
+ SentXPid,
+ SentPort,
+ SentXPort,
+ SentLRef,
+ SentHLRef,
+ SentSRef}},
receive
- {RPid, {RecPid,
- RecXPid,
- RecPort,
- RecXPort,
- RecLRef,
- RecHLRef,
- RecSRef}} ->
- ?line stop_node(Node),
- ?line SentPid = RecPid,
- ?line SentXPid = RecXPid,
- ?line SentPort = RecPort,
- ?line SentXPort = RecXPort,
- ?line SentLRef = RecLRef,
- ?line SentHLRef = RecHLRef,
- ?line SentSRef = RecSRef,
- ?line nc_refc_check(node()),
- ?line ok
+ {RPid, {RecPid,
+ RecXPid,
+ RecPort,
+ RecXPort,
+ RecLRef,
+ RecHLRef,
+ RecSRef}} ->
+ stop_node(Node),
+ SentPid = RecPid,
+ SentXPid = RecXPid,
+ SentPort = RecPort,
+ SentXPort = RecXPort,
+ SentLRef = RecLRef,
+ SentHLRef = RecHLRef,
+ SentSRef = RecSRef,
+ nc_refc_check(node()),
+ ok
end.
-
+
%%
%% Test case: cmp
%%
-cmp(doc) ->
- ["Tests that Erlang term comparison works as it should on node "
- "containers."];
-cmp(suite) -> [];
+%% Tests that Erlang term comparison works as it should on node containers.
cmp(Config) when is_list(Config) ->
%% Inter type comparison ---------------------------------------------------
@@ -234,103 +212,103 @@ cmp(Config) when is_list(Config) ->
IRef = make_ref(),
ERef = mk_ref({get_nodename(), 2}, [1,2,3]),
-
+
IPid = self(),
EPid = mk_pid(RNode, 1, 2),
IPort = hd(erlang:ports()),
EPort = mk_port(RNode, 1),
-
+
%% Test pids ----------------------------------------------------
- ?line true = 1 < IPid,
- ?line true = 1.3 < IPid,
- ?line true = (1 bsl 64) < IPid,
- ?line true = an_atom < IPid,
- ?line true = IRef < IPid,
- ?line true = ERef < IPid,
- ?line true = fun () -> a_fun end < IPid,
- ?line true = IPort < IPid,
- ?line true = EPort < IPid,
- ?line true = IPid < {a, tuple},
- ?line true = IPid < [],
- ?line true = IPid < [a|cons],
- ?line true = IPid < <<"a binary">>,
-
- ?line true = 1 < EPid,
- ?line true = 1.3 < EPid,
- ?line true = (1 bsl 64) < EPid,
- ?line true = an_atom < EPid,
- ?line true = IRef < EPid,
- ?line true = ERef < EPid,
- ?line true = fun () -> a_fun end < EPid,
- ?line true = IPort < EPid,
- ?line true = EPort < EPid,
- ?line true = EPid < {a, tuple},
- ?line true = EPid < [],
- ?line true = EPid < [a|cons],
- ?line true = EPid < <<"a binary">>,
+ true = 1 < IPid,
+ true = 1.3 < IPid,
+ true = (1 bsl 64) < IPid,
+ true = an_atom < IPid,
+ true = IRef < IPid,
+ true = ERef < IPid,
+ true = fun () -> a_fun end < IPid,
+ true = IPort < IPid,
+ true = EPort < IPid,
+ true = IPid < {a, tuple},
+ true = IPid < [],
+ true = IPid < [a|cons],
+ true = IPid < <<"a binary">>,
+
+ true = 1 < EPid,
+ true = 1.3 < EPid,
+ true = (1 bsl 64) < EPid,
+ true = an_atom < EPid,
+ true = IRef < EPid,
+ true = ERef < EPid,
+ true = fun () -> a_fun end < EPid,
+ true = IPort < EPid,
+ true = EPort < EPid,
+ true = EPid < {a, tuple},
+ true = EPid < [],
+ true = EPid < [a|cons],
+ true = EPid < <<"a binary">>,
%% Test ports --------------------------------------------------
- ?line true = 1 < IPort,
- ?line true = 1.3 < IPort,
- ?line true = (1 bsl 64) < IPort,
- ?line true = an_atom < IPort,
- ?line true = IRef < IPort,
- ?line true = ERef < IPort,
- ?line true = fun () -> a_fun end < IPort,
- ?line true = IPort < IPid,
- ?line true = IPort < EPid,
- ?line true = IPort < {a, tuple},
- ?line true = IPort < [],
- ?line true = IPort < [a|cons],
- ?line true = IPort < <<"a binary">>,
-
- ?line true = 1 < EPort,
- ?line true = 1.3 < EPort,
- ?line true = (1 bsl 64) < EPort,
- ?line true = an_atom < EPort,
- ?line true = IRef < EPort,
- ?line true = ERef < EPort,
- ?line true = fun () -> a_fun end < EPort,
- ?line true = EPort < IPid,
- ?line true = EPort < EPid,
- ?line true = EPort < {a, tuple},
- ?line true = EPort < [],
- ?line true = EPort < [a|cons],
- ?line true = EPort < <<"a binary">>,
+ true = 1 < IPort,
+ true = 1.3 < IPort,
+ true = (1 bsl 64) < IPort,
+ true = an_atom < IPort,
+ true = IRef < IPort,
+ true = ERef < IPort,
+ true = fun () -> a_fun end < IPort,
+ true = IPort < IPid,
+ true = IPort < EPid,
+ true = IPort < {a, tuple},
+ true = IPort < [],
+ true = IPort < [a|cons],
+ true = IPort < <<"a binary">>,
+
+ true = 1 < EPort,
+ true = 1.3 < EPort,
+ true = (1 bsl 64) < EPort,
+ true = an_atom < EPort,
+ true = IRef < EPort,
+ true = ERef < EPort,
+ true = fun () -> a_fun end < EPort,
+ true = EPort < IPid,
+ true = EPort < EPid,
+ true = EPort < {a, tuple},
+ true = EPort < [],
+ true = EPort < [a|cons],
+ true = EPort < <<"a binary">>,
%% Test refs ----------------------------------------------------
- ?line true = 1 < IRef,
- ?line true = 1.3 < IRef,
- ?line true = (1 bsl 64) < IRef,
- ?line true = an_atom < IRef,
- ?line true = IRef < fun () -> a_fun end,
- ?line true = IRef < IPort,
- ?line true = IRef < EPort,
- ?line true = IRef < IPid,
- ?line true = IRef < EPid,
- ?line true = IRef < {a, tuple},
- ?line true = IRef < [],
- ?line true = IRef < [a|cons],
- ?line true = IRef < <<"a binary">>,
-
- ?line true = 1 < ERef,
- ?line true = 1.3 < ERef,
- ?line true = (1 bsl 64) < ERef,
- ?line true = an_atom < ERef,
- ?line true = ERef < fun () -> a_fun end,
- ?line true = ERef < IPort,
- ?line true = ERef < EPort,
- ?line true = ERef < IPid,
- ?line true = ERef < EPid,
- ?line true = ERef < {a, tuple},
- ?line true = ERef < [],
- ?line true = ERef < [a|cons],
- ?line true = ERef < <<"a binary">>,
+ true = 1 < IRef,
+ true = 1.3 < IRef,
+ true = (1 bsl 64) < IRef,
+ true = an_atom < IRef,
+ true = IRef < fun () -> a_fun end,
+ true = IRef < IPort,
+ true = IRef < EPort,
+ true = IRef < IPid,
+ true = IRef < EPid,
+ true = IRef < {a, tuple},
+ true = IRef < [],
+ true = IRef < [a|cons],
+ true = IRef < <<"a binary">>,
+
+ true = 1 < ERef,
+ true = 1.3 < ERef,
+ true = (1 bsl 64) < ERef,
+ true = an_atom < ERef,
+ true = ERef < fun () -> a_fun end,
+ true = ERef < IPort,
+ true = ERef < EPort,
+ true = ERef < IPid,
+ true = ERef < EPid,
+ true = ERef < {a, tuple},
+ true = ERef < [],
+ true = ERef < [a|cons],
+ true = ERef < <<"a binary">>,
%% Intra type comparison ---------------------------------------------------
-
+
%% Test pids ----------------------------------------------------
%%
@@ -338,13 +316,13 @@ cmp(Config) when is_list(Config) ->
%% serial, number, nodename, creation
%%
- ?line Pid = mk_pid({b@b, 2}, 4711, 1),
+ Pid = mk_pid({b@b, 2}, 4711, 1),
- ?line true = mk_pid({a@b, 1}, 4710, 2) > Pid,
- ?line true = mk_pid({a@b, 1}, 4712, 1) > Pid,
- ?line true = mk_pid({c@b, 1}, 4711, 1) > Pid,
- ?line true = mk_pid({b@b, 3}, 4711, 1) > Pid,
- ?line true = mk_pid({b@b, 2}, 4711, 1) =:= Pid,
+ true = mk_pid({a@b, 1}, 4710, 2) > Pid,
+ true = mk_pid({a@b, 1}, 4712, 1) > Pid,
+ true = mk_pid({c@b, 1}, 4711, 1) > Pid,
+ true = mk_pid({b@b, 3}, 4711, 1) > Pid,
+ true = mk_pid({b@b, 2}, 4711, 1) =:= Pid,
%% Test ports ---------------------------------------------------
%%
@@ -356,12 +334,12 @@ cmp(Config) when is_list(Config) ->
%% Significance used to be: dist_slot, number,
%% creation.
- ?line Port = mk_port({b@b, 2}, 4711),
+ Port = mk_port({b@b, 2}, 4711),
- ?line true = mk_port({c@b, 1}, 4710) > Port,
- ?line true = mk_port({b@b, 3}, 4710) > Port,
- ?line true = mk_port({b@b, 2}, 4712) > Port,
- ?line true = mk_port({b@b, 2}, 4711) =:= Port,
+ true = mk_port({c@b, 1}, 4710) > Port,
+ true = mk_port({b@b, 3}, 4710) > Port,
+ true = mk_port({b@b, 2}, 4712) > Port,
+ true = mk_port({b@b, 2}, 4711) =:= Port,
%% Test refs ----------------------------------------------------
%% Significance (most -> least):
@@ -373,99 +351,96 @@ cmp(Config) when is_list(Config) ->
%% creation.
%%
- ?line Ref = mk_ref({b@b, 2}, [4711, 4711, 4711]),
+ Ref = mk_ref({b@b, 2}, [4711, 4711, 4711]),
- ?line true = mk_ref({c@b, 1}, [4710, 4710, 4710]) > Ref,
- ?line true = mk_ref({b@b, 3}, [4710, 4710, 4710]) > Ref,
- ?line true = mk_ref({b@b, 2}, [4710, 4710, 4712]) > Ref,
- ?line true = mk_ref({b@b, 2}, [4710, 4712, 4711]) > Ref,
- ?line true = mk_ref({b@b, 2}, [4712, 4711, 4711]) > Ref,
- ?line true = mk_ref({b@b, 2}, [4711, 4711, 4711]) =:= Ref,
+ true = mk_ref({c@b, 1}, [4710, 4710, 4710]) > Ref,
+ true = mk_ref({b@b, 3}, [4710, 4710, 4710]) > Ref,
+ true = mk_ref({b@b, 2}, [4710, 4710, 4712]) > Ref,
+ true = mk_ref({b@b, 2}, [4710, 4712, 4711]) > Ref,
+ true = mk_ref({b@b, 2}, [4712, 4711, 4711]) > Ref,
+ true = mk_ref({b@b, 2}, [4711, 4711, 4711]) =:= Ref,
ok.
%%
%% Test case: ref_eq
%%
-ref_eq(doc) -> ["Test that one word refs \"works\"."];
-ref_eq(suite) -> [];
+%% Test that one word refs works
ref_eq(Config) when is_list(Config) ->
- ?line ThisNode = {node(), erlang:system_info(creation)},
- ?line AnotherNode = {get_nodename(),2},
- ?line LLongRef = mk_ref(ThisNode, [4711, 0, 0]),
- ?line LHalfLongRef = mk_ref(ThisNode, [4711, 0]),
- ?line LShortRef = mk_ref(ThisNode, [4711]),
- ?line true = LLongRef =:= LShortRef,
- ?line true = LLongRef =:= LHalfLongRef,
- ?line true = LLongRef =:= LLongRef,
- ?line true = LHalfLongRef =:= LShortRef,
- ?line true = LHalfLongRef =:= LHalfLongRef,
- ?line true = LShortRef =:= LShortRef,
- ?line false = LShortRef == mk_ref(ThisNode, [4711, 0, 1]), % Not any more
- ?line RLongRef = mk_ref(AnotherNode, [4711, 0, 0]),
- ?line RHalfLongRef = mk_ref(AnotherNode, [4711, 0]),
- ?line RShortRef = mk_ref(AnotherNode, [4711]),
- ?line true = RLongRef =:= RShortRef,
- ?line true = RLongRef =:= RHalfLongRef,
- ?line true = RLongRef =:= RLongRef,
- ?line true = RHalfLongRef =:= RShortRef,
- ?line true = RHalfLongRef =:= RHalfLongRef,
- ?line true = RShortRef =:= RShortRef,
- ?line false = RShortRef == mk_ref(AnotherNode, [4711, 0, 1]), % Not any more
- ?line nc_refc_check(node()),
- ?line ok.
-
+ ThisNode = {node(), erlang:system_info(creation)},
+ AnotherNode = {get_nodename(),2},
+ LLongRef = mk_ref(ThisNode, [4711, 0, 0]),
+ LHalfLongRef = mk_ref(ThisNode, [4711, 0]),
+ LShortRef = mk_ref(ThisNode, [4711]),
+ true = LLongRef =:= LShortRef,
+ true = LLongRef =:= LHalfLongRef,
+ true = LLongRef =:= LLongRef,
+ true = LHalfLongRef =:= LShortRef,
+ true = LHalfLongRef =:= LHalfLongRef,
+ true = LShortRef =:= LShortRef,
+ false = LShortRef == mk_ref(ThisNode, [4711, 0, 1]), % Not any more
+ RLongRef = mk_ref(AnotherNode, [4711, 0, 0]),
+ RHalfLongRef = mk_ref(AnotherNode, [4711, 0]),
+ RShortRef = mk_ref(AnotherNode, [4711]),
+ true = RLongRef =:= RShortRef,
+ true = RLongRef =:= RHalfLongRef,
+ true = RLongRef =:= RLongRef,
+ true = RHalfLongRef =:= RShortRef,
+ true = RHalfLongRef =:= RHalfLongRef,
+ true = RShortRef =:= RShortRef,
+ false = RShortRef == mk_ref(AnotherNode, [4711, 0, 1]), % Not any more
+ nc_refc_check(node()),
+ ok.
+
%%
%% Test case: node_table_gc
%%
-node_table_gc(doc) ->
- ["Tests that node tables are garbage collected."];
-node_table_gc(suite) -> [];
+%% Tests that node tables are garbage collected.
node_table_gc(Config) when is_list(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
erts_debug:set_internal_state(node_tab_delayed_delete, 0),
- ?line PreKnown = nodes(known),
- ?line ?t:format("PreKnown = ~p~n", [PreKnown]),
- ?line make_node_garbage(0, 200000, 1000, []),
- ?line PostKnown = nodes(known),
- ?line PostAreas = erlang:system_info(allocated_areas),
- ?line ?t:format("PostKnown = ~p~n", [PostKnown]),
- ?line ?t:format("PostAreas = ~p~n", [PostAreas]),
- ?line true = length(PostKnown) =< length(PreKnown),
- ?line nc_refc_check(node()),
+ PreKnown = nodes(known),
+ io:format("PreKnown = ~p~n", [PreKnown]),
+ make_node_garbage(0, 200000, 1000, []),
+ PostKnown = nodes(known),
+ PostAreas = erlang:system_info(allocated_areas),
+ io:format("PostKnown = ~p~n", [PostKnown]),
+ io:format("PostAreas = ~p~n", [PostAreas]),
+ true = length(PostKnown) =< length(PreKnown),
+ nc_refc_check(node()),
erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value
- ?line ok.
+ ok.
make_node_garbage(N, L, I, Ps) when N < L ->
- ?line Self = self(),
- ?line P = spawn_link(fun () ->
- % Generate two node entries and one dist
- % entry per node name
- ?line PL1 = make_faked_pid_list(N,
- I div 2,
- 1),
- ?line put(a, PL1),
- ?line PL2 = make_faked_pid_list(N,
- I div 2,
- 2),
- ?line put(b, PL2),
- ?line Self ! {self(), length(nodes(known))}
- end),
- ?line receive
- {P, KnownLength} ->
- ?line true = KnownLength >= I div 2
- end,
- ?line make_node_garbage(N+(I div 2)*2, L, I, [P|Ps]);
+ Self = self(),
+ P = spawn_link(fun () ->
+ % Generate two node entries and one dist
+ % entry per node name
+ PL1 = make_faked_pid_list(N,
+ I div 2,
+ 1),
+ put(a, PL1),
+ PL2 = make_faked_pid_list(N,
+ I div 2,
+ 2),
+ put(b, PL2),
+ Self ! {self(), length(nodes(known))}
+ end),
+ receive
+ {P, KnownLength} ->
+ true = KnownLength >= I div 2
+ end,
+ make_node_garbage(N+(I div 2)*2, L, I, [P|Ps]);
make_node_garbage(_, _, _, Ps) ->
%% Cleanup garbage...
ProcIsCleanedUp
- = fun (Proc) ->
- undefined == erts_debug:get_internal_state({process_status,
- Proc})
- end,
+ = fun (Proc) ->
+ undefined == erts_debug:get_internal_state({process_status,
+ Proc})
+ end,
lists:foreach(fun (P) -> wait_until(fun () -> ProcIsCleanedUp(P) end) end,
- Ps),
- ?line ok.
+ Ps),
+ ok.
make_faked_pid_list(Start, No, Creation) ->
@@ -475,292 +450,274 @@ make_faked_pid_list(_Start, 0, _Creation, Acc) ->
Acc;
make_faked_pid_list(Start, No, Creation, Acc) ->
make_faked_pid_list(Start+1,
- No-1,
- Creation,
- [mk_pid({"faked_node-"
- ++ integer_to_list(Start rem 50000)
- ++ "@"
- ++ atom_to_list(?MODULE),
- Creation},
- 4711,
- 3) | Acc]).
+ No-1,
+ Creation,
+ [mk_pid({"faked_node-"
+ ++ integer_to_list(Start rem 50000)
+ ++ "@"
+ ++ atom_to_list(?MODULE),
+ Creation},
+ 4711,
+ 3) | Acc]).
%%
%% Test case: dist_link_refc
%%
-dist_link_refc(doc) ->
- ["Tests that external reference counts are incremented and decremented "
- "as they should for distributed links"];
-dist_link_refc(suite) -> [];
+%% Tests that external reference counts are incremented and decremented
+%% as they should for distributed links
dist_link_refc(Config) when is_list(Config) ->
- ?line NodeFirstName = get_nodefirstname(),
- ?line ?line {ok, Node} = start_node(NodeFirstName),
- ?line RP = spawn_execer(Node),
- ?line LP = spawn_link_execer(node()),
- ?line true = sync_exec(RP, fun () -> link(LP) end),
- ?line wait_until(fun () ->
- ?line {links, Links} = process_info(LP, links),
- ?line lists:member(RP, Links)
- end),
- ?line NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end),
- ?line 1 = reference_type_count(
- link,
- refering_entity_id({process, LP},
- get_node_references({Node, NodeCre}))),
- ?line exec(RP, fun() -> exit(normal) end),
- ?line wait_until(fun () ->
- ?line {links, Links} = process_info(LP, links),
- ?line not lists:member(RP, Links)
- end),
- ?line 0 = reference_type_count(
- link,
- refering_entity_id({process, LP},
- get_node_references({Node, NodeCre}))),
- ?line exit(LP, normal),
- ?line stop_node(Node),
- ?line nc_refc_check(node()),
- ?line ok.
+ NodeFirstName = get_nodefirstname(),
+ {ok, Node} = start_node(NodeFirstName),
+ RP = spawn_execer(Node),
+ LP = spawn_link_execer(node()),
+ true = sync_exec(RP, fun () -> link(LP) end),
+ wait_until(fun () ->
+ {links, Links} = process_info(LP, links),
+ lists:member(RP, Links)
+ end),
+ NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end),
+ 1 = reference_type_count(
+ link,
+ refering_entity_id({process, LP},
+ get_node_references({Node, NodeCre}))),
+ exec(RP, fun() -> exit(normal) end),
+ wait_until(fun () ->
+ {links, Links} = process_info(LP, links),
+ not lists:member(RP, Links)
+ end),
+ 0 = reference_type_count(
+ link,
+ refering_entity_id({process, LP},
+ get_node_references({Node, NodeCre}))),
+ exit(LP, normal),
+ stop_node(Node),
+ nc_refc_check(node()),
+ ok.
%%
%% Test case: dist_monitor_refc
%%
-dist_monitor_refc(doc) ->
- ["Tests that external reference counts are incremented and decremented "
- "as they should for distributed monitors"];
-dist_monitor_refc(suite) -> [];
+%% Tests that external reference counts are incremented and decremented
+%% as they should for distributed monitors
dist_monitor_refc(Config) when is_list(Config) ->
- ?line NodeFirstName = get_nodefirstname(),
- ?line {ok, Node} = start_node(NodeFirstName),
- ?line RP = spawn_execer(Node),
- ?line LP = spawn_link_execer(node()),
- ?line RMon = sync_exec(RP, fun () -> erlang:monitor(process, LP) end),
- ?line true = is_reference(RMon),
- ?line LMon = sync_exec(LP, fun () -> erlang:monitor(process, RP) end),
- ?line true = is_reference(LMon),
- ?line NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end),
- ?line wait_until(fun () ->
- ?line {monitored_by, MonBy}
- = process_info(LP, monitored_by),
- ?line {monitors, Mon}
- = process_info(LP, monitors),
- ?line (lists:member(RP, MonBy)
- and lists:member({process,RP}, Mon))
- end),
- ?line 3 = reference_type_count(
- monitor,
- refering_entity_id({process, LP},
- get_node_references({Node, NodeCre}))),
- ?line exec(RP, fun () -> exit(normal) end),
- ?line wait_until(fun () ->
- ?line {monitored_by, MonBy}
- = process_info(LP, monitored_by),
- ?line {monitors, Mon}
- = process_info(LP, monitors),
- ?line ((not lists:member(RP, MonBy))
- and (not lists:member({process,RP}, Mon)))
- end),
- ?line ok = sync_exec(LP,
- fun () ->
- receive
- {'DOWN', LMon, process, _, _} ->
- ok
- end
- end),
- ?line 0 = reference_type_count(
- link,
- refering_entity_id({process, LP},
- get_node_references({Node, NodeCre}))),
- ?line exit(LP, normal),
- ?line stop_node(Node),
- ?line nc_refc_check(node()),
- ?line ok.
+ NodeFirstName = get_nodefirstname(),
+ {ok, Node} = start_node(NodeFirstName),
+ RP = spawn_execer(Node),
+ LP = spawn_link_execer(node()),
+ RMon = sync_exec(RP, fun () -> erlang:monitor(process, LP) end),
+ true = is_reference(RMon),
+ LMon = sync_exec(LP, fun () -> erlang:monitor(process, RP) end),
+ true = is_reference(LMon),
+ NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end),
+ wait_until(fun () ->
+ {monitored_by, MonBy}
+ = process_info(LP, monitored_by),
+ {monitors, Mon}
+ = process_info(LP, monitors),
+ (lists:member(RP, MonBy)
+ and lists:member({process,RP}, Mon))
+ end),
+ 3 = reference_type_count(
+ monitor,
+ refering_entity_id({process, LP},
+ get_node_references({Node, NodeCre}))),
+ exec(RP, fun () -> exit(normal) end),
+ wait_until(fun () ->
+ {monitored_by, MonBy}
+ = process_info(LP, monitored_by),
+ {monitors, Mon}
+ = process_info(LP, monitors),
+ ((not lists:member(RP, MonBy))
+ and (not lists:member({process,RP}, Mon)))
+ end),
+ ok = sync_exec(LP,
+ fun () ->
+ receive
+ {'DOWN', LMon, process, _, _} ->
+ ok
+ end
+ end),
+ 0 = reference_type_count(
+ link,
+ refering_entity_id({process, LP},
+ get_node_references({Node, NodeCre}))),
+ exit(LP, normal),
+ stop_node(Node),
+ nc_refc_check(node()),
+ ok.
%%
%% Test case: node_controller_refc
%%
-node_controller_refc(doc) ->
- ["Tests that external reference counts are incremented and decremented "
- "as they should for entities controlling a connections."];
-node_controller_refc(suite) -> [];
+%% Tests that external reference counts are incremented and decremented
+%% as they should for entities controlling a connections.
node_controller_refc(Config) when is_list(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
erts_debug:set_internal_state(node_tab_delayed_delete, 0),
- ?line NodeFirstName = get_nodefirstname(),
- ?line ?line {ok, Node} = start_node(NodeFirstName),
- ?line true = lists:member(Node, nodes()),
- ?line 1 = reference_type_count(control, get_dist_references(Node)),
- ?line P = spawn_link_execer(node()),
- ?line Node
- = sync_exec(P,
- fun () ->
- put(remote_net_kernel,
- rpc:call(Node,erlang,whereis,[net_kernel])),
- node(get(remote_net_kernel))
- end),
- ?line Creation = rpc:call(Node, erlang, system_info, [creation]),
- ?line monitor_node(Node,true),
- ?line stop_node(Node),
- ?line receive {nodedown, Node} -> ok end,
- ?line DistRefs = get_dist_references(Node),
- ?line true = reference_type_count(node, DistRefs) > 0,
- ?line 0 = reference_type_count(control, DistRefs),
+ NodeFirstName = get_nodefirstname(),
+ {ok, Node} = start_node(NodeFirstName),
+ true = lists:member(Node, nodes()),
+ 1 = reference_type_count(control, get_dist_references(Node)),
+ P = spawn_link_execer(node()),
+ Node
+ = sync_exec(P,
+ fun () ->
+ put(remote_net_kernel,
+ rpc:call(Node,erlang,whereis,[net_kernel])),
+ node(get(remote_net_kernel))
+ end),
+ Creation = rpc:call(Node, erlang, system_info, [creation]),
+ monitor_node(Node,true),
+ stop_node(Node),
+ receive {nodedown, Node} -> ok end,
+ DistRefs = get_dist_references(Node),
+ true = reference_type_count(node, DistRefs) > 0,
+ 0 = reference_type_count(control, DistRefs),
% Get rid of all references to Node
- ?line exec(P, fun () -> exit(normal) end),
- ?line wait_until(fun () -> not is_process_alive(P) end),
+ exec(P, fun () -> exit(normal) end),
+ wait_until(fun () -> not is_process_alive(P) end),
lists:foreach(fun (Proc) -> garbage_collect(Proc) end, processes()),
- ?line false = get_node_references({Node,Creation}),
- ?line false = get_dist_references(Node),
- ?line false = lists:member(Node, nodes(known)),
- ?line nc_refc_check(node()),
+ false = get_node_references({Node,Creation}),
+ false = get_dist_references(Node),
+ false = lists:member(Node, nodes(known)),
+ nc_refc_check(node()),
erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value
- ?line ok.
+ ok.
%%
%% Test case: ets_refc
%%
-ets_refc(doc) ->
- ["Tests that external reference counts are incremented and decremented "
- "as they should for data stored in ets tables."];
-ets_refc(suite) -> [];
+%% Tests that external reference counts are incremented and decremented
+%% as they should for data stored in ets tables.
ets_refc(Config) when is_list(Config) ->
- ?line RNode = {get_nodename(), 1},
- ?line RPid = mk_pid(RNode, 4711, 2),
- ?line RPort = mk_port(RNode, 4711),
- ?line RRef = mk_ref(RNode, [4711, 47, 11]),
- ?line Tab = ets:new(ets_refc, []),
- ?line 0 = reference_type_count(ets, get_node_references(RNode)),
- ?line true = ets:insert(Tab, [{a, self()},
- {b, RPid},
- {c, hd(erlang:ports())},
- {d, RPort},
- {e, make_ref()}]),
- ?line 2 = reference_type_count(ets, get_node_references(RNode)),
- ?line true = ets:insert(Tab, {f, RRef}),
- ?line 3 = reference_type_count(ets, get_node_references(RNode)),
- ?line true = ets:delete(Tab, d),
- ?line 2 = reference_type_count(ets, get_node_references(RNode)),
- ?line true = ets:delete_all_objects(Tab),
- ?line 0 = reference_type_count(ets, get_node_references(RNode)),
- ?line true = ets:insert(Tab, [{b, RPid}, {e, make_ref()}]),
- ?line 1 = reference_type_count(ets, get_node_references(RNode)),
- ?line true = ets:delete(Tab),
- ?line 0 = reference_type_count(ets, get_node_references(RNode)),
- ?line nc_refc_check(node()),
- ?line ok.
+ RNode = {get_nodename(), 1},
+ RPid = mk_pid(RNode, 4711, 2),
+ RPort = mk_port(RNode, 4711),
+ RRef = mk_ref(RNode, [4711, 47, 11]),
+ Tab = ets:new(ets_refc, []),
+ 0 = reference_type_count(ets, get_node_references(RNode)),
+ true = ets:insert(Tab, [{a, self()},
+ {b, RPid},
+ {c, hd(erlang:ports())},
+ {d, RPort},
+ {e, make_ref()}]),
+ 2 = reference_type_count(ets, get_node_references(RNode)),
+ true = ets:insert(Tab, {f, RRef}),
+ 3 = reference_type_count(ets, get_node_references(RNode)),
+ true = ets:delete(Tab, d),
+ 2 = reference_type_count(ets, get_node_references(RNode)),
+ true = ets:delete_all_objects(Tab),
+ 0 = reference_type_count(ets, get_node_references(RNode)),
+ true = ets:insert(Tab, [{b, RPid}, {e, make_ref()}]),
+ 1 = reference_type_count(ets, get_node_references(RNode)),
+ true = ets:delete(Tab),
+ 0 = reference_type_count(ets, get_node_references(RNode)),
+ nc_refc_check(node()),
+ ok.
%%
%% Test case: match_spec_refc
%%
-match_spec_refc(doc) ->
- ["Tests that external reference counts are incremented and decremented "
- "as they should for data stored in match specifications."];
-match_spec_refc(suite) -> [];
+%% Tests that external reference counts are incremented and decremented
+%% as they should for data stored in match specifications.
match_spec_refc(Config) when is_list(Config) ->
- ?line RNode = {get_nodename(), 1},
- ?line RPid = mk_pid(RNode, 4711, 2),
- ?line RPort = mk_port(RNode, 4711),
- ?line RRef = mk_ref(RNode, [4711, 47, 11]),
- ?line ok = do_match_spec_test(RNode, RPid, RPort, RRef),
- ?line garbage_collect(),
- ?line NodeRefs = get_node_references(RNode),
- ?line 0 = reference_type_count(binary, NodeRefs),
- ?line 0 = reference_type_count(ets, NodeRefs),
- ?line nc_refc_check(node()),
- ?line ok.
+ RNode = {get_nodename(), 1},
+ RPid = mk_pid(RNode, 4711, 2),
+ RPort = mk_port(RNode, 4711),
+ RRef = mk_ref(RNode, [4711, 47, 11]),
+ ok = do_match_spec_test(RNode, RPid, RPort, RRef),
+ garbage_collect(),
+ NodeRefs = get_node_references(RNode),
+ 0 = reference_type_count(binary, NodeRefs),
+ 0 = reference_type_count(ets, NodeRefs),
+ nc_refc_check(node()),
+ ok.
do_match_spec_test(RNode, RPid, RPort, RRef) ->
- ?line Tab = ets:new(match_spec_refc, []),
- ?line true = ets:insert(Tab, [{a, RPid, RPort, RRef},
- {b, self(), RPort, RRef},
- {c, RPid, RPort, make_ref()},
- {d, RPid, RPort, RRef}]),
- ?line {M1, C1} = ets:select(Tab, [{{'$1',RPid,RPort,RRef},[],['$1']}], 1),
- ?line NodeRefs = get_node_references(RNode),
- ?line 3 = reference_type_count(binary, NodeRefs),
- ?line 10 = reference_type_count(ets, NodeRefs),
- ?line {M2, C2} = ets:select(C1),
- ?line '$end_of_table' = ets:select(C2),
- ?line ets:delete(Tab),
- ?line [a,d] = lists:sort(M1++M2),
- ?line ok.
-
+ Tab = ets:new(match_spec_refc, []),
+ true = ets:insert(Tab, [{a, RPid, RPort, RRef},
+ {b, self(), RPort, RRef},
+ {c, RPid, RPort, make_ref()},
+ {d, RPid, RPort, RRef}]),
+ {M1, C1} = ets:select(Tab, [{{'$1',RPid,RPort,RRef},[],['$1']}], 1),
+ NodeRefs = get_node_references(RNode),
+ 3 = reference_type_count(binary, NodeRefs),
+ 10 = reference_type_count(ets, NodeRefs),
+ {M2, C2} = ets:select(C1),
+ '$end_of_table' = ets:select(C2),
+ ets:delete(Tab),
+ [a,d] = lists:sort(M1++M2),
+ ok.
+
%%
%% Test case: ets_refc
%%
-timer_refc(doc) ->
- ["Tests that external reference counts are incremented and decremented "
- "as they should for data stored in bif timers."];
-timer_refc(suite) -> [];
+%% Tests that external reference counts are incremented and decremented
+%% as they should for data stored in bif timers.
timer_refc(Config) when is_list(Config) ->
- ?line RNode = {get_nodename(), 1},
- ?line RPid = mk_pid(RNode, 4711, 2),
- ?line RPort = mk_port(RNode, 4711),
- ?line RRef = mk_ref(RNode, [4711, 47, 11]),
- ?line 0 = reference_type_count(timer, get_node_references(RNode)),
- ?line Pid = spawn(fun () -> receive after infinity -> ok end end),
- ?line erlang:start_timer(10000, Pid, {RPid, RPort, RRef}),
- ?line 3 = reference_type_count(timer, get_node_references(RNode)),
- ?line exit(Pid, kill),
- ?line Mon = erlang:monitor(process, Pid),
- ?line receive {'DOWN', Mon, process, Pid, _} -> ok end,
- ?line 0 = reference_type_count(timer, get_node_references(RNode)),
- ?line erlang:send_after(500, Pid, {timer, RPid, RPort, RRef}),
- ?line 0 = reference_type_count(timer, get_node_references(RNode)),
- ?line erlang:send_after(500, self(), {timer, RPid, RPort, RRef}),
- ?line erlang:send_after(400, bananfluga, {timer, RPid, RPort, RRef}),
- ?line 6 = reference_type_count(timer, get_node_references(RNode)),
- ?line receive {timer, RPid, RPort, RRef} -> ok end,
- ?line 0 = reference_type_count(timer, get_node_references(RNode)),
- ?line nc_refc_check(node()),
- ?line ok.
-
-otp_4715(doc) -> [];
-otp_4715(suite) -> [];
+ RNode = {get_nodename(), 1},
+ RPid = mk_pid(RNode, 4711, 2),
+ RPort = mk_port(RNode, 4711),
+ RRef = mk_ref(RNode, [4711, 47, 11]),
+ 0 = reference_type_count(timer, get_node_references(RNode)),
+ Pid = spawn(fun () -> receive after infinity -> ok end end),
+ erlang:start_timer(10000, Pid, {RPid, RPort, RRef}),
+ 3 = reference_type_count(timer, get_node_references(RNode)),
+ exit(Pid, kill),
+ Mon = erlang:monitor(process, Pid),
+ receive {'DOWN', Mon, process, Pid, _} -> ok end,
+ 0 = reference_type_count(timer, get_node_references(RNode)),
+ erlang:send_after(500, Pid, {timer, RPid, RPort, RRef}),
+ 0 = reference_type_count(timer, get_node_references(RNode)),
+ erlang:send_after(500, self(), {timer, RPid, RPort, RRef}),
+ erlang:send_after(400, bananfluga, {timer, RPid, RPort, RRef}),
+ 6 = reference_type_count(timer, get_node_references(RNode)),
+ receive {timer, RPid, RPort, RRef} -> ok end,
+ 0 = reference_type_count(timer, get_node_references(RNode)),
+ nc_refc_check(node()),
+ ok.
+
otp_4715(Config) when is_list(Config) ->
- case ?t:is_release_available("r9b") of
- true -> otp_4715_1(Config);
- false -> {skip,"No R9B found"}
+ case test_server:is_release_available("r9b") of
+ true -> otp_4715_1(Config);
+ false -> {skip,"No R9B found"}
end.
otp_4715_1(Config) ->
case erlang:system_info(compat_rel) of
- 9 ->
- ?line run_otp_4715(Config);
- _ ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line ?t:run_on_shielded_node(fun () ->
- run_otp_4715(Config)
- end,
- "+R9 -pa " ++ Pa)
+ 9 ->
+ run_otp_4715(Config);
+ _ ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ test_server:run_on_shielded_node(fun () ->
+ run_otp_4715(Config)
+ end,
+ "+R9 -pa " ++ Pa)
end.
run_otp_4715(Config) when is_list(Config) ->
- ?line erts_debug:set_internal_state(available_internal_state, true),
- ?line PidList = [mk_pid({a@b, 1}, 4710, 2),
- mk_pid({a@b, 1}, 4712, 1),
- mk_pid({c@b, 1}, 4711, 1),
- mk_pid({b@b, 3}, 4711, 1),
- mk_pid({b@b, 2}, 4711, 1)],
-
- ?line R9Sorted = old_mod:sort_on_old_node(PidList),
- ?line R9Sorted = lists:sort(PidList).
-
-pid_wrap(doc) -> [];
-pid_wrap(suite) -> [];
-pid_wrap(Config) when is_list(Config) -> ?line pp_wrap(pid).
-
-port_wrap(doc) -> [];
-port_wrap(suite) -> [];
+ erts_debug:set_internal_state(available_internal_state, true),
+ PidList = [mk_pid({a@b, 1}, 4710, 2),
+ mk_pid({a@b, 1}, 4712, 1),
+ mk_pid({c@b, 1}, 4711, 1),
+ mk_pid({b@b, 3}, 4711, 1),
+ mk_pid({b@b, 2}, 4711, 1)],
+
+ R9Sorted = old_mod:sort_on_old_node(PidList),
+ R9Sorted = lists:sort(PidList).
+
+pid_wrap(Config) when is_list(Config) -> pp_wrap(pid).
+
port_wrap(Config) when is_list(Config) ->
- ?line case ?t:os_type() of
- {unix, _} ->
- ?line pp_wrap(port);
- _ ->
- ?line {skip, "Only run on unix"}
- end.
+ case test_server:os_type() of
+ {unix, _} ->
+ pp_wrap(port);
+ _ ->
+ {skip, "Only run on unix"}
+ end.
get_next_id(pid) ->
erts_debug:get_internal_state(next_pid);
@@ -773,167 +730,161 @@ set_next_id(port, N) ->
erts_debug:set_internal_state(next_port, N).
pp_wrap(What) ->
- ?line N = set_high_pp_next(What),
- ?line Cre = N + 100,
- ?line ?t:format("no creations = ~p~n", [Cre]),
- ?line PreCre = get_next_id(What),
- ?line ?t:format("pre creations = ~p~n", [PreCre]),
- ?line true = is_integer(PreCre),
- ?line do_pp_creations(What, Cre),
- ?line PostCre = get_next_id(What),
- ?line ?t:format("post creations = ~p~n", [PostCre]),
- ?line true = is_integer(PostCre),
- ?line true = PreCre > PostCre,
- ?line Now = set_next_id(What, ?MAX_PIDS_PORTS div 2),
- ?line ?t:format("reset to = ~p~n", [Now]),
- ?line true = is_integer(Now),
- ?line ok.
+ N = set_high_pp_next(What),
+ Cre = N + 100,
+ io:format("no creations = ~p~n", [Cre]),
+ PreCre = get_next_id(What),
+ io:format("pre creations = ~p~n", [PreCre]),
+ true = is_integer(PreCre),
+ do_pp_creations(What, Cre),
+ PostCre = get_next_id(What),
+ io:format("post creations = ~p~n", [PostCre]),
+ true = is_integer(PostCre),
+ true = PreCre > PostCre,
+ Now = set_next_id(What, ?MAX_PIDS_PORTS div 2),
+ io:format("reset to = ~p~n", [Now]),
+ true = is_integer(Now),
+ ok.
set_high_pp_next(What) ->
- ?line set_high_pp_next(What, ?MAX_PIDS_PORTS-1).
-
+ set_high_pp_next(What, ?MAX_PIDS_PORTS-1).
+
set_high_pp_next(What, N) ->
- ?line M = set_next_id(What, N),
- ?line true = is_integer(M),
- ?line case {M >= N, M =< ?MAX_PIDS_PORTS} of
- {true, true} ->
- ?line ?MAX_PIDS_PORTS - M + 1;
- _ ->
- ?line set_high_pp_next(What, N - 100)
- end.
+ M = set_next_id(What, N),
+ true = is_integer(M),
+ case {M >= N, M =< ?MAX_PIDS_PORTS} of
+ {true, true} ->
+ ?MAX_PIDS_PORTS - M + 1;
+ _ ->
+ set_high_pp_next(What, N - 100)
+ end.
do_pp_creations(_What, N) when is_integer(N), N =< 0 ->
- ?line done;
+ done;
do_pp_creations(pid, N) when is_integer(N) ->
%% Create new pid and make sure it works...
- ?line Me = self(),
- ?line Ref = make_ref(),
- ?line Pid = spawn_link(fun () ->
- receive
- Ref ->
- Me ! Ref
- end
- end),
- ?line Pid ! Ref,
- ?line receive
- Ref ->
- ?line do_pp_creations(pid, N - 1)
- end;
+ Me = self(),
+ Ref = make_ref(),
+ Pid = spawn_link(fun () ->
+ receive
+ Ref ->
+ Me ! Ref
+ end
+ end),
+ Pid ! Ref,
+ receive
+ Ref ->
+ do_pp_creations(pid, N - 1)
+ end;
do_pp_creations(port, N) when is_integer(N) ->
%% Create new port and make sure it works...
- ?line "hej" = os:cmd("echo hej") -- "\n",
- ?line do_pp_creations(port, N - 1).
+ "hej" = os:cmd("echo hej") -- "\n",
+ do_pp_creations(port, N - 1).
-bad_nc(doc) -> [];
-bad_nc(suite) -> [];
bad_nc(Config) when is_list(Config) ->
% Make sure emulator don't crash on bad node containers...
- ?line MaxPidNum = (1 bsl 15) - 1,
- ?line MaxPidSer = ?MAX_PIDS_PORTS bsr 15,
- ?line ThisNode = {node(), erlang:system_info(creation)},
- ?line {'EXIT', {badarg, mk_pid, _}}
- = (catch mk_pid(ThisNode, MaxPidNum + 1, 17)),
- ?line {'EXIT', {badarg, mk_pid, _}}
- = (catch mk_pid(ThisNode, 4711, MaxPidSer + 1)),
- ?line {'EXIT', {badarg, mk_port, _}}
- = (catch mk_port(ThisNode, ?MAX_PIDS_PORTS + 1)),
- ?line {'EXIT', {badarg, mk_ref, _}}
- = (catch mk_ref(ThisNode,[(1 bsl 18), 4711, 4711])),
- ?line {'EXIT', {badarg, mk_ref, _}}
- = (catch mk_ref(ThisNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])),
- ?line RemNode = {x@y, 2},
- ?line {'EXIT', {badarg, mk_pid, _}}
- = (catch mk_pid(RemNode, MaxPidNum + 1, MaxPidSer)),
- ?line {'EXIT', {badarg, mk_pid, _}}
- = (catch mk_pid(RemNode, MaxPidNum, MaxPidSer + 1)),
- ?line {'EXIT', {badarg, mk_port, _}}
- = (catch mk_port(RemNode, ?MAX_PIDS_PORTS + 1)),
- ?line {'EXIT', {badarg, mk_ref, _}}
- = (catch mk_ref(RemNode, [(1 bsl 18), 4711, 4711])),
- ?line {'EXIT', {badarg, mk_ref, _}}
- = (catch mk_ref(RemNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])),
- ?line BadNode = {x@y, 4},
- ?line {'EXIT', {badarg, mk_pid, _}}
- = (catch mk_pid(BadNode, 4711, 17)),
- ?line {'EXIT', {badarg, mk_port, _}}
- = (catch mk_port(BadNode, 4711)),
- ?line {'EXIT', {badarg, mk_ref, _}}
- = (catch mk_ref(BadNode, [4711, 4711, 17])),
- ?line ok.
+ MaxPidNum = (1 bsl 15) - 1,
+ MaxPidSer = ?MAX_PIDS_PORTS bsr 15,
+ ThisNode = {node(), erlang:system_info(creation)},
+ {'EXIT', {badarg, mk_pid, _}}
+ = (catch mk_pid(ThisNode, MaxPidNum + 1, 17)),
+ {'EXIT', {badarg, mk_pid, _}}
+ = (catch mk_pid(ThisNode, 4711, MaxPidSer + 1)),
+ {'EXIT', {badarg, mk_port, _}}
+ = (catch mk_port(ThisNode, ?MAX_PIDS_PORTS + 1)),
+ {'EXIT', {badarg, mk_ref, _}}
+ = (catch mk_ref(ThisNode,[(1 bsl 18), 4711, 4711])),
+ {'EXIT', {badarg, mk_ref, _}}
+ = (catch mk_ref(ThisNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])),
+ RemNode = {x@y, 2},
+ {'EXIT', {badarg, mk_pid, _}}
+ = (catch mk_pid(RemNode, MaxPidNum + 1, MaxPidSer)),
+ {'EXIT', {badarg, mk_pid, _}}
+ = (catch mk_pid(RemNode, MaxPidNum, MaxPidSer + 1)),
+ {'EXIT', {badarg, mk_port, _}}
+ = (catch mk_port(RemNode, ?MAX_PIDS_PORTS + 1)),
+ {'EXIT', {badarg, mk_ref, _}}
+ = (catch mk_ref(RemNode, [(1 bsl 18), 4711, 4711])),
+ {'EXIT', {badarg, mk_ref, _}}
+ = (catch mk_ref(RemNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])),
+ BadNode = {x@y, 4},
+ {'EXIT', {badarg, mk_pid, _}}
+ = (catch mk_pid(BadNode, 4711, 17)),
+ {'EXIT', {badarg, mk_port, _}}
+ = (catch mk_port(BadNode, 4711)),
+ {'EXIT', {badarg, mk_ref, _}}
+ = (catch mk_ref(BadNode, [4711, 4711, 17])),
+ ok.
-define(NO_PIDS, 1000000).
-unique_pid(doc) -> [];
-unique_pid(suite) -> [];
unique_pid(Config) when is_list(Config) ->
case catch erlang:system_info(modified_timing_level) of
- Level when is_integer(Level) ->
- {skip,
- "Modified timing (level " ++ integer_to_list(Level)
- ++ ") is enabled. spawn() is too slow for this "
- " test when modified timing is enabled."};
- _ ->
- ?line ?NO_PIDS = length(lists:usort(mkpidlist(?NO_PIDS, []))),
- ?line ok
+ Level when is_integer(Level) ->
+ {skip,
+ "Modified timing (level " ++ integer_to_list(Level)
+ ++ ") is enabled. spawn() is too slow for this "
+ " test when modified timing is enabled."};
+ _ ->
+ ?NO_PIDS = length(lists:usort(mkpidlist(?NO_PIDS, []))),
+ ok
end.
-
+
mkpidlist(0, Ps) -> Ps;
mkpidlist(N, Ps) -> mkpidlist(N-1, [spawn(fun () -> ok end)|Ps]).
-iter_max_procs(doc) -> [];
-iter_max_procs(suite) -> [];
iter_max_procs(Config) when is_list(Config) ->
- ?line NoMoreTests = make_ref(),
- ?line erlang:send_after(10000, self(), NoMoreTests),
- ?line Res = chk_max_proc_line(),
- ?line Res = chk_max_proc_line(),
- ?line done = chk_max_proc_line_until(NoMoreTests, Res),
- ?line {comment,
- io_lib:format("max processes = ~p; "
- "process line length = ~p",
- [element(2, Res), element(1, Res)])}.
-
-
+ NoMoreTests = make_ref(),
+ erlang:send_after(10000, self(), NoMoreTests),
+ Res = chk_max_proc_line(),
+ Res = chk_max_proc_line(),
+ done = chk_max_proc_line_until(NoMoreTests, Res),
+ {comment,
+ io_lib:format("max processes = ~p; "
+ "process line length = ~p",
+ [element(2, Res), element(1, Res)])}.
+
+
max_proc_line(Root, Parent, N) ->
Me = self(),
case catch spawn_link(fun () -> max_proc_line(Root, Me, N+1) end) of
- {'EXIT', {system_limit, _}} when Root /= self() ->
- Root ! {proc_line_length, N, self()},
- receive remove_proc_line -> Parent ! {exiting, Me} end;
- P when is_pid(P), Root =/= self() ->
- receive {exiting, P} -> Parent ! {exiting, Me} end;
- P when is_pid(P) ->
- P;
- Unexpected ->
- exit({unexpected_spawn_result, Unexpected})
+ {'EXIT', {system_limit, _}} when Root /= self() ->
+ Root ! {proc_line_length, N, self()},
+ receive remove_proc_line -> Parent ! {exiting, Me} end;
+ P when is_pid(P), Root =/= self() ->
+ receive {exiting, P} -> Parent ! {exiting, Me} end;
+ P when is_pid(P) ->
+ P;
+ Unexpected ->
+ exit({unexpected_spawn_result, Unexpected})
end.
chk_max_proc_line() ->
- ?line Child = max_proc_line(self(), self(), 0),
- ?line receive
- {proc_line_length, PLL, End} ->
- ?line PC = erlang:system_info(process_count),
- ?line LP = length(processes()),
- ?line ?t:format("proc line length = ~p; "
- "process count = ~p; "
- "length processes = ~p~n",
- [PLL, PC, LP]),
- ?line End ! remove_proc_line,
- ?line PC = LP,
- ?line receive {exiting, Child} -> ok end,
- ?line {PLL, PC}
- end.
+ Child = max_proc_line(self(), self(), 0),
+ receive
+ {proc_line_length, PLL, End} ->
+ PC = erlang:system_info(process_count),
+ LP = length(processes()),
+ io:format("proc line length = ~p; "
+ "process count = ~p; "
+ "length processes = ~p~n",
+ [PLL, PC, LP]),
+ End ! remove_proc_line,
+ PC = LP,
+ receive {exiting, Child} -> ok end,
+ {PLL, PC}
+ end.
chk_max_proc_line_until(NoMoreTests, Res) ->
receive
- NoMoreTests ->
- ?line done
+ NoMoreTests ->
+ done
after 0 ->
- ?line Res = chk_max_proc_line(),
- ?line chk_max_proc_line_until(NoMoreTests, Res)
+ Res = chk_max_proc_line(),
+ chk_max_proc_line_until(NoMoreTests, Res)
end.
%%
@@ -950,126 +901,126 @@ node_container_refc_check(Node) when is_atom(Node) ->
nc_refc_check(Node) when is_atom(Node) ->
Ref = make_ref(),
Self = self(),
- ?t:format("Starting reference count check of node ~w~n", [Node]),
+ io:format("Starting reference count check of node ~w~n", [Node]),
spawn_link(Node,
- fun () ->
- {{node_references, NodeRefs},
- {dist_references, DistRefs}} = ?ND_REFS,
- check_nd_refc({node(), erlang:system_info(creation)},
- NodeRefs,
- DistRefs,
- fun (ErrMsg) ->
- Self ! {Ref, ErrMsg, failed},
- exit(normal)
- end),
- Self ! {Ref, succeded}
- end),
+ fun () ->
+ {{node_references, NodeRefs},
+ {dist_references, DistRefs}} = ?ND_REFS,
+ check_nd_refc({node(), erlang:system_info(creation)},
+ NodeRefs,
+ DistRefs,
+ fun (ErrMsg) ->
+ Self ! {Ref, ErrMsg, failed},
+ exit(normal)
+ end),
+ Self ! {Ref, succeded}
+ end),
receive
- {Ref, ErrorMsg, failed} ->
- ?t:format("~s~n", [ErrorMsg]),
- ?t:fail(reference_count_check_failed);
- {Ref, succeded} ->
- ?t:format("Reference count check of node ~w succeded!~n", [Node]),
- ok
+ {Ref, ErrorMsg, failed} ->
+ io:format("~s~n", [ErrorMsg]),
+ ct:fail(reference_count_check_failed);
+ {Ref, succeded} ->
+ io:format("Reference count check of node ~w succeded!~n", [Node]),
+ ok
end.
check_nd_refc({ThisNodeName, ThisCreation}, NodeRefs, DistRefs, Fail) ->
case catch begin
- check_refc(ThisNodeName,ThisCreation,"node table",NodeRefs),
- check_refc(ThisNodeName,ThisCreation,"dist table",DistRefs),
- ok
- end of
- ok ->
- ok;
- {'EXIT', Reason} ->
- {Y,Mo,D} = date(),
- {H,Mi,S} = time(),
- ErrMsg = io_lib:format("~n"
- "*** Reference count check of node ~w "
- "failed (~p) at ~w~w~w ~w:~w:~w~n"
- "*** Node table references:~n ~p~n"
- "*** Dist table references:~n ~p~n",
- [node(), Reason, Y, Mo, D, H, Mi, S,
- NodeRefs, DistRefs]),
- Fail(lists:flatten(ErrMsg))
+ check_refc(ThisNodeName,ThisCreation,"node table",NodeRefs),
+ check_refc(ThisNodeName,ThisCreation,"dist table",DistRefs),
+ ok
+ end of
+ ok ->
+ ok;
+ {'EXIT', Reason} ->
+ {Y,Mo,D} = date(),
+ {H,Mi,S} = time(),
+ ErrMsg = io_lib:format("~n"
+ "*** Reference count check of node ~w "
+ "failed (~p) at ~w~w~w ~w:~w:~w~n"
+ "*** Node table references:~n ~p~n"
+ "*** Dist table references:~n ~p~n",
+ [node(), Reason, Y, Mo, D, H, Mi, S,
+ NodeRefs, DistRefs]),
+ Fail(lists:flatten(ErrMsg))
end.
check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) ->
lists:foreach(
fun ({Entry, Refc, ReferrerList}) ->
- {DelayedDeleteTimer,
- FoundRefs} =
- lists:foldl(
- fun ({Referrer, ReferencesList}, {DDT, A1}) ->
- {case Referrer of
- {system,delayed_delete_timer} ->
- true;
- _ ->
- DDT
- end,
- A1 + lists:foldl(fun ({_T,Rs},A2) ->
- A2+Rs
- end,
- 0,
- ReferencesList)}
- end,
- {false, 0},
- ReferrerList),
-
- %% Reference count equals found references?
- case {Refc, FoundRefs, DelayedDeleteTimer} of
- {X, X, _} ->
- ok;
- {0, 1, true} ->
- ok;
- _ ->
- exit({invalid_reference_count, Table, Entry})
- end,
-
- %% All entries in table referred to?
- case {Entry, Refc} of
- {ThisNodeName, 0} -> ok;
- {{ThisNodeName, ThisCreation}, 0} -> ok;
- {_, 0} when DelayedDeleteTimer == false ->
- exit({not_referred_entry_in_table, Table, Entry});
- {_, _} -> ok
- end
+ {DelayedDeleteTimer,
+ FoundRefs} =
+ lists:foldl(
+ fun ({Referrer, ReferencesList}, {DDT, A1}) ->
+ {case Referrer of
+ {system,delayed_delete_timer} ->
+ true;
+ _ ->
+ DDT
+ end,
+ A1 + lists:foldl(fun ({_T,Rs},A2) ->
+ A2+Rs
+ end,
+ 0,
+ ReferencesList)}
+ end,
+ {false, 0},
+ ReferrerList),
+
+ %% Reference count equals found references?
+ case {Refc, FoundRefs, DelayedDeleteTimer} of
+ {X, X, _} ->
+ ok;
+ {0, 1, true} ->
+ ok;
+ _ ->
+ exit({invalid_reference_count, Table, Entry})
+ end,
+
+ %% All entries in table referred to?
+ case {Entry, Refc} of
+ {ThisNodeName, 0} -> ok;
+ {{ThisNodeName, ThisCreation}, 0} -> ok;
+ {_, 0} when DelayedDeleteTimer == false ->
+ exit({not_referred_entry_in_table, Table, Entry});
+ {_, _} -> ok
+ end
end,
EntryList),
ok.
get_node_references({NodeName, Creation} = Node) when is_atom(NodeName),
- is_integer(Creation) ->
+ is_integer(Creation) ->
{{node_references, NodeRefs},
- {dist_references, DistRefs}} = ?ND_REFS,
+ {dist_references, DistRefs}} = ?ND_REFS,
check_nd_refc({node(), erlang:system_info(creation)},
- NodeRefs,
- DistRefs,
- fun (ErrMsg) ->
- ?t:format("~s", [ErrMsg]),
- ?t:fail(reference_count_check_failed)
- end),
+ NodeRefs,
+ DistRefs,
+ fun (ErrMsg) ->
+ io:format("~s", [ErrMsg]),
+ ct:fail(reference_count_check_failed)
+ end),
find_references(Node, NodeRefs).
get_dist_references(NodeName) when is_atom(NodeName) ->
- ?line {{node_references, NodeRefs},
- {dist_references, DistRefs}} = ?ND_REFS,
- ?line check_nd_refc({node(), erlang:system_info(creation)},
- NodeRefs,
- DistRefs,
- fun (ErrMsg) ->
- ?line ?t:format("~s", [ErrMsg]),
- ?line ?t:fail(reference_count_check_failed)
- end),
- ?line find_references(NodeName, DistRefs).
+ {{node_references, NodeRefs},
+ {dist_references, DistRefs}} = ?ND_REFS,
+ check_nd_refc({node(), erlang:system_info(creation)},
+ NodeRefs,
+ DistRefs,
+ fun (ErrMsg) ->
+ io:format("~s", [ErrMsg]),
+ ct:fail(reference_count_check_failed)
+ end),
+ find_references(NodeName, DistRefs).
find_references(N, NRefList) ->
case lists:keysearch(N, 1, NRefList) of
- {value, {N, _, ReferrersList}} -> ReferrersList;
- _ -> false
- end.
+ {value, {N, _, ReferrersList}} -> ReferrersList;
+ _ -> false
+ end.
%% Currently unused
% refering_entity_type(RefererType, ReferingEntities) ->
@@ -1081,7 +1032,7 @@ find_references(N, NRefList) ->
% ReferingEntities).
refering_entity_id(ReferingEntityId, [{ReferingEntityId,_} = ReferingEntity
- | _ReferingEntities]) ->
+ | _ReferingEntities]) ->
ReferingEntity;
refering_entity_id(ReferingEntityId, [_ | ReferingEntities]) ->
refering_entity_id(ReferingEntityId, ReferingEntities);
@@ -1094,34 +1045,34 @@ reference_type_count(Type, {_, _ReferenceCountList} = ReferingEntity) ->
reference_type_count(Type, [ReferingEntity]);
reference_type_count(Type, ReferingEntities) when is_list(ReferingEntities) ->
lists:foldl(fun ({_, ReferenceCountList}, Acc1) ->
- lists:foldl(fun ({T, N}, Acc2) when T == Type ->
- N + Acc2;
- (_, Acc2) ->
- Acc2
- end,
- Acc1,
- ReferenceCountList)
- end,
- 0,
- ReferingEntities).
+ lists:foldl(fun ({T, N}, Acc2) when T == Type ->
+ N + Acc2;
+ (_, Acc2) ->
+ Acc2
+ end,
+ Acc1,
+ ReferenceCountList)
+ end,
+ 0,
+ ReferingEntities).
start_node(Name, Args) ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line Res = test_server:start_node(Name,
- slave,
- [{args, "-pa "++Pa++" "++Args}]),
- ?line {ok, Node} = Res,
- ?line rpc:call(Node, erts_debug, set_internal_state,
- [available_internal_state, true]),
- ?line Res.
-
+ Pa = filename:dirname(code:which(?MODULE)),
+ Res = test_server:start_node(Name,
+ slave,
+ [{args, "-pa "++Pa++" "++Args}]),
+ {ok, Node} = Res,
+ rpc:call(Node, erts_debug, set_internal_state,
+ [available_internal_state, true]),
+ Res.
+
start_node(Name) ->
- ?line start_node(Name, "").
+ start_node(Name, "").
stop_node(Node) ->
- ?line nc_refc_check(Node),
- ?line true = test_server:stop_node(Node).
+ nc_refc_check(Node),
+ true = test_server:stop_node(Node).
hostname() ->
from($@, atom_to_list(node())).
@@ -1132,25 +1083,25 @@ from(_H, []) -> [].
wait_until(Pred) ->
case Pred() of
- true -> ok;
- false -> receive after 100 -> wait_until(Pred) end
+ true -> ok;
+ false -> receive after 100 -> wait_until(Pred) end
end.
get_nodefirstname_string() ->
atom_to_list(?MODULE)
- ++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
- ++ "-"
- ++ integer_to_list(erlang:unique_integer([positive])).
+ ++ "-"
+ ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-"
+ ++ integer_to_list(erlang:unique_integer([positive])).
get_nodefirstname() ->
list_to_atom(get_nodefirstname_string()).
get_nodename() ->
list_to_atom(get_nodefirstname_string()
- ++ "@"
- ++ hostname()).
-
+ ++ "@"
+ ++ hostname()).
+
-define(VERSION_MAGIC, 131).
@@ -1187,88 +1138,88 @@ mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) ->
mk_pid({atom_to_list(NodeName), Creation}, Number, Serial);
mk_pid({NodeName, Creation}, Number, Serial) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?PID_EXT,
- ?ATOM_EXT,
- uint16_be(length(NodeName)),
- NodeName,
- uint32_be(Number),
- uint32_be(Serial),
- uint8(Creation)])) of
- Pid when is_pid(Pid) ->
- Pid;
- {'EXIT', {badarg, _}} ->
- exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]});
- Other ->
- exit({unexpected_binary_to_term_result, Other})
+ ?PID_EXT,
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint32_be(Number),
+ uint32_be(Serial),
+ uint8(Creation)])) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
end.
mk_port({NodeName, Creation}, Number) when is_atom(NodeName) ->
mk_port({atom_to_list(NodeName), Creation}, Number);
mk_port({NodeName, Creation}, Number) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?PORT_EXT,
- ?ATOM_EXT,
- uint16_be(length(NodeName)),
- NodeName,
- uint32_be(Number),
- uint8(Creation)])) of
- Port when is_port(Port) ->
- Port;
- {'EXIT', {badarg, _}} ->
- exit({badarg, mk_port, [{NodeName, Creation}, Number]});
- Other ->
- exit({unexpected_binary_to_term_result, Other})
+ ?PORT_EXT,
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint32_be(Number),
+ uint8(Creation)])) of
+ Port when is_port(Port) ->
+ Port;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_port, [{NodeName, Creation}, Number]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
end.
mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName),
- is_integer(Creation),
- is_list(Numbers) ->
+ is_integer(Creation),
+ is_list(Numbers) ->
mk_ref({atom_to_list(NodeName), Creation}, Numbers);
mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName),
- is_integer(Creation),
- is_integer(Number) ->
+ is_integer(Creation),
+ is_integer(Number) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?REFERENCE_EXT,
- ?ATOM_EXT,
- uint16_be(length(NodeName)),
- NodeName,
- uint32_be(Number),
- uint8(Creation)])) of
- Ref when is_reference(Ref) ->
- Ref;
- {'EXIT', {badarg, _}} ->
- exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]});
- Other ->
- exit({unexpected_binary_to_term_result, Other})
+ ?REFERENCE_EXT,
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint32_be(Number),
+ uint8(Creation)])) of
+ Ref when is_reference(Ref) ->
+ Ref;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
end;
mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName),
- is_integer(Creation),
- is_list(Numbers) ->
+ is_integer(Creation),
+ is_list(Numbers) ->
case catch binary_to_term(list_to_binary([?VERSION_MAGIC,
- ?NEW_REFERENCE_EXT,
- uint16_be(length(Numbers)),
- ?ATOM_EXT,
- uint16_be(length(NodeName)),
- NodeName,
- uint8(Creation),
- lists:map(fun (N) ->
- uint32_be(N)
- end,
- Numbers)])) of
- Ref when is_reference(Ref) ->
- Ref;
- {'EXIT', {badarg, _}} ->
- exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]});
- Other ->
- exit({unexpected_binary_to_term_result, Other})
+ ?NEW_REFERENCE_EXT,
+ uint16_be(length(Numbers)),
+ ?ATOM_EXT,
+ uint16_be(length(NodeName)),
+ NodeName,
+ uint8(Creation),
+ lists:map(fun (N) ->
+ uint32_be(N)
+ end,
+ Numbers)])) of
+ Ref when is_reference(Ref) ->
+ Ref;
+ {'EXIT', {badarg, _}} ->
+ exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]});
+ Other ->
+ exit({unexpected_binary_to_term_result, Other})
end.
exec_loop() ->
receive
- {exec_fun, Fun} when is_function(Fun) ->
- Fun();
- {sync_exec_fun, From, Fun} when is_pid(From), is_function(Fun) ->
- From ! {sync_exec_fun_res, self(), Fun()}
+ {exec_fun, Fun} when is_function(Fun) ->
+ Fun();
+ {sync_exec_fun, From, Fun} when is_pid(From), is_function(Fun) ->
+ From ! {sync_exec_fun_res, self(), Fun()}
end,
exec_loop().
@@ -1284,6 +1235,6 @@ exec(Pid, Fun) when is_pid(Pid), is_function(Fun) ->
sync_exec(Pid, Fun) when is_pid(Pid), is_function(Fun) ->
Pid ! {sync_exec_fun, self(), Fun},
receive
- {sync_exec_fun_res, Pid, Res} ->
- Res
+ {sync_exec_fun_res, Pid, Res} ->
+ Res
end.
diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl
index 3660a58c56..9cc851f9cf 100644
--- a/erts/emulator/test/nofrag_SUITE.erl
+++ b/erts/emulator/test/nofrag_SUITE.erl
@@ -20,57 +20,33 @@
-module(nofrag_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
- error_handler/1,error_handler_apply/1,
- error_handler_fixed_apply/1,error_handler_fun/1,
- debug_breakpoint/1]).
+-export([all/0, suite/0,
+ error_handler/1,error_handler_apply/1,
+ error_handler_fixed_apply/1,error_handler_fun/1,
+ debug_breakpoint/1]).
%% Exported functions for an error_handler module.
-export([undefined_function/3,undefined_lambda/3,breakpoint/3]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 3}}].
all() ->
[error_handler, error_handler_apply,
error_handler_fixed_apply, error_handler_fun,
debug_breakpoint].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:minutes(3)),
- [{watchdog,Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
error_handler(Config) when is_list(Config) ->
- ?line process_flag(error_handler, ?MODULE),
+ process_flag(error_handler, ?MODULE),
%% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way
%% to traverse the entire term.
- ?line Term = collect(1024),
- ?line Term = binary_to_term(term_to_binary(Term)),
- ?line 1024 = length(Term),
- ?line [[a,b,c,d,[e,f,g]]] = lists:usort(Term),
+ Term = collect(1024),
+ Term = binary_to_term(term_to_binary(Term)),
+ 1024 = length(Term),
+ [[a,b,c,d,[e,f,g]]] = lists:usort(Term),
ok.
collect(0) ->
@@ -105,25 +81,25 @@ collect_apply(N, Mod) ->
[C|Res].
error_handler_apply(Config) when is_list(Config) ->
- ?line process_flag(error_handler, ?MODULE),
+ process_flag(error_handler, ?MODULE),
%% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way
%% to traverse the entire term.
- ?line Term = collect_apply(1024, fooblurfbar),
- ?line Term = binary_to_term(term_to_binary(Term)),
- ?line 1024 = length(Term),
- ?line [[{a,42},b,c,d,[e,f,g]]] = lists:usort(Term),
+ Term = collect_apply(1024, fooblurfbar),
+ Term = binary_to_term(term_to_binary(Term)),
+ 1024 = length(Term),
+ [[{a,42},b,c,d,[e,f,g]]] = lists:usort(Term),
ok.
error_handler_fixed_apply(Config) when is_list(Config) ->
- ?line process_flag(error_handler, ?MODULE),
+ process_flag(error_handler, ?MODULE),
%% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way
%% to traverse the entire term.
- ?line Term = collect_fixed_apply(1024, fooblurfbar),
- ?line Term = binary_to_term(term_to_binary(Term)),
- ?line 1024 = length(Term),
- ?line [[{a,2},b,c,d,[e,f,g]]] = lists:usort(Term),
+ Term = collect_fixed_apply(1024, fooblurfbar),
+ Term = binary_to_term(term_to_binary(Term)),
+ 1024 = length(Term),
+ [[{a,2},b,c,d,[e,f,g]]] = lists:usort(Term),
ok.
collect_fixed_apply(0, _) ->
@@ -145,19 +121,19 @@ undefined_function(_Mod, _Name, Args) ->
Args.
error_handler_fun(Config) when is_list(Config) ->
- ?line process_flag(error_handler, ?MODULE),
+ process_flag(error_handler, ?MODULE),
%% fun(A, B, C) -> {A,B,C,X} end in module foobarblurf.
B = <<131,112,0,0,0,84,3,109,96,69,208,5,175,207,75,36,93,112,218,232,222,22,251,0,
- 0,0,0,0,0,0,1,100,0,11,102,111,111,98,97,114,98,108,117,114,102,97,0,98,5,
- 244,197,144,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,
- 0,0,0,46,0,0,0,0,0,104,3,97,1,97,2,97,3>>,
- ?line Fun = binary_to_term(B),
- ?line Term = collect_fun(1024, Fun),
- ?line Term = binary_to_term(term_to_binary(Term)),
- ?line 1024 = length(Term),
- ?line [[{foo,bar},{99,1.0},[e,f,g]]] = lists:usort(Term),
- ?line {env,[{1,2,3}]} = erlang:fun_info(Fun, env),
+ 0,0,0,0,0,0,1,100,0,11,102,111,111,98,97,114,98,108,117,114,102,97,0,98,5,
+ 244,197,144,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,
+ 0,0,0,46,0,0,0,0,0,104,3,97,1,97,2,97,3>>,
+ Fun = binary_to_term(B),
+ Term = collect_fun(1024, Fun),
+ Term = binary_to_term(term_to_binary(Term)),
+ 1024 = length(Term),
+ [[{foo,bar},{99,1.0},[e,f,g]]] = lists:usort(Term),
+ {env,[{1,2,3}]} = erlang:fun_info(Fun, env),
ok.
collect_fun(0, _) ->
@@ -179,13 +155,13 @@ undefined_lambda(foobarblurf, Fun, Args) when is_function(Fun) ->
Args.
debug_breakpoint(Config) when is_list(Config) ->
- ?line process_flag(error_handler, ?MODULE),
- ?line erts_debug:breakpoint({?MODULE,foobar,5}, true),
- ?line Term = break_collect(1024),
- ?line Term = binary_to_term(term_to_binary(Term)),
- ?line 1024 = length(Term),
- ?line [[a,b,c,{d,e},[f,g,h]]] = lists:usort(Term),
- ?line erts_debug:breakpoint({?MODULE,foobar,5}, false),
+ process_flag(error_handler, ?MODULE),
+ erts_debug:breakpoint({?MODULE,foobar,5}, true),
+ Term = break_collect(1024),
+ Term = binary_to_term(term_to_binary(Term)),
+ 1024 = length(Term),
+ [[a,b,c,{d,e},[f,g,h]]] = lists:usort(Term),
+ erts_debug:breakpoint({?MODULE,foobar,5}, false),
ok.
break_collect(0) ->
@@ -202,5 +178,3 @@ foobar(_, _, _, _, _) ->
exit(dont_execute_me).
id(I) -> I.
-
-
diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl
index 90b6a36262..04a6f9d18d 100644
--- a/erts/emulator/test/num_bif_SUITE.erl
+++ b/erts/emulator/test/num_bif_SUITE.erl
@@ -1,8 +1,8 @@
%%
%% %CopyrightBegin%
-%%
+%%
%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
-%%
+%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -14,13 +14,13 @@
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-%%
+%%
%% %CopyrightEnd%
%%
-module(num_bif_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Tests the BIFs:
%% abs/1
@@ -36,22 +36,22 @@
%% integer_to_binary/2
%% binary_to_integer/1
--export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1,
+-export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1,
init_per_group/2, end_per_group/2, t_abs/1, t_float/1,
t_float_to_string/1, t_integer_to_string/1,
- t_string_to_integer/1,
+ t_string_to_integer/1, t_list_to_integer_edge_cases/1,
t_string_to_float_safe/1, t_string_to_float_risky/1,
t_round/1, t_trunc/1
]).
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
+all() ->
[t_abs, t_float, t_float_to_string, t_integer_to_string,
{group, t_string_to_float}, t_string_to_integer, t_round,
- t_trunc].
+ t_trunc, t_list_to_integer_edge_cases].
-groups() ->
+groups() ->
[{t_string_to_float, [],
[t_string_to_float_safe, t_string_to_float_risky]}].
@@ -73,7 +73,7 @@ t_abs(Config) when is_list(Config) ->
5.5 = abs(id(5.5)),
0.0 = abs(id(0.0)),
100.0 = abs(id(-100.0)),
-
+
%% Integers.
5 = abs(id(5)),
0 = abs(id(0)),
@@ -93,7 +93,7 @@ t_abs(Config) when is_list(Config) ->
BigNum = abs(BigNum),
BigNum = abs(-BigNum),
ok.
-
+
t_float(Config) when is_list(Config) ->
0.0 = float(id(0)),
2.5 = float(id(2.5)),
@@ -109,7 +109,7 @@ t_float(Config) when is_list(Config) ->
%% Extremly big bignums.
Big = id(list_to_integer(id(lists:duplicate(2000, $1)))),
{'EXIT', {badarg, _}} = (catch float(Big)),
-
+
ok.
@@ -183,7 +183,7 @@ t_float_to_string(Config) when is_list(Config) ->
test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]),
test_fts("1.23000000000000000000e+20",1.23e20, []),
ok.
-
+
test_fts(Expect, Float) ->
Expect = float_to_list(Float),
BinExpect = list_to_binary(Expect),
@@ -255,7 +255,7 @@ t_round(Config) when is_list(Config) ->
256 = round(id(255.6)),
-1033 = round(id(-1033.3)),
-1034 = round(id(-1033.6)),
-
+
% OTP-3722:
X = id((1 bsl 27) - 1),
MX = -X,
@@ -345,9 +345,9 @@ t_integer_to_string(Config) when is_list(Config) ->
%% Invalid types
lists:foreach(fun(Value) ->
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:integer_to_binary(Value)),
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:integer_to_list(Value))
end,[atom,1.2,0.0,[$1,[$2]]]),
@@ -416,27 +416,27 @@ t_string_to_integer(Config) when is_list(Config) ->
%% Invalid types
lists:foreach(fun(Value) ->
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch binary_to_integer(Value)),
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:list_to_integer(Value))
end,[atom,1.2,0.0,[$1,[$2]]]),
-
+
% Default base error cases
lists:foreach(fun(Value) ->
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:binary_to_integer(
list_to_binary(Value))),
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:list_to_integer(Value))
end,["1.0"," 1"," -1","","+"]),
-
+
% Custom base error cases
lists:foreach(fun({Value,Base}) ->
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch binary_to_integer(
list_to_binary(Value),Base)),
- {'EXIT', {badarg, _}} =
+ {'EXIT', {badarg, _}} =
(catch erlang:list_to_integer(Value,Base))
end,[{" 1",1},{" 1",37},{"2",2},{"C",11},
{"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16},
@@ -449,10 +449,61 @@ t_string_to_integer(Config) when is_list(Config) ->
ok.
+%% Tests edge cases for list_to_integer; compares with known good values
+
+t_list_to_integer_edge_cases(Config) when is_list(Config) ->
+ %% Take integer literals and compare to their representation in ExtTerm
+ T = [
+ {16, "0", <<131,97,0>>},
+ {16, "-0", <<131,97,0>>},
+
+ {16, "f", <<131,97,15>>},
+ {16, "-f", <<131,98,255,255,255,241>>},
+
+ {16, "0000000000000000000000000000000000000000000000000f",
+ <<131,97,15>>},
+ {16, "-0000000000000000000000000000000000000000000000000f",
+ <<131,98,255,255,255,241>>},
+
+ {16, "ffffffff", <<131,110,4,0,255,255,255,255>>},
+ {16, "-ffffffff", <<131,110,4,1,255,255,255,255>>},
+
+ {16, "7fffffff", <<131,110,4,0,255,255,255,127>>},
+ {16, "-7fffffff", <<131,98,128,0,0,1>>},
+
+ {16, "ffffffffffffffff",
+ <<131,110,8,0,255,255,255,255,255,255,255,255>>},
+ {16, "-ffffffffffffffff",
+ <<131,110,8,1,255,255,255,255,255,255,255,255>>},
+
+ {16, "7fffffffffffffff",
+ <<131,110,8,0,255,255,255,255,255,255,255,127>>},
+ {16, "-7fffffffffffffff",
+ <<131,110,8,1,255,255,255,255,255,255,255,127>>},
+
+ %% Alleged 32-bit corner case (should not happen on 64-bit). At 32-4
+ %% bits we may corrupt sign bit and fall out of SMALL_INT range.
+ {2, "1000000000000000000000000000", <<131,98,8,0,0,0>>},
+ {2, "-1000000000000000000000000000", <<131,98,248,0,0,0>>},
+
+ %% 64-bit corner case (should not happen on 32-bit) at 64-4 bits we
+ %% corrupt sign bit and fall out of SMALL_INT range (bam! all dead)
+ {2, "100000000000000000000000000000000000000000000000000000000000",
+ <<131,110,8,0,0,0,0,0,0,0,0,8>>},
+ {2, "-100000000000000000000000000000000000000000000000000000000000",
+ <<131,110,8,1,0,0,0,0,0,0,0,8>>}
+ ],
+ [begin
+ io:format("~s base ~p vs ~p~n", [Str, Base, Bin]),
+ FromStr = list_to_integer(Str, Base),
+ FromStr = binary_to_term(Bin)
+ end || {Base, Str, Bin} <- T],
+ ok.
+
test_sti(Num) ->
[begin
io:format("Testing ~p:~p",[Num,Base]),
- test_sti(Num,Base)
+ test_sti(Num,Base)
end|| Base <- lists:seq(2,36)].
test_sti(Num,Base) ->
diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl
index 1586a024d8..0da40ec430 100644
--- a/erts/emulator/test/old_mod.erl
+++ b/erts/emulator/test/old_mod.erl
@@ -23,26 +23,26 @@
-export([sort_on_old_node/1, sorter/3]).
--include("test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
sorter(Receiver, Ref, List) ->
Receiver ! {Ref, lists:sort(List)}.
sort_on_old_node(List) when is_list(List) ->
OldVersion = "r10",
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line {X, Y, Z} = now(),
- ?line NodeName = list_to_atom(OldVersion
- ++ "_"
- ++ integer_to_list(X)
- ++ integer_to_list(Y)
- ++ integer_to_list(Z)),
- ?line {ok, Node} = ?t:start_node(NodeName,
- peer,
- [{args, " -pa " ++ Pa},
- {erl, [{release, OldVersion++"b_patched"}]}]),
- ?line Ref = make_ref(),
- ?line spawn_link(Node, ?MODULE, sorter, [self(), Ref, List]),
- ?line SortedPids = receive {Ref, SP} -> SP end,
- ?line true = ?t:stop_node(Node),
- ?line SortedPids.
+ Pa = filename:dirname(code:which(?MODULE)),
+ {X, Y, Z} = now(),
+ NodeName = list_to_atom(OldVersion
+ ++ "_"
+ ++ integer_to_list(X)
+ ++ integer_to_list(Y)
+ ++ integer_to_list(Z)),
+ {ok, Node} = test_server:start_node(NodeName,
+ peer,
+ [{args, " -pa " ++ Pa},
+ {erl, [{release, OldVersion++"b_patched"}]}]),
+ Ref = make_ref(),
+ spawn_link(Node, ?MODULE, sorter, [self(), Ref, List]),
+ SortedPids = receive {Ref, SP} -> SP end,
+ true = test_server:stop_node(Node),
+ SortedPids.
diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl
index 97c99fe07b..9d40417d0a 100644
--- a/erts/emulator/test/old_scheduler_SUITE.erl
+++ b/erts/emulator/test/old_scheduler_SUITE.erl
@@ -20,43 +20,27 @@
-module(old_scheduler_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2, end_per_testcase/2]).
+-export([all/0, suite/0,
+ init_per_testcase/2, end_per_testcase/2]).
-export([equal/1, many_low/1, few_low/1, max/1, high/1]).
--define(default_timeout, ?t:minutes(11)).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 11}}].
all() ->
case catch erlang:system_info(modified_timing_level) of
- Level when is_integer(Level) ->
- {skipped,
- "Modified timing (level " ++
- integer_to_list(Level) ++
- ") is enabled. Testcases gets messed "
- "up by modfied timing."};
- _ -> [equal, many_low, few_low, max, high]
+ Level when is_integer(Level) ->
+ {skipped,
+ "Modified timing (level " ++
+ integer_to_list(Level) ++
+ ") is enabled. Testcases gets messed "
+ "up by modfied timing."};
+ _ -> [equal, many_low, few_low, max, high]
end.
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
%%-----------------------------------------------------------------------------------
%% TEST SUITE DESCRIPTION
@@ -78,35 +62,30 @@ end_per_group(_GroupName, Config) ->
%%-----------------------------------------------------------------------------------
init_per_testcase(_Case, Config) ->
- ?line Dog = test_server:timetrap(?default_timeout),
%% main test process needs max prio
- ?line Prio = process_flag(priority, max),
- ?line MS = erlang:system_flag(multi_scheduling, block),
- [{prio,Prio},{watchdog,Dog},{multi_scheduling, MS}|Config].
+ Prio = process_flag(priority, max),
+ MS = erlang:system_flag(multi_scheduling, block),
+ [{prio,Prio},{multi_scheduling, MS}|Config].
end_per_testcase(_Case, Config) ->
erlang:system_flag(multi_scheduling, unblock),
- Dog=?config(watchdog, Config),
- Prio=?config(prio, Config),
+ Prio=proplists:get_value(prio, Config),
process_flag(priority, Prio),
- test_server:timetrap_cancel(Dog),
ok.
ok(Config) when is_list(Config) ->
- case ?config(multi_scheduling, Config) of
- blocked ->
- {comment,
- "Multi-scheduling blocked during test. This testcase was not "
- "written to work with multiple schedulers."};
- _ -> ok
+ case proplists:get_value(multi_scheduling, Config) of
+ blocked ->
+ {comment,
+ "Multi-scheduling blocked during test. This testcase was not "
+ "written to work with multiple schedulers."};
+ _ -> ok
end.
%% Run equal number of low and normal prio processes.
-equal(suite) -> [];
-equal(doc) -> [];
equal(Config) when is_list(Config) ->
- ?line Self = self(),
+ Self = self(),
%% specify number of test processes to run
Normal = {normal,500},
@@ -116,102 +95,96 @@ equal(Config) when is_list(Config) ->
Time = 30,
%% start controllers
- ?line Receiver =
- spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end),
- ?line Starter =
- spawn(fun() -> starter(Normal, Low, Receiver) end),
+ Receiver =
+ spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end),
+ Starter =
+ spawn(fun() -> starter(Normal, Low, Receiver) end),
%% receive test data from Receiver
- ?line {NRs,NAvg,LRs,LAvg,Ratio} =
- receive
- {Receiver,Res} -> Res
- end,
+ {NRs,NAvg,LRs,LAvg,Ratio} =
+ receive
+ {Receiver,Res} -> Res
+ end,
%% stop controllers and test processes
- ?line exit(Starter, kill),
- ?line exit(Receiver, kill),
+ exit(Starter, kill),
+ exit(Receiver, kill),
io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [NRs,NAvg,LRs,LAvg,Ratio]),
+ [NRs,NAvg,LRs,LAvg,Ratio]),
%% runtime ratio between normal and low should be ~8
if Ratio < 7.5 ; Ratio > 8.5 ->
- ?t:fail({bad_ratio,Ratio});
+ ct:fail({bad_ratio,Ratio});
true ->
- ok(Config)
+ ok(Config)
end.
%% Run many low and few normal prio processes.
-many_low(suite) -> [];
-many_low(doc) -> [];
many_low(Config) when is_list(Config) ->
- ?line Self = self(),
+ Self = self(),
Normal = {normal,1},
Low = {low,1000},
%% specify time of test (in seconds)
Time = 30,
- ?line Receiver =
- spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end),
- ?line Starter =
- spawn(fun() -> starter(Normal, Low, Receiver) end),
- ?line {NRs,NAvg,LRs,LAvg,Ratio} =
- receive
- {Receiver,Res} -> Res
- end,
- ?line exit(Starter, kill),
- ?line exit(Receiver, kill),
+ Receiver =
+ spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end),
+ Starter =
+ spawn(fun() -> starter(Normal, Low, Receiver) end),
+ {NRs,NAvg,LRs,LAvg,Ratio} =
+ receive
+ {Receiver,Res} -> Res
+ end,
+ exit(Starter, kill),
+ exit(Receiver, kill),
io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [NRs,NAvg,LRs,LAvg,Ratio]),
+ [NRs,NAvg,LRs,LAvg,Ratio]),
if Ratio < 7.5 ; Ratio > 8.5 ->
- ?t:fail({bad_ratio,Ratio});
+ ct:fail({bad_ratio,Ratio});
true ->
- ok(Config)
+ ok(Config)
end.
%% Run few low and many normal prio processes.
-few_low(suite) -> [];
-few_low(doc) -> [];
few_low(Config) when is_list(Config) ->
- ?line Self = self(),
+ Self = self(),
Normal = {normal,1000},
Low = {low,1},
%% specify time of test (in seconds)
Time = 30,
- ?line Receiver =
- spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end),
- ?line Starter =
- spawn(fun() -> starter(Normal, Low, Receiver) end),
- ?line {NRs,NAvg,LRs,LAvg,Ratio} =
- receive
- {Receiver,Res} -> Res
- end,
- ?line exit(Starter, kill),
- ?line exit(Receiver, kill),
+ Receiver =
+ spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Normal, Low) end),
+ Starter =
+ spawn(fun() -> starter(Normal, Low, Receiver) end),
+ {NRs,NAvg,LRs,LAvg,Ratio} =
+ receive
+ {Receiver,Res} -> Res
+ end,
+ exit(Starter, kill),
+ exit(Receiver, kill),
io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [NRs,NAvg,LRs,LAvg,Ratio]),
+ [NRs,NAvg,LRs,LAvg,Ratio]),
if Ratio < 7.0 ; Ratio > 8.5 ->
- ?t:fail({bad_ratio,Ratio});
+ ct:fail({bad_ratio,Ratio});
true ->
- ok(Config)
+ ok(Config)
end.
%% Run max prio processes and verify they get at least as much
%% runtime as high, normal and low.
-max(suite) -> [];
-max(doc) -> [];
max(Config) when is_list(Config) ->
max = process_flag(priority, max), % should already be max (init_per_tc)
- ?line Self = self(),
+ Self = self(),
Max = {max,2},
High = {high,2},
Normal = {normal,100},
@@ -220,69 +193,67 @@ max(Config) when is_list(Config) ->
%% specify time of test (in seconds)
Time = 30,
- ?line Receiver1 =
- spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, High) end),
- ?line Starter1 =
- spawn(fun() -> starter(Max, High, Receiver1) end),
- ?line {M1Rs,M1Avg,HRs,HAvg,Ratio1} =
- receive
- {Receiver1,Res1} -> Res1
- end,
- ?line exit(Starter1, kill),
- ?line exit(Receiver1, kill),
+ Receiver1 =
+ spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, High) end),
+ Starter1 =
+ spawn(fun() -> starter(Max, High, Receiver1) end),
+ {M1Rs,M1Avg,HRs,HAvg,Ratio1} =
+ receive
+ {Receiver1,Res1} -> Res1
+ end,
+ exit(Starter1, kill),
+ exit(Receiver1, kill),
io:format("Reports: ~w max (~w/proc), ~w high (~w/proc). Ratio: ~w~n",
- [M1Rs,M1Avg,HRs,HAvg,Ratio1]),
+ [M1Rs,M1Avg,HRs,HAvg,Ratio1]),
if Ratio1 < 1.0 ->
- ?t:fail({bad_ratio,Ratio1});
+ ct:fail({bad_ratio,Ratio1});
true ->
- ok(Config)
+ ok(Config)
end,
- ?line Receiver2 =
- spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Normal) end),
- ?line Starter2 =
- spawn(fun() -> starter(Max, Normal, Receiver2) end),
- ?line {M2Rs,M2Avg,NRs,NAvg,Ratio2} =
- receive
- {Receiver2,Res2} -> Res2
- end,
- ?line exit(Starter2, kill),
- ?line exit(Receiver2, kill),
+ Receiver2 =
+ spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Normal) end),
+ Starter2 =
+ spawn(fun() -> starter(Max, Normal, Receiver2) end),
+ {M2Rs,M2Avg,NRs,NAvg,Ratio2} =
+ receive
+ {Receiver2,Res2} -> Res2
+ end,
+ exit(Starter2, kill),
+ exit(Receiver2, kill),
io:format("Reports: ~w max (~w/proc), ~w normal (~w/proc). Ratio: ~w~n",
- [M2Rs,M2Avg,NRs,NAvg,Ratio2]),
+ [M2Rs,M2Avg,NRs,NAvg,Ratio2]),
if Ratio2 < 1.0 ->
- ?t:fail({bad_ratio,Ratio2});
+ ct:fail({bad_ratio,Ratio2});
true ->
- ok
+ ok
end,
- ?line Receiver3 =
- spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Low) end),
- ?line Starter3 =
- spawn(fun() -> starter(Max, Low, Receiver3) end),
- ?line {M3Rs,M3Avg,LRs,LAvg,Ratio3} =
- receive
- {Receiver3,Res3} -> Res3
- end,
- ?line exit(Starter3, kill),
- ?line exit(Receiver3, kill),
+ Receiver3 =
+ spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, Max, Low) end),
+ Starter3 =
+ spawn(fun() -> starter(Max, Low, Receiver3) end),
+ {M3Rs,M3Avg,LRs,LAvg,Ratio3} =
+ receive
+ {Receiver3,Res3} -> Res3
+ end,
+ exit(Starter3, kill),
+ exit(Receiver3, kill),
io:format("Reports: ~w max (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [M3Rs,M3Avg,LRs,LAvg,Ratio3]),
+ [M3Rs,M3Avg,LRs,LAvg,Ratio3]),
if Ratio3 < 1.0 ->
- ?t:fail({bad_ratio,Ratio3});
+ ct:fail({bad_ratio,Ratio3});
true ->
- ok(Config)
+ ok(Config)
end.
%% Run high prio processes and verify they get at least as much
%% runtime as normal and low.
-high(suite) -> [];
-high(doc) -> [];
high(Config) when is_list(Config) ->
max = process_flag(priority, max), % should already be max (init_per_tc)
- ?line Self = self(),
+ Self = self(),
High = {high,2},
Normal = {normal,100},
Low = {low,100},
@@ -290,40 +261,40 @@ high(Config) when is_list(Config) ->
%% specify time of test (in seconds)
Time = 30,
- ?line Receiver1 =
- spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Normal) end),
- ?line Starter1 =
- spawn(fun() -> starter(High, Normal, Receiver1) end),
- ?line {H1Rs,H1Avg,NRs,NAvg,Ratio1} =
- receive
- {Receiver1,Res1} -> Res1
- end,
- ?line exit(Starter1, kill),
- ?line exit(Receiver1, kill),
+ Receiver1 =
+ spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Normal) end),
+ Starter1 =
+ spawn(fun() -> starter(High, Normal, Receiver1) end),
+ {H1Rs,H1Avg,NRs,NAvg,Ratio1} =
+ receive
+ {Receiver1,Res1} -> Res1
+ end,
+ exit(Starter1, kill),
+ exit(Receiver1, kill),
io:format("Reports: ~w high (~w/proc), ~w normal (~w/proc). Ratio: ~w~n",
- [H1Rs,H1Avg,NRs,NAvg,Ratio1]),
+ [H1Rs,H1Avg,NRs,NAvg,Ratio1]),
if Ratio1 < 1.0 ->
- ?t:fail({bad_ratio,Ratio1});
+ ct:fail({bad_ratio,Ratio1});
true ->
- ok
+ ok
end,
- ?line Receiver2 =
- spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Low) end),
- ?line Starter2 =
- spawn(fun() -> starter(High, Low, Receiver2) end),
- ?line {H2Rs,H2Avg,LRs,LAvg,Ratio2} =
- receive
- {Receiver2,Res2} -> Res2
- end,
- ?line exit(Starter2, kill),
- ?line exit(Receiver2, kill),
+ Receiver2 =
+ spawn(fun() -> receiver(erlang:monotonic_time(), Time, Self, High, Low) end),
+ Starter2 =
+ spawn(fun() -> starter(High, Low, Receiver2) end),
+ {H2Rs,H2Avg,LRs,LAvg,Ratio2} =
+ receive
+ {Receiver2,Res2} -> Res2
+ end,
+ exit(Starter2, kill),
+ exit(Receiver2, kill),
io:format("Reports: ~w high (~w/proc), ~w low (~w/proc). Ratio: ~w~n",
- [H2Rs,H2Avg,LRs,LAvg,Ratio2]),
+ [H2Rs,H2Avg,LRs,LAvg,Ratio2]),
if Ratio2 < 1.0 ->
- ?t:fail({bad_ratio,Ratio2});
+ ct:fail({bad_ratio,Ratio2});
true ->
- ok(Config)
+ ok(Config)
end.
@@ -338,38 +309,38 @@ receiver(T0, TimeSec, Main, {P1,P1N}, {P2,P2N}) ->
%% uncomment lines below to get life sign (debug)
receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 0) ->
-% T = erlang:convert_time_unit(erlang:monotonic_time() - T0, native, milli_seconds),
-% erlang:display({round(T/1000),P1Rs,P2Rs}),
+ % T = erlang:convert_time_unit(erlang:monotonic_time() - T0, native, milli_seconds),
+ % erlang:display({round(T/1000),P1Rs,P2Rs}),
receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 100000);
receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, C) ->
Remain = Time - erlang:convert_time_unit(erlang:monotonic_time() - T0,
- native, milli_seconds), % test time remaining
+ native, milli_seconds), % test time remaining
Remain1 = if Remain < 0 ->
- 0;
- true ->
- Remain
- end,
+ 0;
+ true ->
+ Remain
+ end,
{P1Rs1,P2Rs1} =
- receive
- {_Pid,P1} -> % report from a P1 process
- {P1Rs+1,P2Rs};
- {_Pid,P2} -> % report from a P2 process
- {P1Rs,P2Rs+1}
- after Remain1 ->
- {P1Rs,P2Rs}
- end,
+ receive
+ {_Pid,P1} -> % report from a P1 process
+ {P1Rs+1,P2Rs};
+ {_Pid,P2} -> % report from a P2 process
+ {P1Rs,P2Rs+1}
+ after Remain1 ->
+ {P1Rs,P2Rs}
+ end,
if Remain > 0 -> % keep going
- receiver(T0, Time, Main, P1,P1N,P1Rs1, P2,P2N,P2Rs1, C-1);
+ receiver(T0, Time, Main, P1,P1N,P1Rs1, P2,P2N,P2Rs1, C-1);
true -> % finish
- %% calculate results and send to main test process
- P1Avg = P1Rs1/P1N,
- P2Avg = P2Rs1/P2N,
- Ratio = if P2Avg < 1.0 -> P1Avg;
- true -> P1Avg/P2Avg
- end,
- Main ! {self(),{P1Rs1,round(P1Avg),P2Rs1,round(P2Avg),Ratio}},
- flush_loop()
+ %% calculate results and send to main test process
+ P1Avg = P1Rs1/P1N,
+ P2Avg = P2Rs1/P2N,
+ Ratio = if P2Avg < 1.0 -> P1Avg;
+ true -> P1Avg/P2Avg
+ end,
+ Main ! {self(),{P1Rs1,round(P1Avg),P2Rs1,round(P2Avg),Ratio}},
+ flush_loop()
end.
starter({P1,P1N}, {P2,P2N}, Receiver) ->
@@ -395,8 +366,8 @@ p_loop(100, Prio, Receiver) ->
receive after 0 -> ok end,
%% if Receiver gone, we're done
case is_process_alive(Receiver) of
- false -> exit(bye);
- true -> ok
+ false -> exit(bye);
+ true -> ok
end,
%% send report
Receiver ! {self(),Prio},
@@ -404,10 +375,10 @@ p_loop(100, Prio, Receiver) ->
p_loop(N, Prio, Receiver) ->
p_loop(N+1, Prio, Receiver).
-
+
flush_loop() ->
receive _ ->
- ok
+ ok
end,
flush_loop().
diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl
index 6eda78a57b..562cf1c92d 100644
--- a/erts/emulator/test/op_SUITE.erl
+++ b/erts/emulator/test/op_SUITE.erl
@@ -20,68 +20,44 @@
-module(op_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
- bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]).
+-export([all/0, suite/0,
+ bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]).
-export([]).
-import(lists, [foldl/3,flatmap/2]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 3}}].
all() ->
[bsl_bsr, logical, t_not, relop_simple, relop,
complex_relop].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(3)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
%% Test the bsl and bsr operators.
bsl_bsr(Config) when is_list(Config) ->
Vs = [unvalue(V) || V <- [-16#8000009-2,-1,0,1,2,73,16#8000000,bad,[]]],
Cases = [{Op,X,Y} || Op <- ['bsr','bsl'], X <- Vs, Y <- Vs],
- ?line run_test_module(Cases, false),
+ run_test_module(Cases, false),
{comment,integer_to_list(length(Cases)) ++ " cases"}.
-logical(doc) -> "Test the logical operators and internal BIFs.";
+%% Test the logical operators and internal BIFs.
logical(Config) when is_list(Config) ->
Vs0 = [true,false,bad],
Vs = [unvalue(V) || V <- Vs0],
Cases = [{Op,X,Y} || Op <- ['and','or','xor'], X <- Vs, Y <- Vs],
- ?line run_test_module(Cases, false),
+ run_test_module(Cases, false),
{comment,integer_to_list(length(Cases)) ++ " cases"}.
-t_not(doc) -> "Test the not operator and internal BIFs.";
+%% Test the not operator and internal BIFs.
t_not(Config) when is_list(Config) ->
- ?line Cases = [{'not',unvalue(V)} || V <- [true,false,42,bad]],
- ?line run_test_module(Cases, false),
+ Cases = [{'not',unvalue(V)} || V <- [true,false,42,bad]],
+ run_test_module(Cases, false),
{comment,integer_to_list(length(Cases)) ++ " cases"}.
-relop_simple(doc) -> "Test that simlpe relations between relation operators hold.";
+%% Test that simlpe relations between relation operators hold.
relop_simple(Config) when is_list(Config) ->
Big1 = 19738924729729787487784874,
Big2 = 38374938373887374983978484,
@@ -90,51 +66,52 @@ relop_simple(Config) when is_list(Config) ->
T1 = erlang:make_tuple(3,87),
T2 = erlang:make_tuple(3,87),
Terms = [-F2,Big2,-F1,-Big1,-33,-33.0,0,0.0,42,42.0,Big1,F1,Big2,F2,a,b,
- {T1,a},{T2,b},[T1,Big1],[T2,Big2]],
-
- ?line Combos = [{V1,V2} || V1 <- Terms, V2 <- Terms],
-
+ {T1,a},{T2,b},[T1,Big1],[T2,Big2]],
+
+ Combos = [{V1,V2} || V1 <- Terms, V2 <- Terms],
+
lists:foreach(fun({A,B}) -> relop_simple_do(A,B) end,
- Combos),
-
- repeat(fun() -> Size = random:uniform(100),
- Rnd1 = make_rand_term(Size),
- {Rnd2,0} = clone_and_mutate(Rnd1, random:uniform(Size)),
- relop_simple_do(Rnd1,Rnd2)
- end,
- 1000),
+ Combos),
+
+ repeat(fun() ->
+ Size = rand:uniform(100),
+ Rnd1 = make_rand_term(Size),
+ {Rnd2,0} = clone_and_mutate(Rnd1, rand:uniform(Size)),
+ relop_simple_do(Rnd1,Rnd2)
+ end,
+ 1000),
ok.
relop_simple_do(V1,V2) ->
%%io:format("compare ~p\n and ~p\n",[V1,V2]),
L = V1 < V2,
- ?line L = not (V1 >= V2),
- ?line L = V2 > V1,
- ?line L = not (V2 =< V1),
+ L = not (V1 >= V2),
+ L = V2 > V1,
+ L = not (V2 =< V1),
G = V1 > V2,
- ?line G = not (V1 =< V2),
- ?line G = V2 < V1,
- ?line G = not (V2 >= V1),
-
+ G = not (V1 =< V2),
+ G = V2 < V1,
+ G = not (V2 >= V1),
+
ID = V1 =:= V2,
- ?line ID = V2 =:= V1,
- ?line ID = not (V1 =/= V2),
- ?line ID = not (V2 =/= V1),
-
+ ID = V2 =:= V1,
+ ID = not (V1 =/= V2),
+ ID = not (V2 =/= V1),
+
EQ = V1 == V2,
- ?line EQ = V2 == V1,
- ?line EQ = not (V1 /= V2),
- ?line EQ = not (V2 /= V1),
-
- ?line case {L, EQ, ID, G, cmp_emu(V1,V2)} of
- { true, false, false, false, -1} -> ok;
- {false, true, false, false, 0} -> ok;
- {false, true, true, false, 0} -> ok;
- {false, false, false, true, +1} -> ok
- end.
-
+ EQ = V2 == V1,
+ EQ = not (V1 /= V2),
+ EQ = not (V2 /= V1),
+
+ case {L, EQ, ID, G, cmp_emu(V1,V2)} of
+ { true, false, false, false, -1} -> ok;
+ {false, true, false, false, 0} -> ok;
+ {false, true, true, false, 0} -> ok;
+ {false, false, false, true, +1} -> ok
+ end.
+
%% Emulate internal "cmp"
cmp_emu(A,B) when is_tuple(A), is_tuple(B) ->
SA = size(A),
@@ -145,8 +122,8 @@ cmp_emu(A,B) when is_tuple(A), is_tuple(B) ->
end;
cmp_emu([A|TA],[B|TB]) ->
case cmp_emu(A,B) of
- 0 -> cmp_emu(TA,TB);
- CMP -> CMP
+ 0 -> cmp_emu(TA,TB);
+ CMP -> CMP
end;
cmp_emu(A,B) ->
%% We cheat and use real "cmp" for the primitive types.
@@ -154,48 +131,48 @@ cmp_emu(A,B) ->
A > B -> +1;
true -> 0
end.
-
+
make_rand_term(1) ->
make_rand_term_single();
make_rand_term(Arity) ->
- case random:uniform(3) of
- 1 ->
- make_rand_list(Arity);
- 2 ->
- list_to_tuple(make_rand_list(Arity));
- 3 ->
- {Car,Rest} = make_rand_term_rand_size(Arity),
- [Car|make_rand_term(Rest)]
+ case rand:uniform(3) of
+ 1 ->
+ make_rand_list(Arity);
+ 2 ->
+ list_to_tuple(make_rand_list(Arity));
+ 3 ->
+ {Car,Rest} = make_rand_term_rand_size(Arity),
+ [Car|make_rand_term(Rest)]
end.
make_rand_term_single() ->
- Range = 1 bsl random:uniform(200),
- case random:uniform(12) of
- 1 -> random;
- 2 -> uniform;
- 3 -> random:uniform(Range) - (Range div 2);
- 4 -> Range * (random:uniform() - 0.5);
- 5 -> 0;
- 6 -> 0.0;
- 7 -> make_ref();
- 8 -> self();
- 9 -> term_to_binary(random:uniform(Range));
- 10 -> fun(X) -> X*Range end;
- 11 -> fun(X) -> X/Range end;
- 12 -> []
+ Range = 1 bsl rand:uniform(200),
+ case rand:uniform(12) of
+ 1 -> random;
+ 2 -> uniform;
+ 3 -> rand:uniform(Range) - (Range div 2);
+ 4 -> Range * (rand:uniform() - 0.5);
+ 5 -> 0;
+ 6 -> 0.0;
+ 7 -> make_ref();
+ 8 -> self();
+ 9 -> term_to_binary(rand:uniform(Range));
+ 10 -> fun(X) -> X*Range end;
+ 11 -> fun(X) -> X/Range end;
+ 12 -> []
end.
make_rand_term_rand_size(1) ->
{make_rand_term(1), 0};
make_rand_term_rand_size(MaxArity) ->
- Arity = random:uniform(MaxArity-1),
+ Arity = rand:uniform(MaxArity-1),
{make_rand_term(Arity), MaxArity-Arity}.
make_rand_list(0) -> [];
make_rand_list(Arity) ->
{Term, Rest} = make_rand_term_rand_size(Arity),
[Term | make_rand_list(Rest)].
-
+
clone_and_mutate(Term, 0) ->
{clone(Term), 0};
@@ -218,82 +195,81 @@ clone(Term) ->
my_list_to_tuple(List) ->
try list_to_tuple(List)
catch
- error:badarg ->
- %%io:format("my_list_to_tuple got badarg exception.\n"),
- list_to_tuple(purify_list(List))
+ error:badarg ->
+ %%io:format("my_list_to_tuple got badarg exception.\n"),
+ list_to_tuple(purify_list(List))
end.
-
+
purify_list(List) ->
lists:reverse(purify_list(List, [])).
purify_list([], Acc) -> Acc;
purify_list([H|T], Acc) -> purify_list(T, [H|Acc]);
purify_list(Other, Acc) -> [Other|Acc].
-
-relop(doc) -> "Test the relational operators and internal BIFs on literals.";
+
+%% Test the relational operators and internal BIFs on literals.
relop(Config) when is_list(Config) ->
Big1 = -38374938373887374983978484,
Big2 = 19738924729729787487784874,
F1 = float(Big1),
F2 = float(Big2),
Vs0 = [a,b,-33,-33.0,0,0.0,42,42.0,Big1,Big2,F1,F2],
- ?line Vs = [unvalue(V) || V <- Vs0],
+ Vs = [unvalue(V) || V <- Vs0],
Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='],
- ?line binop(Ops, Vs).
+ binop(Ops, Vs).
-complex_relop(doc) ->
- "Test the relational operators and internal BIFs on lists and tuples.";
+%% Test the relational operators and internal BIFs on lists and tuples.
complex_relop(Config) when is_list(Config) ->
Big = 99678557475484872464269855544643333,
Float = float(Big),
Vs0 = [an_atom,42.0,42,Big,Float],
Vs = flatmap(fun(X) -> [unvalue({X}),unvalue([X])] end, Vs0),
Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='],
- ?line binop(Ops, Vs).
+ binop(Ops, Vs).
binop(Ops, Vs) ->
- Run = fun(Op, N) -> ?line Cases = [{Op,V1,V2} || V1 <- Vs, V2 <- Vs],
- ?line run_test_module(Cases, true),
- N + length(Cases) end,
- ?line NumCases = foldl(Run, 0, Ops),
+ Run = fun(Op, N) -> Cases = [{Op,V1,V2} || V1 <- Vs, V2 <- Vs],
+ run_test_module(Cases, true),
+ N + length(Cases) end,
+ NumCases = foldl(Run, 0, Ops),
{comment,integer_to_list(NumCases) ++ " cases"}.
-
+
run_test_module(Cases, GuardsOk) ->
- ?line Es = [expr(C) || C <- Cases],
- ?line Ok = unvalue(ok),
- ?line Gts = case GuardsOk of
- true ->
- Ges = [guard_expr(C) || C <- Cases],
- ?line lists:foldr(fun guard_test/2, [Ok], Ges);
- false ->
- [Ok]
- end,
- ?line Fun1 = make_function(guard_tests, Gts),
- ?line Bts = lists:foldr(fun body_test/2, [Ok], Es),
- ?line Fun2 = make_function(body_tests, Bts),
- ?line Bbts = lists:foldr(fun internal_bif/2, [Ok], Es),
- ?line Fun3 = make_function(bif_tests, Bbts),
- ?line Id = {function,1,id,1,[{clause,1,[{var,1,'I'}],[],[{var,1,'I'}]}]},
+ Es = [expr(C) || C <- Cases],
+ Ok = unvalue(ok),
+ Gts = case GuardsOk of
+ true ->
+ Ges = [guard_expr(C) || C <- Cases],
+ lists:foldr(fun guard_test/2, [Ok], Ges);
+ false ->
+ [Ok]
+ end,
+ Fun1 = make_function(guard_tests, Gts),
+ Bts = lists:foldr(fun body_test/2, [Ok], Es),
+ Fun2 = make_function(body_tests, Bts),
+ Bbts = lists:foldr(fun internal_bif/2, [Ok], Es),
+ Fun3 = make_function(bif_tests, Bbts),
+ Id = {function,1,id,1,[{clause,1,[{var,1,'I'}],[],[{var,1,'I'}]}]},
Module0 = make_module(op_tests, [Fun1,Fun2,Fun3,Id]),
Module = erl_parse:new_anno(Module0),
- ?line lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module),
+ lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module),
%% Compile, load, and run the generated module.
- Native = case ?t:is_native(?MODULE) of
- true -> [native];
- false -> []
- end,
- ?line {ok,Mod,Code1} = compile:forms(Module, [time|Native]),
- ?line code:delete(Mod),
- ?line code:purge(Mod),
- ?line {module,Mod} = code:load_binary(Mod, Mod, Code1),
- ?line run_function(Mod, guard_tests),
- ?line run_function(Mod, body_tests),
- ?line run_function(Mod, bif_tests),
-
- ?line true = code:delete(Mod),
- ?line code:purge(Mod),
+ Native = case test_server:is_native(?MODULE) of
+ true -> [native];
+ false -> []
+ end,
+ {ok,Mod,Code1} = compile:forms(Module, [time|Native]),
+ code:delete(Mod),
+ code:purge(Mod),
+ {module,Mod} = code:load_binary(Mod, Mod, Code1),
+ run_function(Mod, guard_tests),
+ run_function(Mod, body_tests),
+ run_function(Mod, bif_tests),
+
+ true = code:delete(Mod),
+ code:purge(Mod),
ok.
@@ -317,19 +293,19 @@ guard_expr({Op,X,Y}) ->
run_function(Mod, Name) ->
case catch Mod:Name() of
- {'EXIT',Reason} ->
- io:format("~p", [get(last)]),
- ?t:fail({'EXIT',Reason});
- _Other ->
- ok
+ {'EXIT',Reason} ->
+ io:format("~p", [get(last)]),
+ ct:fail({'EXIT',Reason});
+ _Other ->
+ ok
end.
-
+
guard_test({E,Expr,Res}, Tail) ->
True = unvalue(true),
[save_term(Expr),
{match,1,unvalue(Res),
{'if',1,[{clause,1,[],[[E]],[True]},
- {clause,1,[],[[True]],[unvalue(false)]}]}}|Tail].
+ {clause,1,[],[[True]],[unvalue(false)]}]}}|Tail].
body_test({E,Expr,{'EXIT',_}}, Tail) ->
[save_term(Expr),
@@ -355,8 +331,8 @@ internal_bif(Op, Args, Expr, Res, Tail) ->
save_term(Term) ->
{call,1,
- {atom,1,put},
- [{atom,1,last},unvalue(Term)]}.
+ {atom,1,put},
+ [{atom,1,last},unvalue(Term)]}.
make_module(Name, Funcs) ->
[{attribute,1,module,Name},
@@ -366,18 +342,18 @@ make_module(Name, Funcs) ->
make_function(Name, Body) ->
{function,1,Name,0,[{clause,1,[],[],Body}]}.
-
+
eval(E0) ->
E = erl_parse:new_anno(E0),
- ?line case catch erl_eval:exprs(E, []) of
- {'EXIT',Reason} -> {'EXIT',Reason};
- {value,Val,_Bs} -> Val
- end.
+ case catch erl_eval:exprs(E, []) of
+ {'EXIT',Reason} -> {'EXIT',Reason};
+ {value,Val,_Bs} -> Val
+ end.
unvalue(V) ->
Abstr = erl_parse:abstract(V),
erl_parse:anno_to_term(Abstr).
-
+
value({nil,_}) -> [];
value({integer,_,X}) -> X;
value({string,_,X}) -> X;
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index 3d0509a28c..328641f5b9 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -74,25 +74,26 @@
%%
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
- init_per_testcase/2, end_per_testcase/2,
- init_per_suite/1, end_per_suite/1,
- stream_small/1, stream_big/1,
- basic_ping/1, slow_writes/1, bad_packet/1, bad_port_messages/1,
- mul_basic/1, mul_slow_writes/1,
- dying_port/1, port_program_with_path/1,
- open_input_file_port/1, open_output_file_port/1,
- iter_max_ports/1, eof/1, input_only/1, output_only/1,
- name1/1,
- t_binary/1, parallell/1, t_exit/1,
- env/1, bad_env/1, cd/1, exit_status/1,
- tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1,
- otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1,
- mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1,
- exit_status_multi_scheduling_block/1, ports/1,
- spawn_driver/1, spawn_executable/1, close_deaf_port/1,
- port_setget_data/1,
- unregister_name/1, parallelism_option/1]).
+-export([all/0, suite/0, groups/0,
+ init_per_testcase/2, end_per_testcase/2,
+ init_per_suite/1, end_per_suite/1,
+ stream_small/1, stream_big/1,
+ basic_ping/1, slow_writes/1, bad_packet/1, bad_port_messages/1,
+ mul_basic/1, mul_slow_writes/1,
+ dying_port/1, port_program_with_path/1,
+ open_input_file_port/1, open_output_file_port/1,
+ count_fds/1,
+ iter_max_ports/1, eof/1, input_only/1, output_only/1,
+ name1/1,
+ t_binary/1, parallell/1, t_exit/1,
+ env/1, huge_env/1, bad_env/1, cd/1, exit_status/1,
+ tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1,
+ otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1,
+ mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1,
+ exit_status_multi_scheduling_block/1, ports/1,
+ spawn_driver/1, spawn_executable/1, close_deaf_port/1,
+ port_setget_data/1,
+ unregister_name/1, parallelism_option/1]).
-export([do_iter_max_ports/2]).
@@ -101,18 +102,20 @@
-export([otp_3906_forker/5, otp_3906_start_forker_starter/4]).
-export([env_slave_main/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 10}}].
all() ->
[otp_6224, {group, stream}, basic_ping, slow_writes,
bad_packet, bad_port_messages, {group, options},
{group, multiple_packets}, parallell, dying_port,
port_program_with_path, open_input_file_port,
- open_output_file_port, name1, env, bad_env, cd,
- exit_status, iter_max_ports, t_exit, {group, tps}, line,
+ open_output_file_port, name1, env, huge_env, bad_env, cd,
+ exit_status, iter_max_ports, count_fds, t_exit, {group, tps}, line,
stderr_to_stdout, otp_3906, otp_4389, win_massive,
mix_up_ports, otp_5112, otp_5119,
exit_status_multi_scheduling_block, ports, spawn_driver,
@@ -126,15 +129,6 @@ groups() ->
{multiple_packets, [], [mul_basic, mul_slow_writes]},
{tps, [], [tps_16_bytes, tps_1K]}].
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
--define(DEFAULT_TIMEOUT, ?t:minutes(5)).
-
init_per_testcase(Case, Config) ->
[{testcase, Case} |Config].
@@ -154,69 +148,63 @@ end_per_suite(Config) when is_list(Config) ->
%% on a Windows machine given the correct environment.
win_massive(Config) when is_list(Config) ->
case os:type() of
- {win32,_} ->
- do_win_massive();
- _ ->
- {skip,"Only on Windows."}
+ {win32,_} ->
+ do_win_massive();
+ _ ->
+ {skip,"Only on Windows."}
end.
do_win_massive() ->
- Dog = test_server:timetrap(test_server:seconds(360)),
+ ct:timetrap({minutes, 6}),
SuiteDir = filename:dirname(code:which(?MODULE)),
Ports = " +Q 8192",
{ok, Node} =
- test_server:start_node(win_massive,
- slave,
- [{args, " -pa " ++ SuiteDir ++ Ports}]),
+ test_server:start_node(win_massive,
+ slave,
+ [{args, " -pa " ++ SuiteDir ++ Ports}]),
ok = rpc:call(Node,?MODULE,win_massive_client,[3000]),
test_server:stop_node(Node),
- test_server:timetrap_cancel(Dog),
ok.
-
+
win_massive_client(N) ->
{ok,P}=gen_tcp:listen(?WIN_MASSIVE_PORT,[{reuseaddr,true}]),
L = win_massive_loop(P,N),
Len = length(L),
lists:foreach(fun(E) ->
- gen_tcp:close(E)
- end,
- L),
+ gen_tcp:close(E)
+ end,
+ L),
case Len div 2 of
- N ->
- ok;
- _Else ->
- {too_few, Len}
+ N ->
+ ok;
+ _Else ->
+ {too_few, Len}
end.
win_massive_loop(_,0) ->
[];
win_massive_loop(P,N) ->
case (catch gen_tcp:connect("localhost",?WIN_MASSIVE_PORT,[])) of
- {ok,A} ->
- case (catch gen_tcp:accept(P)) of
- {ok,B} ->
- %erlang:display(N),
- [A,B|win_massive_loop(P,N-1)];
- _Else ->
- [A]
- end;
- _Else0 ->
- []
+ {ok,A} ->
+ case (catch gen_tcp:accept(P)) of
+ {ok,B} ->
+ %erlang:display(N),
+ [A,B|win_massive_loop(P,N-1)];
+ _Else ->
+ [A]
+ end;
+ _Else0 ->
+ []
end.
-
-
-
%% Test that we can send a stream of bytes and get it back.
%% We will send only a small amount of data, to avoid deadlock.
stream_small(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
stream_ping(Config, 512, "", []),
stream_ping(Config, 1777, "", []),
stream_ping(Config, 1777, "-s512", []),
- test_server:timetrap_cancel(Dog),
ok.
%% Send big amounts of data (much bigger than the buffer size in port test).
@@ -224,22 +212,20 @@ stream_small(Config) when is_list(Config) ->
%% non-blocking reads and writes.
stream_big(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(180)),
+ ct:timetrap({seconds, 180}),
stream_ping(Config, 43755, "", []),
stream_ping(Config, 100000, "", []),
stream_ping(Config, 77777, " -s40000", []),
- test_server:timetrap_cancel(Dog),
ok.
%% Sends packet with header size of 1, 2, and 4, with packets of various
%% sizes.
basic_ping(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(120)),
+ ct:timetrap({minutes, 2}),
ping(Config, sizes(1), 1, "", []),
ping(Config, sizes(2), 2, "", []),
ping(Config, sizes(4), 4, "", []),
- test_server:timetrap_cancel(Dog),
ok.
%% Let the port program insert delays between characters sent back to
@@ -247,17 +233,13 @@ basic_ping(Config) when is_list(Config) ->
%% small chunks rather than all at once.
slow_writes(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(20)),
ping(Config, [8], 4, "-s1", []),
ping(Config, [10], 2, "-s2", []),
- test_server:timetrap_cancel(Dog),
ok.
-bad_packet(doc) ->
- ["Test that we get {'EXIT', Port, einval} if we try to send a bigger "
- "packet than the packet header allows."];
+%% Test that we get {'EXIT', Port, einval} if we try to send a bigger
+%% packet than the packet header allows.
bad_packet(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
PortTest = port_test(Config),
process_flag(trap_exit, true),
@@ -265,16 +247,14 @@ bad_packet(Config) when is_list(Config) ->
bad_packet(PortTest, 1, 257),
bad_packet(PortTest, 2, 65536),
bad_packet(PortTest, 2, 65537),
-
- test_server:timetrap_cancel(Dog),
ok.
bad_packet(PortTest, HeaderSize, PacketSize) ->
P = open_port({spawn, PortTest}, [{packet, HeaderSize}]),
P ! {self(), {command, make_zero_packet(PacketSize)}},
receive
- {'EXIT', P, einval} -> ok;
- Other -> test_server:fail({unexpected_message, Other})
+ {'EXIT', P, einval} -> ok;
+ Other -> ct:fail({unexpected_message, Other})
end.
make_zero_packet(0) -> [];
@@ -287,7 +267,6 @@ make_zero_packet(N) ->
%% Test sending bad messages to a port.
bad_port_messages(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
PortTest = port_test(Config),
process_flag(trap_exit, true),
@@ -295,16 +274,14 @@ bad_port_messages(Config) when is_list(Config) ->
bad_message(PortTest, {a}),
bad_message(PortTest, {self(),{command,bad_command}}),
bad_message(PortTest, {self(),{connect,no_pid}}),
-
- test_server:timetrap_cancel(Dog),
ok.
bad_message(PortTest, Message) ->
P = open_port({spawn,PortTest}, []),
P ! Message,
receive
- {'EXIT',P,badsig} -> ok;
- Other -> test_server:fail({unexpected_message, Other})
+ {'EXIT',P,badsig} -> ok;
+ Other -> ct:fail({unexpected_message, Other})
end.
%% Tests various options (stream and {packet, Number} are implicitly
@@ -314,7 +291,7 @@ bad_message(PortTest, Message) ->
%% Tests the 'binary' option for a port.
t_binary(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(300)),
+ ct:timetrap({seconds, 300}),
%% Packet mode.
ping(Config, sizes(1), 1, "", [binary]),
@@ -325,12 +302,10 @@ t_binary(Config) when is_list(Config) ->
stream_ping(Config, 435, "", [binary]),
stream_ping(Config, 43755, "", [binary]),
stream_ping(Config, 100000, "", [binary]),
-
- test_server:timetrap_cancel(Dog),
ok.
name1(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(100)),
+ ct:timetrap({seconds, 100}),
PortTest = port_test(Config),
Command = lists:concat([PortTest, " "]),
P = open_port({spawn, Command}, []),
@@ -347,13 +322,12 @@ name1(Config) when is_list(Config) ->
{P, closed} -> ok
end,
undefined = whereis(myport),
- test_server:timetrap_cancel(Dog),
ok.
%% Test that the 'eof' option works.
eof(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(100)),
+ ct:timetrap({seconds, 100}),
PortTest = port_test(Config),
Command = lists:concat([PortTest, " -h0 -q"]),
P = open_port({spawn, Command}, [eof]),
@@ -365,47 +339,49 @@ eof(Config) when is_list(Config) ->
receive
{P, closed} -> ok
end,
- test_server:timetrap_cancel(Dog),
ok.
%% Tests that the 'in' option for a port works.
input_only(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(300)),
+ ct:timetrap({seconds, 300}),
expect_input(Config, [0, 1, 10, 13, 127, 128, 255], 1, "", [in]),
expect_input(Config, [0, 1, 255, 2048], 2, "", [in]),
expect_input(Config, [0, 1, 255, 2048], 4, "", [in]),
expect_input(Config, [0, 1, 10, 13, 127, 128, 255],
1, "", [in, binary]),
- test_server:timetrap_cancel(Dog),
ok.
%% Tests that the 'out' option for a port works.
output_only(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(100)),
- Dir = ?config(priv_dir, Config),
+ ct:timetrap({seconds, 100}),
+ Dir = proplists:get_value(priv_dir, Config),
+
+ %% First we test that the port program gets the data
Filename = filename:join(Dir, "output_only_stream"),
- output_and_verify(Config, Filename, "-h0",
- random_packet(35777, "echo")),
- test_server:timetrap_cancel(Dog),
+ Data = random_packet(35777, "echo"),
+ output_and_verify(Config, ["-h0 -o", Filename], Data),
+ Wait_time = 500,
+ test_server:sleep(Wait_time),
+ {ok, Written} = file:read_file(Filename),
+ Data = binary_to_list(Written),
+
+ %% Then we test that any writes to stdout from
+ %% the port program is not sent to erlang
+ output_and_verify(Config, ["-h0"], Data),
ok.
-output_and_verify(Config, Filename, Options, Data) ->
+output_and_verify(Config, Options, Data) ->
PortTest = port_test(Config),
- Command = lists:concat([PortTest, " ",
- Options, " -o", Filename]),
+ Command = lists:concat([PortTest, " " | Options]),
Port = open_port({spawn, Command}, [out]),
Port ! {self(), {command, Data}},
Port ! {self(), close},
receive
- {Port, closed} -> ok
- end,
- Wait_time = 500,
- test_server:sleep(Wait_time),
- {ok, Written} = file:read_file(Filename),
- Data = binary_to_list(Written),
- ok.
+ {Port, closed} -> ok;
+ Msg -> ct:fail({received_unexpected_message, Msg})
+ end.
%% Test that receiving several packages written in the same
%% write operation works.
@@ -414,11 +390,10 @@ output_and_verify(Config, Filename, Options, Data) ->
%% Basic test of receiving multiple packages, written in
%% one operation by the other end.
mul_basic(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(600)),
+ ct:timetrap({minutes, 10}),
expect_input(Config, [0, 1, 255, 10, 13], 1, "", []),
expect_input(Config, [0, 10, 13, 1600, 32767, 65535], 2, "", []),
expect_input(Config, [10, 70000], 4, "", []),
- test_server:timetrap_cancel(Dog),
ok.
%% Test reading a buffer consisting of several packets, some
@@ -427,9 +402,8 @@ mul_basic(Config) when is_list(Config) ->
%% delays in between.)
mul_slow_writes(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(250)),
+ ct:timetrap({minutes, 4}),
expect_input(Config, [0, 20, 255, 10, 1], 1, "-s64", []),
- test_server:timetrap_cancel(Dog),
ok.
%% Runs several port tests in parallell. Each individual test
@@ -437,27 +411,26 @@ mul_slow_writes(Config) when is_list(Config) ->
%% should also finish in about 5 seconds.
parallell(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(300)),
+ ct:timetrap({minutes, 5}),
Testers = [
- fun() -> stream_ping(Config, 1007, "-s100", []) end,
- fun() -> stream_ping(Config, 10007, "-s1000", []) end,
- fun() -> stream_ping(Config, 10007, "-s1000", []) end,
+ fun() -> stream_ping(Config, 1007, "-s100", []) end,
+ fun() -> stream_ping(Config, 10007, "-s1000", []) end,
+ fun() -> stream_ping(Config, 10007, "-s1000", []) end,
- fun() -> expect_input(Config, [21, 22, 23, 24, 25], 1,
- "-s10", [in]) end,
+ fun() -> expect_input(Config, [21, 22, 23, 24, 25], 1,
+ "-s10", [in]) end,
- fun() -> ping(Config, [10], 1, "-d", []) end,
- fun() -> ping(Config, [20000], 2, "-d", []) end,
- fun() -> ping(Config, [101], 1, "-s10", []) end,
- fun() -> ping(Config, [1001], 2, "-s100", []) end,
- fun() -> ping(Config, [10001], 4, "-s1000", []) end,
+ fun() -> ping(Config, [10], 1, "-d", []) end,
+ fun() -> ping(Config, [20000], 2, "-d", []) end,
+ fun() -> ping(Config, [101], 1, "-s10", []) end,
+ fun() -> ping(Config, [1001], 2, "-s100", []) end,
+ fun() -> ping(Config, [10001], 4, "-s1000", []) end,
- fun() -> ping(Config, [501, 501], 2, "-s100", []) end,
- fun() -> ping(Config, [11, 12, 13, 14, 11], 1, "-s5", []) end],
+ fun() -> ping(Config, [501, 501], 2, "-s100", []) end,
+ fun() -> ping(Config, [11, 12, 13, 14, 11], 1, "-s5", []) end],
process_flag(trap_exit, true),
Pids = lists:map(fun fun_spawn/1, Testers),
wait_for(Pids),
- test_server:timetrap_cancel(Dog),
ok.
wait_for([]) ->
@@ -465,18 +438,17 @@ wait_for([]) ->
wait_for(Pids) ->
io:format("Waiting for ~p", [Pids]),
receive
- {'EXIT', Pid, normal} ->
- wait_for(lists:delete(Pid, Pids));
- Other ->
- test_server:fail({bad_exit, Other})
+ {'EXIT', Pid, normal} ->
+ wait_for(lists:delete(Pid, Pids));
+ Other ->
+ ct:fail({bad_exit, Other})
end.
%% Tests starting port programs that terminate by themselves.
%% This used to cause problems on Windows.
-dying_port(suite) -> [];
dying_port(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(150)),
+ ct:timetrap({minutes, 2}),
process_flag(trap_exit, true),
P1 = make_dying_port(Config),
@@ -497,14 +469,12 @@ dying_port(Config) when is_list(Config) ->
wait_for_port_exit(P3),
wait_for_port_exit(P4),
wait_for_port_exit(P5),
-
- test_server:timetrap_cancel(Dog),
ok.
wait_for_port_exit(Port) ->
receive
- {'EXIT', Port, _} ->
- ok
+ {'EXIT', Port, _} ->
+ ok
end.
make_dying_port(Config) when is_list(Config) ->
@@ -523,22 +493,21 @@ make_dying_port(Config) when is_list(Config) ->
%%
%% This testcase works on Unix, but is not very useful.
-port_program_with_path(suite) -> [];
port_program_with_path(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(100)),
- DataDir = ?config(data_dir, Config),
- PrivDir = ?config(priv_dir, Config),
-
+ ct:timetrap({minutes, 2}),
+ DataDir = proplists:get_value(data_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
+
%% Create a copy of the port test program in a directory not
%% included in PATH (i.e. in priv_dir), with the name 'my_port_test.exe'.
%% Also, place a file named 'my_port_test' in the same directory.
%% This used to confuse the CreateProcess() call in spawn driver.
%% (On Unix, there will be a single file created, which will be
%% a copy of the port program.)
-
+
PortTest = os:find_executable("port_test", DataDir),
io:format("os:find_executable(~p, ~p) returned ~p",
- ["port_test", DataDir, PortTest]),
+ ["port_test", DataDir, PortTest]),
{ok, PortTestPgm} = file:read_file(PortTest),
NewName = filename:join(PrivDir, filename:basename(PortTest)),
RedHerring = filename:rootname(NewName),
@@ -546,12 +515,12 @@ port_program_with_path(Config) when is_list(Config) ->
ok = file:write_file(NewName, PortTestPgm),
ok = file:write_file_info(NewName, #file_info{mode=8#111}),
PgmWithPathAndNoExt = filename:rootname(NewName),
-
+
%% Open the port using the path to the copied port test program,
%% but without the .exe extension, and verified that it was started.
%%
%% If the bug is present the open_port call will fail with badarg.
-
+
Command = lists:concat([PgmWithPathAndNoExt, " -h2"]),
P = open_port({spawn, Command}, [{packet, 2}]),
Message = "echo back to me",
@@ -560,17 +529,14 @@ port_program_with_path(Config) when is_list(Config) ->
{P, {data, Message}} ->
ok
end,
- test_server:timetrap_cancel(Dog),
ok.
%% Tests that files can be read using open_port(Filename, [in]).
%% This used to fail on Windows.
-open_input_file_port(suite) -> [];
open_input_file_port(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
- PrivDir = ?config(priv_dir, Config),
-
+ PrivDir = proplists:get_value(priv_dir, Config),
+
%% Create a file with the file driver and read it back using
%% open_port/2.
@@ -578,20 +544,18 @@ open_input_file_port(Config) when is_list(Config) ->
FileData1 = "An input file",
ok = file:write_file(MyFile1, FileData1),
case open_port(MyFile1, [in]) of
- InputPort when is_port(InputPort) ->
- receive
- {InputPort, {data, FileData1}} ->
- ok
- end
+ InputPort when is_port(InputPort) ->
+ receive
+ {InputPort, {data, FileData1}} ->
+ ok
+ end
end,
- test_server:timetrap_cancel(Dog),
ok.
%% Tests that files can be written using open_port(Filename, [out]).
-open_output_file_port(suite) -> [];
open_output_file_port(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(100)),
- PrivDir = ?config(priv_dir, Config),
+ ct:timetrap({minutes, 2}),
+ PrivDir = proplists:get_value(priv_dir, Config),
%% Create a file with open_port/2 and read it back with
%% the file driver.
@@ -606,16 +570,44 @@ open_output_file_port(Config) when is_list(Config) ->
OutputPort ! {self(), close},
{ok, Bin} = file:read_file(MyFile2),
FileData2 = binary_to_list(Bin),
-
- test_server:timetrap_cancel(Dog),
ok.
+%% Tests that all appropriate fd's have been closed in the port program
+count_fds(Config) when is_list(Config) ->
+ case os:type() of
+ {unix, _} ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Filename = filename:join(PrivDir, "my_fd_counter"),
+
+ RunTest = fun(PortOpts) ->
+ PortTest = port_test(Config),
+ Command = lists:concat([PortTest, " -n -f -o", Filename]),
+ Port = open_port({spawn, Command}, PortOpts),
+ Port ! {self(), close},
+ receive
+ {Port, closed} -> ok
+ end,
+ test_server:sleep(500),
+ {ok, Written} = file:read_file(Filename),
+ Written
+ end,
+ <<4:32/native>> = RunTest([out, nouse_stdio]),
+ <<4:32/native>> = RunTest([in, nouse_stdio]),
+ <<5:32/native>> = RunTest([in, out, nouse_stdio]),
+ <<3:32/native>> = RunTest([out, use_stdio]),
+ <<3:32/native>> = RunTest([in, use_stdio]),
+ <<3:32/native>> = RunTest([in, out, use_stdio]),
+ <<3:32/native>> = RunTest([in, out, use_stdio, stderr_to_stdout]),
+ <<3:32/native>> = RunTest([out, use_stdio, stderr_to_stdout]);
+ _ ->
+ {skip, "Skipped on windows"}
+ end.
+
%%
%% Open as many ports as possible. Do this several times and check
%% that we get the same number of ports every time.
%%
-iter_max_ports(suite) -> [];
iter_max_ports(Config) when is_list(Config) ->
%% The child_setup program might dump core if we get out of memory.
%% This is hard to do anything about and is harmless. We run this test
@@ -624,31 +616,30 @@ iter_max_ports(Config) when is_list(Config) ->
%%
Config2 = ignore_cores:setup(?MODULE, iter_max_ports, Config, true),
try
- iter_max_ports_test(Config2)
+ iter_max_ports_test(Config2)
after
- ignore_cores:restore(Config2)
+ ignore_cores:restore(Config2)
end.
-
-
+
+
iter_max_ports_test(Config) ->
- Dog = test_server:timetrap(test_server:minutes(30)),
+ ct:timetrap({minutes, 30}),
PortTest = port_test(Config),
Command = lists:concat([PortTest, " -h0 -q"]),
Iters = case os:type() of
- {win32,_} -> 4;
- _ -> 10
- end,
+ {win32,_} -> 4;
+ _ -> 10
+ end,
%% Run on a different node in order to limit the effect if this test fails.
Dir = filename:dirname(code:which(?MODULE)),
{ok,Node} = test_server:start_node(test_iter_max_socks,slave,
- [{args,"+Q 2048 -pa " ++ Dir}]),
+ [{args,"+Q 2048 -pa " ++ Dir}]),
L = rpc:call(Node,?MODULE,do_iter_max_ports,[Iters, Command]),
test_server:stop_node(Node),
io:format("Result: ~p",[L]),
all_equal(L),
all_equal(L),
- test_server:timetrap_cancel(Dog),
{comment, "Max ports: " ++ integer_to_list(hd(L))}.
do_iter_max_ports(N, Command) when N > 0 ->
@@ -672,46 +663,54 @@ max_ports(Command) ->
close_ports([P|Ps]) ->
P ! {self(), close},
receive
- {P,closed} ->
- ok
+ {P,closed} ->
+ ok
end,
close_ports(Ps);
close_ports([]) ->
ok.
open_ports(Name, Settings) ->
- test_server:sleep(5),
+ case os:type() of
+ {unix, freebsd} ->
+ %% FreeBsd has issues with sendmsg/recvmsg in fork
+ %% implementation and we therefor have to spawn
+ %% slower to make sure that we always hit the same
+ %% make roof.
+ test_server:sleep(10);
+ _ ->
+ test_server:sleep(5)
+ end,
case catch open_port(Name, Settings) of
- P when is_port(P) ->
- [P| open_ports(Name, Settings)];
- {'EXIT', {Code, _}} ->
- case Code of
- enfile ->
- [];
- emfile ->
- [];
- system_limit ->
- [];
- enomem ->
- [];
- Other ->
- test_server:fail({open_ports, Other})
- end;
- Other ->
- test_server:fail({open_ports, Other})
+ P when is_port(P) ->
+ [P| open_ports(Name, Settings)];
+ {'EXIT', {Code, _}} ->
+ case Code of
+ enfile ->
+ [];
+ emfile ->
+ [];
+ system_limit ->
+ [];
+ enomem ->
+ [];
+ Other ->
+ ct:fail({open_ports, Other})
+ end;
+ Other ->
+ ct:fail({open_ports, Other})
end.
%% Tests that exit(Port, Term) works (has been known to crash the emulator).
-t_exit(suite) -> [];
t_exit(Config) when is_list(Config) ->
process_flag(trap_exit, true),
Pid = fun_spawn(fun suicide_port/1, [Config]),
receive
- {'EXIT', Pid, die} ->
- ok;
- Other ->
- test_server:fail({bad_message, Other})
+ {'EXIT', Pid, die} ->
+ ok;
+ Other ->
+ ct:fail({bad_message, Other})
end.
suicide_port(Config) when is_list(Config) ->
@@ -720,118 +719,105 @@ suicide_port(Config) when is_list(Config) ->
receive after infinity -> ok end.
-tps_16_bytes(doc) -> "";
-tps_16_bytes(suite) -> [];
tps_16_bytes(Config) when is_list(Config) ->
tps(16, Config).
-tps_1K(doc) -> "";
-tps_1K(suite) -> [];
tps_1K(Config) when is_list(Config) ->
tps(1024, Config).
tps(Size, Config) ->
- Dog = test_server:timetrap(test_server:seconds(300)),
+ ct:timetrap({minutes, 5}),
PortTest = port_test(Config),
Packet = list_to_binary(random_packet(Size, "e")),
Port = open_port({spawn, PortTest}, [binary, {packet, 2}]),
Transactions = 10000,
{Elapsed, ok} = test_server:timecall(?MODULE, tps,
- [Port, Packet, Transactions]),
- test_server:timetrap_cancel(Dog),
+ [Port, Packet, Transactions]),
{comment, integer_to_list(trunc(Transactions/Elapsed+0.5)) ++ " transactions/s"}.
tps(_Port, _Packet, 0) -> ok;
tps(Port, Packet, N) ->
port_command(Port, Packet),
receive
- {Port, {data, Packet}} ->
- tps(Port, Packet, N-1);
- Other ->
- test_server:fail({bad_message, Other})
+ {Port, {data, Packet}} ->
+ tps(Port, Packet, N-1);
+ Other ->
+ ct:fail({bad_message, Other})
end.
%% Line I/O test
line(Config) when is_list(Config) ->
+ ct:timetrap({minutes, 5}),
Siz = 110,
- Dog = test_server:timetrap(test_server:seconds(300)),
Packet1 = random_packet(Siz),
Packet2 = random_packet(Siz div 2),
%% Test that packets are split into lines
port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet2,
- io_lib:nl()]),
- [{eol, Packet1}, {eol, Packet2}]}],
- 0, "", [{line,Siz}]),
+ io_lib:nl()]),
+ [{eol, Packet1}, {eol, Packet2}]}],
+ 0, "", [{line,Siz}]),
%% Test the same for binaries
port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet2,
- io_lib:nl()]),
- [{eol, Packet1}, {eol, Packet2}]}],
- 0, "", [{line,Siz},binary]),
+ io_lib:nl()]),
+ [{eol, Packet1}, {eol, Packet2}]}],
+ 0, "", [{line,Siz},binary]),
%% Test that too long lines get split
port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet1,
- Packet2, io_lib:nl()]),
- [{eol, Packet1}, {noeol, Packet1},
- {eol, Packet2}]}], 0, "", [{line,Siz}]),
+ Packet2, io_lib:nl()]),
+ [{eol, Packet1}, {noeol, Packet1},
+ {eol, Packet2}]}], 0, "", [{line,Siz}]),
%% Test that last output from closing port program gets received.
L1 = lists:append([Packet1, io_lib:nl(), Packet2]),
S1 = lists:flatten(io_lib:format("-l~w", [length(L1)])),
io:format("S1 = ~w, L1 = ~w~n", [S1,L1]),
port_expect(Config,[{L1,
- [{eol, Packet1}, {noeol, Packet2}, eof]}], 0,
- S1, [{line,Siz},eof]),
+ [{eol, Packet1}, {noeol, Packet2}, eof]}], 0,
+ S1, [{line,Siz},eof]),
%% Test that lonely <CR> Don't get treated as newlines
port_expect(Config,[{lists:append([Packet1, [13], Packet2,
- io_lib:nl()]),
- [{noeol, Packet1}, {eol, [13 |Packet2]}]}],
- 0, "", [{line,Siz}]),
+ io_lib:nl()]),
+ [{noeol, Packet1}, {eol, [13 |Packet2]}]}],
+ 0, "", [{line,Siz}]),
%% Test that packets get built up to lines (delayed output from
%% port program)
port_expect(Config,[{Packet2,[]},
- {lists:append([Packet2, io_lib:nl(),
- Packet1, io_lib:nl()]),
- [{eol, lists:append(Packet2, Packet2)},
- {eol, Packet1}]}], 0, "-d", [{line,Siz}]),
+ {lists:append([Packet2, io_lib:nl(),
+ Packet1, io_lib:nl()]),
+ [{eol, lists:append(Packet2, Packet2)},
+ {eol, Packet1}]}], 0, "-d", [{line,Siz}]),
%% Test that we get badarg if trying both packet and line
bad_argument(Config, [{packet, 5}, {line, 5}]),
- test_server:timetrap_cancel(Dog),
ok.
-%%% Redirection of stderr test
-stderr_to_stdout(suite) ->
- [];
-stderr_to_stdout(doc) ->
- "Test that redirection of standard error to standard output works.";
+%% Test that redirection of standard error to standard output works.
stderr_to_stdout(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(60)),
+ ct:timetrap({minutes, 1}),
%% See that it works
Packet = random_packet(10),
port_expect(Config,[{Packet,[Packet]}], 0, "-e -l10",
- [stderr_to_stdout]),
+ [stderr_to_stdout]),
%% stream_ping(Config, 10, "-e", [stderr_to_stdout]),
%% See that it doesn't always happen (will generate garbage on stderr)
port_expect(Config,[{Packet,[eof]}], 0, "-e -l10", [line,eof]),
- test_server:timetrap_cancel(Dog),
ok.
bad_argument(Config, ArgList) ->
PortTest = port_test(Config),
case catch open_port({spawn, PortTest}, ArgList) of
- {'EXIT', {badarg, _}} ->
- ok
+ {'EXIT', {badarg, _}} ->
+ ok
end.
-
+
%% 'env' option
%% (Can perhaps be made smaller by calling the other utility functions
%% in this module.)
-env(suite) ->
- [];
-env(doc) ->
- ["Test that the 'env' option works"];
+%%
+%% Test that the 'env' option works
env(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(60)),
- Priv = ?config(priv_dir, Config),
+ ct:timetrap({minutes, 1}),
+ Priv = proplists:get_value(priv_dir, Config),
Temp = filename:join(Priv, "env_fun.bin"),
PluppVal = "dirty monkey",
@@ -841,36 +827,34 @@ env(Config) when is_list(Config) ->
os:putenv(Long, "nisse"),
env_slave(Temp, [{"plupp",PluppVal},
- {"DIR_PLUPP","###glurfrik"}],
- fun() ->
- PluppVal = os:getenv("plupp"),
- "###glurfrik" = os:getenv("DIR_PLUPP"),
- "nisse" = os:getenv(Long)
- end),
+ {"DIR_PLUPP","###glurfrik"}],
+ fun() ->
+ PluppVal = os:getenv("plupp"),
+ "###glurfrik" = os:getenv("DIR_PLUPP"),
+ "nisse" = os:getenv(Long)
+ end),
env_slave(Temp, [{"must_define_something","some_value"},
- {"certainly_not_existing",false},
- {"ends_with_equal", "value="},
- {Long,false},
- {"glurf","a glorfy string"}]),
+ {"certainly_not_existing",false},
+ {"ends_with_equal", "value="},
+ {Long,false},
+ {"glurf","a glorfy string"}]),
%% A lot of non existing variables (mingled with existing)
NotExistingList = [{lists:flatten(io_lib:format("V~p_not_existing",[X])),false}
- || X <- lists:seq(1,150)],
+ || X <- lists:seq(1,150)],
ExistingList = [{lists:flatten(io_lib:format("V~p_existing",[X])),"a_value"}
- || X <- lists:seq(1,150)],
+ || X <- lists:seq(1,150)],
env_slave(Temp, lists:sort(ExistingList ++ NotExistingList)),
-
- test_server:timetrap_cancel(Dog),
ok.
env_slave(File, Env) ->
F = fun() ->
- lists:foreach(fun({Name,Val}) ->
- Val = os:getenv(Name)
- end, Env)
- end,
+ lists:foreach(fun({Name,Val}) ->
+ Val = os:getenv(Name)
+ end, Env)
+ end,
env_slave(File, Env, F).
env_slave(File, Env, Body) ->
@@ -878,27 +862,26 @@ env_slave(File, Env, Body) ->
Program = atom_to_list(lib:progname()),
Dir = filename:dirname(code:which(?MODULE)),
Cmd = Program ++ " -pz " ++ Dir ++
- " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++
- File ++ " -run erlang halt",
+ " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++
+ File ++ " -run erlang halt",
Port = open_port({spawn, Cmd}, [{env,Env},{line,256}]),
receive
- {Port,{data,{eol,"ok"}}} ->
- ok;
- {Port,{data,{eol,Error}}} ->
- io:format("~p\n", [Error]),
- test_server:fail();
- Other ->
- test_server:fail(Other)
+ {Port,{data,{eol,"ok"}}} ->
+ ok;
+ {Port,{data,{eol,Error}}} ->
+ ct:fail("eol error ~p\n", [Error]);
+ Other ->
+ ct:fail(Other)
end.
env_slave_main([File]) ->
{ok,Body0} = file:read_file(File),
Body = binary_to_term(Body0),
case Body() of
- {'EXIT',Reason} ->
- io:format("Error: ~p\n", [Reason]);
- _ ->
- io:format("ok\n")
+ {'EXIT',Reason} ->
+ io:format("Error: ~p\n", [Reason]);
+ _ ->
+ io:format("ok\n")
end,
init:stop().
@@ -920,62 +903,93 @@ bad_env(Config) when is_list(Config) ->
try_bad_env(Env) ->
try open_port({spawn,"ls"}, [{env,Env}])
catch
- error:badarg -> ok
+ error:badarg -> ok
+ end.
+
+%% Test that we can handle a very very large environment gracefully.
+huge_env(Config) when is_list(Config) ->
+ ct:timetrap({seconds, 30}),
+ Vars = case os:type() of
+ {win32,_} -> 500;
+ _ ->
+ %% We create a huge environment,
+ %% 20000 variables is about 25MB
+ %% which seems to be the limit on Linux.
+ 20000
+ end,
+ Env = [{[$a + I div (25*25*25*25) rem 25,
+ $a + I div (25*25*25) rem 25,
+ $a + I div (25*25) rem 25,
+ $a+I div 25 rem 25, $a+I rem 25],
+ lists:duplicate(100,$a+I rem 25)}
+ || I <- lists:seq(1,Vars)],
+ try erlang:open_port({spawn,"ls"},[exit_status, {env, Env}]) of
+ P ->
+ receive
+ {P, {exit_status,N}} = M ->
+ %% We test that the exit status is an integer, this means
+ %% that the child program has started. If we get an atom
+ %% something went wrong in the driver which is not ok.
+ ct:log("Got ~p",[M]),
+ true = is_integer(N)
+ end
+ catch E:R ->
+ %% Have to catch the error here, as printing the stackdump
+ %% in the ct log is way to heavy for some test machines.
+ ct:fail("Open port failed ~p:~p",[E,R])
end.
+
+
%% 'cd' option
%% (Can perhaps be made smaller by calling the other utility functions
%% in this module.)
-cd(suite) ->
- [];
-cd(doc) ->
- ["Test that the 'cd' option works"];
+%%
+%% Test that the 'cd' option works
cd(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(60)),
+ ct:timetrap({minutes, 1}),
Program = atom_to_list(lib:progname()),
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
TestDir = filename:join(DataDir, "dir"),
Cmd = Program ++ " -pz " ++ DataDir ++
- " -noshell -s port_test pwd -s erlang halt",
+ " -noshell -s port_test pwd -s erlang halt",
_ = open_port({spawn, Cmd},
- [{cd, TestDir},
- {line, 256}]),
+ [{cd, TestDir},
+ {line, 256}]),
receive
- {_, {data, {eol, String}}} ->
- case filename_equal(String, TestDir) of
- true ->
- ok;
- false ->
- test_server:fail({cd, String})
- end;
- Other2 ->
- test_server:fail({env, Other2})
+ {_, {data, {eol, String}}} ->
+ case filename_equal(String, TestDir) of
+ true ->
+ ok;
+ false ->
+ ct:fail({cd, String})
+ end;
+ Other2 ->
+ ct:fail({env, Other2})
end,
_ = open_port({spawn, Cmd},
- [{cd, unicode:characters_to_binary(TestDir)},
- {line, 256}]),
+ [{cd, unicode:characters_to_binary(TestDir)},
+ {line, 256}]),
receive
- {_, {data, {eol, String2}}} ->
- case filename_equal(String2, TestDir) of
- true ->
- ok;
- false ->
- test_server:fail({cd, String2})
- end;
- Other3 ->
- test_server:fail({env, Other3})
+ {_, {data, {eol, String2}}} ->
+ case filename_equal(String2, TestDir) of
+ true ->
+ ok;
+ false ->
+ ct:fail({cd, String2})
+ end;
+ Other3 ->
+ ct:fail({env, Other3})
end,
-
- test_server:timetrap_cancel(Dog),
ok.
filename_equal(A, B) ->
case os:type() of
- {win32, _} ->
- win_filename_equal(A, B);
- _ ->
- A == B
+ {win32, _} ->
+ win_filename_equal(A, B);
+ _ ->
+ A == B
end.
win_filename_equal([], []) ->
@@ -986,10 +1000,10 @@ win_filename_equal(_, []) ->
false;
win_filename_equal([C1 | Rest1], [C2 | Rest2]) ->
case tolower(C1) == tolower(C2) of
- true ->
- win_filename_equal(Rest1, Rest2);
- false ->
- false
+ true ->
+ win_filename_equal(Rest1, Rest2);
+ false ->
+ false
end.
tolower(C) when C >= $A, C =< $Z ->
@@ -997,17 +1011,14 @@ tolower(C) when C >= $A, C =< $Z ->
tolower(C) ->
C.
-otp_3906(suite) ->
- [];
-otp_3906(doc) ->
- ["Tests that child process deaths are managed correctly when there are "
- " a large amount of concurrently dying children. See ticket OTP-3906."];
+%% Tests that child process deaths are managed correctly when there are
+%% a large amount of concurrently dying children. See ticket OTP-3906.
otp_3906(Config) when is_list(Config) ->
case os:type() of
- {unix, OSName} ->
- otp_3906(Config, OSName);
- _ ->
- {skipped, "Only run on Unix systems"}
+ {unix, OSName} ->
+ otp_3906(Config, OSName);
+ _ ->
+ {skipped, "Only run on Unix systems"}
end.
-define(OTP_3906_CHILDREN, 1000).
@@ -1020,83 +1031,83 @@ otp_3906(Config) when is_list(Config) ->
otp_3906(Config, OSName) ->
DataDir = filename:dirname(proplists:get_value(data_dir,Config)),
{ok, Variables} = file:consult(
- filename:join([DataDir,"..","..",
- "test_server","variables"])),
+ filename:join([DataDir,"..","..",
+ "test_server","variables"])),
case lists:keysearch('CC', 1, Variables) of
- {value,{'CC', CC}} ->
- SuiteDir = filename:dirname(code:which(?MODULE)),
- PrivDir = ?config(priv_dir, Config),
- Prog = otp_3906_make_prog(CC, PrivDir),
- {ok, Node} = test_server:start_node(otp_3906,
- slave,
- [{args, " -pa " ++ SuiteDir},
- {linked, false}]),
- OP = process_flag(priority, max),
- OTE = process_flag(trap_exit, true),
- FS = spawn_link(Node,
- ?MODULE,
- otp_3906_start_forker_starter,
- [?OTP_3906_CHILDREN, [], self(), Prog]),
- Result = receive
- {'EXIT', _ForkerStarter, Reason} ->
- {failed, Reason};
- {emulator_pid, EmPid} ->
- case otp_3906_wait_result(FS, 0, 0) of
- {succeded,
- ?OTP_3906_CHILDREN,
- ?OTP_3906_CHILDREN} ->
- succeded;
- {succeded, Forked, Exited} ->
- otp_3906_list_defunct(EmPid, OSName),
- {failed,
- {mismatch,
- {forked, Forked},
- {exited, Exited}}};
- Res ->
- otp_3906_list_defunct(EmPid, OSName),
- Res
- end
- end,
- process_flag(trap_exit, OTE),
- process_flag(priority, OP),
- test_server:stop_node(Node),
- case Result of
- succeded ->
- ok;
- _ ->
- test_server:fail(Result)
- end;
- _ ->
- {skipped, "No C compiler found"}
+ {value,{'CC', CC}} ->
+ SuiteDir = filename:dirname(code:which(?MODULE)),
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Prog = otp_3906_make_prog(CC, PrivDir),
+ {ok, Node} = test_server:start_node(otp_3906,
+ slave,
+ [{args, " -pa " ++ SuiteDir},
+ {linked, false}]),
+ OP = process_flag(priority, max),
+ OTE = process_flag(trap_exit, true),
+ FS = spawn_link(Node,
+ ?MODULE,
+ otp_3906_start_forker_starter,
+ [?OTP_3906_CHILDREN, [], self(), Prog]),
+ Result = receive
+ {'EXIT', _ForkerStarter, Reason} ->
+ {failed, Reason};
+ {emulator_pid, EmPid} ->
+ case otp_3906_wait_result(FS, 0, 0) of
+ {succeded,
+ ?OTP_3906_CHILDREN,
+ ?OTP_3906_CHILDREN} ->
+ succeded;
+ {succeded, Forked, Exited} ->
+ otp_3906_list_defunct(EmPid, OSName),
+ {failed,
+ {mismatch,
+ {forked, Forked},
+ {exited, Exited}}};
+ Res ->
+ otp_3906_list_defunct(EmPid, OSName),
+ Res
+ end
+ end,
+ process_flag(trap_exit, OTE),
+ process_flag(priority, OP),
+ test_server:stop_node(Node),
+ case Result of
+ succeded ->
+ ok;
+ _ ->
+ ct:fail(Result)
+ end;
+ _ ->
+ {skipped, "No C compiler found"}
end.
otp_3906_list_defunct(EmPid, OSName) ->
% Guess ps switches to use and what to grep for (could be improved)
{Switches, Zombie} = case OSName of
- BSD when BSD == darwin;
- BSD == openbsd;
- BSD == netbsd;
- BSD == freebsd ->
- {"-ajx", "Z"};
- _ ->
- {"-ef", "[dD]efunct"}
- end,
- test_server:format("Emulator pid: ~s~n"
- "Listing of zombie processes:~n"
- "~s~n",
- [EmPid,
- otp_3906_htmlize(os:cmd("ps "
- ++ Switches
- ++ " | grep "
- ++ Zombie))]).
+ BSD when BSD == darwin;
+ BSD == openbsd;
+ BSD == netbsd;
+ BSD == freebsd ->
+ {"-ajx", "Z"};
+ _ ->
+ {"-ef", "[dD]efunct"}
+ end,
+ io:format("Emulator pid: ~s~n"
+ "Listing of zombie processes:~n"
+ "~s~n",
+ [EmPid,
+ otp_3906_htmlize(os:cmd("ps "
+ ++ Switches
+ ++ " | grep "
+ ++ Zombie))]).
otp_3906_htmlize([]) ->
[];
otp_3906_htmlize([C | Cs]) ->
case [C] of
- "<" -> "&lt;" ++ otp_3906_htmlize(Cs);
- ">" -> "&gt;" ++ otp_3906_htmlize(Cs);
- _ -> [C | otp_3906_htmlize(Cs)]
+ "<" -> "&lt;" ++ otp_3906_htmlize(Cs);
+ ">" -> "&gt;" ++ otp_3906_htmlize(Cs);
+ _ -> [C | otp_3906_htmlize(Cs)]
end.
otp_3906_make_prog(CC, PrivDir) ->
@@ -1104,12 +1115,12 @@ otp_3906_make_prog(CC, PrivDir) ->
TrgtFileName = filename:join(PrivDir, ?OTP_3906_PROGNAME),
{ok, SrcFile} = file:open(SrcFileName, write),
io:format(SrcFile,
- "int ~n"
- "main(void) ~n"
- "{ ~n"
- " return ~p; ~n"
- "} ~n",
- [?OTP_3906_EXIT_STATUS]),
+ "int ~n"
+ "main(void) ~n"
+ "{ ~n"
+ " return ~p; ~n"
+ "} ~n",
+ [?OTP_3906_EXIT_STATUS]),
file:close(SrcFile),
os:cmd(CC ++ " " ++ SrcFileName ++ " -o " ++ TrgtFileName),
TrgtFileName.
@@ -1117,21 +1128,21 @@ otp_3906_make_prog(CC, PrivDir) ->
otp_3906_wait_result(ForkerStarter, F, E) ->
receive
- {'EXIT', ForkerStarter, Reason} ->
- {failed, {Reason, {forked, F}, {exited, E}}};
- forked ->
- otp_3906_wait_result(ForkerStarter, F+1, E);
- exited ->
- otp_3906_wait_result(ForkerStarter, F, E+1);
- tick ->
- otp_3906_wait_result(ForkerStarter, F, E);
- succeded ->
- {succeded, F, E}
+ {'EXIT', ForkerStarter, Reason} ->
+ {failed, {Reason, {forked, F}, {exited, E}}};
+ forked ->
+ otp_3906_wait_result(ForkerStarter, F+1, E);
+ exited ->
+ otp_3906_wait_result(ForkerStarter, F, E+1);
+ tick ->
+ otp_3906_wait_result(ForkerStarter, F, E);
+ succeded ->
+ {succeded, F, E}
after
- ?OTP_3906_TICK_TIMEOUT ->
- unlink(ForkerStarter),
- exit(ForkerStarter, timeout),
- {failed, {timeout, {forked, F}, {exited, E}}}
+ ?OTP_3906_TICK_TIMEOUT ->
+ unlink(ForkerStarter),
+ exit(ForkerStarter, timeout),
+ {failed, {timeout, {forked, F}, {exited, E}}}
end.
otp_3906_collect([], _) ->
@@ -1141,17 +1152,17 @@ otp_3906_collect(RefList, Sup) ->
otp_3906_collect_one(RefList, Sup) ->
receive
- Ref when is_reference(Ref) ->
- Sup ! tick,
- lists:delete(Ref, RefList)
+ Ref when is_reference(Ref) ->
+ Sup ! tick,
+ lists:delete(Ref, RefList)
end.
-
+
otp_3906_start_forker(N, Sup, Prog) ->
Ref = make_ref(),
spawn_opt(?MODULE,
- otp_3906_forker,
- [N, self(), Ref, Sup, Prog],
- [link, {priority, max}]),
+ otp_3906_forker,
+ [N, self(), Ref, Sup, Prog],
+ [link, {priority, max}]),
Ref.
otp_3906_start_forker_starter(N, RefList, Sup, Prog) ->
@@ -1170,18 +1181,18 @@ otp_3906_forker_starter(N, RefList, Sup, Prog)
otp_3906_forker_starter(N, RefList, Sup, Prog)
when is_integer(N), N > ?OTP_3906_OSP_P_ERLP ->
otp_3906_forker_starter(N-?OTP_3906_OSP_P_ERLP,
- [otp_3906_start_forker(?OTP_3906_OSP_P_ERLP,
- Sup,
- Prog)|RefList],
- Sup,
- Prog);
+ [otp_3906_start_forker(?OTP_3906_OSP_P_ERLP,
+ Sup,
+ Prog)|RefList],
+ Sup,
+ Prog);
otp_3906_forker_starter(N, RefList, Sup, Prog) when is_integer(N) ->
otp_3906_forker_starter(0,
- [otp_3906_start_forker(N,
- Sup,
- Prog)|RefList],
- Sup,
- Prog).
+ [otp_3906_start_forker(N,
+ Sup,
+ Prog)|RefList],
+ Sup,
+ Prog).
otp_3906_forker(0, Parent, Ref, _, _) ->
unlink(Parent),
@@ -1190,183 +1201,165 @@ otp_3906_forker(N, Parent, Ref, Sup, Prog) ->
Port = erlang:open_port({spawn, Prog}, [exit_status, in]),
Sup ! forked,
receive
- {Port, {exit_status, ?OTP_3906_EXIT_STATUS}} ->
- Sup ! exited,
- otp_3906_forker(N-1, Parent, Ref, Sup, Prog);
- {Port, Res} ->
- exit(Res);
- Other ->
- exit(Other)
+ {Port, {exit_status, ?OTP_3906_EXIT_STATUS}} ->
+ Sup ! exited,
+ otp_3906_forker(N-1, Parent, Ref, Sup, Prog);
+ {Port, Res} ->
+ exit(Res);
+ Other ->
+ exit(Other)
end.
-otp_4389(suite) -> [];
-otp_4389(doc) -> [];
otp_4389(Config) when is_list(Config) ->
case os:type() of
- {unix, _} ->
- Dog = test_server:timetrap(test_server:seconds(240)),
- TCR = self(),
- case get_true_cmd() of
- True when is_list(True) ->
- lists:foreach(
- fun (P) ->
- receive
- {P, ok} -> ok;
- {P, Err} -> ?t:fail(Err)
- end
- end,
- lists:map(
- fun(_) ->
- spawn_link(
- fun() ->
- process_flag(trap_exit, true),
- case catch open_port({spawn, True},
- [stream,exit_status]) of
- P when is_port(P) ->
- receive
- {P,{exit_status,_}} ->
- TCR ! {self(),ok};
- {'EXIT',_,{R2,_}} when R2 == emfile;
- R2 == eagain ->
- TCR ! {self(),ok};
- Err2 ->
- TCR ! {self(),{msg,Err2}}
- end;
- {'EXIT',{R1,_}} when R1 == emfile;
- R1 == eagain ->
- TCR ! {self(),ok};
- Err1 ->
- TCR ! {self(), {open_port,Err1}}
- end
- end)
- end,
- lists:duplicate(1000,[]))),
- test_server:timetrap_cancel(Dog),
- {comment,
- "This test case doesn't always fail when the bug that "
- "it tests for is present (it is most likely to fail on"
- " a multi processor machine). If the test case fails it"
- " will fail by deadlocking the emulator."};
- _ ->
- {skipped, "\"true\" command not found"}
- end;
- _ ->
- {skip,"Only run on Unix"}
+ {unix, _} ->
+ ct:timetrap({minutes, 4}),
+ TCR = self(),
+ case get_true_cmd() of
+ True when is_list(True) ->
+ lists:foreach(
+ fun (P) ->
+ receive
+ {P, ok} -> ok;
+ {P, Err} -> ct:fail(Err)
+ end
+ end,
+ lists:map(
+ fun(_) ->
+ spawn_link(
+ fun() ->
+ process_flag(trap_exit, true),
+ case catch open_port({spawn, True},
+ [stream,exit_status]) of
+ P when is_port(P) ->
+ receive
+ {P,{exit_status,_}} ->
+ TCR ! {self(),ok};
+ {'EXIT',_,{R2,_}} when R2 == emfile;
+ R2 == eagain;
+ R2 == enomem ->
+ TCR ! {self(),ok};
+ Err2 ->
+ TCR ! {self(),{msg,Err2}}
+ end;
+ {'EXIT',{R1,_}} when R1 == emfile;
+ R1 == eagain;
+ R1 == enomem ->
+ TCR ! {self(),ok};
+ Err1 ->
+ TCR ! {self(), {open_port,Err1}}
+ end
+ end)
+ end,
+ lists:duplicate(1000,[]))),
+ {comment,
+ "This test case doesn't always fail when the bug that "
+ "it tests for is present (it is most likely to fail on"
+ " a multi processor machine). If the test case fails it"
+ " will fail by deadlocking the emulator."};
+ _ ->
+ {skipped, "\"true\" command not found"}
+ end;
+ _ ->
+ {skip,"Only run on Unix"}
end.
get_true_cmd() ->
DoFileExist = fun (FileName) ->
- case file:read_file_info(FileName) of
- {ok, _} -> throw(FileName);
- _ -> not_found
- end
- end,
+ case file:read_file_info(FileName) of
+ {ok, _} -> throw(FileName);
+ _ -> not_found
+ end
+ end,
catch begin
- %% First check in /usr/bin and /bin
- DoFileExist("/usr/bin/true"),
- DoFileExist("/bin/true"),
- %% Try which
- case filename:dirname(os:cmd("which true")) of
- "." -> not_found;
- TrueDir -> filename:join(TrueDir, "true")
- end
- end.
+ %% First check in /usr/bin and /bin
+ DoFileExist("/usr/bin/true"),
+ DoFileExist("/bin/true"),
+ %% Try which
+ case filename:dirname(os:cmd("which true")) of
+ "." -> not_found;
+ TrueDir -> filename:join(TrueDir, "true")
+ end
+ end.
%% 'exit_status' option
-exit_status(suite) ->
- [];
-exit_status(doc) ->
- ["Test that the 'exit_status' option works"];
+%%
+%% Test that the 'exit_status' option works
exit_status(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(60)),
- port_expect(Config,[{"x",
- [{exit_status, 5}]}],
- 1, "", [exit_status]),
- test_server:timetrap_cancel(Dog),
+ ct:timetrap({minutes, 1}),
+ port_expect(Config,
+ [{"x", [{exit_status, 5}]}],
+ 1, "", [exit_status]),
ok.
-spawn_driver(suite) ->
- [];
-spawn_driver(doc) ->
- ["Test spawning a driver specifically"];
+%% Test spawning a driver specifically
spawn_driver(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
ok = load_driver(Path, "echo_drv"),
Port = erlang:open_port({spawn_driver, "echo_drv"}, []),
Port ! {self(), {command, "Hello port!"}},
receive
- {Port, {data, "Hello port!"}} = Msg1 ->
- io:format("~p~n", [Msg1]),
- ok;
- Other ->
- test_server:fail({unexpected, Other})
- end,
+ {Port, {data, "Hello port!"}} = Msg1 ->
+ io:format("~p~n", [Msg1]),
+ ok;
+ Other ->
+ ct:fail({unexpected, Other})
+ end,
Port ! {self(), close},
receive {Port, closed} -> ok end,
Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"},
- []),
+ []),
receive
- {Port2, {data, "Hello port?"}} = Msg2 ->
- io:format("~p~n", [Msg2]),
- ok;
- Other2 ->
- test_server:fail({unexpected2, Other2})
- end,
+ {Port2, {data, "Hello port?"}} = Msg2 ->
+ io:format("~p~n", [Msg2]),
+ ok;
+ Other2 ->
+ ct:fail({unexpected2, Other2})
+ end,
Port2 ! {self(), close},
receive {Port2, closed} -> ok end,
{'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, "ls"}, [])),
{'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, "cmd"}, [])),
{'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, os:find_executable("erl")}, [])),
- test_server:timetrap_cancel(Dog),
ok.
-parallelism_option(suite) ->
- [];
-parallelism_option(doc) ->
- ["Test parallelism option of open_port"];
+%% Test parallelism option of open_port
parallelism_option(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Path = ?config(data_dir, Config),
- ?line ok = load_driver(Path, "echo_drv"),
- ?line Port = erlang:open_port({spawn_driver, "echo_drv"},
- [{parallelism, true}]),
- ?line {parallelism, true} = erlang:port_info(Port, parallelism),
- ?line Port ! {self(), {command, "Hello port!"}},
- ?line receive
- {Port, {data, "Hello port!"}} = Msg1 ->
- io:format("~p~n", [Msg1]),
- ok;
- Other ->
- test_server:fail({unexpected, Other})
- end,
- ?line Port ! {self(), close},
- ?line receive {Port, closed} -> ok end,
-
- ?line Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"},
- [{parallelism, false}]),
- ?line {parallelism, false} = erlang:port_info(Port2, parallelism),
- ?line receive
- {Port2, {data, "Hello port?"}} = Msg2 ->
- io:format("~p~n", [Msg2]),
- ok;
- Other2 ->
- test_server:fail({unexpected2, Other2})
- end,
- ?line Port2 ! {self(), close},
- ?line receive {Port2, closed} -> ok end,
- ?line test_server:timetrap_cancel(Dog),
+ Path = proplists:get_value(data_dir, Config),
+ ok = load_driver(Path, "echo_drv"),
+ Port = erlang:open_port({spawn_driver, "echo_drv"},
+ [{parallelism, true}]),
+ {parallelism, true} = erlang:port_info(Port, parallelism),
+ Port ! {self(), {command, "Hello port!"}},
+ receive
+ {Port, {data, "Hello port!"}} = Msg1 ->
+ io:format("~p~n", [Msg1]),
+ ok;
+ Other ->
+ ct:fail({unexpected, Other})
+ end,
+ Port ! {self(), close},
+ receive {Port, closed} -> ok end,
+
+ Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"},
+ [{parallelism, false}]),
+ {parallelism, false} = erlang:port_info(Port2, parallelism),
+ receive
+ {Port2, {data, "Hello port?"}} = Msg2 ->
+ io:format("~p~n", [Msg2]),
+ ok;
+ Other2 ->
+ ct:fail({unexpected2, Other2})
+ end,
+ Port2 ! {self(), close},
+ receive {Port2, closed} -> ok end,
ok.
-spawn_executable(suite) ->
- [];
-spawn_executable(doc) ->
- ["Test spawning an executable specifically"];
+%% Test spawning an executable specifically
spawn_executable(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
EchoArgs1 = filename:join([DataDir,"echo_args"]),
ExactFile1 = filename:nativename(os:find_executable(EchoArgs1)),
[ExactFile1] = run_echo_args(DataDir,[]),
@@ -1376,25 +1369,25 @@ spawn_executable(Config) when is_list(Config) ->
["echo_arguments"] = run_echo_args(DataDir,["echo_arguments"]),
["echo_arguments"] = run_echo_args(DataDir,[binary, "echo_arguments"]),
[ExactFile1,"hello world","dlrow olleh"] =
- run_echo_args(DataDir,[ExactFile1,"hello world","dlrow olleh"]),
+ run_echo_args(DataDir,[ExactFile1,"hello world","dlrow olleh"]),
[ExactFile1] = run_echo_args(DataDir,[default]),
[ExactFile1] = run_echo_args(DataDir,[binary, default]),
[ExactFile1,"hello world","dlrow olleh"] =
- run_echo_args(DataDir,[switch_order,ExactFile1,"hello world",
- "dlrow olleh"]),
+ run_echo_args(DataDir,[switch_order,ExactFile1,"hello world",
+ "dlrow olleh"]),
[ExactFile1,"hello world","dlrow olleh"] =
- run_echo_args(DataDir,[binary,switch_order,ExactFile1,"hello world",
- "dlrow olleh"]),
+ run_echo_args(DataDir,[binary,switch_order,ExactFile1,"hello world",
+ "dlrow olleh"]),
[ExactFile1,"hello world","dlrow olleh"] =
- run_echo_args(DataDir,[default,"hello world","dlrow olleh"]),
+ run_echo_args(DataDir,[default,"hello world","dlrow olleh"]),
[ExactFile1,"hello world","dlrow olleh"] =
- run_echo_args_2("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\""),
+ run_echo_args_2("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\""),
[ExactFile1,"hello world","dlrow olleh"] =
- run_echo_args_2(unicode:characters_to_binary("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\"")),
+ run_echo_args_2(unicode:characters_to_binary("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\"")),
- PrivDir = ?config(priv_dir, Config),
- SpaceDir =filename:join([PrivDir,"With Spaces"]),
+ PrivDir = proplists:get_value(priv_dir, Config),
+ SpaceDir = filename:join([PrivDir,"With Spaces"]),
file:make_dir(SpaceDir),
Executable = filename:basename(ExactFile1),
file:copy(ExactFile1,filename:join([SpaceDir,Executable])),
@@ -1405,33 +1398,32 @@ spawn_executable(Config) when is_list(Config) ->
["echo_args"] = run_echo_args(SpaceDir,["echo_args"]),
["echo_arguments"] = run_echo_args(SpaceDir,["echo_arguments"]),
[ExactFile2,"hello world","dlrow olleh"] =
- run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]),
+ run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]),
[ExactFile2,"hello world","dlrow olleh"] =
- run_echo_args(SpaceDir,[binary, ExactFile2,"hello world","dlrow olleh"]),
+ run_echo_args(SpaceDir,[binary, ExactFile2,"hello world","dlrow olleh"]),
[ExactFile2,"hello \"world\"","\"dlrow\" olleh"] =
- run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]),
+ run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]),
[ExactFile2,"hello \"world\"","\"dlrow\" olleh"] =
- run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]),
+ run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]),
[ExactFile2] = run_echo_args(SpaceDir,[default]),
[ExactFile2,"hello world","dlrow olleh"] =
- run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world",
- "dlrow olleh"]),
+ run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world", "dlrow olleh"]),
[ExactFile2,"hello world","dlrow olleh"] =
- run_echo_args(SpaceDir,[default,"hello world","dlrow olleh"]),
+ run_echo_args(SpaceDir,[default,"hello world","dlrow olleh"]),
[ExactFile2,"hello world","dlrow olleh"] =
- run_echo_args_2("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\""),
+ run_echo_args_2("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\""),
[ExactFile2,"hello world","dlrow olleh"] =
- run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")),
+ run_echo_args_2(unicode:characters_to_binary("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\"")),
ExeExt =
- case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of
- "exe" ->
- ".exe";
- _ ->
- ""
- end,
+ case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of
+ "exe" ->
+ ".exe";
+ _ ->
+ ""
+ end,
Executable2 = "spoky name"++ExeExt,
file:copy(ExactFile1,filename:join([SpaceDir,Executable2])),
ExactFile3 = filename:nativename(filename:join([SpaceDir,Executable2])),
@@ -1440,38 +1432,37 @@ spawn_executable(Config) when is_list(Config) ->
["echo_args"] = run_echo_args(SpaceDir,Executable2,["echo_args"]),
["echo_arguments"] = run_echo_args(SpaceDir,Executable2,["echo_arguments"]),
[ExactFile3,"hello world","dlrow olleh"] =
- run_echo_args(SpaceDir,Executable2,[ExactFile3,"hello world","dlrow olleh"]),
+ run_echo_args(SpaceDir,Executable2,[ExactFile3,"hello world","dlrow olleh"]),
[ExactFile3] = run_echo_args(SpaceDir,Executable2,[default]),
[ExactFile3,"hello world","dlrow olleh"] =
- run_echo_args(SpaceDir,Executable2,
- [switch_order,ExactFile3,"hello world",
- "dlrow olleh"]),
+ run_echo_args(SpaceDir,Executable2,
+ [switch_order,ExactFile3,"hello world",
+ "dlrow olleh"]),
[ExactFile3,"hello world","dlrow olleh"] =
- run_echo_args(SpaceDir,Executable2,
- [default,"hello world","dlrow olleh"]),
+ run_echo_args(SpaceDir,Executable2,
+ [default,"hello world","dlrow olleh"]),
[ExactFile3,"hello world","dlrow olleh"] =
- run_echo_args_2("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\""),
+ run_echo_args_2("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\""),
[ExactFile3,"hello world","dlrow olleh"] =
- run_echo_args_2(unicode:characters_to_binary("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\"")),
+ run_echo_args_2(unicode:characters_to_binary("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\"")),
{'EXIT',{enoent,_}} = (catch run_echo_args(SpaceDir,"fnurflmonfi",
- [default,"hello world",
- "dlrow olleh"])),
+ [default,"hello world",
+ "dlrow olleh"])),
NonExec = "kronxfrt"++ExeExt,
file:write_file(filename:join([SpaceDir,NonExec]),
- <<"Not an executable">>),
+ <<"Not an executable">>),
{'EXIT',{eacces,_}} = (catch run_echo_args(SpaceDir,NonExec,
- [default,"hello world",
- "dlrow olleh"])),
+ [default,"hello world",
+ "dlrow olleh"])),
{'EXIT',{enoent,_}} = (catch open_port({spawn_executable,"cmd"},[])),
{'EXIT',{enoent,_}} = (catch open_port({spawn_executable,"sh"},[])),
case os:type() of
- {win32,_} ->
- test_bat_file(SpaceDir);
- {unix,_} ->
- test_sh_file(SpaceDir)
+ {win32,_} ->
+ test_bat_file(SpaceDir);
+ {unix,_} ->
+ test_sh_file(SpaceDir)
end,
- test_server:timetrap_cancel(Dog),
ok.
unregister_name(Config) when is_list(Config) ->
@@ -1482,29 +1473,29 @@ test_bat_file(Dir) ->
FN = "tf.bat",
Full = filename:join([Dir,FN]),
D = [<<"@echo off\r\n">>,
- <<"echo argv[0]:^|%0^|\r\n">>,
- <<"if \"%1\" == \"\" goto done\r\n">>,
- <<"echo argv[1]:^|%1^|\r\n">>,
- <<"if \"%2\" == \"\" goto done\r\n">>,
- <<"echo argv[2]:^|%2^|\r\n">>,
- <<"if \"%3\" == \"\" goto done\r\n">>,
- <<"echo argv[3]:^|%3^|\r\n">>,
- <<"if \"%4\" == \"\" goto done\r\n">>,
- <<"echo argv[4]:^|%4^|\r\n">>,
- <<"if \"%5\" == \"\" goto done\r\n">>,
- <<"echo argv[5]:^|%5^|\r\n">>,
- <<"\r\n">>,
- <<":done\r\n">>,
- <<"\r\n">>],
+ <<"echo argv[0]:^|%0^|\r\n">>,
+ <<"if \"%1\" == \"\" goto done\r\n">>,
+ <<"echo argv[1]:^|%1^|\r\n">>,
+ <<"if \"%2\" == \"\" goto done\r\n">>,
+ <<"echo argv[2]:^|%2^|\r\n">>,
+ <<"if \"%3\" == \"\" goto done\r\n">>,
+ <<"echo argv[3]:^|%3^|\r\n">>,
+ <<"if \"%4\" == \"\" goto done\r\n">>,
+ <<"echo argv[4]:^|%4^|\r\n">>,
+ <<"if \"%5\" == \"\" goto done\r\n">>,
+ <<"echo argv[5]:^|%5^|\r\n">>,
+ <<"\r\n">>,
+ <<":done\r\n">>,
+ <<"\r\n">>],
file:write_file(Full,list_to_binary(D)),
EF = filename:basename(FN),
[DN,"hello","world"] =
- run_echo_args(Dir,FN,
- [default,"hello","world"]),
+ run_echo_args(Dir,FN,
+ [default,"hello","world"]),
%% The arg0 argumant should be ignored when running batch files
[DN,"hello","world"] =
- run_echo_args(Dir,FN,
- ["knaskurt","hello","world"]),
+ run_echo_args(Dir,FN,
+ ["knaskurt","hello","world"]),
EF = filename:basename(DN),
ok.
@@ -1512,40 +1503,40 @@ test_sh_file(Dir) ->
FN = "tf.sh",
Full = filename:join([Dir,FN]),
D = [<<"#! /bin/sh\n">>,
- <<"echo 'argv[0]:|'$0'|'\n">>,
- <<"i=1\n">>,
- <<"while [ '!' -z \"$1\" ]; do\n">>,
- <<" echo 'argv['$i']:|'\"$1\"'|'\n">>,
- <<" shift\n">>,
- <<" i=`expr $i + 1`\n">>,
- <<"done\n">>],
+ <<"echo 'argv[0]:|'$0'|'\n">>,
+ <<"i=1\n">>,
+ <<"while [ '!' -z \"$1\" ]; do\n">>,
+ <<" echo 'argv['$i']:|'\"$1\"'|'\n">>,
+ <<" shift\n">>,
+ <<" i=`expr $i + 1`\n">>,
+ <<"done\n">>],
file:write_file(Full,list_to_binary(D)),
chmodplusx(Full),
[Full,"hello","world"] =
- run_echo_args(Dir,FN,
- [default,"hello","world"]),
+ run_echo_args(Dir,FN,
+ [default,"hello","world"]),
[Full,"hello","world of spaces"] =
- run_echo_args(Dir,FN,
- [default,"hello","world of spaces"]),
+ run_echo_args(Dir,FN,
+ [default,"hello","world of spaces"]),
file:write_file(filename:join([Dir,"testfile1"]),<<"testdata1">>),
file:write_file(filename:join([Dir,"testfile2"]),<<"testdata2">>),
Pattern = filename:join([Dir,"testfile*"]),
L = filelib:wildcard(Pattern),
2 = length(L),
[Full,"hello",Pattern] =
- run_echo_args(Dir,FN,
- [default,"hello",Pattern]),
- ok.
+ run_echo_args(Dir,FN,
+ [default,"hello",Pattern]),
+ ok.
+
-
chmodplusx(Filename) ->
case file:read_file_info(Filename) of
- {ok,FI} ->
- FI2 = FI#file_info{mode = ((FI#file_info.mode) bor 8#00100)},
- file:write_file_info(Filename,FI2);
- _ ->
- ok
+ {ok,FI} ->
+ FI2 = FI#file_info{mode = ((FI#file_info.mode) bor 8#00100)},
+ file:write_file_info(Filename,FI2);
+ _ ->
+ ok
end.
run_echo_args_2(FullnameAndArgs) ->
@@ -1554,7 +1545,7 @@ run_echo_args_2(FullnameAndArgs) ->
Port ! {self(), close},
receive {Port, closed} -> ok end,
parse_echo_args_output(Data).
-
+
run_echo_args(Where,Args) ->
run_echo_args(Where,"echo_args",Args).
@@ -1562,9 +1553,9 @@ run_echo_args(Where,Prog,Args) ->
{Binary, ArgvArg} = pack_argv(Args),
Command0 = filename:join([Where,Prog]),
Command = case Binary of
- true -> unicode:characters_to_binary(Command0);
- false -> Command0
- end,
+ true -> unicode:characters_to_binary(Command0);
+ false -> Command0
+ end,
Port = open_port({spawn_executable,Command},ArgvArg++[eof]),
Data = collect_data(Port),
Port ! {self(), close},
@@ -1578,14 +1569,14 @@ pack_argv(Args) ->
pack_argv(Args, Binary) ->
case Args of
- [] ->
- [];
- [default|T] ->
- [{args,[make_bin(Arg,Binary) || Arg <- T]}];
- [switch_order,H|T] ->
- [{args,[make_bin(Arg,Binary) || Arg <- T]},{arg0,make_bin(H,Binary)}];
- [H|T] ->
- [{arg0,make_bin(H,Binary)},{args,[make_bin(Arg,Binary) || Arg <- T]}]
+ [] ->
+ [];
+ [default|T] ->
+ [{args,[make_bin(Arg,Binary) || Arg <- T]}];
+ [switch_order,H|T] ->
+ [{args,[make_bin(Arg,Binary) || Arg <- T]},{arg0,make_bin(H,Binary)}];
+ [H|T] ->
+ [{arg0,make_bin(H,Binary)},{args,[make_bin(Arg,Binary) || Arg <- T]}]
end.
make_bin(Str, false) -> Str;
@@ -1593,54 +1584,49 @@ make_bin(Str, true) -> unicode:characters_to_binary(Str).
collect_data(Port) ->
receive
- {Port, {data, Data}} ->
- Data ++ collect_data(Port);
- {Port, eof} ->
- []
+ {Port, {data, Data}} ->
+ Data ++ collect_data(Port);
+ {Port, eof} ->
+ []
end.
parse_echo_args_output(Data) ->
[lists:last(string:tokens(S,"|")) || S <- string:tokens(Data,"\r\n")].
-mix_up_ports(suite) ->
- [];
-mix_up_ports(doc) ->
- ["Test that the emulator does not mix up ports when the port table wraps"];
+%% Test that the emulator does not mix up ports when the port table wraps
mix_up_ports(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
ok = load_driver(Path, "echo_drv"),
Port = erlang:open_port({spawn, "echo_drv"}, []),
Port ! {self(), {command, "Hello port!"}},
receive
- {Port, {data, "Hello port!"}} = Msg1 ->
- io:format("~p~n", [Msg1]),
- ok;
- Other ->
- test_server:fail({unexpected, Other})
- end,
+ {Port, {data, "Hello port!"}} = Msg1 ->
+ io:format("~p~n", [Msg1]),
+ ok;
+ Other ->
+ ct:fail({unexpected, Other})
+ end,
Port ! {self(), close},
receive {Port, closed} -> ok end,
loop(start, done,
- fun(P) ->
- Q =
- (catch erlang:open_port({spawn, "echo_drv"}, [])),
-%% io:format("~p ", [Q]),
- if is_port(Q) ->
- Q;
- true ->
- io:format("~p~n", [P]),
- done
- end
- end),
+ fun(P) ->
+ Q =
+ (catch erlang:open_port({spawn, "echo_drv"}, [])),
+ %% io:format("~p ", [Q]),
+ if is_port(Q) ->
+ Q;
+ true ->
+ io:format("~p~n", [P]),
+ done
+ end
+ end),
Port ! {self(), {command, "Hello again port!"}},
receive
- Msg2 ->
- test_server:fail({unexpected, Msg2})
- after 1000 ->
- ok
- end,
- test_server:timetrap_cancel(Dog),
+ Msg2 ->
+ ct:fail({unexpected, Msg2})
+ after 1000 ->
+ ok
+ end,
ok.
loop(Stop, Stop, Fun) when is_function(Fun) ->
@@ -1649,131 +1635,118 @@ loop(Start, Stop, Fun) when is_function(Fun) ->
loop(Fun(Start), Stop, Fun).
-otp_5112(suite) ->
- [];
-otp_5112(doc) ->
- ["Test that link to connected process is taken away when port calls",
- "driver_exit() also when the port index has wrapped"];
+%% Test that link to connected process is taken away when port calls
+%% driver_exit() also when the port index has wrapped
otp_5112(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
ok = load_driver(Path, "exit_drv"),
Port = otp_5112_get_wrapped_port(),
- ?t:format("Max ports: ~p~n",[max_ports()]),
- ?t:format("Port: ~p~n",[Port]),
+ io:format("Max ports: ~p~n",[max_ports()]),
+ io:format("Port: ~p~n",[Port]),
{links, Links1} = process_info(self(),links),
- ?t:format("Links1: ~p~n",[Links1]),
+ io:format("Links1: ~p~n",[Links1]),
true = lists:member(Port, Links1),
Port ! {self(), {command, ""}},
- ?line wait_until(fun () -> lists:member(Port, erlang:ports()) == false end),
+ wait_until(fun () -> lists:member(Port, erlang:ports()) == false end),
{links, Links2} = process_info(self(),links),
- ?t:format("Links2: ~p~n",[Links2]),
+ io:format("Links2: ~p~n",[Links2]),
false = lists:member(Port, Links2), %% This used to fail
- test_server:timetrap_cancel(Dog),
ok.
otp_5112_get_wrapped_port() ->
P1 = erlang:open_port({spawn, "exit_drv"}, []),
case port_ix(P1) < max_ports() of
- true ->
- ?t:format("Need to wrap port index (~p)~n", [P1]),
- otp_5112_wrap_port_ix([P1]),
- P2 = erlang:open_port({spawn, "exit_drv"}, []),
- false = port_ix(P2) < max_ports(),
- P2;
- false ->
- ?t:format("Port index already wrapped (~p)~n", [P1]),
- P1
- end.
+ true ->
+ io:format("Need to wrap port index (~p)~n", [P1]),
+ otp_5112_wrap_port_ix([P1]),
+ P2 = erlang:open_port({spawn, "exit_drv"}, []),
+ false = port_ix(P2) < max_ports(),
+ P2;
+ false ->
+ io:format("Port index already wrapped (~p)~n", [P1]),
+ P1
+ end.
otp_5112_wrap_port_ix(Ports) ->
case (catch erlang:open_port({spawn, "exit_drv"}, [])) of
- Port when is_port(Port) ->
- otp_5112_wrap_port_ix([Port|Ports]);
- _ ->
- %% Port table now full; empty port table
- lists:foreach(fun (P) -> P ! {self(), close} end,
- Ports),
- ok
- end.
+ Port when is_port(Port) ->
+ otp_5112_wrap_port_ix([Port|Ports]);
+ _ ->
+ %% Port table now full; empty port table
+ lists:foreach(fun (P) -> P ! {self(), close} end,
+ Ports),
+ ok
+ end.
-otp_5119(suite) ->
- [];
-otp_5119(doc) ->
- ["Test that port index is not unnecessarily wrapped"];
+%% Test that port index is not unnecessarily wrapped
otp_5119(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
ok = load_driver(Path, "exit_drv"),
PI1 = port_ix(otp_5119_fill_empty_port_tab([])),
Port2 = erlang:open_port({spawn, "exit_drv"}, []),
PI2 = port_ix(Port2),
{PortIx1, PortIx2} = case PI2 > PI1 of
- true ->
- {PI1, PI2};
- false ->
- {port_ix(otp_5119_fill_empty_port_tab([Port2])),
- port_ix(erlang:open_port({spawn, "exit_drv"}, []))}
- end,
+ true ->
+ {PI1, PI2};
+ false ->
+ {port_ix(otp_5119_fill_empty_port_tab([Port2])),
+ port_ix(erlang:open_port({spawn, "exit_drv"}, []))}
+ end,
MaxPorts = max_ports(),
- ?t:format("PortIx1 = ~p ~p~n", [PI1, PortIx1]),
- ?t:format("PortIx2 = ~p ~p~n", [PI2, PortIx2]),
- ?t:format("MaxPorts = ~p~n", [MaxPorts]),
+ io:format("PortIx1 = ~p ~p~n", [PI1, PortIx1]),
+ io:format("PortIx2 = ~p ~p~n", [PI2, PortIx2]),
+ io:format("MaxPorts = ~p~n", [MaxPorts]),
true = PortIx2 > PortIx1,
true = PortIx2 =< PortIx1 + MaxPorts,
- test_server:timetrap_cancel(Dog),
ok.
otp_5119_fill_empty_port_tab(Ports) ->
case (catch erlang:open_port({spawn, "exit_drv"}, [])) of
- Port when is_port(Port) ->
- otp_5119_fill_empty_port_tab([Port|Ports]);
- _ ->
- %% Port table now full; empty port table
- lists:foreach(fun (P) -> P ! {self(), close} end,
- Ports),
- [LastPort|_] = Ports,
- LastPort
- end.
+ Port when is_port(Port) ->
+ otp_5119_fill_empty_port_tab([Port|Ports]);
+ _ ->
+ %% Port table now full; empty port table
+ lists:foreach(fun (P) -> P ! {self(), close} end,
+ Ports),
+ [LastPort|_] = Ports,
+ LastPort
+ end.
max_ports() ->
erlang:system_info(port_limit).
port_ix(Port) when is_port(Port) ->
["#Port",_,PortIxStr] = string:tokens(erlang:port_to_list(Port),
- "<.>"),
+ "<.>"),
list_to_integer(PortIxStr).
-otp_6224(doc) -> ["Check that port command failure doesn't crash the emulator"];
-otp_6224(suite) -> [];
+%% Check that port command failure doesn't crash the emulator
otp_6224(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
ok = load_driver(Path, "failure_drv"),
Go = make_ref(),
Failer = spawn(fun () ->
- receive Go -> ok end,
- Port = open_port({spawn, "failure_drv"},
- []),
- Port ! {self(), {command, "Fail, please!"}},
- otp_6224_loop()
- end),
+ receive Go -> ok end,
+ Port = open_port({spawn, "failure_drv"},
+ []),
+ Port ! {self(), {command, "Fail, please!"}},
+ otp_6224_loop()
+ end),
Mon = erlang:monitor(process, Failer),
Failer ! Go,
receive
- {'DOWN', Mon, process, Failer, Reason} ->
- case Reason of
- {driver_failed, _} -> ok;
- driver_failed -> ok;
- _ -> ?t:fail({unexpected_exit_reason,
- Reason})
- end
- end,
- test_server:timetrap_cancel(Dog),
+ {'DOWN', Mon, process, Failer, Reason} ->
+ case Reason of
+ {driver_failed, _} -> ok;
+ driver_failed -> ok;
+ _ -> ct:fail({unexpected_exit_reason,
+ Reason})
+ end
+ end,
ok.
-
+
otp_6224_loop() ->
receive _ -> ok after 0 -> ok end,
otp_6224_loop().
@@ -1782,29 +1755,26 @@ otp_6224_loop() ->
-define(EXIT_STATUS_MSB_MAX_PROCS, 64).
-define(EXIT_STATUS_MSB_MAX_PORTS, 300).
-exit_status_multi_scheduling_block(doc) -> [];
-exit_status_multi_scheduling_block(suite) -> [];
exit_status_multi_scheduling_block(Config) when is_list(Config) ->
Repeat = 3,
- case ?t:os_type() of
- {unix, _} ->
- Dog = ?t:timetrap(test_server:minutes(2*Repeat)),
- SleepSecs = 6,
- try
- lists:foreach(fun (_) ->
- exit_status_msb_test(Config,
- SleepSecs)
- end,
- lists:seq(1, Repeat))
- after
- %% Wait for the system to recover (regardless
- %% of success or not) otherwise later testcases
- %% may unnecessarily fail.
- ?t:timetrap_cancel(Dog),
- receive after SleepSecs+500 -> ok end
- end;
- _ -> {skip, "Not implemented for this OS"}
- end.
+ case test_server:os_type() of
+ {unix, _} ->
+ ct:timetrap({minutes, 2*Repeat}),
+ SleepSecs = 6,
+ try
+ lists:foreach(fun (_) ->
+ exit_status_msb_test(Config,
+ SleepSecs)
+ end,
+ lists:seq(1, Repeat))
+ after
+ %% Wait for the system to recover (regardless
+ %% of success or not) otherwise later testcases
+ %% may unnecessarily fail.
+ receive after SleepSecs+500 -> ok end
+ end;
+ _ -> {skip, "Not implemented for this OS"}
+ end.
exit_status_msb_test(Config, SleepSecs) when is_list(Config) ->
%%
@@ -1814,131 +1784,131 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) ->
%%
NoSchedsOnln = erlang:system_info(schedulers_online),
Parent = self(),
- ?t:format("SleepSecs = ~p~n", [SleepSecs]),
+ io:format("SleepSecs = ~p~n", [SleepSecs]),
PortProg = "sleep " ++ integer_to_list(SleepSecs),
Start = erlang:monotonic_time(micro_seconds),
NoProcs = case NoSchedsOnln of
- NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS ->
- NProcs;
- _ ->
- ?EXIT_STATUS_MSB_MAX_PROCS
- end,
+ NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS ->
+ NProcs;
+ _ ->
+ ?EXIT_STATUS_MSB_MAX_PROCS
+ end,
NoPortsPerProc = case 20*NoProcs of
- TNPorts when TNPorts < ?EXIT_STATUS_MSB_MAX_PORTS -> 20;
- _ -> ?EXIT_STATUS_MSB_MAX_PORTS div NoProcs
- end,
- ?t:format("NoProcs = ~p~nNoPortsPerProc = ~p~n",
- [NoProcs, NoPortsPerProc]),
+ TNPorts when TNPorts < ?EXIT_STATUS_MSB_MAX_PORTS -> 20;
+ _ -> ?EXIT_STATUS_MSB_MAX_PORTS div NoProcs
+ end,
+ io:format("NoProcs = ~p~nNoPortsPerProc = ~p~n",
+ [NoProcs, NoPortsPerProc]),
ProcFun
- = fun () ->
- PrtSIds = lists:map(
- fun (_) ->
- erlang:yield(),
- case catch open_port({spawn, PortProg},
- [exit_status]) of
- Prt when is_port(Prt) ->
- {Prt,
- erlang:system_info(scheduler_id)};
- {'EXIT', {Err, _}} when Err == eagain;
- Err == emfile ->
- noop;
- {'EXIT', Err} when Err == eagain;
- Err == emfile ->
- noop;
- Error ->
- ?t:fail(Error)
- end
- end,
- lists:seq(1, NoPortsPerProc)),
- SIds = lists:filter(fun (noop) -> false;
- (_) -> true
- end,
- lists:map(fun (noop) -> noop;
- ({_, SId}) -> SId
- end,
- PrtSIds)),
- process_flag(scheduler, 0),
- Parent ! {self(), started, SIds},
- lists:foreach(
- fun (noop) ->
- noop;
- ({Port, _}) ->
- receive
- {Port, {exit_status, 0}} ->
- ok;
- {Port, {exit_status, Status}} when Status > 128 ->
- %% Sometimes happens when we have created
- %% too many ports.
- ok;
- {Port, {exit_status, _}} = ESMsg ->
- {Port, {exit_status, 0}} = ESMsg
- end
- end,
- PrtSIds),
- Parent ! {self(), done}
- end,
+ = fun () ->
+ PrtSIds = lists:map(
+ fun (_) ->
+ erlang:yield(),
+ case catch open_port({spawn, PortProg},
+ [exit_status]) of
+ Prt when is_port(Prt) ->
+ {Prt,
+ erlang:system_info(scheduler_id)};
+ {'EXIT', {Err, _}} when Err == eagain;
+ Err == emfile;
+ Err == enomem ->
+ noop;
+ {'EXIT', Err} when Err == eagain;
+ Err == emfile;
+ Err == enomem ->
+ noop;
+ Error ->
+ ct:fail(Error)
+ end
+ end,
+ lists:seq(1, NoPortsPerProc)),
+ SIds = lists:filter(fun (noop) -> false;
+ (_) -> true
+ end,
+ lists:map(fun (noop) -> noop;
+ ({_, SId}) -> SId
+ end,
+ PrtSIds)),
+ process_flag(scheduler, 0),
+ Parent ! {self(), started, SIds},
+ lists:foreach(
+ fun (noop) ->
+ noop;
+ ({Port, _}) ->
+ receive
+ {Port, {exit_status, 0}} ->
+ ok;
+ {Port, {exit_status, Status}} when Status > 128 ->
+ %% Sometimes happens when we have created
+ %% too many ports.
+ ok;
+ {Port, {exit_status, _}} = ESMsg ->
+ {Port, {exit_status, 0}} = ESMsg
+ end
+ end,
+ PrtSIds),
+ Parent ! {self(), done}
+ end,
Procs = lists:map(fun (N) ->
- spawn_opt(ProcFun,
- [link,
- {scheduler,
- (N rem NoSchedsOnln)+1}])
- end,
- lists:seq(1, NoProcs)),
+ spawn_opt(ProcFun,
+ [link,
+ {scheduler,
+ (N rem NoSchedsOnln)+1}])
+ end,
+ lists:seq(1, NoProcs)),
SIds = lists:map(fun (P) ->
- receive {P, started, SIds} -> SIds end
- end,
- Procs),
+ receive {P, started, SIds} -> SIds end
+ end,
+ Procs),
StartedTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000,
- ?t:format("StartedTime = ~p~n", [StartedTime]),
+ io:format("StartedTime = ~p~n", [StartedTime]),
true = StartedTime < SleepSecs,
erlang:system_flag(multi_scheduling, block),
lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs),
DoneTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000,
- ?t:format("DoneTime = ~p~n", [DoneTime]),
+ io:format("DoneTime = ~p~n", [DoneTime]),
true = DoneTime > SleepSecs,
ok = verify_multi_scheduling_blocked(),
erlang:system_flag(multi_scheduling, unblock),
case {length(lists:usort(lists:flatten(SIds))), NoSchedsOnln} of
- {N, N} ->
- ok;
- {N, M} ->
- ?t:fail("Failed to create ports on all"
- ++ integer_to_list(M) ++ " available"
- "schedulers. Only created ports on "
- ++ integer_to_list(N) ++ " schedulers.")
- end.
+ {N, N} ->
+ ok;
+ {N, M} ->
+ ct:fail("Failed to create ports on all ~w available"
+ "schedulers. Only created ports on ~w schedulers.", [M, N])
+ end.
save_sid(SIds) ->
SId = erlang:system_info(scheduler_id),
case lists:member(SId, SIds) of
- true -> SIds;
- false -> [SId|SIds]
+ true -> SIds;
+ false -> [SId|SIds]
end.
sid_proc(SIds) ->
NewSIds = save_sid(SIds),
receive
- {From, want_sids} ->
- From ! {self(), sids, NewSIds}
+ {From, want_sids} ->
+ From ! {self(), sids, NewSIds}
after 0 ->
- sid_proc(NewSIds)
+ sid_proc(NewSIds)
end.
verify_multi_scheduling_blocked() ->
Procs = lists:map(fun (_) ->
- spawn_link(fun () -> sid_proc([]) end)
- end,
- lists:seq(1, 3*erlang:system_info(schedulers_online))),
+ spawn_link(fun () -> sid_proc([]) end)
+ end,
+ lists:seq(1, 3*erlang:system_info(schedulers_online))),
receive after 1000 -> ok end,
SIds = lists:map(fun (P) ->
- P ! {self(), want_sids},
- receive {P, sids, PSIds} -> PSIds end
- end,
- Procs),
+ P ! {self(), want_sids},
+ receive {P, sids, PSIds} -> PSIds end
+ end,
+ Procs),
1 = length(lists:usort(lists:flatten(SIds))),
ok.
-
-
+
+
%%% Pinging functions.
stream_ping(Config, Size, CmdLine, Options) ->
@@ -1947,10 +1917,10 @@ stream_ping(Config, Size, CmdLine, Options) ->
ping(Config, Sizes, HSize, CmdLine, Options) ->
Actions = lists:map(fun(Size) ->
- [$p|Packet] = random_packet(Size, "ping"),
- {[$p|Packet], [[$P|Packet]]}
- end,
- Sizes),
+ [$p|Packet] = random_packet(Size, "ping"),
+ {[$p|Packet], [[$P|Packet]]}
+ end,
+ Sizes),
port_expect(Config, Actions, HSize, CmdLine, Options).
%% expect_input(Sizes, HSize, CmdLine, Options)
@@ -1972,7 +1942,7 @@ expect_input1(Config, [Size|Rest], Params, Expect, ReplyCommand) ->
expect_input1(Config, [], {HSize, CmdLine0, Options}, Expect, ReplyCommand) ->
CmdLine = build_cmd_line(CmdLine0, ReplyCommand, []),
port_expect(Config, [{false, lists:reverse(Expect)}],
- HSize, CmdLine, Options).
+ HSize, CmdLine, Options).
build_cmd_line(FixedCmdLine, [Cmd|Rest], []) ->
build_cmd_line(FixedCmdLine, Rest, [Cmd]);
@@ -1995,15 +1965,15 @@ build_cmd_line(FixedCmdLine, [], Result) ->
%% Returns the port.
port_expect(Config, Actions, HSize, CmdLine, Options0) ->
-% io:format("port_expect(~p, ~p, ~p, ~p)",
-% [Actions, HSize, CmdLine, Options0]),
+ % io:format("port_expect(~p, ~p, ~p, ~p)",
+ % [Actions, HSize, CmdLine, Options0]),
PortTest = port_test(Config),
Cmd = lists:concat([PortTest, " -h", HSize, " ", CmdLine]),
PortType =
- case HSize of
- 0 -> stream;
- _ -> {packet, HSize}
- end,
+ case HSize of
+ 0 -> stream;
+ _ -> {packet, HSize}
+ end,
Options = [PortType|Options0],
io:format("open_port({spawn, ~p}, ~p)", [Cmd, Options]),
Port = open_port({spawn, Cmd}, Options),
@@ -2014,11 +1984,11 @@ port_expect(Port, [{Send, Expects}|Rest], Options) when is_list(Expects) ->
port_send(Port, Send),
IsBinaryPort = lists:member(binary, Options),
Receiver =
- case {lists:member(stream, Options), line_option(Options)} of
- {false, _} -> fun receive_all/2;
- {true,false} -> fun stream_receive_all/2;
- {_, true} -> fun receive_all/2
- end,
+ case {lists:member(stream, Options), line_option(Options)} of
+ {false, _} -> fun receive_all/2;
+ {true,false} -> fun stream_receive_all/2;
+ {_, true} -> fun receive_all/2
+ end,
Receiver(Port, maybe_to_binary(Expects, IsBinaryPort)),
port_expect(Port, Rest, Options);
port_expect(_, [], _) ->
@@ -2046,34 +2016,34 @@ maybe_to_binary(Expects, false) ->
port_send(_Port, false) -> ok;
port_send(Port, Send) when is_list(Send) ->
-% io:format("port_send(~p, ~p)", [Port, Send]),
+ % io:format("port_send(~p, ~p)", [Port, Send]),
Port ! {self(), {command, Send}}.
receive_all(Port, [Expect|Rest]) ->
-% io:format("receive_all(~p, [~p|Rest])", [Port, Expect]),
+ % io:format("receive_all(~p, [~p|Rest])", [Port, Expect]),
receive
- {Port, {data, Expect}} ->
- io:format("Received ~s", [format(Expect)]),
- ok;
- {Port, {data, Other}} ->
- io:format("Received ~s; expected ~s",
- [format(Other), format(Expect)]),
- test_server:fail(bad_message);
- Other ->
- %% (We're not yet prepared for receiving both 'eol' and
- %% 'exit_status'; remember that they may appear in any order.)
- case {Expect, Rest, Other} of
- {eof, [], {Port, eof}} ->
- io:format("Received soft EOF.",[]),
- ok;
- {{exit_status, S}, [], {Port, {exit_status, S}}} ->
- io:format("Received exit status ~p.",[S]),
- ok;
- _ ->
-%%% io:format("Unexpected message: ~s", [format(Other)]),
- io:format("Unexpected message: ~w", [Other]),
- test_server:fail(unexpected_message)
- end
+ {Port, {data, Expect}} ->
+ io:format("Received ~s", [format(Expect)]),
+ ok;
+ {Port, {data, Other}} ->
+ io:format("Received ~s; expected ~s",
+ [format(Other), format(Expect)]),
+ ct:fail(bad_message);
+ Other ->
+ %% (We're not yet prepared for receiving both 'eol' and
+ %% 'exit_status'; remember that they may appear in any order.)
+ case {Expect, Rest, Other} of
+ {eof, [], {Port, eof}} ->
+ io:format("Received soft EOF.",[]),
+ ok;
+ {{exit_status, S}, [], {Port, {exit_status, S}}} ->
+ io:format("Received exit status ~p.",[S]),
+ ok;
+ _ ->
+ %%% io:format("Unexpected message: ~s", [format(Other)]),
+ io:format("Unexpected message: ~w", [Other]),
+ ct:fail(unexpected_message)
+ end
end,
receive_all(Port, Rest);
receive_all(_Port, []) ->
@@ -2088,30 +2058,30 @@ stream_receive_all1(_Port, []) ->
ok;
stream_receive_all1(Port, Expect) ->
receive
- {Port, {data, Data}} ->
- Remaining = compare(Data, Expect),
- stream_receive_all1(Port, Remaining);
- Other ->
- test_server:fail({bad_message, Other})
+ {Port, {data, Data}} ->
+ Remaining = compare(Data, Expect),
+ stream_receive_all1(Port, Remaining);
+ Other ->
+ ct:fail({bad_message, Other})
end.
compare(B1, B2) when is_binary(B1), is_binary(B2), byte_size(B1) =< byte_size(B2) ->
case split_binary(B2, size(B1)) of
- {B1,Remaining} ->
- Remaining;
- _Other ->
- test_server:fail(nomatch)
+ {B1,Remaining} ->
+ Remaining;
+ _Other ->
+ ct:fail(nomatch)
end;
compare(B1, B2) when is_binary(B1), is_binary(B2) ->
- test_server:fail(too_much_data);
+ ct:fail(too_much_data);
compare([X|Rest1], [X|Rest2]) ->
compare(Rest1, Rest2);
compare([_|_], [_|_]) ->
- test_server:fail(nomatch);
+ ct:fail(nomatch);
compare([], Remaining) ->
Remaining;
compare(_Data, []) ->
- test_server:fail(too_much_data).
+ ct:fail(too_much_data).
maybe_to_list(Bin) when is_binary(Bin) ->
binary_to_list(Bin);
@@ -2122,10 +2092,10 @@ format({Eol,List}) ->
io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]);
format(List) when is_list(List) ->
case list_at_least(50, List) of
- true ->
- io_lib:format("\"~-50s...\"", [List]);
- false ->
- io_lib:format("~p", [List])
+ true ->
+ io_lib:format("\"~-50s...\"", [List]);
+ false ->
+ io_lib:format("~p", [List])
end;
format(Bin) when is_binary(Bin), size(Bin) >= 50 ->
io_lib:format("binary<~-50s...>", [binary_to_list(Bin, 1, 50)]);
@@ -2152,17 +2122,17 @@ build_packet(0, Result, _NextChar) ->
lists:reverse(Result);
build_packet(Left, Result, NextChar0) ->
NextChar =
- if
- NextChar0 >= 126 ->
- 33;
- true ->
- NextChar0+1
- end,
+ if
+ NextChar0 >= 126 ->
+ 33;
+ true ->
+ NextChar0+1
+ end,
build_packet(Left-1, [NextChar0|Result], NextChar).
sizes() ->
[10, 13, 64, 127, 128, 255, 256, 1023, 1024,
- 32767, 32768, 65535, 65536].
+ 32767, 32768, 65535, 65536].
sizes(Header_Size) ->
sizes(Header_Size, sizes(), []).
@@ -2183,15 +2153,14 @@ random_char(Chars) ->
lists:nth(uniform(length(Chars)), Chars).
uniform(N) ->
- case get(random_seed) of
- undefined ->
- {X, Y, Z} = Seed = time(),
- io:format("Random seed = ~p\n",[Seed]),
- random:seed(X, Y, Z);
- _ ->
- ok
+ case rand:export_seed() of
+ undefined ->
+ rand:seed(exsplus),
+ io:format("Random seed = ~p\n", [rand:export_seed()]);
+ _ ->
+ ok
end,
- random:uniform(N).
+ rand:uniform(N).
fun_spawn(Fun) ->
fun_spawn(Fun, []).
@@ -2200,13 +2169,11 @@ fun_spawn(Fun, Args) ->
spawn_link(erlang, apply, [Fun, Args]).
port_test(Config) when is_list(Config) ->
- filename:join(?config(data_dir, Config), "port_test").
-
+ filename:join(proplists:get_value(data_dir, Config), "port_test").
-ports(doc) -> "Test that erlang:ports/0 returns a consistent snapshot of ports";
-ports(suite) -> [];
+%% Test that erlang:ports/0 returns a consistent snapshot of ports
ports(Config) when is_list(Config) ->
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
ok = load_driver(Path, "exit_drv"),
receive after 1000 -> ok end, % Wait for other ports to stabilize
@@ -2233,7 +2200,7 @@ ports_snapshots(Iter, TrafficPid, OtherPorts) ->
TrafficPid ! {self(), stop},
receive {TrafficPid, EventList, TrafficPorts} -> ok end,
-
+
%%io:format("Snapshot=~p\n", [Snapshot]),
ports_verify(Snapshot, OtherPorts ++ TrafficPorts, EventList),
@@ -2245,78 +2212,77 @@ ports_traffic(MaxPorts) ->
ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) ->
receive
- start ->
- %%io:format("Traffic started in ~p\n",[self()]),
- ports_traffic_started(MaxPorts, {PortList, PortCnt}, []);
- {Pid,die} ->
- lists:foreach(fun(Port)-> erlang:port_close(Port) end,
- PortList),
- Pid ! {self(),dead}
+ start ->
+ %%io:format("Traffic started in ~p\n",[self()]),
+ ports_traffic_started(MaxPorts, {PortList, PortCnt}, []);
+ {Pid,die} ->
+ lists:foreach(fun(Port)-> erlang:port_close(Port) end,
+ PortList),
+ Pid ! {self(),dead}
end.
ports_traffic_started(MaxPorts, {PortList, PortCnt}, EventList) ->
receive
- {Pid, stop} ->
- %%io:format("Traffic stopped in ~p\n",[self()]),
- Pid ! {self(), EventList, PortList},
- ports_traffic_stopped(MaxPorts, {PortList, PortCnt})
+ {Pid, stop} ->
+ %%io:format("Traffic stopped in ~p\n",[self()]),
+ Pid ! {self(), EventList, PortList},
+ ports_traffic_stopped(MaxPorts, {PortList, PortCnt})
after 0 ->
- ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList)
+ ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList)
end.
ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) ->
N = uniform(MaxPorts),
case N > PortCnt of
- true -> % Open port
- P = open_port({spawn, "exit_drv"}, []),
- %%io:format("Created port ~p\n",[P]),
- ports_traffic_started(MaxPorts, {[P|PortList], PortCnt+1},
- [{open,P}|EventList]);
-
- false -> % Close port
- P = lists:nth(N, PortList),
- %%io:format("Close port ~p\n",[P]),
- true = erlang:port_close(P),
- ports_traffic_started(MaxPorts, {lists:delete(P,PortList), PortCnt-1},
- [{close,P}|EventList])
+ true -> % Open port
+ P = open_port({spawn, "exit_drv"}, []),
+ %%io:format("Created port ~p\n",[P]),
+ ports_traffic_started(MaxPorts, {[P|PortList], PortCnt+1},
+ [{open,P}|EventList]);
+
+ false -> % Close port
+ P = lists:nth(N, PortList),
+ %%io:format("Close port ~p\n",[P]),
+ true = erlang:port_close(P),
+ ports_traffic_started(MaxPorts, {lists:delete(P,PortList), PortCnt-1},
+ [{close,P}|EventList])
end.
ports_verify(Ports, PortsAfter, EventList) ->
%%io:format("Candidate=~p\nEvents=~p\n", [PortsAfter, EventList]),
case lists:sort(Ports) =:= lists:sort(PortsAfter) of
- true ->
- io:format("Snapshot of ~p ports verified ok.\n",[length(Ports)]),
- ok;
- false ->
- %% Note that we track the event list "backwards", undoing open/close:
- case EventList of
- [{open,P} | Tail] ->
- ports_verify(Ports, lists:delete(P,PortsAfter), Tail);
-
- [{close,P} | Tail] ->
- ports_verify(Ports, [P | PortsAfter], Tail);
-
- [] ->
- test_server:fail("Inconsistent snapshot from erlang:ports()")
- end
+ true ->
+ io:format("Snapshot of ~p ports verified ok.\n",[length(Ports)]),
+ ok;
+ false ->
+ %% Note that we track the event list "backwards", undoing open/close:
+ case EventList of
+ [{open,P} | Tail] ->
+ ports_verify(Ports, lists:delete(P,PortsAfter), Tail);
+
+ [{close,P} | Tail] ->
+ ports_verify(Ports, [P | PortsAfter], Tail);
+
+ [] ->
+ ct:fail("Inconsistent snapshot from erlang:ports()")
+ end
end.
load_driver(Dir, Driver) ->
case erl_ddll:load_driver(Dir, Driver) of
- ok -> ok;
- {error, Error} = Res ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- Res
+ ok -> ok;
+ {error, Error} = Res ->
+ io:format("~s\n", [erl_ddll:format_error(Error)]),
+ Res
end.
-close_deaf_port(doc) -> ["Send data to port program that does not read it, then close port."
- "Primary targeting Windows to test threaded_handle_closer in sys.c"];
-close_deaf_port(suite) -> [];
+%% Send data to port program that does not read it, then close port.
+%% Primary targeting Windows to test threaded_handle_closer in sys.c
close_deaf_port(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(100)),
- DataDir = ?config(data_dir, Config),
+ ct:timetrap({minutes, 2}),
+ DataDir = proplists:get_value(data_dir, Config),
DeadPort = os:find_executable("dead_port", DataDir),
Port = open_port({spawn,DeadPort++" 60"},[]),
erlang:port_command(Port,"Hello, can you hear me!?!?"),
@@ -2325,83 +2291,82 @@ close_deaf_port(Config) when is_list(Config) ->
Res = close_deaf_port_1(0, DeadPort),
io:format("Waiting for OS procs to terminate...\n"),
receive after 5*1000 -> ok end,
- test_server:timetrap_cancel(Dog),
Res.
close_deaf_port_1(200, _) ->
ok;
close_deaf_port_1(N, Cmd) ->
- Timeout = integer_to_list(random:uniform(5*1000)),
+ Timeout = integer_to_list(rand:uniform(5*1000)),
try open_port({spawn_executable,Cmd},[{args,[Timeout]}]) of
- Port ->
- erlang:port_command(Port,"Hello, can you hear me!?!?"),
- port_close(Port),
- close_deaf_port_1(N+1, Cmd)
+ Port ->
+ erlang:port_command(Port,"Hello, can you hear me!?!?"),
+ port_close(Port),
+ close_deaf_port_1(N+1, Cmd)
catch
- _:eagain ->
- {comment, "Could not spawn more than " ++ integer_to_list(N) ++ " OS processes."}
+ _:eagain ->
+ {comment, "Could not spawn more than " ++ integer_to_list(N) ++ " OS processes."}
end.
%% Test undocumented port_set_data/2 and port_get_data/1
%% Hammer from multiple processes a while
%% and then abrubtly close the port (OTP-12208).
port_setget_data(Config) when is_list(Config) ->
- ok = load_driver(?config(data_dir, Config), "echo_drv"),
+ ok = load_driver(proplists:get_value(data_dir, Config), "echo_drv"),
Port = erlang:open_port({spawn_driver, "echo_drv"}, []),
NSched = erlang:system_info(schedulers_online),
HeapData = {1,2,3,<<"A heap binary">>,fun()->"This is fun"end,
- list_to_binary(lists:seq(1,100))},
+ list_to_binary(lists:seq(1,100))},
PRs = lists:map(fun(I) ->
- spawn_opt(fun() -> port_setget_data_hammer(Port,HeapData,false,1) end,
- [monitor, {scheduler, I rem NSched}])
- end,
- lists:seq(1,10)),
+ spawn_opt(fun() -> port_setget_data_hammer(Port,HeapData,false,1) end,
+ [monitor, {scheduler, I rem NSched}])
+ end,
+ lists:seq(1,10)),
receive after 100 -> ok end,
Papa = self(),
lists:foreach(fun({Pid,_}) -> Pid ! {Papa,prepare_for_close} end, PRs),
lists:foreach(fun({Pid,_}) ->
- receive {Pid,prepare_for_close} -> ok end
- end,
- PRs),
+ receive {Pid,prepare_for_close} -> ok end
+ end,
+ PRs),
port_close(Port),
lists:foreach(fun({Pid,Ref}) ->
- receive {'DOWN', Ref, process, Pid, normal} -> ok end
- end,
- PRs),
+ receive {'DOWN', Ref, process, Pid, normal} -> ok end
+ end,
+ PRs),
ok.
port_setget_data_hammer(Port, HeapData, IsSet0, N) ->
- Rand = random:uniform(3),
+ Rand = rand:uniform(3),
IsSet1 = try case Rand of
- 1 -> true = erlang:port_set_data(Port, atom), true;
- 2 -> true = erlang:port_set_data(Port, HeapData), true;
- 3 -> case erlang:port_get_data(Port) of
- atom -> true;
- HeapData -> true;
- undefined -> false=IsSet0
- end
- end
- catch
- error:badarg ->
- true = get(prepare_for_close),
- io:format("~p did ~p rounds before port closed\n", [self(), N]),
- exit(normal)
- end,
+ 1 -> true = erlang:port_set_data(Port, atom), true;
+ 2 -> true = erlang:port_set_data(Port, HeapData), true;
+ 3 -> case erlang:port_get_data(Port) of
+ atom -> true;
+ HeapData -> true;
+ undefined -> false=IsSet0
+ end
+ end
+ catch
+ error:badarg ->
+ true = get(prepare_for_close),
+ io:format("~p did ~p rounds before port closed\n", [self(), N]),
+ exit(normal)
+ end,
receive {Papa, prepare_for_close} ->
- put(prepare_for_close, true),
- Papa ! {self(),prepare_for_close}
+ put(prepare_for_close, true),
+ Papa ! {self(),prepare_for_close}
after 0 ->
- ok
+ ok
end,
port_setget_data_hammer(Port, HeapData, IsSet1, N+1).
wait_until(Fun) ->
case catch Fun() of
- true ->
- ok;
- _ ->
- receive after 100 -> ok end,
- wait_until(Fun)
+ true ->
+ ok;
+ _ ->
+ receive after 100 -> ok end,
+ wait_until(Fun)
end.
diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c
index 7abefab2e3..cc3ebdf0f8 100644
--- a/erts/emulator/test/port_SUITE_data/port_test.c
+++ b/erts/emulator/test/port_SUITE_data/port_test.c
@@ -13,6 +13,7 @@
#ifndef __WIN32__
#include <unistd.h>
+#include <limits.h>
#include <sys/time.h>
@@ -48,6 +49,7 @@ typedef struct {
* after reading the header for a packet
* before reading the rest.
*/
+ int fd_count; /* Count the number of open fds */
int break_mode; /* If set, this program will close standard
* input, which should case broken pipe
* error in the writer.
@@ -107,7 +109,7 @@ MAIN(argc, argv)
int argc;
char *argv[];
{
- int ret;
+ int ret, fd_count;
if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) {
fprintf(stderr, "Couldn't malloc for port_data");
exit(1);
@@ -115,6 +117,7 @@ char *argv[];
port_data->header_size = 0;
port_data->io_buf_size = 0;
port_data->delay_mode = 0;
+ port_data->fd_count = 0;
port_data->break_mode = 0;
port_data->quit_mode = 0;
port_data->slow_writes = 0;
@@ -144,6 +147,9 @@ char *argv[];
case 'e':
port_data->fd_to_erl = 2;
break;
+ case 'f':
+ port_data->fd_count = 1;
+ break;
case 'h': /* Header size for packets. */
switch (argv[1][2]) {
case '0': port_data->header_size = 0; break;
@@ -189,18 +195,31 @@ char *argv[];
/* XXX Add error printout here */
}
+ if (port_data->fd_count) {
+#ifdef __WIN32__
+ DWORD handles;
+ GetProcessHandleCount(GetCurrentProcess(), &handles);
+ fd_count = handles;
+#else
+ int i;
+ for (i = 0, fd_count = 0; i < 1024; i++)
+ if (fcntl(i, F_GETFD) >= 0) {
+ fd_count++;
+ }
+#endif
+ }
+
+ if (port_data->output_file)
+ replace_stdout(port_data->output_file);
+
+ if (port_data->fd_count)
+ reply(&fd_count, sizeof(fd_count));
+
if (port_data->no_packet_loop){
free(port_data);
exit(0);
}
- /*
- * If an output file was given, let it replace standard output.
- */
-
- if (port_data->output_file)
- replace_stdout(port_data->output_file);
-
ret = packet_loop();
if(port_data->io_buf_size > 0)
free(port_data->io_buf);
diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl
index b65a22a528..9b794be415 100644
--- a/erts/emulator/test/port_bif_SUITE.erl
+++ b/erts/emulator/test/port_bif_SUITE.erl
@@ -21,8 +21,8 @@
-module(port_bif_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, command/1,
+-export([all/0, suite/0, groups/0,
+ command/1,
command_e_1/1, command_e_2/1, command_e_3/1, command_e_4/1,
port_info1/1, port_info2/1,
port_info_os_pid/1, port_info_race/1,
@@ -30,11 +30,11 @@
-export([do_command_e_1/1, do_command_e_2/1, do_command_e_4/1]).
--export([init_per_testcase/2, end_per_testcase/2]).
+-include_lib("common_test/include/ct.hrl").
--include_lib("test_server/include/test_server.hrl").
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 10}}].
all() ->
[command, {group, port_info}, connect, control,
@@ -46,27 +46,6 @@ groups() ->
{port_info, [],
[port_info1, port_info2, port_info_os_pid, port_info_race]}].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-
-init_per_testcase(_Func, Config) when is_list(Config) ->
- Dog=test_server:timetrap(test_server:minutes(10)),
- [{watchdog, Dog}|Config].
-end_per_testcase(_Func, Config) when is_list(Config) ->
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog).
-
command(Config) when is_list(Config) ->
load_control_drv(Config),
@@ -87,17 +66,17 @@ do_command(P, Data) ->
{P,{data,Data0}} ->
case {list_to_binary(Data0),list_to_binary([Data])} of
{B,B} -> ok;
- _ -> test_server:fail({unexpected_data,Data0})
+ _ -> ct:fail({unexpected_data,Data0})
end;
Other ->
- test_server:fail({unexpected_message,Other})
+ ct:fail({unexpected_message,Other})
end.
%% port_command/2: badarg 1st arg
command_e_1(Config) when is_list(Config) ->
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
Program = filename:join(DataDir, "port_test"),
process_flag(trap_exit, true),
@@ -106,9 +85,9 @@ command_e_1(Config) when is_list(Config) ->
{'EXIT', Pid, {badarg, _}} when is_pid(Pid) ->
ok;
Other ->
- test_server:fail(Other)
+ ct:fail(Other)
after 10000 ->
- test_server:fail(timeout)
+ ct:fail(timeout)
end,
ok.
@@ -119,7 +98,7 @@ do_command_e_1(Program) ->
%% port_command/2: badarg 2nd arg
command_e_2(Config) when is_list(Config) ->
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
Program = filename:join(DataDir, "port_test"),
process_flag(trap_exit, true),
@@ -128,9 +107,9 @@ command_e_2(Config) when is_list(Config) ->
{'EXIT', Pid, {badarg, _}} when is_pid(Pid) ->
ok;
Other ->
- test_server:fail(Other)
+ ct:fail(Other)
after 10000 ->
- test_server:fail(timeout)
+ ct:fail(timeout)
end,
ok.
@@ -141,7 +120,7 @@ do_command_e_2(Program) ->
%% port_command/2: Posix signals trapped
command_e_3(Config) when is_list(Config) ->
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
Program = filename:join(DataDir, "port_test"),
process_flag(trap_exit, true),
@@ -152,15 +131,15 @@ command_e_3(Config) when is_list(Config) ->
{'EXIT', Port, einval} when is_port(Port) ->
ok;
Other ->
- test_server:fail(Other)
+ ct:fail(Other)
after 10000 ->
- test_server:fail(timeout)
+ ct:fail(timeout)
end,
ok.
%% port_command/2: Posix exit signals not trapped
command_e_4(Config) when is_list(Config) ->
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
Program = filename:join(DataDir, "port_test"),
process_flag(trap_exit, true),
@@ -169,9 +148,9 @@ command_e_4(Config) when is_list(Config) ->
{'EXIT', Pid, {einval, _}} when is_pid(Pid) ->
ok;
Other ->
- test_server:fail(Other)
+ ct:fail(Other)
after 10000 ->
- test_server:fail(timeout)
+ ct:fail(timeout)
end,
ok.
@@ -248,7 +227,7 @@ do_port_info_os_pid() ->
{os_pid, InfoOSPid} = erlang:port_info(P, os_pid),
EchoPidStr = receive
{P, {data, EchoPidStr0}} -> EchoPidStr0
- after 10000 -> test_server:fail(timeout)
+ after 10000 -> ct:fail(timeout)
end,
{ok, [EchoPid], []} = io_lib:fread("~u\n", EchoPidStr),
{value,{os_pid, InfoOSPid}}=lists:keysearch(os_pid, 1, A),
@@ -257,7 +236,7 @@ do_port_info_os_pid() ->
ok.
port_info_race(Config) when is_list(Config) ->
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
Program = filename:join(DataDir, "port_test"),
Top = self(),
P1 = open_port({spawn,Program}, [{packet,1}]),
@@ -283,10 +262,9 @@ output_test(_, _, Input, Output) when Output > 16#1fffffff ->
output_test(P, Bin, Input0, Output0) ->
erlang:port_command(P, Bin),
receive
- {P,{data,Bin}} -> ok;
- Other ->
- io:format("~p", [Other]),
- ?t:fail()
+ {P,{data,Bin}} -> ok;
+ Other ->
+ ct:fail("~p", [Other])
end,
Input = Input0 + size(Bin),
Output = Output0 + size(Bin),
@@ -296,8 +274,8 @@ output_test(P, Bin, Input0, Output0) ->
%% We can't test much here, but hopefully a debug-built emulator will crasch
%% if there is something wrong with the heap allocation.
case erlang:statistics(io) of
- {{input,In},{output,Out}} when is_integer(In), is_integer(Out) ->
- ok
+ {{input,In},{output,Out}} when is_integer(In), is_integer(Out) ->
+ ok
end,
output_test(P, Bin, Input, Output).
@@ -345,7 +323,7 @@ connect(Config) when is_list(Config) ->
exit(P, you_should_die),
receive
{'EXIT',RecPid,you_should_die} -> ok;
- Other -> ?line ?t:fail({bad_message,Other})
+ Other -> ct:fail({bad_message,Other})
end,
%% Done.
@@ -410,7 +388,7 @@ test_op(P, Op) ->
<<Op:32>> = list_to_binary(R).
echo_to_busy(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
+ ct:timetrap({seconds, 10}),
load_control_drv(Config),
P = open_port({spawn, control_drv}, []),
erlang:port_control(P, $b, [1]), % Set to busy.
@@ -422,11 +400,10 @@ echo_to_busy(Config) when is_list(Config) ->
{Echoer, done} ->
ok;
{Echoer, Other} ->
- test_server:fail(Other);
+ ct:fail(Other);
Other ->
- test_server:fail({unexpected_message, Other})
+ ct:fail({unexpected_message, Other})
end,
- test_server:timetrap_cancel(Dog),
ok.
echoer(P, ReplyTo) ->
@@ -451,7 +428,7 @@ echo(P, Size) ->
Packet = erlang:port_control(P, $e, [unaligned_sub_bin(Bin)]).
load_control_drv(Config) when is_list(Config) ->
- DataDir = ?config(data_dir, Config),
+ DataDir = proplists:get_value(data_dir, Config),
erl_ddll:start(),
ok = load_driver(DataDir, "control_drv").
@@ -485,14 +462,7 @@ random_char(Chars) ->
lists:nth(uniform(length(Chars)), Chars).
uniform(N) ->
- case get(random_seed) of
- undefined ->
- {X, Y, Z} = time(),
- random:seed(X, Y, Z);
- _ ->
- ok
- end,
- random:uniform(N).
+ rand:uniform(N).
unaligned_sub_bin(Bin0) ->
Bin1 = <<0:3,Bin0/binary,31:5>>,
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index 97aa5e573e..5bb216ff79 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -26,7 +26,7 @@
%% process_info/1,2
%% register/2 (partially)
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(heap_binary_size, 64).
@@ -41,6 +41,7 @@
process_info_2_list/1, process_info_lock_reschedule/1,
process_info_lock_reschedule2/1,
process_info_lock_reschedule3/1,
+ process_info_garbage_collection/1,
bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1,
process_status_exiting/1,
otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1,
@@ -66,7 +67,9 @@
-export([hangaround/2, processes_bif_test/0, do_processes/1,
processes_term_proc_list_test/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 9}}].
all() ->
[spawn_with_binaries, t_exit_1, {group, t_exit_2},
@@ -75,7 +78,9 @@ all() ->
process_info_other_dist_msg, process_info_2_list,
process_info_lock_reschedule,
process_info_lock_reschedule2,
- process_info_lock_reschedule3, process_status_exiting,
+ process_info_lock_reschedule3,
+ process_info_garbage_collection,
+ process_status_exiting,
bump_reductions, low_prio, yield, yield2, otp_4725,
bad_register, garbage_collect, process_info_messages,
process_flag_badarg, process_flag_heap_size,
@@ -113,7 +118,7 @@ init_per_suite(Config) ->
[{started_apps, A}|Config].
end_per_suite(Config) ->
- As = ?config(started_apps, Config),
+ As = proplists:get_value(started_apps, Config),
lists:foreach(fun (A) -> application:stop(A) end, As),
catch erts_debug:set_internal_state(available_internal_state, false),
Config.
@@ -125,12 +130,10 @@ end_per_group(_GroupName, Config) ->
Config.
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(10)),
- [{watchdog, Dog},{testcase, Func}|Config].
+ [{testcase, Func}|Config].
end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
+ ok.
fun_spawn(Fun) ->
spawn_link(erlang, apply, [Fun, []]).
@@ -155,11 +158,10 @@ binary_owner(Bin) when is_binary(Bin) ->
%% Tests exit/1 with a big message.
t_exit_1(Config) when is_list(Config) ->
+ ct:timetrap({seconds, 20}),
start_spawner(),
- Dog = test_server:timetrap(test_server:seconds(20)),
process_flag(trap_exit, true),
test_server:do_times(10, fun t_exit_1/0),
- test_server:timetrap_cancel(Dog),
stop_spawner(),
ok.
@@ -173,11 +175,10 @@ t_exit_1() ->
%% Tests exit/2 with a lot of data in the exit message.
t_exit_2_other(Config) when is_list(Config) ->
+ ct:timetrap({seconds, 20}),
start_spawner(),
- Dog = test_server:timetrap(test_server:seconds(20)),
process_flag(trap_exit, true),
test_server:do_times(10, fun t_exit_2_other/0),
- test_server:timetrap_cancel(Dog),
stop_spawner(),
ok.
@@ -191,34 +192,32 @@ t_exit_2_other() ->
%% Tests that exit(Pid, normal) does not kill another process.;
t_exit_2_other_normal(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(20)),
+ ct:timetrap({seconds, 20}),
process_flag(trap_exit, true),
Pid = fun_spawn(fun() -> receive x -> ok end end),
exit(Pid, normal),
receive
{'EXIT', Pid, Reason} ->
- test_server:fail({process_died, Reason})
+ ct:fail({process_died, Reason})
after 1000 ->
ok
end,
case process_info(Pid) of
undefined ->
- test_server:fail(process_died_on_normal);
+ ct:fail(process_died_on_normal);
List when is_list(List) ->
ok
end,
exit(Pid, kill),
- test_server:timetrap_cancel(Dog),
ok.
%% Tests that we can trap an exit message sent with exit/2 from
%% the same process.
self_exit(Config) when is_list(Config) ->
+ ct:timetrap({seconds, 10}),
start_spawner(),
- Dog = test_server:timetrap(test_server:seconds(10)),
process_flag(trap_exit, true),
test_server:do_times(200, fun self_exit/0),
- test_server:timetrap_cancel(Dog),
stop_spawner(),
ok.
@@ -237,7 +236,7 @@ normal_suicide_exit(Config) when is_list(Config) ->
Pid = fun_spawn(fun() -> exit(self(), normal) end),
receive
{'EXIT', Pid, normal} -> ok;
- Other -> test_server:fail({bad_message, Other})
+ Other -> ct:fail({bad_message, Other})
end.
%% Tests exit(self(), Term) is equivalent to exit(Term) for a process
@@ -248,7 +247,7 @@ abnormal_suicide_exit(Config) when is_list(Config) ->
Pid = fun_spawn(fun() -> exit(self(), Garbage) end),
receive
{'EXIT', Pid, Garbage} -> ok;
- Other -> test_server:fail({bad_message, Other})
+ Other -> ct:fail({bad_message, Other})
end.
%% Tests that exit(self(), die) cannot be catched.
@@ -257,21 +256,20 @@ t_exit_2_catch(Config) when is_list(Config) ->
Pid = fun_spawn(fun() -> catch exit(self(), die) end),
receive
{'EXIT', Pid, normal} ->
- test_server:fail(catch_worked);
+ ct:fail(catch_worked);
{'EXIT', Pid, die} ->
ok;
Other ->
- test_server:fail({bad_message, Other})
+ ct:fail({bad_message, Other})
end.
%% Tests trapping of an 'EXIT' message generated by a bad argument to
%% the abs/1 bif. The 'EXIT' message will intentionally be very big.
trap_exit_badarg(Config) when is_list(Config) ->
+ ct:timetrap({seconds, 10}),
start_spawner(),
- Dog = test_server:timetrap(test_server:seconds(10)),
process_flag(trap_exit, true),
test_server:do_times(10, fun trap_exit_badarg/0),
- test_server:timetrap_cancel(Dog),
stop_spawner(),
ok.
@@ -285,7 +283,7 @@ trap_exit_badarg() ->
ok;
Other ->
ok = io:format("Bad EXIT message: ~P", [Other, 30]),
- test_server:fail(bad_exit_message)
+ ct:fail(bad_exit_message)
end.
bad_guy(Arg) ->
@@ -317,10 +315,9 @@ big_binary(N, Acc) ->
%% Test receiving an EXIT message when spawning a BIF with bad arguments.
trap_exit_badarg_in_bif(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(10)),
+ ct:timetrap({seconds, 10}),
process_flag(trap_exit, true),
test_server:do_times(10, fun trap_exit_badarg_bif/0),
- test_server:timetrap_cancel(Dog),
ok.
trap_exit_badarg_bif() ->
@@ -329,7 +326,7 @@ trap_exit_badarg_bif() ->
{'EXIT', Pid, {badarg, _}} ->
ok;
Other ->
- test_server:fail({unexpected, Other})
+ ct:fail({unexpected, Other})
end.
%% The following sequences of events have crasched Beam.
@@ -342,15 +339,13 @@ trap_exit_badarg_bif() ->
%% 3) The process will crash the next time it executes 'receive'.
exit_and_timeout(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(20)),
+ ct:timetrap({seconds, 20}),
process_flag(trap_exit, true),
Parent = self(),
Low = fun_spawn(fun() -> eat_low(Parent) end),
High = fun_spawn(fun() -> eat_high(Low) end),
eat_wait_for(Low, High),
-
- test_server:timetrap_cancel(Dog),
ok.
@@ -361,7 +356,7 @@ eat_wait_for(Low, High) ->
{'EXIT', High, normal} ->
eat_wait_for(Low, High);
Other ->
- test_server:fail({bad_message, Other})
+ ct:fail({bad_message, Other})
end.
eat_low(_Parent) ->
@@ -394,14 +389,12 @@ loop(StopTime) ->
%% Tries to send two different exit messages to a process.
%% (The second one should be ignored.)
exit_twice(Config) when is_list(Config) ->
- Dog = test_server:timetrap(test_server:seconds(20)),
+ ct:timetrap({seconds, 20}),
process_flag(trap_exit, true),
Low = fun_spawn(fun etwice_low/0),
High = fun_spawn(fun() -> etwice_high(Low) end),
etwice_wait_for(Low, High),
-
- test_server:timetrap_cancel(Dog),
ok.
etwice_wait_for(Low, High) ->
@@ -409,11 +402,11 @@ etwice_wait_for(Low, High) ->
{'EXIT', Low, first} ->
ok;
{'EXIT', Low, Other} ->
- test_server:fail({wrong_exit_reason, Other});
+ ct:fail({wrong_exit_reason, Other});
{'EXIT', High, normal} ->
etwice_wait_for(Low, High);
Other ->
- test_server:fail({bad_message, Other})
+ ct:fail({bad_message, Other})
end.
etwice_low() ->
@@ -666,10 +659,6 @@ chk_pi_order([],[]) ->
chk_pi_order([{Arg, _}| Values], [Arg|Args]) ->
chk_pi_order(Values, Args).
-process_info_2_list(doc) ->
- [];
-process_info_2_list(suite) ->
- [];
process_info_2_list(Config) when is_list(Config) ->
Proc = spawn(fun () -> receive after infinity -> ok end end),
register(process_SUITE_process_info_2_list1, self()),
@@ -702,10 +691,6 @@ process_info_2_list(Config) when is_list(Config) ->
lists:foreach(fun ({backtrace, _}) -> ok end, V3),
ok.
-process_info_lock_reschedule(doc) ->
- [];
-process_info_lock_reschedule(suite) ->
- [];
process_info_lock_reschedule(Config) when is_list(Config) ->
%% We need a process that is running and an item that requires
%% process_info to take the main process lock.
@@ -738,7 +723,7 @@ process_info_lock_reschedule(Config) when is_list(Config) ->
exit(Target2, bang),
OkStatus;
{status, BadStatus} ->
- ?t:fail(BadStatus)
+ ct:fail(BadStatus)
end.
pi_loop(_Name, _Pid, 0) ->
@@ -747,10 +732,6 @@ pi_loop(Name, Pid, N) ->
{registered_name, Name} = process_info(Pid, registered_name),
pi_loop(Name, Pid, N-1).
-process_info_lock_reschedule2(doc) ->
- [];
-process_info_lock_reschedule2(suite) ->
- [];
process_info_lock_reschedule2(Config) when is_list(Config) ->
Parent = self(),
Fun = fun () ->
@@ -806,10 +787,6 @@ do_pi_msg_len(PT, AT) ->
lists:map(fun (_) -> ok end, [a,b,c,d]),
{message_queue_len, _} = process_info(element(2,PT), element(2,AT)).
-process_info_lock_reschedule3(doc) ->
- [];
-process_info_lock_reschedule3(suite) ->
- [];
process_info_lock_reschedule3(Config) when is_list(Config) ->
%% We need a process that is running and an item that requires
%% process_info to take the main process lock.
@@ -840,7 +817,7 @@ process_info_lock_reschedule3(Config) when is_list(Config) ->
exit(Target2, bang),
OkStatus;
{status, BadStatus} ->
- ?t:fail(BadStatus)
+ ct:fail(BadStatus)
end.
process_status_exiting(Config) when is_list(Config) ->
@@ -932,6 +909,48 @@ start_spawner() ->
stop_spawner() ->
ok.
+%% Tests erlang:process_info(Pid, garbage_collection_info)
+process_info_garbage_collection(_Config) ->
+ Parent = self(),
+ Pid = spawn_link(
+ fun() ->
+ receive go -> ok end,
+ (fun F(0) ->
+ Parent ! deep,
+ receive ok -> ok end,
+ [];
+ F(N) ->
+ timer:sleep(1),
+ [lists:seq(1,100) | F(N-1)]
+ end)(1000),
+ Parent ! shallow,
+ receive done -> ok end
+ end),
+ {garbage_collection_info, Before} =
+ erlang:process_info(Pid, garbage_collection_info),
+ Pid ! go, receive deep -> ok end,
+ {_, Deep} = erlang:process_info(Pid, garbage_collection_info),
+ Pid ! ok, receive shallow -> ok end,
+ {_, After} = erlang:process_info(Pid, garbage_collection_info),
+ Pid ! done,
+
+ %% Do some general checks to see if everything seems to be roughly correct
+ ct:log("Before: ~p",[Before]),
+ ct:log("Deep: ~p",[Deep]),
+ ct:log("After: ~p",[After]),
+
+ %% Check stack_size
+ true = proplists:get_value(stack_size, Before) < proplists:get_value(stack_size, Deep),
+ true = proplists:get_value(stack_size, After) < proplists:get_value(stack_size, Deep),
+
+ %% Check used heap size
+ true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before)
+ < proplists:get_value(heap_size, Deep) + proplists:get_value(old_heap_size, Deep),
+ true = proplists:get_value(heap_size, Before) + proplists:get_value(old_heap_size, Before)
+ < proplists:get_value(heap_size, After) + proplists:get_value(old_heap_size, After),
+
+ ok.
+
%% Tests erlang:bump_reductions/1.
bump_reductions(Config) when is_list(Config) ->
erlang:garbage_collect(),
@@ -942,10 +961,10 @@ bump_reductions(Config) when is_list(Config) ->
case R2-R1 of
Diff when Diff < 100 ->
ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]),
- test_server:fail({small_diff, Diff});
+ ct:fail({small_diff, Diff});
Diff when Diff > 110 ->
ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]),
- test_server:fail({big_diff, Diff});
+ ct:fail({big_diff, Diff});
Diff ->
io:format("~p\n", [Diff]),
ok
@@ -1032,8 +1051,7 @@ make_unaligned_sub_binary(Bin0) ->
<<0:3,Bin:Sz/binary,31:5>> = id(Bin1),
Bin.
-yield(doc) ->
- "Tests erlang:yield/1.";
+%% Tests erlang:yield/1
yield(Config) when is_list(Config) ->
case catch erlang:system_info(modified_timing_level) of
Level when is_integer(Level) ->
@@ -1074,7 +1092,7 @@ yield_test() ->
{Diff, _} ->
ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w",
[R1, R2, Schedcnt]),
- test_server:fail({measurement_error, Diff, Schedcnt})
+ ct:fail({measurement_error, Diff, Schedcnt})
end.
call_yield() ->
@@ -1111,8 +1129,6 @@ schedcnt(stop, {Ref, Pid}) when is_reference(Ref), is_pid(Pid) ->
Cnt
end.
-yield2(doc) -> [];
-yield2(suite) -> [];
yield2(Config) when is_list(Config) ->
Me = self(),
Go = make_ref(),
@@ -1163,7 +1179,7 @@ yield2(Config) when is_list(Config) ->
io:format("Reductions = ~p~n", [Reductions]),
ok;
{RedDiff, Reductions} ->
- ?t:fail({unexpected_reduction_count, Reductions})
+ ct:fail({unexpected_reduction_count, Reductions})
end,
none = next_tmsg(P),
@@ -1204,8 +1220,6 @@ fail_register(Name, Process) ->
{'EXIT',{badarg,_}} = (catch Name ! anything_goes),
ok.
-garbage_collect(doc) -> [];
-garbage_collect(suite) -> [];
garbage_collect(Config) when is_list(Config) ->
Prio = process_flag(priority, high),
true = erlang:garbage_collect(),
@@ -1244,10 +1258,7 @@ garbage_collect(Config) when is_list(Config) ->
process_flag(priority, Prio),
ok.
-process_info_messages(doc) ->
- ["This used to cause the nofrag emulator to dump core"];
-process_info_messages(suite) ->
- [];
+%% This used to cause the nofrag emulator to dump core
process_info_messages(Config) when is_list(Config) ->
process_info_messages_test(),
ok.
@@ -1305,10 +1316,6 @@ process_info_messages_test() ->
chk_badarg(Fun) ->
try Fun(), exit(no_badarg) catch error:badarg -> ok end.
-process_flag_badarg(doc) ->
- [];
-process_flag_badarg(suite) ->
- [];
process_flag_badarg(Config) when is_list(Config) ->
chk_badarg(fun () -> process_flag(gurka, banan) end),
chk_badarg(fun () -> process_flag(trap_exit, gurka) end),
@@ -1326,8 +1333,6 @@ process_flag_badarg(Config) when is_list(Config) ->
-include_lib("stdlib/include/ms_transform.hrl").
-otp_6237(doc) -> [];
-otp_6237(suite) -> [];
otp_6237(Config) when is_list(Config) ->
Slctrs = lists:map(fun (_) ->
spawn_link(fun () ->
@@ -1394,10 +1399,6 @@ otp_6237_select_loop() ->
conses_per_red,
debug_level}).
-processes_large_tab(doc) ->
- [];
-processes_large_tab(suite) ->
- [];
processes_large_tab(Config) when is_list(Config) ->
sys_mem_cond_run(2048, fun () -> processes_large_tab_test(Config) end).
@@ -1425,7 +1426,7 @@ processes_large_tab_test(Config) ->
#ptab_list_bif_info{debug_level = Lvl} when Lvl > MaxDbgLvl ->
20;
#ptab_list_bif_info{debug_level = Lvl} when Lvl < 0 ->
- ?t:fail({debug_level, Lvl});
+ ct:fail({debug_level, Lvl});
#ptab_list_bif_info{debug_level = Lvl} ->
Lvl
end,
@@ -1443,15 +1444,11 @@ processes_large_tab_test(Config) ->
[processes_bif_info]) of
#ptab_list_bif_info{tab_chunks = Chunks} when is_integer(Chunks),
Chunks > 1 -> ok;
- PBInfo -> ?t:fail(PBInfo)
+ PBInfo -> ct:fail(PBInfo)
end,
stop_node(LargeNode),
chk_processes_bif_test_res(Res).
-processes_default_tab(doc) ->
- [];
-processes_default_tab(suite) ->
- [];
processes_default_tab(Config) when is_list(Config) ->
sys_mem_cond_run(1024, fun () -> processes_default_tab_test(Config) end).
@@ -1461,10 +1458,6 @@ processes_default_tab_test(Config) ->
stop_node(DefaultNode),
chk_processes_bif_test_res(Res).
-processes_small_tab(doc) ->
- [];
-processes_small_tab(suite) ->
- [];
processes_small_tab(Config) when is_list(Config) ->
{ok, SmallNode} = start_node(Config, "+P 1024"),
Res = rpc:call(SmallNode, ?MODULE, processes_bif_test, []),
@@ -1473,10 +1466,6 @@ processes_small_tab(Config) when is_list(Config) ->
true = PBInfo#ptab_list_bif_info.tab_chunks < 10,
chk_processes_bif_test_res(Res).
-processes_this_tab(doc) ->
- [];
-processes_this_tab(suite) ->
- [];
processes_this_tab(Config) when is_list(Config) ->
Mem = case {erlang:system_info(build_type),
erlang:system_info(allocator)} of
@@ -1490,7 +1479,7 @@ processes_this_tab(Config) when is_list(Config) ->
chk_processes_bif_test_res(ok) -> ok;
chk_processes_bif_test_res({comment, _} = Comment) -> Comment;
-chk_processes_bif_test_res(Failure) -> ?t:fail(Failure).
+chk_processes_bif_test_res(Failure) -> ct:fail(Failure).
print_processes_bif_info(#ptab_list_bif_info{min_start_reds = MinStartReds,
tab_chunks = TabChunks,
@@ -1501,7 +1490,7 @@ print_processes_bif_info(#ptab_list_bif_info{min_start_reds = MinStartReds,
term_procs_max_reds = TPMaxReds,
conses_per_red = ConsesPerRed,
debug_level = DbgLvl}) ->
- ?t:format("processes/0 bif info on node ~p:~n"
+ io:format("processes/0 bif info on node ~p:~n"
"Min start reductions = ~p~n"
"Process table chunks = ~p~n"
"Process table chunks size = ~p~n"
@@ -1542,7 +1531,7 @@ processes_unexpected_result(CorrectProcs, Procs) ->
status,
priority],
MissingProcs = CorrectProcs -- Procs,
- ?t:format("Missing processes: ~p",
+ io:format("Missing processes: ~p",
[lists:map(fun (Pid) ->
[{pid, Pid}
| case process_info(Pid, ProcInfo) of
@@ -1552,7 +1541,7 @@ processes_unexpected_result(CorrectProcs, Procs) ->
end,
MissingProcs)]),
SuperfluousProcs = Procs -- CorrectProcs,
- ?t:format("Superfluous processes: ~p",
+ io:format("Superfluous processes: ~p",
[lists:map(fun (Pid) ->
[{pid, Pid}
| case process_info(Pid, ProcInfo) of
@@ -1561,7 +1550,7 @@ processes_unexpected_result(CorrectProcs, Procs) ->
end]
end,
SuperfluousProcs)]),
- ?t:fail(unexpected_result).
+ ct:fail(unexpected_result).
hangaround(Cleaner, Type) ->
%% Type is only used to distinguish different processes from
@@ -1666,7 +1655,7 @@ do_processes_bif_test(WantReds, DieTest, Processes) ->
DoIt = make_ref(),
GetGoing = make_ref(),
{NoTestProcs, TestProcs} = spawn_initial_hangarounds(Cleaner),
- ?t:format("Testing with ~p processes~n", [NoTestProcs]),
+ io:format("Testing with ~p processes~n", [NoTestProcs]),
SpawnHangAround = fun () ->
spawn(?MODULE, hangaround, [Cleaner, new_hangaround])
end,
@@ -1708,7 +1697,7 @@ do_processes_bif_test(WantReds, DieTest, Processes) ->
Procs = lists:sort(Procs0),
CorrectProcs = lists:sort(CorrectProcs0),
LengthCorrectProcs = length(CorrectProcs),
- ?t:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]),
+ io:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]),
true = LengthCorrectProcs > NoTestProcs,
case CorrectProcs =:= Procs of
true ->
@@ -1729,12 +1718,12 @@ do_processes_bif_test(WantReds, DieTest, Processes) ->
do_processes_bif_die_test(false, _Processes) ->
- ?t:format("Skipping test killing process executing processes/0~n",[]),
+ io:format("Skipping test killing process executing processes/0~n",[]),
ok;
do_processes_bif_die_test(true, Processes) ->
do_processes_bif_die_test(5, Processes);
do_processes_bif_die_test(N, Processes) ->
- ?t:format("Doing test killing process executing processes/0~n",[]),
+ io:format("Doing test killing process executing processes/0~n",[]),
try
Tester = self(),
Oooh_Nooooooo = make_ref(),
@@ -1784,8 +1773,8 @@ do_processes_bif_die_test(N, Processes) ->
ok
catch
throw:{kill_in_trap, R} when N > 0 ->
- ?t:format("Failed to kill in trap: ~p~n", [R]),
- ?t:format("Trying again~n", []),
+ io:format("Failed to kill in trap: ~p~n", [R]),
+ io:format("Trying again~n", []),
do_processes_bif_die_test(N-1, Processes)
end.
@@ -1815,7 +1804,7 @@ wait_until_system_recover(Tmr) ->
receive
{timeout, Tmr, _} ->
Comment = "WARNING: Test processes still hanging around!",
- ?t:format("~s~n", [Comment]),
+ io:format("~s~n", [Comment]),
put(processes_bif_testcase_comment, Comment),
lists:foreach(
fun (P) when P == self() ->
@@ -1823,7 +1812,7 @@ wait_until_system_recover(Tmr) ->
(P) ->
case process_info(P, initial_call) of
{initial_call,{?MODULE, _, _} = MFA} ->
- ?t:format("~p ~p~n", [P, MFA]);
+ io:format("~p ~p~n", [P, MFA]);
{initial_call,{_, _, _}} ->
ok;
undefined ->
@@ -1839,10 +1828,6 @@ wait_until_system_recover(Tmr) ->
receive {timeout, Tmr, _} -> ok after 0 -> ok end,
ok.
-processes_last_call_trap(doc) ->
- [];
-processes_last_call_trap(suite) ->
- [];
processes_last_call_trap(Config) when is_list(Config) ->
enable_internal_state(),
Processes = fun () -> processes() end,
@@ -1865,10 +1850,6 @@ processes_last_call_trap(Config) when is_list(Config) ->
my_processes() ->
processes().
-processes_apply_trap(doc) ->
- [];
-processes_apply_trap(suite) ->
- [];
processes_apply_trap(Config) when is_list(Config) ->
enable_internal_state(),
PBInfo = erts_debug:get_internal_state(processes_bif_info),
@@ -1883,10 +1864,6 @@ processes_apply_trap(Config) when is_list(Config) ->
apply(erlang, processes, [])
end, lists:seq(1,100)).
-processes_gc_trap(doc) ->
- [];
-processes_gc_trap(suite) ->
- [];
processes_gc_trap(Config) when is_list(Config) ->
Tester = self(),
enable_internal_state(),
@@ -1925,10 +1902,6 @@ processes_gc_trap(Config) when is_list(Config) ->
exit(Suspendee, bang),
ok.
-process_flag_heap_size(doc) ->
- [];
-process_flag_heap_size(suite) ->
- [];
process_flag_heap_size(Config) when is_list(Config) ->
HSize = 2586, % must be gc fib+ number
VHSize = 318187, % must be gc fib+ number
@@ -1940,10 +1913,6 @@ process_flag_heap_size(Config) when is_list(Config) ->
VHSize = erlang:process_flag(min_bin_vheap_size, OldVHmin),
ok.
-spawn_opt_heap_size(doc) ->
- [];
-spawn_opt_heap_size(suite) ->
- [];
spawn_opt_heap_size(Config) when is_list(Config) ->
HSize = 987, % must be gc fib+ number
VHSize = 46422, % must be gc fib+ number
@@ -1954,10 +1923,6 @@ spawn_opt_heap_size(Config) when is_list(Config) ->
Pid ! stop,
ok.
-processes_term_proc_list(doc) ->
- [];
-processes_term_proc_list(suite) ->
- [];
processes_term_proc_list(Config) when is_list(Config) ->
Tester = self(),
as_expected = processes_term_proc_list_test(false),
@@ -2107,24 +2072,12 @@ processes_term_proc_list_test(MustChk) ->
as_expected.
-otp_7738_waiting(doc) ->
- [];
-otp_7738_waiting(suite) ->
- [];
otp_7738_waiting(Config) when is_list(Config) ->
otp_7738_test(waiting).
-otp_7738_suspended(doc) ->
- [];
-otp_7738_suspended(suite) ->
- [];
otp_7738_suspended(Config) when is_list(Config) ->
otp_7738_test(suspended).
-otp_7738_resume(doc) ->
- [];
-otp_7738_resume(suite) ->
- [];
otp_7738_resume(Config) when is_list(Config) ->
otp_7738_test(resume).
@@ -2193,8 +2146,8 @@ do_otp_7738_test(Type) ->
ok
after 2000 ->
I = process_info(R, [status, message_queue_len]),
- ?t:format("~p~n", [I]),
- ?t:fail(no_progress)
+ io:format("~p~n", [I]),
+ ct:fail(no_progress)
end,
ok.
@@ -2281,7 +2234,7 @@ no_priority_inversion2(Config) when is_list(Config) ->
RH = request_gc(PL, high),
receive
{garbage_collect, _, _} ->
- ?t:fail(unexpected_gc)
+ ct:fail(unexpected_gc)
after 1000 ->
ok
end,
@@ -2390,7 +2343,7 @@ gc_request_when_gc_disabled(Config) when is_list(Config) ->
async = garbage_collect(P, [{async, ReqId}]),
receive
{garbage_collect, ReqId, Result} ->
- ?t:fail({unexpected_gc, Result});
+ ct:fail({unexpected_gc, Result});
{P, gc_state, true} ->
ok
end,
@@ -2460,15 +2413,15 @@ start_node(Config, Args) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
- ++ atom_to_list(?config(testcase, Config))
+ ++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
++ integer_to_list(erlang:system_time(seconds))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
- ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
+ test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
enable_internal_state() ->
case catch erts_debug:get_internal_state(available_internal_state) of
diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl
index 9a0f034e72..6da7da04de 100644
--- a/erts/emulator/test/random_iolist.erl
+++ b/erts/emulator/test/random_iolist.erl
@@ -36,7 +36,7 @@ run2(Iter,Fun1,Fun2) ->
compare2(Iter,Fun1,Fun2).
random_byte() ->
- random:uniform(256) - 1.
+ rand:uniform(256) - 1.
random_list(0,Acc) ->
Acc;
@@ -45,7 +45,7 @@ random_list(N,Acc) ->
random_binary(N) ->
B = list_to_binary(random_list(N,[])),
- case {random:uniform(2),size(B)} of
+ case {rand:uniform(2),size(B)} of
{2,M} when M > 1 ->
S = M-1,
<<_:3,C:S/binary,_:5>> = B,
@@ -57,7 +57,7 @@ random_list(N) ->
random_list(N,[]).
front() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
10 ->
false;
_ ->
@@ -65,7 +65,7 @@ front() ->
end.
any_type() ->
- case random:uniform(10) of
+ case rand:uniform(10) of
1 ->
list;
2 ->
@@ -77,7 +77,7 @@ any_type() ->
end.
tail_type() ->
- case random:uniform(5) of
+ case rand:uniform(5) of
1 ->
list;
2 ->
@@ -90,9 +90,9 @@ random_length(N) ->
UpperLimit = 255,
case N of
M when M > UpperLimit ->
- random:uniform(UpperLimit+1) - 1;
+ rand:uniform(UpperLimit+1) - 1;
_ ->
- random:uniform(N+1) - 1
+ rand:uniform(N+1) - 1
end.
random_iolist(0,Acc) ->
@@ -139,7 +139,7 @@ random_iolist(N) ->
standard_seed() ->
- random:seed(1201,855653,380975).
+ rand:seed(exsplus, {1201,855653,380975}).
do_comp(List,F1,F2) ->
X = F1(List),
diff --git a/erts/emulator/test/receive_SUITE.erl b/erts/emulator/test/receive_SUITE.erl
index ccae0df72e..6097e54219 100644
--- a/erts/emulator/test/receive_SUITE.erl
+++ b/erts/emulator/test/receive_SUITE.erl
@@ -22,15 +22,14 @@
%% Tests receive after.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
call_with_huge_message_queue/1,receive_in_between/1]).
--export([init_per_testcase/2,end_per_testcase/2]).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 3}}].
all() ->
[call_with_huge_message_queue, receive_in_between].
@@ -38,27 +37,6 @@ all() ->
groups() ->
[].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(3)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
call_with_huge_message_queue(Config) when is_list(Config) ->
Pid = spawn_link(fun echo_loop/0),
@@ -77,8 +55,7 @@ call_with_huge_message_queue(Config) when is_list(Config) ->
Q when Q < 10 ->
ok;
Q ->
- io:format("Best Q = ~p", [Q]),
- ?t:fail()
+ ct:fail("Best Q = ~p", [Q])
end,
ok.
diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl
index 1042c23d65..287a2ffb73 100644
--- a/erts/emulator/test/ref_SUITE.erl
+++ b/erts/emulator/test/ref_SUITE.erl
@@ -20,54 +20,29 @@
-module(ref_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2]).
+-export([all/0, suite/0]).
-export([wrap_1/1]).
-export([loop_ref/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-init_per_testcase(_, Config) ->
- ?line Dog=test_server:timetrap(test_server:minutes(2)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_, Config) ->
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
all() ->
[wrap_1].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-wrap_1(doc) -> "Check that refs don't wrap around easily.";
+%% Check that refs don't wrap around easily.
wrap_1(Config) when is_list(Config) ->
- ?line spawn_link(?MODULE, loop_ref, [self()]),
- ?line receive
- done ->
- test_server:fail(wrapfast)
- after 30000 ->
- ok
- end,
+ spawn_link(?MODULE, loop_ref, [self()]),
+ receive
+ done ->
+ ct:fail(wrapfast)
+ after 30000 ->
+ ok
+ end,
ok.
loop_ref(Parent) ->
diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl
index 5ecca0f547..ad8a9c29f3 100644
--- a/erts/emulator/test/register_SUITE.erl
+++ b/erts/emulator/test/register_SUITE.erl
@@ -23,47 +23,20 @@
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%-compile(export_all).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2, end_per_testcase/2]).
+-export([all/0, suite/0]).
-export([otp_8099/1]).
--define(DEFAULT_TIMEOUT, ?t:minutes(2)).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
all() ->
[otp_8099].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Case, Config) when is_list(Config) ->
- Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, Dog}, {testcase, Case} | Config].
-
-end_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
- ok.
-
%%
%% Test cases
%%
@@ -83,25 +56,20 @@ otp_8099(Config) when is_list(Config) ->
otp_8099_test(0) ->
ok;
otp_8099_test(N) ->
- ?line P = spawn(fun () -> otp_8099_proc() end),
- ?line case catch register(?OTP_8099_NAME, P) of
+ P = spawn(fun () -> otp_8099_proc() end),
+ case catch register(?OTP_8099_NAME, P) of
true ->
- ?line ok;
+ ok;
_ ->
- ?line OP = whereis(?OTP_8099_NAME),
- ?line (catch unregister(?OTP_8099_NAME)),
- ?line (catch exit(OP, kill)),
- ?line true = (catch register(?OTP_8099_NAME, P))
+ OP = whereis(?OTP_8099_NAME),
+ (catch unregister(?OTP_8099_NAME)),
+ (catch exit(OP, kill)),
+ true = (catch register(?OTP_8099_NAME, P))
end,
- ?line P = whereis(?OTP_8099_NAME),
- ?line exit(P, kill),
- ?line otp_8099_test(N-1).
+ P = whereis(?OTP_8099_NAME),
+ exit(P, kill),
+ otp_8099_test(N-1).
otp_8099_proc() ->
receive _ -> ok end,
otp_8099_proc().
-
-%%
-%% Utils
-%%
-
diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl
index 544d841f16..bbdc2e6688 100644
--- a/erts/emulator/test/save_calls_SUITE.erl
+++ b/erts/emulator/test/save_calls_SUITE.erl
@@ -20,12 +20,9 @@
-module(save_calls_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,
- init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2]).
+-export([all/0, suite/0, init_per_testcase/2,end_per_testcase/2]).
-export([save_calls_1/1,dont_break_reductions/1]).
@@ -36,36 +33,21 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[save_calls_1, dont_break_reductions].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
init_per_testcase(dont_break_reductions,Config) ->
%% Skip on --enable-native-libs as hipe rescedules after each
%% function call.
case erlang:system_info(hipe_architecture) of
- undefined ->
- Config;
- Architecture ->
- {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists),
- ChunkName = hipe_unified_loader:chunk_name(Architecture),
- NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]),
- case NativeChunk of
- {ok,{_,[{_,Bin}]}} when is_binary(Bin) ->
- {skip,"Does not work for --enable-native-libs"};
- {error, beam_lib, _} -> Config
- end
+ undefined ->
+ Config;
+ Architecture ->
+ {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists),
+ ChunkName = hipe_unified_loader:chunk_name(Architecture),
+ NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]),
+ case NativeChunk of
+ {ok,{_,[{_,Bin}]}} when is_binary(Bin) ->
+ {skip,"Does not work for --enable-native-libs"};
+ {error, beam_lib, _} -> Config
+ end
end;
init_per_testcase(_,Config) ->
Config.
@@ -73,91 +55,88 @@ init_per_testcase(_,Config) ->
end_per_testcase(_,_Config) ->
ok.
-dont_break_reductions(suite) ->
- [];
-dont_break_reductions(doc) ->
- ["Check that save_calls dont break reduction-based scheduling"];
+%% Check that save_calls dont break reduction-based scheduling
dont_break_reductions(Config) when is_list(Config) ->
- ?line RPS1 = reds_per_sched(0),
- ?line RPS2 = reds_per_sched(20),
- ?line Diff = abs(RPS1 - RPS2),
- ?line true = (Diff < (0.05 * RPS1)),
+ RPS1 = reds_per_sched(0),
+ RPS2 = reds_per_sched(20),
+ Diff = abs(RPS1 - RPS2),
+ true = (Diff < (0.05 * RPS1)),
ok.
reds_per_sched(SaveCalls) ->
- ?line Parent = self(),
- ?line HowMany = 10000,
- ?line Pid = spawn(fun() ->
- process_flag(save_calls,SaveCalls),
- receive
- go ->
- carmichaels_below(HowMany),
- Parent ! erlang:process_info(self(),reductions)
- end
- end),
- ?line TH = spawn(fun() -> trace_handler(0,Parent,Pid) end),
- ?line erlang:trace(Pid, true,[running,procs,{tracer,TH}]),
- ?line Pid ! go,
- ?line {Sched,Reds} = receive
- {accumulated,X} ->
- receive {reductions,Y} ->
- {X,Y}
- after 30000 ->
- timeout
- end
- after 30000 ->
- timeout
- end,
- ?line Reds div Sched.
+ Parent = self(),
+ HowMany = 10000,
+ Pid = spawn(fun() ->
+ process_flag(save_calls,SaveCalls),
+ receive
+ go ->
+ carmichaels_below(HowMany),
+ Parent ! erlang:process_info(self(),reductions)
+ end
+ end),
+ TH = spawn(fun() -> trace_handler(0,Parent,Pid) end),
+ erlang:trace(Pid, true,[running,procs,{tracer,TH}]),
+ Pid ! go,
+ {Sched,Reds} = receive
+ {accumulated,X} ->
+ receive {reductions,Y} ->
+ {X,Y}
+ after 30000 ->
+ timeout
+ end
+ after 30000 ->
+ timeout
+ end,
+ Reds div Sched.
trace_handler(Acc,Parent,Client) ->
receive
- {trace,Client,out,_} ->
- trace_handler(Acc+1,Parent,Client);
- {trace,Client,exit,_} ->
- Parent ! {accumulated, Acc};
- _ ->
- trace_handler(Acc,Parent,Client)
+ {trace,Client,out,_} ->
+ trace_handler(Acc+1,Parent,Client);
+ {trace,Client,exit,_} ->
+ Parent ! {accumulated, Acc};
+ _ ->
+ trace_handler(Acc,Parent,Client)
after 10000 ->
- ok
+ ok
end.
-save_calls_1(doc) -> "Test call saving.";
+%% Test call saving.
save_calls_1(Config) when is_list(Config) ->
case test_server:is_native(?MODULE) of
- true -> {skipped,"Native code"};
- false -> save_calls_1()
+ true -> {skipped,"Native code"};
+ false -> save_calls_1()
end.
-
+
save_calls_1() ->
- ?line erlang:process_flag(self(), save_calls, 0),
- ?line {last_calls, false} = process_info(self(), last_calls),
-
- ?line erlang:process_flag(self(), save_calls, 10),
- ?line {last_calls, _L1} = process_info(self(), last_calls),
- ?line ?MODULE:do_bipp(),
- ?line {last_calls, L2} = process_info(self(), last_calls),
- ?line L21 = lists:filter(fun is_local_function/1, L2),
- ?line case L21 of
- [{?MODULE,do_bipp,0},
- timeout,
- 'send',
- {?MODULE,do_bopp,1},
- 'receive',
- timeout,
- {?MODULE,do_bepp,0}] ->
- ok;
- X ->
- test_server:fail({l21, X})
- end,
-
- ?line erlang:process_flag(self(), save_calls, 10),
- ?line {last_calls, L3} = process_info(self(), last_calls),
- ?line L31 = lists:filter(fun is_local_function/1, L3),
- ?line [] = L31,
+ erlang:process_flag(self(), save_calls, 0),
+ {last_calls, false} = process_info(self(), last_calls),
+
+ erlang:process_flag(self(), save_calls, 10),
+ {last_calls, _L1} = process_info(self(), last_calls),
+ ?MODULE:do_bipp(),
+ {last_calls, L2} = process_info(self(), last_calls),
+ L21 = lists:filter(fun is_local_function/1, L2),
+ case L21 of
+ [{?MODULE,do_bipp,0},
+ timeout,
+ 'send',
+ {?MODULE,do_bopp,1},
+ 'receive',
+ timeout,
+ {?MODULE,do_bepp,0}] ->
+ ok;
+ X ->
+ ct:fail({l21, X})
+ end,
+
+ erlang:process_flag(self(), save_calls, 10),
+ {last_calls, L3} = process_info(self(), last_calls),
+ L31 = lists:filter(fun is_local_function/1, L3),
+ [] = L31,
ok.
do_bipp() ->
@@ -172,7 +151,7 @@ do_bapp() ->
do_bopp(T) ->
receive
- X -> X
+ X -> X
after T -> ok
end.
@@ -189,25 +168,25 @@ is_local_function(_) ->
% Number crunching for reds test.
carmichaels_below(N) ->
- random:seed(3172,9814,20125),
+ rand:seed(exsplus, {3172,9814,20125}),
carmichaels_below(1,N).
carmichaels_below(N,N2) when N >= N2 ->
0;
carmichaels_below(N,N2) ->
X = case fast_prime(N,10) of
- false -> 0;
- true ->
- case fast_prime2(N,10) of
- true ->
- %io:format("Prime: ~p~n",[N]),
- 0;
- false ->
- io:format("Carmichael: ~p (dividable by ~p)~n",
- [N,smallest_divisor(N)]),
- 1
- end
- end,
+ false -> 0;
+ true ->
+ case fast_prime2(N,10) of
+ true ->
+ %io:format("Prime: ~p~n",[N]),
+ 0;
+ false ->
+ io:format("Carmichael: ~p (dividable by ~p)~n",
+ [N,smallest_divisor(N)]),
+ 1
+ end
+ end,
X+carmichaels_below(N+2,N2).
expmod(_,E,_) when E == 0 ->
@@ -219,7 +198,7 @@ expmod(Base,Exp,Mod) ->
(Base * expmod(Base,Exp - 1,Mod)) rem Mod.
uniform(N) ->
- random:uniform(N-1).
+ rand:uniform(N-1).
fermat(N) ->
R = uniform(N),
@@ -231,30 +210,30 @@ do_fast_prime(_N,0) ->
true;
do_fast_prime(N,Times) ->
case fermat(N) of
- true ->
- do_fast_prime(N,Times-1);
- false ->
- false
+ true ->
+ do_fast_prime(N,Times-1);
+ false ->
+ false
end.
-
+
fast_prime(N,T) ->
do_fast_prime(N,T).
expmod2(_,E,_) when E == 0 ->
1;
expmod2(Base,Exp,Mod) when (Exp rem 2) == 0 ->
-%% Uncomment the code below to simulate scheduling bug!
-% case erlang:process_info(self(),last_calls) of
-% {last_calls,false} -> ok;
-% _ -> erlang:yield()
-% end,
+ %% Uncomment the code below to simulate scheduling bug!
+ % case erlang:process_info(self(),last_calls) of
+ % {last_calls,false} -> ok;
+ % _ -> erlang:yield()
+ % end,
X = expmod2(Base,Exp div 2,Mod),
Y=(X*X) rem Mod,
if
- Y == 1, X =/= 1, X =/= (Mod - 1) ->
- 0;
- true ->
- Y rem Mod
+ Y == 1, X =/= 1, X =/= (Mod - 1) ->
+ 0;
+ true ->
+ Y rem Mod
end;
expmod2(Base,Exp,Mod) ->
(Base * expmod2(Base,Exp - 1,Mod)) rem Mod.
@@ -269,12 +248,12 @@ do_fast_prime2(_N,0) ->
true;
do_fast_prime2(N,Times) ->
case miller_rabbin(N) of
- true ->
- do_fast_prime2(N,Times-1);
- false ->
- false
+ true ->
+ do_fast_prime2(N,Times-1);
+ false ->
+ false
end.
-
+
fast_prime2(N,T) ->
do_fast_prime2(N,T).
@@ -283,17 +262,16 @@ smallest_divisor(N) ->
find_divisor(N,TD) ->
if
- TD*TD > N ->
- N;
- true ->
- case divides(TD,N) of
- true ->
- TD;
- false ->
- find_divisor(N,TD+1)
- end
+ TD*TD > N ->
+ N;
+ true ->
+ case divides(TD,N) of
+ true ->
+ TD;
+ false ->
+ find_divisor(N,TD+1)
+ end
end.
divides(A,B) ->
(B rem A) == 0.
-
diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl
index 986a73ebb1..64c280b198 100644
--- a/erts/emulator/test/scheduler_SUITE.erl
+++ b/erts/emulator/test/scheduler_SUITE.erl
@@ -31,12 +31,12 @@
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%-compile(export_all).
--export([all/0, suite/0,groups/0,init_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2, end_per_testcase/2, end_per_suite/1]).
+-export([all/0, suite/0, groups/0,
+ init_per_suite/1, end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2]).
-export([equal/1,
few_low/1,
@@ -54,23 +54,25 @@
sct_cmd/1,
sbt_cmd/1,
scheduler_threads/1,
+ scheduler_suspend_basic/1,
scheduler_suspend/1,
dirty_scheduler_threads/1,
+ dirty_scheduler_exit/1,
reader_groups/1]).
--define(DEFAULT_TIMEOUT, ?t:minutes(15)).
-
--define(MIN_SCHEDULER_TEST_TIMEOUT, ?t:minutes(1)).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 15}}].
all() ->
[equal, few_low, many_low, equal_with_part_time_high,
equal_with_part_time_max,
equal_and_high_with_part_time_max, equal_with_high,
- equal_with_high_max, bound_process,
- {group, scheduler_bind}, scheduler_threads, scheduler_suspend,
- dirty_scheduler_threads,
+ equal_with_high_max,
+ bound_process,
+ {group, scheduler_bind}, scheduler_threads,
+ scheduler_suspend_basic, scheduler_suspend,
+ dirty_scheduler_threads, dirty_scheduler_exit,
reader_groups].
groups() ->
@@ -85,12 +87,6 @@ end_per_suite(Config) ->
catch erts_debug:set_internal_state(available_internal_state, false),
Config.
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
init_per_testcase(update_cpu_info, Config) ->
case os:find_executable("taskset") of
false ->
@@ -102,15 +98,12 @@ init_per_testcase(Case, Config) when is_list(Config) ->
init_per_tc(Case, Config).
init_per_tc(Case, Config) ->
- Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
process_flag(priority, max),
erlang:display({'------------', ?MODULE, Case, '------------'}),
OkRes = ok,
- [{watchdog, Dog}, {testcase, Case}, {ok_res, OkRes} |Config].
+ [{testcase, Case}, {ok_res, OkRes} |Config].
end_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
ok.
-define(ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED, (2000*2000)).
@@ -130,130 +123,130 @@ many_low(Config) when is_list(Config) ->
low_normal_test(Config, 2*active_schedulers(), 1000).
low_normal_test(Config, NW, LW) ->
- ?line Tracer = start_tracer(),
- ?line Low = workers(LW, low),
- ?line Normal = workers(NW, normal),
- ?line Res = do_it(Tracer, Low, Normal, [], []),
- ?line chk_result(Res, LW, NW, 0, 0, true, false, false),
- ?line workers_exit([Low, Normal]),
- ?line ok(Res, Config).
+ Tracer = start_tracer(),
+ Low = workers(LW, low),
+ Normal = workers(NW, normal),
+ Res = do_it(Tracer, Low, Normal, [], []),
+ chk_result(Res, LW, NW, 0, 0, true, false, false),
+ workers_exit([Low, Normal]),
+ ok(Res, Config).
equal_with_part_time_high(Config) when is_list(Config) ->
- ?line NW = 500,
- ?line LW = 500,
- ?line HW = 1,
- ?line Tracer = start_tracer(),
- ?line Normal = workers(NW, normal),
- ?line Low = workers(LW, low),
- ?line High = part_time_workers(HW, high),
- ?line Res = do_it(Tracer, Low, Normal, High, []),
- ?line chk_result(Res, LW, NW, HW, 0, true, true, false),
- ?line workers_exit([Low, Normal, High]),
- ?line ok(Res, Config).
+ NW = 500,
+ LW = 500,
+ HW = 1,
+ Tracer = start_tracer(),
+ Normal = workers(NW, normal),
+ Low = workers(LW, low),
+ High = part_time_workers(HW, high),
+ Res = do_it(Tracer, Low, Normal, High, []),
+ chk_result(Res, LW, NW, HW, 0, true, true, false),
+ workers_exit([Low, Normal, High]),
+ ok(Res, Config).
equal_and_high_with_part_time_max(Config) when is_list(Config) ->
- ?line NW = 500,
- ?line LW = 500,
- ?line HW = 500,
- ?line MW = 1,
- ?line Tracer = start_tracer(),
- ?line Low = workers(LW, low),
- ?line Normal = workers(NW, normal),
- ?line High = workers(HW, high),
- ?line Max = part_time_workers(MW, max),
- ?line Res = do_it(Tracer, Low, Normal, High, Max),
- ?line chk_result(Res, LW, NW, HW, MW, false, true, true),
- ?line workers_exit([Low, Normal, Max]),
- ?line ok(Res, Config).
+ NW = 500,
+ LW = 500,
+ HW = 500,
+ MW = 1,
+ Tracer = start_tracer(),
+ Low = workers(LW, low),
+ Normal = workers(NW, normal),
+ High = workers(HW, high),
+ Max = part_time_workers(MW, max),
+ Res = do_it(Tracer, Low, Normal, High, Max),
+ chk_result(Res, LW, NW, HW, MW, false, true, true),
+ workers_exit([Low, Normal, Max]),
+ ok(Res, Config).
equal_with_part_time_max(Config) when is_list(Config) ->
- ?line NW = 500,
- ?line LW = 500,
- ?line MW = 1,
- ?line Tracer = start_tracer(),
- ?line Low = workers(LW, low),
- ?line Normal = workers(NW, normal),
- ?line Max = part_time_workers(MW, max),
- ?line Res = do_it(Tracer, Low, Normal, [], Max),
- ?line chk_result(Res, LW, NW, 0, MW, true, false, true),
- ?line workers_exit([Low, Normal, Max]),
- ?line ok(Res, Config).
+ NW = 500,
+ LW = 500,
+ MW = 1,
+ Tracer = start_tracer(),
+ Low = workers(LW, low),
+ Normal = workers(NW, normal),
+ Max = part_time_workers(MW, max),
+ Res = do_it(Tracer, Low, Normal, [], Max),
+ chk_result(Res, LW, NW, 0, MW, true, false, true),
+ workers_exit([Low, Normal, Max]),
+ ok(Res, Config).
equal_with_high(Config) when is_list(Config) ->
- ?line NW = 500,
- ?line LW = 500,
- ?line HW = 1,
- ?line Tracer = start_tracer(),
- ?line Low = workers(LW, low),
- ?line Normal = workers(NW, normal),
- ?line High = workers(HW, high),
- ?line Res = do_it(Tracer, Low, Normal, High, []),
- ?line LNExe = case active_schedulers() of
+ NW = 500,
+ LW = 500,
+ HW = 1,
+ Tracer = start_tracer(),
+ Low = workers(LW, low),
+ Normal = workers(NW, normal),
+ High = workers(HW, high),
+ Res = do_it(Tracer, Low, Normal, High, []),
+ LNExe = case active_schedulers() of
S when S =< HW -> false;
_ -> true
end,
- ?line chk_result(Res, LW, NW, HW, 0, LNExe, true, false),
- ?line workers_exit([Low, Normal, High]),
- ?line ok(Res, Config).
+ chk_result(Res, LW, NW, HW, 0, LNExe, true, false),
+ workers_exit([Low, Normal, High]),
+ ok(Res, Config).
equal_with_high_max(Config) when is_list(Config) ->
- ?line NW = 500,
- ?line LW = 500,
- ?line HW = 1,
- ?line MW = 1,
- ?line Tracer = start_tracer(),
- ?line Normal = workers(NW, normal),
- ?line Low = workers(LW, low),
- ?line High = workers(HW, high),
- ?line Max = workers(MW, max),
- ?line Res = do_it(Tracer, Low, Normal, High, Max),
- ?line {LNExe, HExe} = case active_schedulers() of
+ NW = 500,
+ LW = 500,
+ HW = 1,
+ MW = 1,
+ Tracer = start_tracer(),
+ Normal = workers(NW, normal),
+ Low = workers(LW, low),
+ High = workers(HW, high),
+ Max = workers(MW, max),
+ Res = do_it(Tracer, Low, Normal, High, Max),
+ {LNExe, HExe} = case active_schedulers() of
S when S =< MW -> {false, false};
S when S =< (MW + HW) -> {false, true};
_ -> {true, true}
end,
- ?line chk_result(Res, LW, NW, HW, MW, LNExe, HExe, true),
- ?line workers_exit([Low, Normal, Max]),
- ?line ok(Res, Config).
+ chk_result(Res, LW, NW, HW, MW, LNExe, HExe, true),
+ workers_exit([Low, Normal, Max]),
+ ok(Res, Config).
bound_process(Config) when is_list(Config) ->
case erlang:system_info(run_queues) == erlang:system_info(schedulers) of
- true ->
- ?line NStartBase = 20000,
- ?line NStart = case {erlang:system_info(debug_compiled),
- erlang:system_info(lock_checking)} of
- {true, true} -> NStartBase div 100;
- {_, true} -> NStartBase div 10;
- _ -> NStartBase
- end,
- ?line MStart = 100,
- ?line Seq = lists:seq(1, 100),
- ?line Tester = self(),
- ?line Procs = lists:map(
- fun (N) when N rem 2 == 0 ->
- spawn_opt(fun () ->
- bound_loop(NStart,
- NStart,
- MStart,
- 1),
- Tester ! {self(), done}
- end,
- [{scheduler, 1}, link]);
- (_N) ->
- spawn_link(fun () ->
- bound_loop(NStart,
- NStart,
- MStart,
- false),
- Tester ! {self(), done}
- end)
- end,
- Seq),
- ?line lists:foreach(fun (P) -> receive {P, done} -> ok end end,
- Procs),
- ?line ok;
- false ->
- {skipped, "Functionality not supported"}
+ true ->
+ NStartBase = 20000,
+ NStart = case {erlang:system_info(debug_compiled),
+ erlang:system_info(lock_checking)} of
+ {true, true} -> NStartBase div 100;
+ {_, true} -> NStartBase div 10;
+ _ -> NStartBase
+ end,
+ MStart = 100,
+ Seq = lists:seq(1, 100),
+ Tester = self(),
+ Procs = lists:map(
+ fun (N) when N rem 2 == 0 ->
+ spawn_opt(fun () ->
+ bound_loop(NStart,
+ NStart,
+ MStart,
+ 1),
+ Tester ! {self(), done}
+ end,
+ [{scheduler, 1}, link]);
+ (_N) ->
+ spawn_link(fun () ->
+ bound_loop(NStart,
+ NStart,
+ MStart,
+ false),
+ Tester ! {self(), done}
+ end)
+ end,
+ Seq),
+ lists:foreach(fun (P) -> receive {P, done} -> ok end end,
+ Procs),
+ ok;
+ false ->
+ {skipped, "Functionality not supported"}
end.
bound_loop(_, 0, 0, _) ->
@@ -487,59 +480,59 @@ bound_loop(NS, N, M, Sched) ->
":L30-31t0-1c15n3p0").
-define(TOPOLOGY_F_TERM,
- [{processor,[{node,[{core,[{thread,{logical,0}},
- {thread,{logical,1}}]},
- {core,[{thread,{logical,2}},
- {thread,{logical,3}}]},
- {core,[{thread,{logical,4}},
- {thread,{logical,5}}]},
- {core,[{thread,{logical,6}},
- {thread,{logical,7}}]}]},
- {node,[{core,[{thread,{logical,8}},
- {thread,{logical,9}}]},
- {core,[{thread,{logical,10}},
- {thread,{logical,11}}]},
- {core,[{thread,{logical,12}},
- {thread,{logical,13}}]},
- {core,[{thread,{logical,14}},
- {thread,{logical,15}}]}]},
- {node,[{core,[{thread,{logical,16}},
- {thread,{logical,17}}]},
- {core,[{thread,{logical,18}},
- {thread,{logical,19}}]},
- {core,[{thread,{logical,20}},
- {thread,{logical,21}}]},
- {core,[{thread,{logical,22}},
- {thread,{logical,23}}]}]},
- {node,[{core,[{thread,{logical,24}},
- {thread,{logical,25}}]},
- {core,[{thread,{logical,26}},
- {thread,{logical,27}}]},
- {core,[{thread,{logical,28}},
- {thread,{logical,29}}]},
- {core,[{thread,{logical,30}},
- {thread,{logical,31}}]}]}]}]).
+ [{processor,[{node,[{core,[{thread,{logical,0}},
+ {thread,{logical,1}}]},
+ {core,[{thread,{logical,2}},
+ {thread,{logical,3}}]},
+ {core,[{thread,{logical,4}},
+ {thread,{logical,5}}]},
+ {core,[{thread,{logical,6}},
+ {thread,{logical,7}}]}]},
+ {node,[{core,[{thread,{logical,8}},
+ {thread,{logical,9}}]},
+ {core,[{thread,{logical,10}},
+ {thread,{logical,11}}]},
+ {core,[{thread,{logical,12}},
+ {thread,{logical,13}}]},
+ {core,[{thread,{logical,14}},
+ {thread,{logical,15}}]}]},
+ {node,[{core,[{thread,{logical,16}},
+ {thread,{logical,17}}]},
+ {core,[{thread,{logical,18}},
+ {thread,{logical,19}}]},
+ {core,[{thread,{logical,20}},
+ {thread,{logical,21}}]},
+ {core,[{thread,{logical,22}},
+ {thread,{logical,23}}]}]},
+ {node,[{core,[{thread,{logical,24}},
+ {thread,{logical,25}}]},
+ {core,[{thread,{logical,26}},
+ {thread,{logical,27}}]},
+ {core,[{thread,{logical,28}},
+ {thread,{logical,29}}]},
+ {core,[{thread,{logical,30}},
+ {thread,{logical,31}}]}]}]}]).
bindings(Node, BindType) ->
Parent = self(),
Ref = make_ref(),
Pid = spawn_link(Node,
- fun () ->
- enable_internal_state(),
- Res = (catch erts_debug:get_internal_state(
- {fake_scheduler_bindings,
- BindType})),
- Parent ! {Ref, Res}
- end),
+ fun () ->
+ enable_internal_state(),
+ Res = (catch erts_debug:get_internal_state(
+ {fake_scheduler_bindings,
+ BindType})),
+ Parent ! {Ref, Res}
+ end),
receive
- {Ref, Res} ->
- ?t:format("~p: ~p~n", [BindType, Res]),
- unlink(Pid),
- Res
+ {Ref, Res} ->
+ io:format("~p: ~p~n", [BindType, Res]),
+ unlink(Pid),
+ Res
end.
scheduler_bind_types(Config) when is_list(Config) ->
- ?line OldRelFlags = clear_erl_rel_flags(),
+ OldRelFlags = clear_erl_rel_flags(),
try
scheduler_bind_types_test(Config,
?TOPOLOGY_A_TERM,
@@ -568,267 +561,267 @@ scheduler_bind_types(Config) when is_list(Config) ->
after
restore_erl_rel_flags(OldRelFlags)
end,
- ?line ok.
+ ok.
scheduler_bind_types_test(Config, Topology, CmdLine, TermLetter) ->
- ?line ?t:format("Testing (~p): ~p~n", [TermLetter, Topology]),
- ?line {ok, Node0} = start_node(Config),
- ?line _ = rpc:call(Node0, erlang, system_flag, [cpu_topology, Topology]),
- ?line cmp(Topology, rpc:call(Node0, erlang, system_info, [cpu_topology])),
- ?line check_bind_types(Node0, TermLetter),
- ?line stop_node(Node0),
- ?line {ok, Node1} = start_node(Config, CmdLine),
- ?line cmp(Topology, rpc:call(Node1, erlang, system_info, [cpu_topology])),
- ?line check_bind_types(Node1, TermLetter),
- ?line stop_node(Node1).
+ io:format("Testing (~p): ~p~n", [TermLetter, Topology]),
+ {ok, Node0} = start_node(Config),
+ _ = rpc:call(Node0, erlang, system_flag, [cpu_topology, Topology]),
+ cmp(Topology, rpc:call(Node0, erlang, system_info, [cpu_topology])),
+ check_bind_types(Node0, TermLetter),
+ stop_node(Node0),
+ {ok, Node1} = start_node(Config, CmdLine),
+ cmp(Topology, rpc:call(Node1, erlang, system_info, [cpu_topology])),
+ check_bind_types(Node1, TermLetter),
+ stop_node(Node1).
check_bind_types(Node, a) ->
- ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}
- = bindings(Node, no_spread),
- ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
- = bindings(Node, thread_spread),
- ?line {0,4,8,12,2,6,10,14,1,5,9,13,3,7,11,15}
- = bindings(Node, processor_spread),
- ?line {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}
- = bindings(Node, spread),
- ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15}
- = bindings(Node, no_node_thread_spread),
- ?line {0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15}
- = bindings(Node, no_node_processor_spread),
- ?line {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15}
- = bindings(Node, thread_no_node_processor_spread),
- ?line {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15}
- = bindings(Node, default_bind),
- ?line ok;
+ {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}
+ = bindings(Node, no_spread),
+ {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
+ = bindings(Node, thread_spread),
+ {0,4,8,12,2,6,10,14,1,5,9,13,3,7,11,15}
+ = bindings(Node, processor_spread),
+ {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}
+ = bindings(Node, spread),
+ {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15}
+ = bindings(Node, no_node_thread_spread),
+ {0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15}
+ = bindings(Node, no_node_processor_spread),
+ {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15}
+ = bindings(Node, thread_no_node_processor_spread),
+ {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15}
+ = bindings(Node, default_bind),
+ ok;
check_bind_types(Node, b) ->
- ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}
- = bindings(Node, no_spread),
- ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
- = bindings(Node, thread_spread),
- ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15}
- = bindings(Node, processor_spread),
- ?line {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}
- = bindings(Node, spread),
- ?line {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15}
- = bindings(Node, no_node_thread_spread),
- ?line {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15}
- = bindings(Node, no_node_processor_spread),
- ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
- = bindings(Node, thread_no_node_processor_spread),
- ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
- = bindings(Node, default_bind),
- ?line ok;
+ {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}
+ = bindings(Node, no_spread),
+ {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
+ = bindings(Node, thread_spread),
+ {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15}
+ = bindings(Node, processor_spread),
+ {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15}
+ = bindings(Node, spread),
+ {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15}
+ = bindings(Node, no_node_thread_spread),
+ {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15}
+ = bindings(Node, no_node_processor_spread),
+ {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
+ = bindings(Node, thread_no_node_processor_spread),
+ {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
+ = bindings(Node, default_bind),
+ ok;
check_bind_types(Node, c) ->
- ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
- 25,26,27,28,29,30,31} = bindings(Node, no_spread),
- ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,
- 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread),
- ?line {0,4,8,16,20,24,2,6,10,18,22,26,12,28,14,30,1,5,9,17,21,25,
- 3,7,11,19,23,27,13,29,15,31} = bindings(Node, processor_spread),
- ?line {0,8,16,24,4,20,12,28,2,10,18,26,6,22,14,30,1,9,17,25,5,21,13,29,3,11,
- 19,27,7,23,15,31} = bindings(Node, spread),
- ?line {0,2,4,6,1,3,5,7,8,10,9,11,12,14,13,15,16,18,20,22,17,19,21,23,24,26,
- 25,27,28,30,29,31} = bindings(Node, no_node_thread_spread),
- ?line {0,4,2,6,1,5,3,7,8,10,9,11,12,14,13,15,16,20,18,22,17,21,19,23,24,26,
- 25,27,28,30,29,31} = bindings(Node, no_node_processor_spread),
- ?line {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21,
- 19,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread),
- ?line {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21,
- 19,23,25,27,29,31} = bindings(Node, default_bind),
- ?line ok;
+ {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
+ 25,26,27,28,29,30,31} = bindings(Node, no_spread),
+ {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,
+ 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread),
+ {0,4,8,16,20,24,2,6,10,18,22,26,12,28,14,30,1,5,9,17,21,25,
+ 3,7,11,19,23,27,13,29,15,31} = bindings(Node, processor_spread),
+ {0,8,16,24,4,20,12,28,2,10,18,26,6,22,14,30,1,9,17,25,5,21,13,29,3,11,
+ 19,27,7,23,15,31} = bindings(Node, spread),
+ {0,2,4,6,1,3,5,7,8,10,9,11,12,14,13,15,16,18,20,22,17,19,21,23,24,26,
+ 25,27,28,30,29,31} = bindings(Node, no_node_thread_spread),
+ {0,4,2,6,1,5,3,7,8,10,9,11,12,14,13,15,16,20,18,22,17,21,19,23,24,26,
+ 25,27,28,30,29,31} = bindings(Node, no_node_processor_spread),
+ {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21,
+ 19,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread),
+ {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21,
+ 19,23,25,27,29,31} = bindings(Node, default_bind),
+ ok;
check_bind_types(Node, d) ->
- ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
- 25,26,27,28,29,30,31} = bindings(Node, no_spread),
- ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,
- 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread),
- ?line {0,8,12,16,24,28,2,10,14,18,26,30,4,20,6,22,1,9,13,17,25,29,3,11,15,
- 19,27,31,5,21,7,23} = bindings(Node, processor_spread),
- ?line {0,8,16,24,12,28,4,20,2,10,18,26,14,30,6,22,1,9,17,25,13,29,5,21,3,11,
- 19,27,15,31,7,23} = bindings(Node, spread),
- ?line {0,2,1,3,4,6,5,7,8,10,12,14,9,11,13,15,16,18,17,19,20,22,21,23,24,26,
- 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread),
- ?line {0,2,1,3,4,6,5,7,8,12,10,14,9,13,11,15,16,18,17,19,20,22,21,23,24,28,
- 26,30,25,29,27,31} = bindings(Node, no_node_processor_spread),
- ?line {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19,
- 21,23,25,29,27,31} = bindings(Node, thread_no_node_processor_spread),
- ?line {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19,
- 21,23,25,29,27,31} = bindings(Node, default_bind),
- ?line ok;
+ {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
+ 25,26,27,28,29,30,31} = bindings(Node, no_spread),
+ {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,
+ 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread),
+ {0,8,12,16,24,28,2,10,14,18,26,30,4,20,6,22,1,9,13,17,25,29,3,11,15,
+ 19,27,31,5,21,7,23} = bindings(Node, processor_spread),
+ {0,8,16,24,12,28,4,20,2,10,18,26,14,30,6,22,1,9,17,25,13,29,5,21,3,11,
+ 19,27,15,31,7,23} = bindings(Node, spread),
+ {0,2,1,3,4,6,5,7,8,10,12,14,9,11,13,15,16,18,17,19,20,22,21,23,24,26,
+ 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread),
+ {0,2,1,3,4,6,5,7,8,12,10,14,9,13,11,15,16,18,17,19,20,22,21,23,24,28,
+ 26,30,25,29,27,31} = bindings(Node, no_node_processor_spread),
+ {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19,
+ 21,23,25,29,27,31} = bindings(Node, thread_no_node_processor_spread),
+ {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19,
+ 21,23,25,29,27,31} = bindings(Node, default_bind),
+ ok;
check_bind_types(Node, e) ->
- ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}
- = bindings(Node, no_spread),
- ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
- = bindings(Node, thread_spread),
- ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15}
- = bindings(Node, processor_spread),
- ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15}
- = bindings(Node, spread),
- ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15}
- = bindings(Node, no_node_thread_spread),
- ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15}
- = bindings(Node, no_node_processor_spread),
- ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
- = bindings(Node, thread_no_node_processor_spread),
- ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
- = bindings(Node, default_bind),
- ?line ok;
+ {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}
+ = bindings(Node, no_spread),
+ {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
+ = bindings(Node, thread_spread),
+ {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15}
+ = bindings(Node, processor_spread),
+ {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15}
+ = bindings(Node, spread),
+ {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15}
+ = bindings(Node, no_node_thread_spread),
+ {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15}
+ = bindings(Node, no_node_processor_spread),
+ {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
+ = bindings(Node, thread_no_node_processor_spread),
+ {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15}
+ = bindings(Node, default_bind),
+ ok;
check_bind_types(Node, f) ->
- ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
- 25,26,27,28,29,30,31} = bindings(Node, no_spread),
- ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,
- 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread),
- ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,
- 15,17,19,21,23,25,27,29,31} = bindings(Node, processor_spread),
- ?line {0,8,16,24,2,10,18,26,4,12,20,28,6,14,22,30,1,9,17,25,3,11,19,27,5,13,
- 21,29,7,15,23,31} = bindings(Node, spread),
- ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26,
- 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread),
- ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26,
- 28,30,25,27,29,31} = bindings(Node, no_node_processor_spread),
- ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19,
- 21,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread),
- ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19,
- 21,23,25,27,29,31} = bindings(Node, default_bind),
- ?line ok;
+ {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
+ 25,26,27,28,29,30,31} = bindings(Node, no_spread),
+ {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,
+ 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread),
+ {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,
+ 15,17,19,21,23,25,27,29,31} = bindings(Node, processor_spread),
+ {0,8,16,24,2,10,18,26,4,12,20,28,6,14,22,30,1,9,17,25,3,11,19,27,5,13,
+ 21,29,7,15,23,31} = bindings(Node, spread),
+ {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26,
+ 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread),
+ {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26,
+ 28,30,25,27,29,31} = bindings(Node, no_node_processor_spread),
+ {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19,
+ 21,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread),
+ {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19,
+ 21,23,25,27,29,31} = bindings(Node, default_bind),
+ ok;
check_bind_types(Node, _) ->
- ?line bindings(Node, no_spread),
- ?line bindings(Node, thread_spread),
- ?line bindings(Node, processor_spread),
- ?line bindings(Node, spread),
- ?line bindings(Node, no_node_thread_spread),
- ?line bindings(Node, no_node_processor_spread),
- ?line bindings(Node, thread_no_node_processor_spread),
- ?line bindings(Node, default_bind),
- ?line ok.
+ bindings(Node, no_spread),
+ bindings(Node, thread_spread),
+ bindings(Node, processor_spread),
+ bindings(Node, spread),
+ bindings(Node, no_node_thread_spread),
+ bindings(Node, no_node_processor_spread),
+ bindings(Node, thread_no_node_processor_spread),
+ bindings(Node, default_bind),
+ ok.
cpu_topology(Config) when is_list(Config) ->
- ?line OldRelFlags = clear_erl_rel_flags(),
+ OldRelFlags = clear_erl_rel_flags(),
try
- ?line cpu_topology_test(
- Config,
- [{node,[{processor,[{core,{logical,0}},
- {core,{logical,1}}]}]},
- {processor,[{node,[{core,{logical,2}},
- {core,{logical,3}}]}]},
- {node,[{processor,[{core,{logical,4}},
- {core,{logical,5}}]}]},
- {processor,[{node,[{core,{logical,6}},
- {core,{logical,7}}]}]}],
- "+sct "
- "L0-1c0-1p0n0"
- ":L2-3c0-1n1p1"
- ":L4-5c0-1p2n2"
- ":L6-7c0-1n3p3"),
- ?line cpu_topology_test(
- Config,
- [{node,[{processor,[{core,{logical,0}},
- {core,{logical,1}}]},
- {processor,[{core,{logical,2}},
- {core,{logical,3}}]}]},
- {processor,[{node,[{core,{logical,4}},
- {core,{logical,5}}]},
- {node,[{core,{logical,6}},
- {core,{logical,7}}]}]},
- {node,[{processor,[{core,{logical,8}},
- {core,{logical,9}}]},
- {processor,[{core,{logical,10}},
- {core,{logical,11}}]}]},
- {processor,[{node,[{core,{logical,12}},
- {core,{logical,13}}]},
- {node,[{core,{logical,14}},
- {core,{logical,15}}]}]}],
- "+sct "
- "L0-1c0-1p0n0"
- ":L2-3c0-1p1n0"
- ":L4-5c0-1n1p2"
- ":L6-7c2-3n2p2"
- ":L8-9c0-1p3n3"
- ":L10-11c0-1p4n3"
- ":L12-13c0-1n4p5"
- ":L14-15c2-3n5p5"),
- ?line cpu_topology_test(
- Config,
- [{node,[{processor,[{core,{logical,0}},
- {core,{logical,1}}]}]},
- {processor,[{node,[{core,{logical,2}},
- {core,{logical,3}}]}]},
- {processor,[{node,[{core,{logical,4}},
- {core,{logical,5}}]}]},
- {node,[{processor,[{core,{logical,6}},
- {core,{logical,7}}]}]},
- {node,[{processor,[{core,{logical,8}},
- {core,{logical,9}}]}]},
- {processor,[{node,[{core,{logical,10}},
- {core,{logical,11}}]}]}],
- "+sct "
- "L0-1c0-1p0n0"
- ":L2-3c0-1n1p1"
- ":L4-5c0-1n2p2"
- ":L6-7c0-1p3n3"
- ":L8-9c0-1p4n4"
- ":L10-11c0-1n5p5")
+ cpu_topology_test(
+ Config,
+ [{node,[{processor,[{core,{logical,0}},
+ {core,{logical,1}}]}]},
+ {processor,[{node,[{core,{logical,2}},
+ {core,{logical,3}}]}]},
+ {node,[{processor,[{core,{logical,4}},
+ {core,{logical,5}}]}]},
+ {processor,[{node,[{core,{logical,6}},
+ {core,{logical,7}}]}]}],
+ "+sct "
+ "L0-1c0-1p0n0"
+ ":L2-3c0-1n1p1"
+ ":L4-5c0-1p2n2"
+ ":L6-7c0-1n3p3"),
+ cpu_topology_test(
+ Config,
+ [{node,[{processor,[{core,{logical,0}},
+ {core,{logical,1}}]},
+ {processor,[{core,{logical,2}},
+ {core,{logical,3}}]}]},
+ {processor,[{node,[{core,{logical,4}},
+ {core,{logical,5}}]},
+ {node,[{core,{logical,6}},
+ {core,{logical,7}}]}]},
+ {node,[{processor,[{core,{logical,8}},
+ {core,{logical,9}}]},
+ {processor,[{core,{logical,10}},
+ {core,{logical,11}}]}]},
+ {processor,[{node,[{core,{logical,12}},
+ {core,{logical,13}}]},
+ {node,[{core,{logical,14}},
+ {core,{logical,15}}]}]}],
+ "+sct "
+ "L0-1c0-1p0n0"
+ ":L2-3c0-1p1n0"
+ ":L4-5c0-1n1p2"
+ ":L6-7c2-3n2p2"
+ ":L8-9c0-1p3n3"
+ ":L10-11c0-1p4n3"
+ ":L12-13c0-1n4p5"
+ ":L14-15c2-3n5p5"),
+ cpu_topology_test(
+ Config,
+ [{node,[{processor,[{core,{logical,0}},
+ {core,{logical,1}}]}]},
+ {processor,[{node,[{core,{logical,2}},
+ {core,{logical,3}}]}]},
+ {processor,[{node,[{core,{logical,4}},
+ {core,{logical,5}}]}]},
+ {node,[{processor,[{core,{logical,6}},
+ {core,{logical,7}}]}]},
+ {node,[{processor,[{core,{logical,8}},
+ {core,{logical,9}}]}]},
+ {processor,[{node,[{core,{logical,10}},
+ {core,{logical,11}}]}]}],
+ "+sct "
+ "L0-1c0-1p0n0"
+ ":L2-3c0-1n1p1"
+ ":L4-5c0-1n2p2"
+ ":L6-7c0-1p3n3"
+ ":L8-9c0-1p4n4"
+ ":L10-11c0-1n5p5")
after
- restore_erl_rel_flags(OldRelFlags)
+ restore_erl_rel_flags(OldRelFlags)
end,
- ?line ok.
+ ok.
cpu_topology_test(Config, Topology, Cmd) ->
- ?line ?t:format("Testing~n ~p~n ~p~n", [Topology, Cmd]),
- ?line cpu_topology_bif_test(Config, Topology),
- ?line cpu_topology_cmdline_test(Config, Topology, Cmd),
- ?line ok.
+ io:format("Testing~n ~p~n ~p~n", [Topology, Cmd]),
+ cpu_topology_bif_test(Config, Topology),
+ cpu_topology_cmdline_test(Config, Topology, Cmd),
+ ok.
cpu_topology_bif_test(_Config, false) ->
- ?line ok;
+ ok;
cpu_topology_bif_test(Config, Topology) ->
- ?line {ok, Node} = start_node(Config),
- ?line _ = rpc:call(Node, erlang, system_flag, [cpu_topology, Topology]),
- ?line cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])),
- ?line stop_node(Node),
- ?line ok.
+ {ok, Node} = start_node(Config),
+ _ = rpc:call(Node, erlang, system_flag, [cpu_topology, Topology]),
+ cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])),
+ stop_node(Node),
+ ok.
cpu_topology_cmdline_test(_Config, _Topology, false) ->
- ?line ok;
+ ok;
cpu_topology_cmdline_test(Config, Topology, Cmd) ->
- ?line {ok, Node} = start_node(Config, Cmd),
- ?line cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])),
- ?line stop_node(Node),
- ?line ok.
+ {ok, Node} = start_node(Config, Cmd),
+ cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])),
+ stop_node(Node),
+ ok.
update_cpu_info(Config) when is_list(Config) ->
- ?line OldOnline = erlang:system_info(schedulers_online),
- ?line OldAff = get_affinity_mask(),
- ?line ?t:format("START - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n",
+ OldOnline = erlang:system_info(schedulers_online),
+ OldAff = get_affinity_mask(),
+ io:format("START - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n",
[OldAff, OldOnline, erlang:system_info(scheduler_bindings)]),
- ?line case {erlang:system_info(logical_processors_available), OldAff} of
+ case {erlang:system_info(logical_processors_available), OldAff} of
{Avail, _} when Avail == unknown; OldAff == unknown ->
%% Nothing much to test; just a smoke test
case erlang:system_info(update_cpu_info) of
- unchanged -> ?line ok;
- changed -> ?line ok
+ unchanged -> ok;
+ changed -> ok
end;
_ ->
try
- ?line adjust_schedulers_online(),
+ adjust_schedulers_online(),
case erlang:system_info(schedulers_online) of
1 ->
%% Nothing much to test; just a smoke test
- ?line ok;
+ ok;
Onln0 ->
%% unset least significant bit
- ?line Aff = (OldAff band (OldAff - 1)),
- ?line set_affinity_mask(Aff),
- ?line Onln1 = Onln0 - 1,
- ?line case adjust_schedulers_online() of
+ Aff = (OldAff band (OldAff - 1)),
+ set_affinity_mask(Aff),
+ Onln1 = Onln0 - 1,
+ case adjust_schedulers_online() of
{Onln0, Onln1} ->
- ?line Onln1 = erlang:system_info(schedulers_online),
- ?line receive after 500 -> ok end,
- ?line ?t:format("TEST - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n",
+ Onln1 = erlang:system_info(schedulers_online),
+ receive after 500 -> ok end,
+ io:format("TEST - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n",
[Aff, Onln1, erlang:system_info(scheduler_bindings)]),
- ?line unchanged = adjust_schedulers_online(),
- ?line ok;
+ unchanged = adjust_schedulers_online(),
+ ok;
Fail ->
- ?line ?t:fail(Fail)
+ ct:fail(Fail)
end
end
after
@@ -836,7 +829,7 @@ update_cpu_info(Config) when is_list(Config) ->
adjust_schedulers_online(),
erlang:system_flag(schedulers_online, OldOnline),
receive after 500 -> ok end,
- ?t:format("END - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n",
+ io:format("END - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n",
[get_affinity_mask(),
erlang:system_info(schedulers_online),
erlang:system_info(scheduler_bindings)])
@@ -883,7 +876,7 @@ get_affinity_mask(_Port, _Status, Affinity) ->
Affinity.
get_affinity_mask() ->
- case ?t:os_type() of
+ case test_server:os_type() of
{unix, linux} ->
case catch open_port({spawn, "taskset -p " ++ os:getpid()},
[exit_status]) of
@@ -927,21 +920,21 @@ set_affinity_mask(Mask) ->
end.
sct_cmd(Config) when is_list(Config) ->
- ?line Topology = ?TOPOLOGY_A_TERM,
- ?line OldRelFlags = clear_erl_rel_flags(),
+ Topology = ?TOPOLOGY_A_TERM,
+ OldRelFlags = clear_erl_rel_flags(),
try
- ?line {ok, Node} = start_node(Config, ?TOPOLOGY_A_CMD),
- ?line cmp(Topology,
+ {ok, Node} = start_node(Config, ?TOPOLOGY_A_CMD),
+ cmp(Topology,
rpc:call(Node, erlang, system_info, [cpu_topology])),
- ?line cmp(Topology,
+ cmp(Topology,
rpc:call(Node, erlang, system_flag, [cpu_topology, Topology])),
- ?line cmp(Topology,
+ cmp(Topology,
rpc:call(Node, erlang, system_info, [cpu_topology])),
- ?line stop_node(Node)
+ stop_node(Node)
after
restore_erl_rel_flags(OldRelFlags)
end,
- ?line ok.
+ ok.
-define(BIND_TYPES,
[{"u", unbound},
@@ -965,7 +958,7 @@ sbt_cmd(Config) when is_list(Config) ->
end,
case Bind of
notsup ->
- ?line {skipped, "Binding of schedulers not supported"};
+ {skipped, "Binding of schedulers not supported"};
go_for_it ->
CpuTCmd = case erlang:system_info({cpu_topology,detected}) of
undefined ->
@@ -988,14 +981,14 @@ sbt_cmd(Config) when is_list(Config) ->
end,
case CpuTCmd of
false ->
- ?line {skipped, "Don't know how to create cpu topology"};
+ {skipped, "Don't know how to create cpu topology"};
_ ->
case erlang:system_info(logical_processors) of
LP when is_integer(LP) ->
OldRelFlags = clear_erl_rel_flags(),
try
lists:foreach(fun ({ClBt, Bt}) ->
- ?line sbt_test(Config,
+ sbt_test(Config,
CpuTCmd,
ClBt,
Bt,
@@ -1005,44 +998,44 @@ sbt_cmd(Config) when is_list(Config) ->
after
restore_erl_rel_flags(OldRelFlags)
end,
- ?line ok;
+ ok;
_ ->
- ?line {skipped,
+ {skipped,
"Don't know the amount of logical processors"}
end
end
end.
sbt_test(Config, CpuTCmd, ClBt, Bt, LP) ->
- ?line ?t:format("Testing +sbt ~s (~p)~n", [ClBt, Bt]),
- ?line LPS = integer_to_list(LP),
- ?line Cmd = CpuTCmd++" +sbt "++ClBt++" +S"++LPS++":"++LPS,
- ?line {ok, Node} = start_node(Config, Cmd),
- ?line Bt = rpc:call(Node,
+ io:format("Testing +sbt ~s (~p)~n", [ClBt, Bt]),
+ LPS = integer_to_list(LP),
+ Cmd = CpuTCmd++" +sbt "++ClBt++" +S"++LPS++":"++LPS,
+ {ok, Node} = start_node(Config, Cmd),
+ Bt = rpc:call(Node,
erlang,
system_info,
[scheduler_bind_type]),
- ?line SB = rpc:call(Node,
+ SB = rpc:call(Node,
erlang,
system_info,
[scheduler_bindings]),
- ?line ?t:format("scheduler bindings: ~p~n", [SB]),
- ?line BS = case {Bt, erlang:system_info(logical_processors_available)} of
+ io:format("scheduler bindings: ~p~n", [SB]),
+ BS = case {Bt, erlang:system_info(logical_processors_available)} of
{unbound, _} -> 0;
{_, Int} when is_integer(Int) -> Int;
{_, _} -> LP
end,
- ?line lists:foldl(fun (S, 0) ->
- ?line unbound = S,
+ lists:foldl(fun (S, 0) ->
+ unbound = S,
0;
(S, N) ->
- ?line true = is_integer(S),
+ true = is_integer(S),
N-1
end,
BS,
tuple_to_list(SB)),
- ?line stop_node(Node),
- ?line ok.
+ stop_node(Node),
+ ok.
scheduler_threads(Config) when is_list(Config) ->
SmpSupport = erlang:system_info(smp_support),
@@ -1130,6 +1123,7 @@ dirty_schedulers_online_test(true) ->
dirty_schedulers_online_smp_test(erlang:system_info(schedulers_online)).
dirty_schedulers_online_smp_test(SchedOnln) when SchedOnln < 4 -> ok;
dirty_schedulers_online_smp_test(SchedOnln) ->
+ receive after 500 -> ok end,
DirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online),
SchedOnln = DirtyCPUSchedOnln,
HalfSchedOnln = SchedOnln div 2,
@@ -1138,9 +1132,11 @@ dirty_schedulers_online_smp_test(SchedOnln) ->
HalfDirtyCPUSchedOnln = erlang:system_flag(schedulers_online, SchedOnln),
DirtyCPUSchedOnln = erlang:system_flag(dirty_cpu_schedulers_online,
HalfDirtyCPUSchedOnln),
+ receive after 500 -> ok end,
HalfDirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online),
QrtrDirtyCPUSchedOnln = HalfDirtyCPUSchedOnln div 2,
SchedOnln = erlang:system_flag(schedulers_online, HalfSchedOnln),
+ receive after 500 -> ok end,
QrtrDirtyCPUSchedOnln = erlang:system_info(dirty_cpu_schedulers_online),
ok.
@@ -1166,49 +1162,208 @@ get_dsstate(Config, Cmd) ->
stop_node(Node),
{DSCPU, DSCPUOnln, DSIO}.
+dirty_scheduler_exit(Config) when is_list(Config) ->
+ try
+ erlang:system_info(dirty_cpu_schedulers),
+ dirty_scheduler_exit_test(Config)
+ catch
+ error:badarg ->
+ {skipped, "No dirty scheduler support"}
+ end.
+
+dirty_scheduler_exit_test(Config) ->
+ {ok, Node} = start_node(Config, "+SDio 1"),
+ [ok] = mcall(Node,
+ [fun() ->
+ Path = proplists:get_value(data_dir, Config),
+ Lib = atom_to_list(?MODULE),
+ ok = erlang:load_nif(filename:join(Path,Lib), []),
+ ok = test_dirty_scheduler_exit()
+ end]),
+ stop_node(Node),
+ ok.
+
+test_dirty_scheduler_exit() ->
+ process_flag(trap_exit,true),
+ test_dse(10,[]).
+test_dse(0,Pids) ->
+ timer:sleep(100),
+ kill_dse(Pids,[]);
+test_dse(N,Pids) ->
+ Pid = spawn_link(fun dirty_sleeper/0),
+ test_dse(N-1,[Pid|Pids]).
+kill_dse([],Killed) ->
+ wait_dse(Killed);
+kill_dse([Pid|Pids],AlreadyKilled) ->
+ exit(Pid,kill),
+ kill_dse(Pids,[Pid|AlreadyKilled]).
+wait_dse([]) ->
+ ok;
+wait_dse([Pid|Pids]) ->
+ receive
+ {'EXIT',Pid,killed} ->
+ ok
+ end,
+ wait_dse(Pids).
+
+dirty_sleeper() ->
+ erlang:nif_error({error,?MODULE}).
+
+scheduler_suspend_basic(Config) when is_list(Config) ->
+ case erlang:system_info(multi_scheduling) of
+ disabled ->
+ {skip, "Nothing to test"};
+ _ ->
+ Onln = erlang:system_info(schedulers_online),
+ try
+ scheduler_suspend_basic_test()
+ after
+ erlang:system_flag(schedulers_online, Onln)
+ end
+ end.
+
+scheduler_suspend_basic_test() ->
+ %% The receives after setting scheduler states are there
+ %% since the operation is not fully synchronous. For example,
+ %% we do not wait for dirty cpu schedulers online to complete
+ %% before returning from erlang:system_flag(schedulers_online, _).
+
+ erlang:system_flag(schedulers_online,
+ erlang:system_info(schedulers)),
+ try
+ erlang:system_flag(dirty_cpu_schedulers_online,
+ erlang:system_info(dirty_cpu_schedulers)),
+ receive after 500 -> ok end
+ catch
+ _ : _ ->
+ ok
+ end,
+
+ S0 = sched_state(),
+ io:format("~p~n", [S0]),
+ {{normal,NTot0,NOnln0,NAct0},
+ {dirty_cpu,DCTot0,DCOnln0,DCAct0},
+ {dirty_io,DITot0,DIOnln0,DIAct0}} = S0,
+ enabled = erlang:system_info(multi_scheduling),
+
+ DCOne = case DCTot0 of
+ 0 -> 0;
+ _ -> 1
+ end,
+
+ blocked_normal = erlang:system_flag(multi_scheduling, block_normal),
+ blocked_normal = erlang:system_info(multi_scheduling),
+ {{normal,NTot0,NOnln0,1},
+ {dirty_cpu,DCTot0,DCOnln0,DCAct0},
+ {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(),
+
+ NOnln0 = erlang:system_flag(schedulers_online, 1),
+ receive after 500 -> ok end,
+ {{normal,NTot0,1,1},
+ {dirty_cpu,DCTot0,DCOne,DCOne},
+ {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(),
+
+ 1 = erlang:system_flag(schedulers_online, NOnln0),
+ receive after 500 -> ok end,
+ {{normal,NTot0,NOnln0,1},
+ {dirty_cpu,DCTot0,DCOnln0,DCAct0},
+ {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(),
+
+ blocked = erlang:system_flag(multi_scheduling, block),
+ blocked = erlang:system_info(multi_scheduling),
+ receive after 500 -> ok end,
+ {{normal,NTot0,NOnln0,1},
+ {dirty_cpu,DCTot0,DCOnln0,0},
+ {dirty_io,DITot0,DIOnln0,0}} = sched_state(),
+
+ NOnln0 = erlang:system_flag(schedulers_online, 1),
+ receive after 500 -> ok end,
+ {{normal,NTot0,1,1},
+ {dirty_cpu,DCTot0,DCOne,0},
+ {dirty_io,DITot0,DIOnln0,0}} = sched_state(),
+
+ 1 = erlang:system_flag(schedulers_online, NOnln0),
+ receive after 500 -> ok end,
+ {{normal,NTot0,NOnln0,1},
+ {dirty_cpu,DCTot0,DCOnln0,0},
+ {dirty_io,DITot0,DIOnln0,0}} = sched_state(),
+
+ blocked = erlang:system_flag(multi_scheduling, unblock_normal),
+ blocked = erlang:system_info(multi_scheduling),
+ {{normal,NTot0,NOnln0,1},
+ {dirty_cpu,DCTot0,DCOnln0,0},
+ {dirty_io,DITot0,DIOnln0,0}} = sched_state(),
+
+ enabled = erlang:system_flag(multi_scheduling, unblock),
+ enabled = erlang:system_info(multi_scheduling),
+ receive after 500 -> ok end,
+ {{normal,NTot0,NOnln0,NAct0},
+ {dirty_cpu,DCTot0,DCOnln0,DCAct0},
+ {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(),
+
+ NOnln0 = erlang:system_flag(schedulers_online, 1),
+ receive after 500 -> ok end,
+ {{normal,NTot0,1,1},
+ {dirty_cpu,DCTot0,DCOne,DCOne},
+ {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(),
+
+ 1 = erlang:system_flag(schedulers_online, NOnln0),
+ receive after 500 -> ok end,
+ {{normal,NTot0,NOnln0,NAct0},
+ {dirty_cpu,DCTot0,DCOnln0,DCAct0},
+ {dirty_io,DITot0,DIOnln0,DIAct0}} = sched_state(),
+
+ ok.
+
+
scheduler_suspend(Config) when is_list(Config) ->
- ?line Dog = ?t:timetrap(?t:minutes(5)),
- ?line lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end,
+ ct:timetrap({minutes, 5}),
+ lists:foreach(fun (S) -> scheduler_suspend_test(Config, S) end,
[64, 32, 16, default]),
- ?line ?t:timetrap_cancel(Dog),
- ?line ok.
+ ok.
scheduler_suspend_test(Config, Schedulers) ->
- ?line Cmd = case Schedulers of
+ Cmd = case Schedulers of
default ->
"";
_ ->
S = integer_to_list(Schedulers),
"+S"++S++":"++S
end,
- ?line {ok, Node} = start_node(Config, Cmd),
- ?line [SState] = mcall(Node, [fun () ->
- erlang:system_info(schedulers_state)
- end]),
- ?line ?t:format("SState=~p~n", [SState]),
- ?line {Sched, SchedOnln, _SchedAvail} = SState,
- ?line true = is_integer(Sched),
- ?line [ok] = mcall(Node, [fun () -> sst0_loop(300) end]),
- ?line [ok] = mcall(Node, [fun () -> sst1_loop(300) end]),
- ?line [ok] = mcall(Node, [fun () -> sst2_loop(300) end]),
- ?line [ok, ok, ok, ok, ok] = mcall(Node,
- [fun () -> sst0_loop(200) end,
- fun () -> sst1_loop(200) end,
- fun () -> sst2_loop(200) end,
- fun () -> sst2_loop(200) end,
- fun () -> sst3_loop(Sched, 200) end]),
- ?line [SState] = mcall(Node, [fun () ->
- case Sched == SchedOnln of
- false ->
- Sched = erlang:system_flag(
- schedulers_online,
- SchedOnln);
- true ->
- ok
- end,
- erlang:system_info(schedulers_state)
- end]),
- ?line stop_node(Node),
- ?line ok.
+ {ok, Node} = start_node(Config, Cmd),
+ [SState] = mcall(Node, [fun () ->
+ erlang:system_info(schedulers_state)
+ end]),
+
+ io:format("SState=~p~n", [SState]),
+ {Sched, SchedOnln, _SchedAvail} = SState,
+ true = is_integer(Sched),
+ [ok] = mcall(Node, [fun () -> sst0_loop(300) end]),
+ [ok] = mcall(Node, [fun () -> sst1_loop(300) end]),
+ [ok] = mcall(Node, [fun () -> sst2_loop(300) end]),
+ [ok] = mcall(Node, [fun () -> sst4_loop(300) end]),
+ [ok] = mcall(Node, [fun () -> sst5_loop(300) end]),
+ [ok, ok, ok, ok,
+ ok, ok, ok] = mcall(Node,
+ [fun () -> sst0_loop(200) end,
+ fun () -> sst1_loop(200) end,
+ fun () -> sst2_loop(200) end,
+ fun () -> sst2_loop(200) end,
+ fun () -> sst3_loop(Sched, 200) end,
+ fun () -> sst4_loop(200) end,
+ fun () -> sst5_loop(200) end]),
+ [SState] = mcall(Node, [fun () ->
+ case Sched == SchedOnln of
+ false ->
+ Sched = erlang:system_flag(
+ schedulers_online,
+ SchedOnln);
+ true ->
+ ok
+ end,
+ erlang:system_info(schedulers_state)
+ end]),
+ stop_node(Node),
+ ok.
sst0_loop(0) ->
@@ -1272,270 +1427,283 @@ sst3_loop_with_dirty_schedulers(S, DS, N) ->
erlang:system_flag(dirty_cpu_schedulers_online, DS),
sst3_loop_with_dirty_schedulers(S, DS, N-1).
+sst4_loop(0) ->
+ ok;
+sst4_loop(N) ->
+ erlang:system_flag(multi_scheduling, block_normal),
+ erlang:system_flag(multi_scheduling, unblock_normal),
+ sst4_loop(N-1).
+
+sst5_loop(0) ->
+ ok;
+sst5_loop(N) ->
+ erlang:system_flag(multi_scheduling, block_normal),
+ erlang:system_flag(multi_scheduling, unblock_normal),
+ sst5_loop(N-1).
+
reader_groups(Config) when is_list(Config) ->
%% White box testing. These results are correct, but other results
%% could be too...
%% The actual tilepro64 topology
CPUT0 = [{processor,[{node,[{core,{logical,0}},
- {core,{logical,1}},
- {core,{logical,2}},
- {core,{logical,8}},
- {core,{logical,9}},
- {core,{logical,10}},
- {core,{logical,11}},
- {core,{logical,16}},
- {core,{logical,17}},
- {core,{logical,18}},
- {core,{logical,19}},
- {core,{logical,24}},
- {core,{logical,25}},
- {core,{logical,27}},
- {core,{logical,29}}]},
- {node,[{core,{logical,3}},
- {core,{logical,4}},
- {core,{logical,5}},
- {core,{logical,6}},
- {core,{logical,7}},
- {core,{logical,12}},
- {core,{logical,13}},
- {core,{logical,14}},
- {core,{logical,15}},
- {core,{logical,20}},
- {core,{logical,21}},
- {core,{logical,22}},
- {core,{logical,23}},
- {core,{logical,28}},
- {core,{logical,30}}]},
- {node,[{core,{logical,31}},
- {core,{logical,36}},
- {core,{logical,37}},
- {core,{logical,38}},
- {core,{logical,44}},
- {core,{logical,45}},
- {core,{logical,46}},
- {core,{logical,47}},
- {core,{logical,51}},
- {core,{logical,52}},
- {core,{logical,53}},
- {core,{logical,54}},
- {core,{logical,55}},
- {core,{logical,60}},
- {core,{logical,61}}]},
- {node,[{core,{logical,26}},
- {core,{logical,32}},
- {core,{logical,33}},
- {core,{logical,34}},
- {core,{logical,35}},
- {core,{logical,39}},
- {core,{logical,40}},
- {core,{logical,41}},
- {core,{logical,42}},
- {core,{logical,43}},
- {core,{logical,48}},
- {core,{logical,49}},
- {core,{logical,50}},
- {core,{logical,58}}]}]}],
-
- ?line [{0,1},{1,1},{2,1},{3,3},{4,3},{5,3},{6,3},{7,3},{8,1},{9,1},{10,1},
- {11,1},{12,3},{13,3},{14,4},{15,4},{16,2},{17,2},{18,2},{19,2},
- {20,4},{21,4},{22,4},{23,4},{24,2},{25,2},{26,7},{27,2},{28,4},
- {29,2},{30,4},{31,5},{32,7},{33,7},{34,7},{35,7},{36,5},{37,5},
- {38,5},{39,7},{40,7},{41,8},{42,8},{43,8},{44,5},{45,5},{46,5},
- {47,6},{48,8},{49,8},{50,8},{51,6},{52,6},{53,6},{54,6},{55,6},
- {58,8},{60,6},{61,6}]
- = reader_groups_map(CPUT0, 8),
+ {core,{logical,1}},
+ {core,{logical,2}},
+ {core,{logical,8}},
+ {core,{logical,9}},
+ {core,{logical,10}},
+ {core,{logical,11}},
+ {core,{logical,16}},
+ {core,{logical,17}},
+ {core,{logical,18}},
+ {core,{logical,19}},
+ {core,{logical,24}},
+ {core,{logical,25}},
+ {core,{logical,27}},
+ {core,{logical,29}}]},
+ {node,[{core,{logical,3}},
+ {core,{logical,4}},
+ {core,{logical,5}},
+ {core,{logical,6}},
+ {core,{logical,7}},
+ {core,{logical,12}},
+ {core,{logical,13}},
+ {core,{logical,14}},
+ {core,{logical,15}},
+ {core,{logical,20}},
+ {core,{logical,21}},
+ {core,{logical,22}},
+ {core,{logical,23}},
+ {core,{logical,28}},
+ {core,{logical,30}}]},
+ {node,[{core,{logical,31}},
+ {core,{logical,36}},
+ {core,{logical,37}},
+ {core,{logical,38}},
+ {core,{logical,44}},
+ {core,{logical,45}},
+ {core,{logical,46}},
+ {core,{logical,47}},
+ {core,{logical,51}},
+ {core,{logical,52}},
+ {core,{logical,53}},
+ {core,{logical,54}},
+ {core,{logical,55}},
+ {core,{logical,60}},
+ {core,{logical,61}}]},
+ {node,[{core,{logical,26}},
+ {core,{logical,32}},
+ {core,{logical,33}},
+ {core,{logical,34}},
+ {core,{logical,35}},
+ {core,{logical,39}},
+ {core,{logical,40}},
+ {core,{logical,41}},
+ {core,{logical,42}},
+ {core,{logical,43}},
+ {core,{logical,48}},
+ {core,{logical,49}},
+ {core,{logical,50}},
+ {core,{logical,58}}]}]}],
+
+ [{0,1},{1,1},{2,1},{3,3},{4,3},{5,3},{6,3},{7,3},{8,1},{9,1},{10,1},
+ {11,1},{12,3},{13,3},{14,4},{15,4},{16,2},{17,2},{18,2},{19,2},
+ {20,4},{21,4},{22,4},{23,4},{24,2},{25,2},{26,7},{27,2},{28,4},
+ {29,2},{30,4},{31,5},{32,7},{33,7},{34,7},{35,7},{36,5},{37,5},
+ {38,5},{39,7},{40,7},{41,8},{42,8},{43,8},{44,5},{45,5},{46,5},
+ {47,6},{48,8},{49,8},{50,8},{51,6},{52,6},{53,6},{54,6},{55,6},
+ {58,8},{60,6},{61,6}]
+ = reader_groups_map(CPUT0, 8),
CPUT1 = [n([p([c([t(l(0)),t(l(1)),t(l(2)),t(l(3))]),
- c([t(l(4)),t(l(5)),t(l(6)),t(l(7))]),
- c([t(l(8)),t(l(9)),t(l(10)),t(l(11))]),
- c([t(l(12)),t(l(13)),t(l(14)),t(l(15))])]),
- p([c([t(l(16)),t(l(17)),t(l(18)),t(l(19))]),
- c([t(l(20)),t(l(21)),t(l(22)),t(l(23))]),
- c([t(l(24)),t(l(25)),t(l(26)),t(l(27))]),
- c([t(l(28)),t(l(29)),t(l(30)),t(l(31))])])]),
- n([p([c([t(l(32)),t(l(33)),t(l(34)),t(l(35))]),
- c([t(l(36)),t(l(37)),t(l(38)),t(l(39))]),
- c([t(l(40)),t(l(41)),t(l(42)),t(l(43))]),
- c([t(l(44)),t(l(45)),t(l(46)),t(l(47))])]),
- p([c([t(l(48)),t(l(49)),t(l(50)),t(l(51))]),
- c([t(l(52)),t(l(53)),t(l(54)),t(l(55))]),
- c([t(l(56)),t(l(57)),t(l(58)),t(l(59))]),
- c([t(l(60)),t(l(61)),t(l(62)),t(l(63))])])]),
- n([p([c([t(l(64)),t(l(65)),t(l(66)),t(l(67))]),
- c([t(l(68)),t(l(69)),t(l(70)),t(l(71))]),
- c([t(l(72)),t(l(73)),t(l(74)),t(l(75))]),
- c([t(l(76)),t(l(77)),t(l(78)),t(l(79))])]),
- p([c([t(l(80)),t(l(81)),t(l(82)),t(l(83))]),
- c([t(l(84)),t(l(85)),t(l(86)),t(l(87))]),
- c([t(l(88)),t(l(89)),t(l(90)),t(l(91))]),
- c([t(l(92)),t(l(93)),t(l(94)),t(l(95))])])]),
- n([p([c([t(l(96)),t(l(97)),t(l(98)),t(l(99))]),
- c([t(l(100)),t(l(101)),t(l(102)),t(l(103))]),
- c([t(l(104)),t(l(105)),t(l(106)),t(l(107))]),
- c([t(l(108)),t(l(109)),t(l(110)),t(l(111))])]),
- p([c([t(l(112)),t(l(113)),t(l(114)),t(l(115))]),
- c([t(l(116)),t(l(117)),t(l(118)),t(l(119))]),
- c([t(l(120)),t(l(121)),t(l(122)),t(l(123))]),
- c([t(l(124)),t(l(125)),t(l(126)),t(l(127))])])])],
-
- ?line [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3},
- {10,3},{11,3},{12,4},{13,4},{14,4},{15,4},{16,5},{17,5},{18,5},
- {19,5},{20,6},{21,6},{22,6},{23,6},{24,7},{25,7},{26,7},{27,7},
- {28,8},{29,8},{30,8},{31,8},{32,9},{33,9},{34,9},{35,9},{36,10},
- {37,10},{38,10},{39,10},{40,11},{41,11},{42,11},{43,11},{44,12},
- {45,12},{46,12},{47,12},{48,13},{49,13},{50,13},{51,13},{52,14},
- {53,14},{54,14},{55,14},{56,15},{57,15},{58,15},{59,15},{60,16},
- {61,16},{62,16},{63,16},{64,17},{65,17},{66,17},{67,17},{68,18},
- {69,18},{70,18},{71,18},{72,19},{73,19},{74,19},{75,19},{76,20},
- {77,20},{78,20},{79,20},{80,21},{81,21},{82,21},{83,21},{84,22},
- {85,22},{86,22},{87,22},{88,23},{89,23},{90,23},{91,23},{92,24},
- {93,24},{94,24},{95,24},{96,25},{97,25},{98,25},{99,25},{100,26},
- {101,26},{102,26},{103,26},{104,27},{105,27},{106,27},{107,27},
- {108,28},{109,28},{110,28},{111,28},{112,29},{113,29},{114,29},
- {115,29},{116,30},{117,30},{118,30},{119,30},{120,31},{121,31},
- {122,31},{123,31},{124,32},{125,32},{126,32},{127,32}]
- = reader_groups_map(CPUT1, 128),
-
- ?line [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1},
- {11,1},{12,1},{13,1},{14,1},{15,1},{16,1},{17,1},{18,1},{19,1},
- {20,1},{21,1},{22,1},{23,1},{24,1},{25,1},{26,1},{27,1},{28,1},
- {29,1},{30,1},{31,1},{32,1},{33,1},{34,1},{35,1},{36,1},{37,1},
- {38,1},{39,1},{40,1},{41,1},{42,1},{43,1},{44,1},{45,1},{46,1},
- {47,1},{48,1},{49,1},{50,1},{51,1},{52,1},{53,1},{54,1},{55,1},
- {56,1},{57,1},{58,1},{59,1},{60,1},{61,1},{62,1},{63,1},{64,2},
- {65,2},{66,2},{67,2},{68,2},{69,2},{70,2},{71,2},{72,2},{73,2},
- {74,2},{75,2},{76,2},{77,2},{78,2},{79,2},{80,2},{81,2},{82,2},
- {83,2},{84,2},{85,2},{86,2},{87,2},{88,2},{89,2},{90,2},{91,2},
- {92,2},{93,2},{94,2},{95,2},{96,2},{97,2},{98,2},{99,2},{100,2},
- {101,2},{102,2},{103,2},{104,2},{105,2},{106,2},{107,2},{108,2},
- {109,2},{110,2},{111,2},{112,2},{113,2},{114,2},{115,2},{116,2},
- {117,2},{118,2},{119,2},{120,2},{121,2},{122,2},{123,2},{124,2},
- {125,2},{126,2},{127,2}]
- = reader_groups_map(CPUT1, 2),
-
- ?line [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3},{10,3},
- {11,3},{12,3},{13,3},{14,3},{15,3},{16,4},{17,4},{18,4},{19,4},
- {20,4},{21,4},{22,4},{23,4},{24,5},{25,5},{26,5},{27,5},{28,5},
- {29,5},{30,5},{31,5},{32,6},{33,6},{34,6},{35,6},{36,6},{37,6},
- {38,6},{39,6},{40,7},{41,7},{42,7},{43,7},{44,7},{45,7},{46,7},
- {47,7},{48,8},{49,8},{50,8},{51,8},{52,8},{53,8},{54,8},{55,8},
- {56,9},{57,9},{58,9},{59,9},{60,9},{61,9},{62,9},{63,9},{64,10},
- {65,10},{66,10},{67,10},{68,10},{69,10},{70,10},{71,10},{72,11},
- {73,11},{74,11},{75,11},{76,11},{77,11},{78,11},{79,11},{80,12},
- {81,12},{82,12},{83,12},{84,12},{85,12},{86,12},{87,12},{88,13},
- {89,13},{90,13},{91,13},{92,13},{93,13},{94,13},{95,13},{96,14},
- {97,14},{98,14},{99,14},{100,14},{101,14},{102,14},{103,14},
- {104,15},{105,15},{106,15},{107,15},{108,15},{109,15},{110,15},
- {111,15},{112,16},{113,16},{114,16},{115,16},{116,16},{117,16},
- {118,16},{119,16},{120,17},{121,17},{122,17},{123,17},{124,17},
- {125,17},{126,17},{127,17}]
- = reader_groups_map(CPUT1, 17),
-
- ?line [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1},
- {11,1},{12,1},{13,1},{14,1},{15,1},{16,2},{17,2},{18,2},{19,2},
- {20,2},{21,2},{22,2},{23,2},{24,2},{25,2},{26,2},{27,2},{28,2},
- {29,2},{30,2},{31,2},{32,3},{33,3},{34,3},{35,3},{36,3},{37,3},
- {38,3},{39,3},{40,3},{41,3},{42,3},{43,3},{44,3},{45,3},{46,3},
- {47,3},{48,4},{49,4},{50,4},{51,4},{52,4},{53,4},{54,4},{55,4},
- {56,4},{57,4},{58,4},{59,4},{60,4},{61,4},{62,4},{63,4},{64,5},
- {65,5},{66,5},{67,5},{68,5},{69,5},{70,5},{71,5},{72,5},{73,5},
- {74,5},{75,5},{76,5},{77,5},{78,5},{79,5},{80,6},{81,6},{82,6},
- {83,6},{84,6},{85,6},{86,6},{87,6},{88,6},{89,6},{90,6},{91,6},
- {92,6},{93,6},{94,6},{95,6},{96,7},{97,7},{98,7},{99,7},{100,7},
- {101,7},{102,7},{103,7},{104,7},{105,7},{106,7},{107,7},{108,7},
- {109,7},{110,7},{111,7},{112,7},{113,7},{114,7},{115,7},{116,7},
- {117,7},{118,7},{119,7},{120,7},{121,7},{122,7},{123,7},{124,7},
- {125,7},{126,7},{127,7}]
- = reader_groups_map(CPUT1, 7),
-
- ?line CPUT2 = [p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))]),
- p([t(l(5)),t(l(6)),t(l(7)),t(l(8)),t(l(9))]),
- p([t(l(10))]),
- p([c(l(11)),c(l(12)),c(l(13))]),
- p([c(l(14)),c(l(15))])],
-
- ?line [{0,1},{1,1},{2,1},{3,1},{4,1},
- {5,2},{6,2},{7,2},{8,2},{9,2},
- {10,3},
- {11,4},{12,4},{13,4},
- {14,5},{15,5}] = reader_groups_map(CPUT2, 5),
-
-
- ?line [{0,1},{1,1},{2,2},{3,2},{4,2},
- {5,3},{6,3},{7,3},{8,3},{9,3},
- {10,4},
- {11,5},{12,5},{13,5},
- {14,6},{15,6}] = reader_groups_map(CPUT2, 6),
-
- ?line [{0,1},{1,1},{2,2},{3,2},{4,2},
- {5,3},{6,3},{7,3},{8,3},{9,3},
- {10,4},
- {11,5},{12,6},{13,6},
- {14,7},{15,7}] = reader_groups_map(CPUT2, 7),
-
- ?line [{0,1},{1,1},{2,2},{3,2},{4,2},
- {5,3},{6,3},{7,3},{8,3},{9,3},
- {10,4},
- {11,5},{12,6},{13,6},
- {14,7},{15,8}] = reader_groups_map(CPUT2, 8),
-
- ?line [{0,1},{1,2},{2,2},{3,3},{4,3},
- {5,4},{6,4},{7,4},{8,4},{9,4},
- {10,5},
- {11,6},{12,7},{13,7},
- {14,8},{15,9}] = reader_groups_map(CPUT2, 9),
-
- ?line [{0,1},{1,2},{2,2},{3,3},{4,3},
- {5,4},{6,4},{7,4},{8,4},{9,4},
- {10,5},
- {11,6},{12,7},{13,8},
- {14,9},{15,10}] = reader_groups_map(CPUT2, 10),
-
- ?line [{0,1},{1,2},{2,3},{3,4},{4,4},
- {5,5},{6,5},{7,5},{8,5},{9,5},
- {10,6},
- {11,7},{12,8},{13,9},
- {14,10},{15,11}] = reader_groups_map(CPUT2, 11),
-
- ?line [{0,1},{1,2},{2,3},{3,4},{4,5},
- {5,6},{6,6},{7,6},{8,6},{9,6},
- {10,7},
- {11,8},{12,9},{13,10},
- {14,11},{15,12}] = reader_groups_map(CPUT2, 100),
+ c([t(l(4)),t(l(5)),t(l(6)),t(l(7))]),
+ c([t(l(8)),t(l(9)),t(l(10)),t(l(11))]),
+ c([t(l(12)),t(l(13)),t(l(14)),t(l(15))])]),
+ p([c([t(l(16)),t(l(17)),t(l(18)),t(l(19))]),
+ c([t(l(20)),t(l(21)),t(l(22)),t(l(23))]),
+ c([t(l(24)),t(l(25)),t(l(26)),t(l(27))]),
+ c([t(l(28)),t(l(29)),t(l(30)),t(l(31))])])]),
+ n([p([c([t(l(32)),t(l(33)),t(l(34)),t(l(35))]),
+ c([t(l(36)),t(l(37)),t(l(38)),t(l(39))]),
+ c([t(l(40)),t(l(41)),t(l(42)),t(l(43))]),
+ c([t(l(44)),t(l(45)),t(l(46)),t(l(47))])]),
+ p([c([t(l(48)),t(l(49)),t(l(50)),t(l(51))]),
+ c([t(l(52)),t(l(53)),t(l(54)),t(l(55))]),
+ c([t(l(56)),t(l(57)),t(l(58)),t(l(59))]),
+ c([t(l(60)),t(l(61)),t(l(62)),t(l(63))])])]),
+ n([p([c([t(l(64)),t(l(65)),t(l(66)),t(l(67))]),
+ c([t(l(68)),t(l(69)),t(l(70)),t(l(71))]),
+ c([t(l(72)),t(l(73)),t(l(74)),t(l(75))]),
+ c([t(l(76)),t(l(77)),t(l(78)),t(l(79))])]),
+ p([c([t(l(80)),t(l(81)),t(l(82)),t(l(83))]),
+ c([t(l(84)),t(l(85)),t(l(86)),t(l(87))]),
+ c([t(l(88)),t(l(89)),t(l(90)),t(l(91))]),
+ c([t(l(92)),t(l(93)),t(l(94)),t(l(95))])])]),
+ n([p([c([t(l(96)),t(l(97)),t(l(98)),t(l(99))]),
+ c([t(l(100)),t(l(101)),t(l(102)),t(l(103))]),
+ c([t(l(104)),t(l(105)),t(l(106)),t(l(107))]),
+ c([t(l(108)),t(l(109)),t(l(110)),t(l(111))])]),
+ p([c([t(l(112)),t(l(113)),t(l(114)),t(l(115))]),
+ c([t(l(116)),t(l(117)),t(l(118)),t(l(119))]),
+ c([t(l(120)),t(l(121)),t(l(122)),t(l(123))]),
+ c([t(l(124)),t(l(125)),t(l(126)),t(l(127))])])])],
+
+ [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3},
+ {10,3},{11,3},{12,4},{13,4},{14,4},{15,4},{16,5},{17,5},{18,5},
+ {19,5},{20,6},{21,6},{22,6},{23,6},{24,7},{25,7},{26,7},{27,7},
+ {28,8},{29,8},{30,8},{31,8},{32,9},{33,9},{34,9},{35,9},{36,10},
+ {37,10},{38,10},{39,10},{40,11},{41,11},{42,11},{43,11},{44,12},
+ {45,12},{46,12},{47,12},{48,13},{49,13},{50,13},{51,13},{52,14},
+ {53,14},{54,14},{55,14},{56,15},{57,15},{58,15},{59,15},{60,16},
+ {61,16},{62,16},{63,16},{64,17},{65,17},{66,17},{67,17},{68,18},
+ {69,18},{70,18},{71,18},{72,19},{73,19},{74,19},{75,19},{76,20},
+ {77,20},{78,20},{79,20},{80,21},{81,21},{82,21},{83,21},{84,22},
+ {85,22},{86,22},{87,22},{88,23},{89,23},{90,23},{91,23},{92,24},
+ {93,24},{94,24},{95,24},{96,25},{97,25},{98,25},{99,25},{100,26},
+ {101,26},{102,26},{103,26},{104,27},{105,27},{106,27},{107,27},
+ {108,28},{109,28},{110,28},{111,28},{112,29},{113,29},{114,29},
+ {115,29},{116,30},{117,30},{118,30},{119,30},{120,31},{121,31},
+ {122,31},{123,31},{124,32},{125,32},{126,32},{127,32}]
+ = reader_groups_map(CPUT1, 128),
+
+ [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1},
+ {11,1},{12,1},{13,1},{14,1},{15,1},{16,1},{17,1},{18,1},{19,1},
+ {20,1},{21,1},{22,1},{23,1},{24,1},{25,1},{26,1},{27,1},{28,1},
+ {29,1},{30,1},{31,1},{32,1},{33,1},{34,1},{35,1},{36,1},{37,1},
+ {38,1},{39,1},{40,1},{41,1},{42,1},{43,1},{44,1},{45,1},{46,1},
+ {47,1},{48,1},{49,1},{50,1},{51,1},{52,1},{53,1},{54,1},{55,1},
+ {56,1},{57,1},{58,1},{59,1},{60,1},{61,1},{62,1},{63,1},{64,2},
+ {65,2},{66,2},{67,2},{68,2},{69,2},{70,2},{71,2},{72,2},{73,2},
+ {74,2},{75,2},{76,2},{77,2},{78,2},{79,2},{80,2},{81,2},{82,2},
+ {83,2},{84,2},{85,2},{86,2},{87,2},{88,2},{89,2},{90,2},{91,2},
+ {92,2},{93,2},{94,2},{95,2},{96,2},{97,2},{98,2},{99,2},{100,2},
+ {101,2},{102,2},{103,2},{104,2},{105,2},{106,2},{107,2},{108,2},
+ {109,2},{110,2},{111,2},{112,2},{113,2},{114,2},{115,2},{116,2},
+ {117,2},{118,2},{119,2},{120,2},{121,2},{122,2},{123,2},{124,2},
+ {125,2},{126,2},{127,2}]
+ = reader_groups_map(CPUT1, 2),
+
+ [{0,1},{1,1},{2,1},{3,1},{4,2},{5,2},{6,2},{7,2},{8,3},{9,3},{10,3},
+ {11,3},{12,3},{13,3},{14,3},{15,3},{16,4},{17,4},{18,4},{19,4},
+ {20,4},{21,4},{22,4},{23,4},{24,5},{25,5},{26,5},{27,5},{28,5},
+ {29,5},{30,5},{31,5},{32,6},{33,6},{34,6},{35,6},{36,6},{37,6},
+ {38,6},{39,6},{40,7},{41,7},{42,7},{43,7},{44,7},{45,7},{46,7},
+ {47,7},{48,8},{49,8},{50,8},{51,8},{52,8},{53,8},{54,8},{55,8},
+ {56,9},{57,9},{58,9},{59,9},{60,9},{61,9},{62,9},{63,9},{64,10},
+ {65,10},{66,10},{67,10},{68,10},{69,10},{70,10},{71,10},{72,11},
+ {73,11},{74,11},{75,11},{76,11},{77,11},{78,11},{79,11},{80,12},
+ {81,12},{82,12},{83,12},{84,12},{85,12},{86,12},{87,12},{88,13},
+ {89,13},{90,13},{91,13},{92,13},{93,13},{94,13},{95,13},{96,14},
+ {97,14},{98,14},{99,14},{100,14},{101,14},{102,14},{103,14},
+ {104,15},{105,15},{106,15},{107,15},{108,15},{109,15},{110,15},
+ {111,15},{112,16},{113,16},{114,16},{115,16},{116,16},{117,16},
+ {118,16},{119,16},{120,17},{121,17},{122,17},{123,17},{124,17},
+ {125,17},{126,17},{127,17}]
+ = reader_groups_map(CPUT1, 17),
+
+ [{0,1},{1,1},{2,1},{3,1},{4,1},{5,1},{6,1},{7,1},{8,1},{9,1},{10,1},
+ {11,1},{12,1},{13,1},{14,1},{15,1},{16,2},{17,2},{18,2},{19,2},
+ {20,2},{21,2},{22,2},{23,2},{24,2},{25,2},{26,2},{27,2},{28,2},
+ {29,2},{30,2},{31,2},{32,3},{33,3},{34,3},{35,3},{36,3},{37,3},
+ {38,3},{39,3},{40,3},{41,3},{42,3},{43,3},{44,3},{45,3},{46,3},
+ {47,3},{48,4},{49,4},{50,4},{51,4},{52,4},{53,4},{54,4},{55,4},
+ {56,4},{57,4},{58,4},{59,4},{60,4},{61,4},{62,4},{63,4},{64,5},
+ {65,5},{66,5},{67,5},{68,5},{69,5},{70,5},{71,5},{72,5},{73,5},
+ {74,5},{75,5},{76,5},{77,5},{78,5},{79,5},{80,6},{81,6},{82,6},
+ {83,6},{84,6},{85,6},{86,6},{87,6},{88,6},{89,6},{90,6},{91,6},
+ {92,6},{93,6},{94,6},{95,6},{96,7},{97,7},{98,7},{99,7},{100,7},
+ {101,7},{102,7},{103,7},{104,7},{105,7},{106,7},{107,7},{108,7},
+ {109,7},{110,7},{111,7},{112,7},{113,7},{114,7},{115,7},{116,7},
+ {117,7},{118,7},{119,7},{120,7},{121,7},{122,7},{123,7},{124,7},
+ {125,7},{126,7},{127,7}]
+ = reader_groups_map(CPUT1, 7),
+
+ CPUT2 = [p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))]),
+ p([t(l(5)),t(l(6)),t(l(7)),t(l(8)),t(l(9))]),
+ p([t(l(10))]),
+ p([c(l(11)),c(l(12)),c(l(13))]),
+ p([c(l(14)),c(l(15))])],
+
+ [{0,1},{1,1},{2,1},{3,1},{4,1},
+ {5,2},{6,2},{7,2},{8,2},{9,2},
+ {10,3},
+ {11,4},{12,4},{13,4},
+ {14,5},{15,5}] = reader_groups_map(CPUT2, 5),
+
+
+ [{0,1},{1,1},{2,2},{3,2},{4,2},
+ {5,3},{6,3},{7,3},{8,3},{9,3},
+ {10,4},
+ {11,5},{12,5},{13,5},
+ {14,6},{15,6}] = reader_groups_map(CPUT2, 6),
+
+ [{0,1},{1,1},{2,2},{3,2},{4,2},
+ {5,3},{6,3},{7,3},{8,3},{9,3},
+ {10,4},
+ {11,5},{12,6},{13,6},
+ {14,7},{15,7}] = reader_groups_map(CPUT2, 7),
+
+ [{0,1},{1,1},{2,2},{3,2},{4,2},
+ {5,3},{6,3},{7,3},{8,3},{9,3},
+ {10,4},
+ {11,5},{12,6},{13,6},
+ {14,7},{15,8}] = reader_groups_map(CPUT2, 8),
+
+ [{0,1},{1,2},{2,2},{3,3},{4,3},
+ {5,4},{6,4},{7,4},{8,4},{9,4},
+ {10,5},
+ {11,6},{12,7},{13,7},
+ {14,8},{15,9}] = reader_groups_map(CPUT2, 9),
+
+ [{0,1},{1,2},{2,2},{3,3},{4,3},
+ {5,4},{6,4},{7,4},{8,4},{9,4},
+ {10,5},
+ {11,6},{12,7},{13,8},
+ {14,9},{15,10}] = reader_groups_map(CPUT2, 10),
+
+ [{0,1},{1,2},{2,3},{3,4},{4,4},
+ {5,5},{6,5},{7,5},{8,5},{9,5},
+ {10,6},
+ {11,7},{12,8},{13,9},
+ {14,10},{15,11}] = reader_groups_map(CPUT2, 11),
+
+ [{0,1},{1,2},{2,3},{3,4},{4,5},
+ {5,6},{6,6},{7,6},{8,6},{9,6},
+ {10,7},
+ {11,8},{12,9},{13,10},
+ {14,11},{15,12}] = reader_groups_map(CPUT2, 100),
CPUT3 = [p([t(l(5)),t(l(6)),t(l(7)),t(l(8)),t(l(9))]),
- p([t(l(10))]),
- p([c(l(11)),c(l(12)),c(l(13))]),
- p([c(l(14)),c(l(15))]),
- p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))])],
+ p([t(l(10))]),
+ p([c(l(11)),c(l(12)),c(l(13))]),
+ p([c(l(14)),c(l(15))]),
+ p([c(l(0)),c(l(1)),c(l(2)),c(l(3)),c(l(4))])],
- ?line [{0,5},{1,5},{2,6},{3,6},{4,6},
- {5,1},{6,1},{7,1},{8,1},{9,1},
- {10,2},{11,3},{12,3},{13,3},
- {14,4},{15,4}] = reader_groups_map(CPUT3, 6),
+ [{0,5},{1,5},{2,6},{3,6},{4,6},
+ {5,1},{6,1},{7,1},{8,1},{9,1},
+ {10,2},{11,3},{12,3},{13,3},
+ {14,4},{15,4}] = reader_groups_map(CPUT3, 6),
CPUT4 = [p([t(l(0)),t(l(1)),t(l(2)),t(l(3)),t(l(4))]),
- p([t(l(5))]),
- p([c(l(6)),c(l(7)),c(l(8))]),
- p([c(l(9)),c(l(10))]),
- p([c(l(11)),c(l(12)),c(l(13)),c(l(14)),c(l(15))])],
-
- ?line [{0,1},{1,1},{2,1},{3,1},{4,1},
- {5,2},
- {6,3},{7,3},{8,3},
- {9,4},{10,4},
- {11,5},{12,5},{13,6},{14,6},{15,6}] = reader_groups_map(CPUT4, 6),
-
- ?line [{0,1},{1,1},{2,1},{3,1},{4,1},
- {5,2},
- {6,3},{7,4},{8,4},
- {9,5},{10,5},
- {11,6},{12,6},{13,7},{14,7},{15,7}] = reader_groups_map(CPUT4, 7),
-
- ?line [{0,1},{65535,2}] = reader_groups_map([c(l(0)),c(l(65535))], 10),
-
- ?line ok.
+ p([t(l(5))]),
+ p([c(l(6)),c(l(7)),c(l(8))]),
+ p([c(l(9)),c(l(10))]),
+ p([c(l(11)),c(l(12)),c(l(13)),c(l(14)),c(l(15))])],
+
+ [{0,1},{1,1},{2,1},{3,1},{4,1},
+ {5,2},
+ {6,3},{7,3},{8,3},
+ {9,4},{10,4},
+ {11,5},{12,5},{13,6},{14,6},{15,6}] = reader_groups_map(CPUT4, 6),
+
+ [{0,1},{1,1},{2,1},{3,1},{4,1},
+ {5,2},
+ {6,3},{7,4},{8,4},
+ {9,5},{10,5},
+ {11,6},{12,6},{13,7},{14,7},{15,7}] = reader_groups_map(CPUT4, 7),
+
+ [{0,1},{65535,2}] = reader_groups_map([c(l(0)),c(l(65535))], 10),
+ ok.
reader_groups_map(CPUT, Groups) ->
@@ -1550,6 +1718,34 @@ reader_groups_map(CPUT, Groups) ->
%% Utils
%%
+sched_state() ->
+ sched_state(erlang:system_info(all_schedulers_state),
+ undefined,
+ {dirty_cpu,0,0,0},
+ {dirty_io,0,0,0}).
+
+
+sched_state([], N, DC, DI) ->
+ try
+ chk_basic(N),
+ chk_basic(DC),
+ chk_basic(DI),
+ {N, DC, DI}
+ catch
+ _ : _ ->
+ ?t:fail({inconsisten_scheduler_state, {N, DC, DI}})
+ end;
+sched_state([{normal, _, _, _} = S | Rest], _S, DC, DI) ->
+ sched_state(Rest, S, DC, DI);
+sched_state([{dirty_cpu, _, _, _} = DC | Rest], S, _DC, DI) ->
+ sched_state(Rest, S, DC, DI);
+sched_state([{dirty_io, _, _, _} = DI | Rest], S, DC, _DI) ->
+ sched_state(Rest, S, DC, DI).
+
+chk_basic({_Type, Tot, Onln, Act}) ->
+ true = Tot >= Onln,
+ true = Onln >= Act.
+
l(Id) ->
{logical, Id}.
@@ -1568,21 +1764,21 @@ n(X) ->
mcall(Node, Funs) ->
Parent = self(),
Refs = lists:map(fun (Fun) ->
- Ref = make_ref(),
- spawn_link(Node,
- fun () ->
- Res = Fun(),
- unlink(Parent),
- Parent ! {Ref, Res}
- end),
- Ref
- end, Funs),
+ Ref = make_ref(),
+ spawn_link(Node,
+ fun () ->
+ Res = Fun(),
+ unlink(Parent),
+ Parent ! {Ref, Res}
+ end),
+ Ref
+ end, Funs),
lists:map(fun (Ref) ->
- receive
- {Ref, Res} ->
- Res
- end
- end, Refs).
+ receive
+ {Ref, Res} ->
+ Res
+ end
+ end, Refs).
erl_rel_flag_var() ->
"ERL_OTP"++erlang:system_info(otp_release)++"_FLAGS".
@@ -1606,101 +1802,101 @@ restore_erl_rel_flags(OldValue) ->
ok(too_slow, _Config) ->
{comment, "Too slow system to do any actual testing..."};
ok(_Res, Config) ->
- ?config(ok_res, Config).
+ proplists:get_value(ok_res, Config).
chk_result(too_slow,
- _LWorkers,
- _NWorkers,
- _HWorkers,
- _MWorkers,
- _LNShouldWork,
- _HShouldWork,
- _MShouldWork) ->
- ?line ok;
+ _LWorkers,
+ _NWorkers,
+ _HWorkers,
+ _MWorkers,
+ _LNShouldWork,
+ _HShouldWork,
+ _MShouldWork) ->
+ ok;
chk_result([{low, L, Lmin, _Lmax},
- {normal, N, Nmin, _Nmax},
- {high, H, Hmin, _Hmax},
- {max, M, Mmin, _Mmax}] = Res,
- LWorkers,
- NWorkers,
- HWorkers,
- MWorkers,
- LNShouldWork,
- HShouldWork,
- MShouldWork) ->
- ?line ?t:format("~p~n", [Res]),
- ?line Relax = relax_limits(),
+ {normal, N, Nmin, _Nmax},
+ {high, H, Hmin, _Hmax},
+ {max, M, Mmin, _Mmax}] = Res,
+ LWorkers,
+ NWorkers,
+ HWorkers,
+ MWorkers,
+ LNShouldWork,
+ HShouldWork,
+ MShouldWork) ->
+ io:format("~p~n", [Res]),
+ Relax = relax_limits(),
case {L, N} of
- {0, 0} ->
- ?line false = LNShouldWork;
- _ ->
- ?line {LminRatioLim,
- NminRatioLim,
- LNRatioLimMin,
- LNRatioLimMax} = case Relax of
- false -> {0.5, 0.5, 0.05, 0.25};
- true -> {0.05, 0.05, 0.01, 0.4}
- end,
- ?line Lavg = L/LWorkers,
- ?line Navg = N/NWorkers,
- ?line Ratio = Lavg/Navg,
- ?line LminRatio = Lmin/Lavg,
- ?line NminRatio = Nmin/Navg,
- ?line ?t:format("low min ratio=~p~n"
- "normal min ratio=~p~n"
- "low avg=~p~n"
- "normal avg=~p~n"
- "low/normal ratio=~p~n",
- [LminRatio, NminRatio, Lavg, Navg, Ratio]),
- erlang:display({low_min_ratio, LminRatio}),
- erlang:display({normal_min_ratio, NminRatio}),
- erlang:display({low_avg, Lavg}),
- erlang:display({normal_avg, Navg}),
- erlang:display({low_normal_ratio, Ratio}),
- ?line chk_lim(LminRatioLim, LminRatio, 1.0, low_min_ratio),
- ?line chk_lim(NminRatioLim, NminRatio, 1.0, normal_min_ratio),
- ?line chk_lim(LNRatioLimMin, Ratio, LNRatioLimMax, low_normal_ratio),
- ?line true = LNShouldWork,
- ?line ok
+ {0, 0} ->
+ false = LNShouldWork;
+ _ ->
+ {LminRatioLim,
+ NminRatioLim,
+ LNRatioLimMin,
+ LNRatioLimMax} = case Relax of
+ false -> {0.5, 0.5, 0.05, 0.25};
+ true -> {0.05, 0.05, 0.01, 0.4}
+ end,
+ Lavg = L/LWorkers,
+ Navg = N/NWorkers,
+ Ratio = Lavg/Navg,
+ LminRatio = Lmin/Lavg,
+ NminRatio = Nmin/Navg,
+ io:format("low min ratio=~p~n"
+ "normal min ratio=~p~n"
+ "low avg=~p~n"
+ "normal avg=~p~n"
+ "low/normal ratio=~p~n",
+ [LminRatio, NminRatio, Lavg, Navg, Ratio]),
+ erlang:display({low_min_ratio, LminRatio}),
+ erlang:display({normal_min_ratio, NminRatio}),
+ erlang:display({low_avg, Lavg}),
+ erlang:display({normal_avg, Navg}),
+ erlang:display({low_normal_ratio, Ratio}),
+ chk_lim(LminRatioLim, LminRatio, 1.0, low_min_ratio),
+ chk_lim(NminRatioLim, NminRatio, 1.0, normal_min_ratio),
+ chk_lim(LNRatioLimMin, Ratio, LNRatioLimMax, low_normal_ratio),
+ true = LNShouldWork,
+ ok
end,
case H of
- 0 ->
- ?line false = HShouldWork;
- _ ->
- ?line HminRatioLim = case Relax of
- false -> 0.5;
- true -> 0.1
- end,
- ?line Havg = H/HWorkers,
- ?line HminRatio = Hmin/Havg,
- erlang:display({high_min_ratio, HminRatio}),
- ?line chk_lim(HminRatioLim, HminRatio, 1.0, high_min_ratio),
- ?line true = HShouldWork,
- ?line ok
+ 0 ->
+ false = HShouldWork;
+ _ ->
+ HminRatioLim = case Relax of
+ false -> 0.5;
+ true -> 0.1
+ end,
+ Havg = H/HWorkers,
+ HminRatio = Hmin/Havg,
+ erlang:display({high_min_ratio, HminRatio}),
+ chk_lim(HminRatioLim, HminRatio, 1.0, high_min_ratio),
+ true = HShouldWork,
+ ok
end,
case M of
- 0 ->
- ?line false = MShouldWork;
- _ ->
- ?line MminRatioLim = case Relax of
- false -> 0.5;
- true -> 0.1
- end,
- ?line Mavg = M/MWorkers,
- ?line MminRatio = Mmin/Mavg,
- erlang:display({max_min_ratio, MminRatio}),
- ?line chk_lim(MminRatioLim, MminRatio, 1.0, max_min_ratio),
- ?line true = MShouldWork,
- ?line ok
+ 0 ->
+ false = MShouldWork;
+ _ ->
+ MminRatioLim = case Relax of
+ false -> 0.5;
+ true -> 0.1
+ end,
+ Mavg = M/MWorkers,
+ MminRatio = Mmin/Mavg,
+ erlang:display({max_min_ratio, MminRatio}),
+ chk_lim(MminRatioLim, MminRatio, 1.0, max_min_ratio),
+ true = MShouldWork,
+ ok
end,
- ?line ok.
+ ok.
chk_lim(Min, V, Max, _What) when Min =< V, V =< Max ->
ok;
chk_lim(_Min, V, _Max, What) ->
- ?t:fail({bad, What, V}).
+ ct:fail({bad, What, V}).
snd(_Msg, []) ->
[];
@@ -1711,7 +1907,7 @@ snd(Msg, [P|Ps]) ->
relax_limits() ->
case strange_system_scale() of
Scale when Scale > 1 ->
- ?t:format("Relaxing limits~n", []),
+ io:format("Relaxing limits~n", []),
true;
_ ->
false
@@ -1836,8 +2032,8 @@ do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) ->
EndWait = erlang:monotonic_time(milli_seconds),
BalanceWait = EndWait-StartWait,
erlang:display({balance_wait, BalanceWait}),
- Timeout = ?DEFAULT_TIMEOUT - ?t:minutes(4) - BalanceWait,
- Res = case Timeout < ?MIN_SCHEDULER_TEST_TIMEOUT of
+ Timeout = (15 - 4)*60*1000 - BalanceWait,
+ Res = case Timeout < 60*1000 of
true ->
stop_work(Low, Normal, High, Max),
too_slow;
@@ -1907,55 +2103,55 @@ part_time_workers(N, Prio) ->
tracer(Low, Normal, High, Max) ->
receive
- {tracees, Prio, Tracees} ->
- save_tracees(Prio, Tracees),
- case Prio of
- low -> tracer(Tracees++Low, Normal, High, Max);
- normal -> tracer(Low, Tracees++Normal, High, Max);
- high -> tracer(Low, Normal, Tracees++High, Max);
- max -> tracer(Low, Normal, High, Tracees++Max)
- end;
- {get_result, Ref, Who} ->
- Delivered = erlang:trace_delivered(all),
- receive
- {trace_delivered, all, Delivered} ->
- ok
- end,
- {Lc, Nc, Hc, Mc} = read_trace(),
- GetMinMax
- = fun (Prio, Procs) ->
- LargeNum = 1 bsl 64,
- case lists:foldl(fun (P, {Mn, Mx} = MnMx) ->
- {Prio, C} = get(P),
- case C < Mn of
- true ->
- case C > Mx of
- true ->
- {C, C};
- false ->
- {C, Mx}
- end;
- false ->
- case C > Mx of
- true -> {Mn, C};
- false -> MnMx
- end
- end
- end,
- {LargeNum, 0},
- Procs) of
- {LargeNum, 0} -> {0, 0};
- Res -> Res
- end
- end,
- {Lmin, Lmax} = GetMinMax(low, Low),
- {Nmin, Nmax} = GetMinMax(normal, Normal),
- {Hmin, Hmax} = GetMinMax(high, High),
- {Mmin, Mmax} = GetMinMax(max, Max),
- Who ! {trace_result, Ref, [{low, Lc, Lmin, Lmax},
- {normal, Nc, Nmin, Nmax},
- {high, Hc, Hmin, Hmax},
- {max, Mc, Mmin, Mmax}]}
+ {tracees, Prio, Tracees} ->
+ save_tracees(Prio, Tracees),
+ case Prio of
+ low -> tracer(Tracees++Low, Normal, High, Max);
+ normal -> tracer(Low, Tracees++Normal, High, Max);
+ high -> tracer(Low, Normal, Tracees++High, Max);
+ max -> tracer(Low, Normal, High, Tracees++Max)
+ end;
+ {get_result, Ref, Who} ->
+ Delivered = erlang:trace_delivered(all),
+ receive
+ {trace_delivered, all, Delivered} ->
+ ok
+ end,
+ {Lc, Nc, Hc, Mc} = read_trace(),
+ GetMinMax
+ = fun (Prio, Procs) ->
+ LargeNum = 1 bsl 64,
+ case lists:foldl(fun (P, {Mn, Mx} = MnMx) ->
+ {Prio, C} = get(P),
+ case C < Mn of
+ true ->
+ case C > Mx of
+ true ->
+ {C, C};
+ false ->
+ {C, Mx}
+ end;
+ false ->
+ case C > Mx of
+ true -> {Mn, C};
+ false -> MnMx
+ end
+ end
+ end,
+ {LargeNum, 0},
+ Procs) of
+ {LargeNum, 0} -> {0, 0};
+ Res -> Res
+ end
+ end,
+ {Lmin, Lmax} = GetMinMax(low, Low),
+ {Nmin, Nmax} = GetMinMax(normal, Normal),
+ {Hmin, Hmax} = GetMinMax(high, High),
+ {Mmin, Mmax} = GetMinMax(max, Max),
+ Who ! {trace_result, Ref, [{low, Lc, Lmin, Lmax},
+ {normal, Nc, Nmin, Nmax},
+ {high, Hc, Hmin, Hmax},
+ {max, Mc, Mmin, Mmax}]}
end.
read_trace() ->
@@ -2031,15 +2227,15 @@ start_node(Config, Args) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
- ++ atom_to_list(?config(testcase, Config))
+ ++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
++ integer_to_list(erlang:system_time(seconds))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
- ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
+ test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
enable_internal_state() ->
@@ -2051,7 +2247,7 @@ enable_internal_state() ->
cmp(X, X) ->
ok;
cmp(X, Y) ->
- ?t:format("cmp failed:~n X=~p~n Y=~p~n", [X,Y]),
+ io:format("cmp failed:~n X=~p~n Y=~p~n", [X,Y]),
cmp_aux(X, Y).
@@ -2063,7 +2259,7 @@ cmp_aux(T0, T1) when is_tuple(T0), is_tuple(T1), size(T0) == size(T1) ->
cmp_aux(X, X) ->
ok;
cmp_aux(F0, F1) ->
- ?t:fail({no_match, F0, F1}).
+ ct:fail({no_match, F0, F1}).
cmp_tuple(_T0, _T1, N, Sz) when N > Sz ->
ok;
diff --git a/erts/emulator/test/scheduler_SUITE_data/Makefile.src b/erts/emulator/test/scheduler_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..859112cf19
--- /dev/null
+++ b/erts/emulator/test/scheduler_SUITE_data/Makefile.src
@@ -0,0 +1,8 @@
+
+SCHEDULER_LIBS = scheduler_SUITE@dll@
+
+all: $(SCHEDULER_LIBS)
+
+@SHLIB_RULES@
+
+$(SCHEDULER_LIBS): scheduler_SUITE.c
diff --git a/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c
new file mode 100644
index 0000000000..022858c114
--- /dev/null
+++ b/erts/emulator/test/scheduler_SUITE_data/scheduler_SUITE.c
@@ -0,0 +1,31 @@
+#include <unistd.h>
+#include "erl_nif.h"
+
+static int
+load(ErlNifEnv* env, void** priv, ERL_NIF_TERM info)
+{
+ ErlNifSysInfo sys_info;
+ enif_system_info(&sys_info, sizeof(ErlNifSysInfo));
+ if (!sys_info.smp_support || !sys_info.dirty_scheduler_support)
+ return 1;
+ return 0;
+}
+
+static ERL_NIF_TERM
+dirty_sleeper(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
+ sleep(3);
+#endif
+ return enif_make_atom(env, "ok");
+}
+
+static ErlNifFunc funcs[] = {
+#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT
+ {"dirty_sleeper", 0, dirty_sleeper, ERL_NIF_DIRTY_JOB_IO_BOUND}
+#else
+ {"dirty_sleeper", 0, dirty_sleeper, 0}
+#endif
+};
+
+ERL_NIF_INIT(scheduler_SUITE, funcs, &load, NULL, NULL, NULL);
diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl
index 670865cd3f..75161389b1 100644
--- a/erts/emulator/test/send_term_SUITE.erl
+++ b/erts/emulator/test/send_term_SUITE.erl
@@ -20,49 +20,25 @@
-module(send_term_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,basic/1]).
--export([init_per_testcase/2,end_per_testcase/2]).
+-export([all/0, suite/0, basic/1]).
-export([generate_external_terms_files/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(3)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 3}}].
all() ->
[basic].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
basic(Config) when is_list(Config) ->
Drv = "send_term_drv",
- ?line P = start_driver(Config, Drv),
+ P = start_driver(Config, Drv),
- ?line [] = term(P, 0),
- ?line Self = self(),
+ [] = term(P, 0),
+ Self = self(),
{blurf,42,[],[-42,{}|"abc"++P],"kalle",3.1416,Self,#{}} = term(P, 1),
Map41 = maps:from_list([{blurf, 42},
@@ -76,36 +52,36 @@ basic(Config) when is_list(Config) ->
{3.1416, Self},
{#{}, blurf}]),
Map42 = term(P, 42),
- ?line Deep = lists:seq(0, 199),
- ?line Deep = term(P, 2),
- ?line {B1,B2} = term(P, 3),
- ?line B1 = list_to_binary(lists:seq(0, 255)),
- ?line B2 = list_to_binary(lists:seq(23, 255-17)),
+ Deep = lists:seq(0, 199),
+ Deep = term(P, 2),
+ {B1,B2} = term(P, 3),
+ B1 = list_to_binary(lists:seq(0, 255)),
+ B2 = list_to_binary(lists:seq(23, 255-17)),
%% Pid sending. We need another process.
- ?line Child = spawn_link(fun() ->
+ Child = spawn_link(fun() ->
erlang:port_command(P, [4])
end),
- ?line {Self,Child} = receive_any(),
+ {Self,Child} = receive_any(),
%% ERL_DRV_EXT2TERM
- ?line ExpectExt2Term = expected_ext2term_drv(?config(data_dir, Config)),
- ?line ExpectExt2Term = term(P, 5),
+ ExpectExt2Term = expected_ext2term_drv(proplists:get_value(data_dir, Config)),
+ ExpectExt2Term = term(P, 5),
%% ERL_DRV_INT, ERL_DRV_UINT
- ?line case erlang:system_info({wordsize, external}) of
+ case erlang:system_info({wordsize, external}) of
4 ->
- ?line {-1, 4294967295} = term(P, 6);
+ {-1, 4294967295} = term(P, 6);
8 ->
- ?line {-1, 18446744073709551615} = term(P, 6)
+ {-1, 18446744073709551615} = term(P, 6)
end,
%% ERL_DRV_BUF2BINARY
- ?line ExpectedBinTup = {<<>>,
+ ExpectedBinTup = {<<>>,
<<>>,
list_to_binary(lists:duplicate(17,17)),
list_to_binary(lists:duplicate(1024,17))},
- ?line ExpectedBinTup = term(P, 7),
+ ExpectedBinTup = term(P, 7),
%% single terms
Singles = [{[], 8}, % ERL_DRV_NIL
@@ -140,35 +116,34 @@ basic(Config) when is_list(Config) ->
{-20233590931456, 38}, % ERL_DRV_INT64
{-9223372036854775808, 39},
{#{}, 40}], % ERL_DRV_MAP
- ?line {Terms, Ops} = lists:unzip(Singles),
- ?line Terms = term(P,Ops),
+ {Terms, Ops} = lists:unzip(Singles),
+ Terms = term(P,Ops),
AFloat = term(P, 26), % ERL_DRV_FLOAT
- ?line true = AFloat < 0.001,
- ?line true = AFloat > -0.001,
+ true = AFloat < 0.001,
+ true = AFloat > -0.001,
%% Failure cases.
- ?line [] = term(P, 127),
- ?line receive
+ [] = term(P, 127),
+ receive
Any ->
- ?line io:format("Unexpected: ~p\n", [Any]),
- ?line ?t:fail()
+ ct:fail("Unexpected: ~p\n", [Any])
after 0 ->
ok
end,
- ?line ok = chk_temp_alloc(),
+ ok = chk_temp_alloc(),
%% In a private heap system, verify that there are no binaries
%% left for the process.
- ?line erlang:garbage_collect(), %Get rid of binaries.
+ erlang:garbage_collect(), %Get rid of binaries.
case erlang:system_info(heap_type) of
private ->
- ?line {binary,[]} = process_info(self(), binary);
+ {binary,[]} = process_info(self(), binary);
_ -> ok
end,
- ?line stop_driver(P, Drv),
+ stop_driver(P, Drv),
ok.
term(P, Op) ->
@@ -184,28 +159,28 @@ chk_temp_alloc() ->
case erlang:system_info({allocator,temp_alloc}) of
false ->
%% Temp alloc is not enabled
- ?line ok;
+ ok;
TIL ->
%% Verify that we havn't got anything allocated by temp_alloc
lists:foreach(
fun ({instance, _, TI}) ->
- ?line {value, {mbcs, MBCInfo}}
+ {value, {mbcs, MBCInfo}}
= lists:keysearch(mbcs, 1, TI),
- ?line {value, {blocks, 0, _, _}}
+ {value, {blocks, 0, _, _}}
= lists:keysearch(blocks, 1, MBCInfo),
- ?line {value, {sbcs, SBCInfo}}
+ {value, {sbcs, SBCInfo}}
= lists:keysearch(sbcs, 1, TI),
- ?line {value, {blocks, 0, _, _}}
+ {value, {blocks, 0, _, _}}
= lists:keysearch(blocks, 1, SBCInfo)
end,
TIL),
- ?line ok
+ ok
end.
%% Start/stop drivers.
start_driver(Config, Name) ->
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
erl_ddll:start(),
ok = load_driver(Path, Name),
open_port({spawn, Name}, []).
@@ -219,17 +194,17 @@ load_driver(Dir, Driver) ->
end.
stop_driver(Port, Name) ->
- ?line true = erlang:port_close(Port),
+ true = erlang:port_close(Port),
receive
{Port,Message} ->
- ?t:fail({strange_message_from_port,Message})
+ ct:fail({strange_message_from_port,Message})
after 0 ->
ok
end,
%% Unload the driver.
ok = erl_ddll:unload_driver(Name),
- ?line ok = erl_ddll:stop().
+ ok = erl_ddll:stop().
get_external_terms(DataDir) ->
{ok, Bin} = file:read_file([DataDir, "ext_terms.bin"]),
@@ -261,37 +236,36 @@ generate_external_terms_files(BaseDir) ->
RPort = hd(rpc:call(Node, erlang, ports, [])),
true = is_port(RPort),
slave:stop(Node),
- Terms =
- [{4711, -4711, [an_atom, "a list"]},
- [1000000000000000000000,-1111111111111111, "blupp!", blipp],
- {RPid, {RRef, RPort}, self(), hd(erlang:ports()), make_ref()},
- {{}, [], [], fun () -> ok end, <<"hej hopp trallalaaaaaaaaaaaaaaa">>},
- [44444444444444444444444,-44444444444, "b!", blippppppp],
- {4711, RPid, {RRef, RPort}, -4711, [an_atom, "a list"]},
- {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())},
- {4711, -4711, [an_atom, "a list"]},
- {4711, -4711, [atom, "list"]},
- {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())},
- {4444444444444444444,-44444, {{{{{{{{{{{{}}}}}}}}}}}}, make_ref()},
- {444444444444444444444,-44444, [[[[[[[[[[[1]]]]]]]]]]], make_ref()},
- {444444444444444444,-44444, {{{{{{{{{{{{2}}}}}}}}}}}}, make_ref()},
- {4444444444444444444444,-44444, {{{{{{{{{{{{3}}}}}}}}}}}}, make_ref()},
- {44444444444444444444,-44444, {{{{{{{{{{{{4}}}}}}}}}}}}, make_ref()},
- {4444444444444444,-44444, [[[[[[[[[[[5]]]]]]]]]]], make_ref()},
- {444444444444444444444,-44444, {{{{{{{{{{{{6}}}}}}}}}}}}, make_ref()},
- {444444444444444,-44444, {{{{{{{{{{{{7}}}}}}}}}}}}, make_ref()},
- {4444444444444444444,-44444, {{{{{{{{{{{{8}}}}}}}}}}}}, make_ref()},
- #{},
- #{1 => 11, 2 => 22, 3 => 33},
- maps:from_list([{K,K*11} || K <- lists:seq(1,100)])],
+ Terms = [{4711, -4711, [an_atom, "a list"]},
+ [1000000000000000000000,-1111111111111111, "blupp!", blipp],
+ {RPid, {RRef, RPort}, self(), hd(erlang:ports()), make_ref()},
+ {{}, [], [], fun () -> ok end, <<"hej hopp trallalaaaaaaaaaaaaaaa">>},
+ [44444444444444444444444,-44444444444, "b!", blippppppp],
+ {4711, RPid, {RRef, RPort}, -4711, [an_atom, "a list"]},
+ {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())},
+ {4711, -4711, [an_atom, "a list"]},
+ {4711, -4711, [atom, "list"]},
+ {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())},
+ {4444444444444444444,-44444, {{{{{{{{{{{{}}}}}}}}}}}}, make_ref()},
+ {444444444444444444444,-44444, [[[[[[[[[[[1]]]]]]]]]]], make_ref()},
+ {444444444444444444,-44444, {{{{{{{{{{{{2}}}}}}}}}}}}, make_ref()},
+ {4444444444444444444444,-44444, {{{{{{{{{{{{3}}}}}}}}}}}}, make_ref()},
+ {44444444444444444444,-44444, {{{{{{{{{{{{4}}}}}}}}}}}}, make_ref()},
+ {4444444444444444,-44444, [[[[[[[[[[[5]]]]]]]]]]], make_ref()},
+ {444444444444444444444,-44444, {{{{{{{{{{{{6}}}}}}}}}}}}, make_ref()},
+ {444444444444444,-44444, {{{{{{{{{{{{7}}}}}}}}}}}}, make_ref()},
+ {4444444444444444444,-44444, {{{{{{{{{{{{8}}}}}}}}}}}}, make_ref()},
+ #{},
+ #{1 => 11, 2 => 22, 3 => 33},
+ maps:from_list([{K,K*11} || K <- lists:seq(1,100)])],
ok = file:write_file(filename:join([BaseDir,
- "send_term_SUITE_data",
- "ext_terms.bin"]),
- term_to_binary(Terms, [compressed])),
+ "send_term_SUITE_data",
+ "ext_terms.bin"]),
+ term_to_binary(Terms, [compressed])),
{ok, IoDev} = file:open(filename:join([BaseDir,
- "send_term_SUITE_data",
- "ext_terms.h"]),
- [write]),
+ "send_term_SUITE_data",
+ "ext_terms.h"]),
+ [write]),
write_ext_terms_h(IoDev, Terms),
file:close(IoDev).
@@ -301,12 +275,12 @@ write_ext_terms_h(IoDev, Terms) ->
io:format(IoDev, "#define EXT_TERMS_H__~n",[]),
{ExtTerms, MaxSize} = make_ext_terms(Terms),
io:format(IoDev,
- "static struct {~n"
- " unsigned char ext[~p];~n"
- " int ext_size;~n"
- " unsigned char cext[~p];~n"
- " int cext_size;~n"
- "} ext_terms[] = {~n",[MaxSize, MaxSize]),
+ "static struct {~n"
+ " unsigned char ext[~p];~n"
+ " int ext_size;~n"
+ " unsigned char cext[~p];~n"
+ " int cext_size;~n"
+ "} ext_terms[] = {~n",[MaxSize, MaxSize]),
E = write_ext_terms_h(IoDev, ExtTerms, 0),
io:format(IoDev, "};~n",[]),
io:format(IoDev, "#define NO_OF_EXT_TERMS ~p~n", [E]),
diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl
index 2e51712737..e2236774a7 100644
--- a/erts/emulator/test/sensitive_SUITE.erl
+++ b/erts/emulator/test/sensitive_SUITE.erl
@@ -20,28 +20,20 @@
-module(sensitive_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
- stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1,
- meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1,
- t_process_info/1,t_process_display/1,save_calls/1]).
+-export([all/0, suite/0,
+ stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1,
+ meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1,
+ t_process_info/1,t_process_display/1,save_calls/1]).
-export([remote_process_display/0,an_exported_function/1]).
-import(lists, [keysearch/3,foreach/2,sort/1]).
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:minutes(5)),
- [{watchdog,Dog}|Config].
-
-end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 5}}].
all() ->
[stickiness, send_trace, recv_trace, proc_trace,
@@ -49,164 +41,148 @@ all() ->
seq_trace, t_process_info, t_process_display,
save_calls].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
stickiness(Config) when is_list(Config) ->
- ?line {Tracer,Mref} = spawn_monitor(fun() ->
- receive after infinity -> ok end
- end),
- ?line false = process_flag(sensitive, true),
+ {Tracer,Mref} = spawn_monitor(fun() ->
+ receive after infinity -> ok end
+ end),
+ false = process_flag(sensitive, true),
put(foo, bar),
Flags = sort([send,'receive',procs,call,running,garbage_collection,
- set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link]),
- ?line foreach(fun(F) ->
- 1 = erlang:trace(self(), true, [F,{tracer,Tracer}])
- end, Flags),
- ?line foreach(fun(F) ->
- 1 = erlang:trace(self(), false, [F,{tracer,Tracer}])
- end, Flags),
- ?line 1 = erlang:trace(self(), true, [{tracer,Tracer}|Flags]),
- ?line 1 = erlang:trace(self(), false, [{tracer,Tracer}|Flags]),
-
- ?line {messages,[]} = process_info(Tracer, messages),
+ set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link]),
+ foreach(fun(F) ->
+ 1 = erlang:trace(self(), true, [F,{tracer,Tracer}])
+ end, Flags),
+ foreach(fun(F) ->
+ 1 = erlang:trace(self(), false, [F,{tracer,Tracer}])
+ end, Flags),
+ 1 = erlang:trace(self(), true, [{tracer,Tracer}|Flags]),
+ 1 = erlang:trace(self(), false, [{tracer,Tracer}|Flags]),
+
+ {messages,[]} = process_info(Tracer, messages),
exit(Tracer, kill),
receive {'DOWN',Mref,_,_,_} -> ok end,
-
+
case process_info(self(), dictionary) of
- {dictionary,[]} -> ok;
- {dictionary,_} -> ?line ?t:fail(sensitive_flag_cleared)
+ {dictionary,[]} -> ok;
+ {dictionary,_} -> ct:fail(sensitive_flag_cleared)
end,
NewTracer = spawn_link(fun() -> receive after infinity -> ok end end),
- ?line 1 = erlang:trace(self(), true, [{tracer,NewTracer}|Flags]),
- ?line Flags = sort(element(2, erlang:trace_info(self(), flags))),
- ?line {tracer,NewTracer} = erlang:trace_info(self(), tracer),
+ 1 = erlang:trace(self(), true, [{tracer,NewTracer}|Flags]),
+ Flags = sort(element(2, erlang:trace_info(self(), flags))),
+ {tracer,NewTracer} = erlang:trace_info(self(), tracer),
%% Process still sensitive. Tracer should disappear when we clear
%% all trace flags.
- ?line 1 = erlang:trace(self(), false, [{tracer,NewTracer}|Flags]),
- ?line {tracer,[]} = erlang:trace_info(self(), tracer),
+ 1 = erlang:trace(self(), false, [{tracer,NewTracer}|Flags]),
+ {tracer,[]} = erlang:trace_info(self(), tracer),
- ?line unlink(NewTracer), exit(NewTracer, kill),
+ unlink(NewTracer), exit(NewTracer, kill),
ok.
send_trace(Config) when is_list(Config) ->
- ?line {Dead,Mref} = spawn_monitor(fun() -> ok end),
+ {Dead,Mref} = spawn_monitor(fun() -> ok end),
receive {'DOWN',Mref,_,_,_} -> ok end,
- ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
- ?line Sink = spawn_link(fun() -> receive after infinity -> ok end end),
+ Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
+ Sink = spawn_link(fun() -> receive after infinity -> ok end end),
Self = self(),
- ?line 1 = erlang:trace(self(), true, [send,{tracer,Tracer}]),
- ?line Dead ! before,
- ?line Sink ! before,
- ?line false = process_flag(sensitive, true),
- ?line Sink ! {blurf,lists:seq(1, 50)},
- ?line true = process_flag(sensitive, true),
- ?line Sink ! lists:seq(1, 100),
- ?line Dead ! forget_me,
- ?line true = process_flag(sensitive, false),
- ?line Sink ! after1,
- ?line false = process_flag(sensitive, false),
- ?line Sink ! after2,
- ?line Dead ! after2,
- ?line wait_trace(Self),
-
- ?line {messages,Messages} = process_info(Tracer, messages),
- ?line [{trace,Self,send_to_non_existing_process,before,Dead},
- {trace,Self,send,before,Sink},
- {trace,Self,send,after1,Sink},
- {trace,Self,send,after2,Sink},
- {trace,Self,send_to_non_existing_process,after2,Dead}] = Messages,
-
- ?line unlink(Tracer), exit(Tracer, kill),
- ?line unlink(Sink), exit(Sink, kill),
+ 1 = erlang:trace(self(), true, [send,{tracer,Tracer}]),
+ Dead ! before,
+ Sink ! before,
+ false = process_flag(sensitive, true),
+ Sink ! {blurf,lists:seq(1, 50)},
+ true = process_flag(sensitive, true),
+ Sink ! lists:seq(1, 100),
+ Dead ! forget_me,
+ true = process_flag(sensitive, false),
+ Sink ! after1,
+ false = process_flag(sensitive, false),
+ Sink ! after2,
+ Dead ! after2,
+ wait_trace(Self),
+
+ {messages,Messages} = process_info(Tracer, messages),
+ [{trace,Self,send_to_non_existing_process,before,Dead},
+ {trace,Self,send,before,Sink},
+ {trace,Self,send,after1,Sink},
+ {trace,Self,send,after2,Sink},
+ {trace,Self,send_to_non_existing_process,after2,Dead}] = Messages,
+
+ unlink(Tracer), exit(Tracer, kill),
+ unlink(Sink), exit(Sink, kill),
ok.
recv_trace(Config) when is_list(Config) ->
Parent = self(),
- ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
- ?line Sender = spawn_link(fun() -> recv_trace_sender(Parent) end),
+ Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
+ Sender = spawn_link(fun() -> recv_trace_sender(Parent) end),
- ?line 1 = erlang:trace(self(), true, ['receive',{tracer,Tracer}]),
+ 1 = erlang:trace(self(), true, ['receive',{tracer,Tracer}]),
Sender ! 1,
receive a -> wait_trace(Sender) end,
- ?line false = process_flag(sensitive, true),
+ false = process_flag(sensitive, true),
Sender ! 2,
receive {b,[x,y,z]} -> wait_trace(Sender) end,
-
- ?line true = process_flag(sensitive, false),
+
+ true = process_flag(sensitive, false),
Sender ! 3,
receive c -> wait_trace(Sender) end,
-
- ?line {messages,Messages} = process_info(Tracer, messages),
+
+ {messages,Messages} = process_info(Tracer, messages),
[{trace,Parent,'receive',a},
{trace,Parent,'receive',{trace_delivered,_,_}},
{trace,Parent,'receive',c}|_] = Messages,
- ?line unlink(Tracer), exit(Tracer, kill),
- ?line unlink(Sender), exit(Sender, kill),
+ unlink(Tracer), exit(Tracer, kill),
+ unlink(Sender), exit(Sender, kill),
ok.
recv_trace_sender(Pid) ->
receive
- 1 -> Pid ! a;
- 2 -> Pid ! {b,[x,y,z]};
- 3 -> Pid ! c
+ 1 -> Pid ! a;
+ 2 -> Pid ! {b,[x,y,z]};
+ 3 -> Pid ! c
end,
recv_trace_sender(Pid).
proc_trace(Config) when is_list(Config) ->
Self = self(),
- ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
+ Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
- ?line 1 = erlang:trace(self(), true, [procs,{tracer,Tracer}]),
- ?line false = process_flag(sensitive, true),
+ 1 = erlang:trace(self(), true, [procs,{tracer,Tracer}]),
+ false = process_flag(sensitive, true),
spawn(fun() -> ok end),
- ?line register(nisse, self()),
- ?line unregister(nisse),
- ?line link(Tracer),
- ?line unlink(Tracer),
- ?line Linker0 = spawn_link(fun() -> ok end),
+ register(nisse, self()),
+ unregister(nisse),
+ link(Tracer),
+ unlink(Tracer),
+ Linker0 = spawn_link(fun() -> ok end),
Mref0 = erlang:monitor(process, Linker0),
- ?line {_,Mref} = spawn_monitor(fun() -> link(Self), unlink(Self) end),
+ {_,Mref} = spawn_monitor(fun() -> link(Self), unlink(Self) end),
receive {'DOWN',Mref0,_,_,_} -> ok end,
receive {'DOWN',Mref,_,_,_} -> ok end,
- ?line true = process_flag(sensitive, false),
+ true = process_flag(sensitive, false),
Dead = spawn(fun() -> ok end),
- ?line register(arne, self()),
- ?line unregister(arne),
- ?line {Linker,Mref2} = spawn_monitor(fun() -> link(Self), unlink(Self) end),
+ register(arne, self()),
+ unregister(arne),
+ {Linker,Mref2} = spawn_monitor(fun() -> link(Self), unlink(Self) end),
receive {'DOWN',Mref2,_,_,_} -> ok end,
- ?line Last = spawn_link(fun() -> ok end),
+ Last = spawn_link(fun() -> ok end),
receive after 10 -> ok end,
- ?line wait_trace(all),
- ?line {messages,Messages} = process_info(Tracer, messages),
+ wait_trace(all),
+ {messages,Messages} = process_info(Tracer, messages),
[{trace,Self,spawn,Dead,{erlang,apply,_}},
{trace,Self,register,arne},
{trace,Self,unregister,arne},
@@ -217,80 +193,80 @@ proc_trace(Config) when is_list(Config) ->
{trace,Self,link,Last},
{trace,Self,getting_unlinked,Last}] = Messages,
- ?line unlink(Tracer), exit(Tracer, kill),
+ unlink(Tracer), exit(Tracer, kill),
ok.
call_trace(Config) when is_list(Config) ->
Self = self(),
- ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
-
- ?line 1 = erlang:trace(self(), true, [call,{tracer,Tracer}]),
- ?line 1 = erlang:trace_pattern({?MODULE,an_exported_function,1},
- true, [global]),
- ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [global]),
- ?line 1 = erlang:trace_pattern({erlang,binary_to_list,1}, true, [local]),
- ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [local]),
-
- ?line false = process_flag(sensitive, true),
- ?line {ok,42} = a_local_function(42),
- ?line 7 = an_exported_function(6),
- ?line <<7,8,9,10>> = list_to_binary(id([7,8,9,10])),
- ?line [42,43] = binary_to_list(id(<<42,43>>)),
- ?line true = process_flag(sensitive, false),
-
- ?line {ok,{a,b}} = a_local_function({a,b}),
- ?line 1 = an_exported_function(0),
- ?line <<1,2,3>> = list_to_binary(id([1,2,3])),
- ?line [42,43,44] = binary_to_list(id(<<42,43,44>>)),
-
- ?line wait_trace(Self),
-
- ?line {messages,Messages} = process_info(Tracer, messages),
- ?line [{trace,Self,call,{?MODULE,a_local_function,[{a,b}]}},
- {trace,Self,call,{?MODULE,an_exported_function,[0]}},
- {trace,Self,call,{?MODULE,id,[_]}},
- {trace,Self,call,{erlang,list_to_binary,[[1,2,3]]}},
- {trace,Self,call,{sensitive_SUITE,id,[<<42,43,44>>]}},
- {trace,Self,call,{erlang,binary_to_list,[<<42,43,44>>]}},
- {trace,Self,call,{?MODULE,wait_trace,[Self]}}] = Messages,
-
- ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [local]),
- ?line erlang:trace_pattern({erlang,'_','_'}, false, [local]),
- ?line erlang:trace_pattern({'_','_','_'}, false, [global]),
-
- ?line unlink(Tracer), exit(Tracer, kill),
+ Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
+
+ 1 = erlang:trace(self(), true, [call,{tracer,Tracer}]),
+ 1 = erlang:trace_pattern({?MODULE,an_exported_function,1},
+ true, [global]),
+ 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [global]),
+ 1 = erlang:trace_pattern({erlang,binary_to_list,1}, true, [local]),
+ Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [local]),
+
+ false = process_flag(sensitive, true),
+ {ok,42} = a_local_function(42),
+ 7 = an_exported_function(6),
+ <<7,8,9,10>> = list_to_binary(id([7,8,9,10])),
+ [42,43] = binary_to_list(id(<<42,43>>)),
+ true = process_flag(sensitive, false),
+
+ {ok,{a,b}} = a_local_function({a,b}),
+ 1 = an_exported_function(0),
+ <<1,2,3>> = list_to_binary(id([1,2,3])),
+ [42,43,44] = binary_to_list(id(<<42,43,44>>)),
+
+ wait_trace(Self),
+
+ {messages,Messages} = process_info(Tracer, messages),
+ [{trace,Self,call,{?MODULE,a_local_function,[{a,b}]}},
+ {trace,Self,call,{?MODULE,an_exported_function,[0]}},
+ {trace,Self,call,{?MODULE,id,[_]}},
+ {trace,Self,call,{erlang,list_to_binary,[[1,2,3]]}},
+ {trace,Self,call,{sensitive_SUITE,id,[<<42,43,44>>]}},
+ {trace,Self,call,{erlang,binary_to_list,[<<42,43,44>>]}},
+ {trace,Self,call,{?MODULE,wait_trace,[Self]}}] = Messages,
+
+ Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [local]),
+ erlang:trace_pattern({erlang,'_','_'}, false, [local]),
+ erlang:trace_pattern({'_','_','_'}, false, [global]),
+
+ unlink(Tracer), exit(Tracer, kill),
ok.
meta_trace(Config) when is_list(Config) ->
Self = self(),
- ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
-
- ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [{meta,Tracer}]),
- ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [{meta,Tracer}]),
-
- ?line false = process_flag(sensitive, true),
- ?line {ok,blurf} = a_local_function(blurf),
- ?line 100 = an_exported_function(99),
- ?line <<8,9,10>> = list_to_binary(id([8,9,10])),
- ?line true = process_flag(sensitive, false),
-
- ?line {ok,{x,y}} = a_local_function({x,y}),
- ?line 1 = an_exported_function(0),
- ?line <<10>> = list_to_binary(id([10])),
- ?line wait_trace(Self),
-
- ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [meta]),
- ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, false, [meta]),
- ?line a_local_function(0),
-
- ?line {messages,Messages} = process_info(Tracer, messages),
- ?line [{trace_ts,Self,call,{?MODULE,a_local_function,[{x,y}]},{_,_,_}},
- {trace_ts,Self,call,{?MODULE,an_exported_function,[0]},{_,_,_}},
- {trace_ts,Self,call,{?MODULE,id,[_]},{_,_,_}},
- {trace_ts,Self,call,{erlang,list_to_binary,[[10]]},{_,_,_}},
- {trace_ts,Self,call,{?MODULE,wait_trace,[Self]},{_,_,_}}] = Messages,
-
- ?line unlink(Tracer), exit(Tracer, kill),
+ Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
+
+ Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [{meta,Tracer}]),
+ 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [{meta,Tracer}]),
+
+ false = process_flag(sensitive, true),
+ {ok,blurf} = a_local_function(blurf),
+ 100 = an_exported_function(99),
+ <<8,9,10>> = list_to_binary(id([8,9,10])),
+ true = process_flag(sensitive, false),
+
+ {ok,{x,y}} = a_local_function({x,y}),
+ 1 = an_exported_function(0),
+ <<10>> = list_to_binary(id([10])),
+ wait_trace(Self),
+
+ Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [meta]),
+ 1 = erlang:trace_pattern({erlang,list_to_binary,1}, false, [meta]),
+ a_local_function(0),
+
+ {messages,Messages} = process_info(Tracer, messages),
+ [{trace_ts,Self,call,{?MODULE,a_local_function,[{x,y}]},{_,_,_}},
+ {trace_ts,Self,call,{?MODULE,an_exported_function,[0]},{_,_,_}},
+ {trace_ts,Self,call,{?MODULE,id,[_]},{_,_,_}},
+ {trace_ts,Self,call,{erlang,list_to_binary,[[10]]},{_,_,_}},
+ {trace_ts,Self,call,{?MODULE,wait_trace,[Self]},{_,_,_}}] = Messages,
+
+ unlink(Tracer), exit(Tracer, kill),
ok.
a_local_function(A) ->
@@ -301,66 +277,66 @@ an_exported_function(X) ->
running_trace(Config) when is_list(Config) ->
Self = self(),
- ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
+ Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
- ?line false = process_flag(sensitive, true),
- ?line 1 = erlang:trace(Self, true, [running,{tracer,Tracer}]),
+ false = process_flag(sensitive, true),
+ 1 = erlang:trace(Self, true, [running,{tracer,Tracer}]),
erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(),
erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(),
- ?line true = process_flag(sensitive, false),
+ true = process_flag(sensitive, false),
erlang:yield(),
- ?line 1 = erlang:trace(Self, false, [running,{tracer,Tracer}]),
+ 1 = erlang:trace(Self, false, [running,{tracer,Tracer}]),
- ?line wait_trace(Self),
- ?line {messages,Messages} = process_info(Tracer, messages),
- ?line [{trace,Self,out,{sensitive_SUITE,running_trace,1}},
- {trace,Self,in,{sensitive_SUITE,running_trace,1}}] = Messages,
+ wait_trace(Self),
+ {messages,Messages} = process_info(Tracer, messages),
+ [{trace,Self,out,{sensitive_SUITE,running_trace,1}},
+ {trace,Self,in,{sensitive_SUITE,running_trace,1}}] = Messages,
- ?line unlink(Tracer), exit(Tracer, kill),
+ unlink(Tracer), exit(Tracer, kill),
ok.
gc_trace(Config) when is_list(Config) ->
Self = self(),
- ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
+ Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
- ?line false = process_flag(sensitive, true),
- ?line 1 = erlang:trace(Self, true, [garbage_collection,{tracer,Tracer}]),
+ false = process_flag(sensitive, true),
+ 1 = erlang:trace(Self, true, [garbage_collection,{tracer,Tracer}]),
erlang:garbage_collect(), erlang:garbage_collect(),
erlang:garbage_collect(), erlang:garbage_collect(),
erlang:garbage_collect(), erlang:garbage_collect(),
erlang:garbage_collect(), erlang:garbage_collect(),
- ?line true = process_flag(sensitive, false),
+ true = process_flag(sensitive, false),
erlang:garbage_collect(),
- ?line 1 = erlang:trace(Self, false, [garbage_collection,{tracer,Tracer}]),
+ 1 = erlang:trace(Self, false, [garbage_collection,{tracer,Tracer}]),
- ?line wait_trace(Self),
- ?line {messages,Messages} = process_info(Tracer, messages),
- ?line [{trace,Self,gc_start,_},{trace,Self,gc_end,_}] = Messages,
+ wait_trace(Self),
+ {messages,Messages} = process_info(Tracer, messages),
+ [{trace,Self,gc_start,_},{trace,Self,gc_end,_}] = Messages,
- ?line unlink(Tracer), exit(Tracer, kill),
+ unlink(Tracer), exit(Tracer, kill),
ok.
seq_trace(Config) when is_list(Config) ->
Self = self(),
- ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
- ?line seq_trace:set_system_tracer(Tracer),
-
- ?line false = process_flag(sensitive, true),
-
- ?line Echo = spawn_link(fun() ->
- receive
- {Pid,Message} ->
- Pid ! {reply,Message}
- end
- end),
- ?line Sender = spawn_link(fun() ->
- seq_trace:set_token(label, 42),
- seq_trace:set_token('receive', true),
- seq_trace:set_token(send, true),
- seq_trace:set_token(print, true),
- seq_trace:print(42, "trace started"),
- Self ! blurf
- end),
+ Tracer = spawn_link(fun() -> receive after infinity -> ok end end),
+ seq_trace:set_system_tracer(Tracer),
+
+ false = process_flag(sensitive, true),
+
+ Echo = spawn_link(fun() ->
+ receive
+ {Pid,Message} ->
+ Pid ! {reply,Message}
+ end
+ end),
+ Sender = spawn_link(fun() ->
+ seq_trace:set_token(label, 42),
+ seq_trace:set_token('receive', true),
+ seq_trace:set_token(send, true),
+ seq_trace:set_token(print, true),
+ seq_trace:print(42, "trace started"),
+ Self ! blurf
+ end),
seq_trace:set_token(label, 17),
seq_trace:set_token('receive', true),
seq_trace:set_token(send, true),
@@ -370,49 +346,49 @@ seq_trace(Config) when is_list(Config) ->
receive {reply,hello} -> ok end,
receive blurf -> ok end,
- ?line wait_trace(all),
+ wait_trace(all),
+
+ {messages,Messages} = process_info(Tracer, messages),
+ [{seq_trace,17,{'receive',{0,2},Self,Echo,{Self,hello}}},
+ {seq_trace,17,{send,{2,3},Echo,Self,{reply,hello}}}] =
+ [M || {seq_trace,17,_}=M <- Messages],
- ?line {messages,Messages} = process_info(Tracer, messages),
- ?line [{seq_trace,17,{'receive',{0,2},Self,Echo,{Self,hello}}},
- {seq_trace,17,{send,{2,3},Echo,Self,{reply,hello}}}] =
- [M || {seq_trace,17,_}=M <- Messages],
+ [{seq_trace,42,{print,{0,1},Sender,[],"trace started"}},
+ {seq_trace,42,{send,{0,2},Sender,Self,blurf}}] =
+ [M || {seq_trace,42,_}=M <- Messages],
- ?line [{seq_trace,42,{print,{0,1},Sender,[],"trace started"}},
- {seq_trace,42,{send,{0,2},Sender,Self,blurf}}] =
- [M || {seq_trace,42,_}=M <- Messages],
-
- ?line unlink(Tracer), exit(Tracer, kill),
- ?line unlink(Echo), exit(Echo, kill),
- ?line unlink(Sender), exit(Sender, kill),
+ unlink(Tracer), exit(Tracer, kill),
+ unlink(Echo), exit(Echo, kill),
+ unlink(Sender), exit(Sender, kill),
ok.
t_process_info(Config) when is_list(Config) ->
Parent = self(),
- ?line Pid = spawn_link(fun() ->
- put(foo, bar),
- false = process_flag(sensitive, true),
- Parent ! go,
- receive
- revert ->
- true = process_flag(sensitive, false),
- Parent ! go_again,
- receive never -> ok end
- end end),
+ Pid = spawn_link(fun() ->
+ put(foo, bar),
+ false = process_flag(sensitive, true),
+ Parent ! go,
+ receive
+ revert ->
+ true = process_flag(sensitive, false),
+ Parent ! go_again,
+ receive never -> ok end
+ end end),
receive go -> ok end,
- ?line put(foo, bar),
- ?line self() ! Pid ! {i,am,a,message},
+ put(foo, bar),
+ self() ! Pid ! {i,am,a,message},
- ?line false = process_flag(sensitive, true),
- ?line t_process_info_suppressed(self()),
- ?line t_process_info_suppressed(Pid),
+ false = process_flag(sensitive, true),
+ t_process_info_suppressed(self()),
+ t_process_info_suppressed(Pid),
- ?line true = process_flag(sensitive, false),
+ true = process_flag(sensitive, false),
Pid ! revert,
receive go_again -> ok end,
- ?line t_process_info_normal(self()),
- ?line t_process_info_normal(Pid),
+ t_process_info_normal(self()),
+ t_process_info_normal(Pid),
ok.
t_process_info_suppressed(Pid) ->
@@ -423,7 +399,7 @@ t_process_info_suppressed(Pid) ->
t_process_info_normal(Pid) ->
{value,{foo,bar}} = keysearch(foo, 1, my_process_info(Pid, dictionary)),
case process_info(Pid, backtrace) of
- {backtrace,Bin} when size(Bin) > 20 -> ok
+ {backtrace,Bin} when size(Bin) > 20 -> ok
end,
[{i,am,a,message}] = my_process_info(Pid, messages).
@@ -431,16 +407,16 @@ my_process_info(Pid, Tag) ->
{Tag,Value} = process_info(Pid, Tag),
All = process_info(Pid),
case keysearch(Tag, 1, All) of
- false -> Value;
- {value,{Tag,Value}} -> Value
+ false -> Value;
+ {value,{Tag,Value}} -> Value
end.
t_process_display(Config) when is_list(Config) ->
- ?line Dir = filename:dirname(code:which(?MODULE)),
- ?line Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++
- " -run " ++ ?MODULE_STRING ++ " remote_process_display",
- ?line io:put_chars(Cmd),
- ?line P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]),
+ Dir = filename:dirname(code:which(?MODULE)),
+ Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++
+ " -run " ++ ?MODULE_STRING ++ " remote_process_display",
+ io:put_chars(Cmd),
+ P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]),
<<"done",_/binary>> = get_all(P),
ok.
@@ -456,27 +432,26 @@ get_all(P) ->
get_all(P, Acc) ->
receive
- {P,{data,S}} ->
- get_all(P, [Acc|S]);
- {P,eof} ->
- iolist_to_binary(Acc)
+ {P,{data,S}} ->
+ get_all(P, [Acc|S]);
+ {P,eof} ->
+ iolist_to_binary(Acc)
end.
save_calls(Config) when is_list(Config) ->
process_flag(save_calls, 10),
false = process_flag(sensitive, true),
- ?line {last_calls,LastCalls} = process_info(self(), last_calls),
- ?line [{erlang,process_flag,2}] = LastCalls,
- ?line [2,4,6] = lists:map(fun(E) -> 2*E end, [1,2,3]),
- ?line {last_calls,LastCalls} = process_info(self(), last_calls),
+ {last_calls,LastCalls} = process_info(self(), last_calls),
+ [{erlang,process_flag,2}] = LastCalls,
+ [2,4,6] = lists:map(fun(E) -> 2*E end, [1,2,3]),
+ {last_calls,LastCalls} = process_info(self(), last_calls),
ok.
wait_trace(Pid) ->
Ref = erlang:trace_delivered(Pid),
receive
- {trace_delivered,Pid,Ref} -> ok
+ {trace_delivered,Pid,Ref} -> ok
end.
-
+
id(I) -> I.
-
diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl
index 4aa690fb0f..63397fbbb4 100644
--- a/erts/emulator/test/signal_SUITE.erl
+++ b/erts/emulator/test/signal_SUITE.erl
@@ -28,12 +28,10 @@
-module(signal_SUITE).
-author('[email protected]').
--define(DEFAULT_TIMEOUT_SECONDS, 120).
-
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
+-include_lib("common_test/include/ct.hrl").
+-export([all/0, suite/0,init_per_suite/1, end_per_suite/1]).
+-export([init_per_testcase/2, end_per_testcase/2]).
% Test cases
-export([xm_sig_order/1,
@@ -51,16 +49,12 @@
pending_exit_group_leader/1,
exit_before_pending_exit/1]).
--export([init_per_testcase/2, end_per_testcase/2]).
-
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- ?line Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMEOUT_SECONDS)),
available_internal_state(true),
- ?line [{testcase, Func},{watchdog, Dog}|Config].
+ [{testcase, Func}|Config].
end_per_testcase(_Func, Config) ->
- ?line Dog = ?config(watchdog, Config),
- ?line ?t:timetrap_cancel(Dog).
+ ok.
init_per_suite(Config) ->
Config.
@@ -70,7 +64,9 @@ end_per_suite(_Config) ->
catch erts_debug:set_internal_state(not_running_optimization, true),
available_internal_state(false).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
all() ->
[xm_sig_order, pending_exit_unlink_process,
@@ -83,41 +79,30 @@ all() ->
pending_exit_process_info_2, pending_exit_group_leader,
exit_before_pending_exit].
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-xm_sig_order(doc) -> ["Test that exit signals and messages are received "
- "in correct order"];
-xm_sig_order(suite) -> [];
+%% Test that exit signals and messages are received in correct order
xm_sig_order(Config) when is_list(Config) ->
- ?line LNode = node(),
- ?line repeat(fun () -> xm_sig_order_test(LNode) end, 1000),
- ?line {ok, RNode} = start_node(Config),
- ?line repeat(fun () -> xm_sig_order_test(RNode) end, 1000),
- ?line stop_node(RNode),
- ?line ok.
+ LNode = node(),
+ repeat(fun () -> xm_sig_order_test(LNode) end, 1000),
+ {ok, RNode} = start_node(Config),
+ repeat(fun () -> xm_sig_order_test(RNode) end, 1000),
+ stop_node(RNode),
+ ok.
xm_sig_order_test(Node) ->
- ?line P = spawn(Node, fun () -> xm_sig_order_proc() end),
- ?line M = erlang:monitor(process, P),
- ?line P ! may_reach,
- ?line P ! may_reach,
- ?line P ! may_reach,
- ?line exit(P, good_signal_order),
- ?line P ! may_not_reach,
- ?line P ! may_not_reach,
- ?line P ! may_not_reach,
- ?line receive
+ P = spawn(Node, fun () -> xm_sig_order_proc() end),
+ M = erlang:monitor(process, P),
+ P ! may_reach,
+ P ! may_reach,
+ P ! may_reach,
+ exit(P, good_signal_order),
+ P ! may_not_reach,
+ P ! may_not_reach,
+ P ! may_not_reach,
+ receive
{'DOWN', M, process, P, R} ->
- ?line good_signal_order = R
+ good_signal_order = R
end.
xm_sig_order_proc() ->
@@ -128,168 +113,149 @@ xm_sig_order_proc() ->
end,
xm_sig_order_proc().
-pending_exit_unlink_process(doc) -> [];
-pending_exit_unlink_process(suite) -> [];
pending_exit_unlink_process(Config) when is_list(Config) ->
- ?line pending_exit_test(self(), unlink).
+ pending_exit_test(self(), unlink).
-pending_exit_unlink_dist_process(doc) -> [];
-pending_exit_unlink_dist_process(suite) -> [];
pending_exit_unlink_dist_process(Config) when is_list(Config) ->
- ?line {ok, Node} = start_node(Config),
- ?line From = spawn(Node, fun () -> receive after infinity -> ok end end),
- ?line Res = pending_exit_test(From, unlink),
- ?line stop_node(Node),
- ?line Res.
-
-pending_exit_unlink_port(doc) -> [];
-pending_exit_unlink_port(suite) -> [];
+ {ok, Node} = start_node(Config),
+ From = spawn(Node, fun () -> receive after infinity -> ok end end),
+ Res = pending_exit_test(From, unlink),
+ stop_node(Node),
+ Res.
+
pending_exit_unlink_port(Config) when is_list(Config) ->
- ?line pending_exit_test(hd(erlang:ports()), unlink).
+ pending_exit_test(hd(erlang:ports()), unlink).
-pending_exit_trap_exit(doc) -> [];
-pending_exit_trap_exit(suite) -> [];
pending_exit_trap_exit(Config) when is_list(Config) ->
- ?line pending_exit_test(self(), trap_exit).
+ pending_exit_test(self(), trap_exit).
-pending_exit_receive(doc) -> [];
-pending_exit_receive(suite) -> [];
pending_exit_receive(Config) when is_list(Config) ->
- ?line pending_exit_test(self(), 'receive').
+ pending_exit_test(self(), 'receive').
-pending_exit_exit(doc) -> [];
-pending_exit_exit(suite) -> [];
pending_exit_exit(Config) when is_list(Config) ->
- ?line pending_exit_test(self(), exit).
+ pending_exit_test(self(), exit).
-pending_exit_gc(doc) -> [];
-pending_exit_gc(suite) -> [];
pending_exit_gc(Config) when is_list(Config) ->
- ?line pending_exit_test(self(), gc).
+ pending_exit_test(self(), gc).
pending_exit_test(From, Type) ->
- ?line case catch erlang:system_info(smp_support) of
- true ->
- ?line OTE = process_flag(trap_exit, true),
- ?line Ref = make_ref(),
- ?line Master = self(),
- ?line ExitBySignal = case Type of
- gc ->
- lists:duplicate(10000,
- exit_by_signal);
- _ ->
- exit_by_signal
- end,
- ?line Pid = spawn_link(
- fun () ->
- receive go -> ok end,
- false = have_pending_exit(),
- exit = fake_exit(From,
- self(),
- ExitBySignal),
- true = have_pending_exit(),
- Master ! {self(), Ref, Type},
- case Type of
- gc ->
- force_gc(),
- erlang:yield();
- unlink ->
- unlink(From);
- trap_exit ->
- process_flag(trap_exit, true);
- 'receive' ->
- receive _ -> ok
- after 0 -> ok
- end;
- exit ->
- ok
- end,
- exit(exit_by_myself)
- end),
- ?line Mon = erlang:monitor(process, Pid),
- ?line Pid ! go,
- ?line Reason = receive
- {'DOWN', Mon, process, Pid, R} ->
- ?line receive
- {Pid, Ref, Type} ->
- ?line ok
- after 0 ->
- ?line ?t:fail(premature_exit)
- end,
- ?line case Type of
- exit ->
- ?line exit_by_myself = R;
- _ ->
- ?line ExitBySignal = R
- end
- end,
- ?line receive
- {'EXIT', Pid, R2} ->
- ?line Reason = R2
- end,
- ?line process_flag(trap_exit, OTE),
- ?line ok,
- {comment,
- "Test only valid with current SMP emulator."};
- _ ->
- {skipped,
- "SMP support not enabled. "
- "Test only valid with current SMP emulator."}
- end.
+ case catch erlang:system_info(smp_support) of
+ true ->
+ OTE = process_flag(trap_exit, true),
+ Ref = make_ref(),
+ Master = self(),
+ ExitBySignal = case Type of
+ gc ->
+ lists:duplicate(10000,
+ exit_by_signal);
+ _ ->
+ exit_by_signal
+ end,
+ Pid = spawn_link(
+ fun () ->
+ receive go -> ok end,
+ false = have_pending_exit(),
+ exit = fake_exit(From,
+ self(),
+ ExitBySignal),
+ true = have_pending_exit(),
+ Master ! {self(), Ref, Type},
+ case Type of
+ gc ->
+ force_gc(),
+ erlang:yield();
+ unlink ->
+ unlink(From);
+ trap_exit ->
+ process_flag(trap_exit, true);
+ 'receive' ->
+ receive _ -> ok
+ after 0 -> ok
+ end;
+ exit ->
+ ok
+ end,
+ exit(exit_by_myself)
+ end),
+ Mon = erlang:monitor(process, Pid),
+ Pid ! go,
+ Reason = receive
+ {'DOWN', Mon, process, Pid, R} ->
+ receive
+ {Pid, Ref, Type} ->
+ ok
+ after 0 ->
+ ct:fail(premature_exit)
+ end,
+ case Type of
+ exit ->
+ exit_by_myself = R;
+ _ ->
+ ExitBySignal = R
+ end
+ end,
+ receive
+ {'EXIT', Pid, R2} ->
+ Reason = R2
+ end,
+ process_flag(trap_exit, OTE),
+ ok,
+ {comment, "Test only valid with current SMP emulator."};
+ _ ->
+ {skipped, "SMP support not enabled. Test only valid with current SMP emulator."}
+ end.
-exit_before_pending_exit(doc) -> [];
-exit_before_pending_exit(suite) -> [];
exit_before_pending_exit(Config) when is_list(Config) ->
%% This is a testcase testcase very specific to the smp
%% implementation as it is of the time of writing.
%%
%% The testcase tries to check that a process can
%% exit by itself even though it has a pending exit.
- ?line OTE = process_flag(trap_exit, true),
- ?line Master = self(),
- ?line Tester = spawn_link(
- fun () ->
- Opts = case {erlang:system_info(run_queues),
- erlang:system_info(schedulers_online)} of
- {RQ, SO} when RQ =:= 1; SO =:= 1 -> [];
- _ ->
- process_flag(scheduler, 1),
- [{scheduler, 2}]
- end,
- P = self(),
- Exiter = spawn_opt(fun () ->
- receive
- {exit_me, P, R} ->
- exit(P, R)
- end
- end, Opts),
- erlang:yield(),
- Exiter ! {exit_me, self(), exited_by_exiter},
- %% We want to get a pending exit
- %% before we exit ourselves. We
- %% don't want to be scheduled out
- %% since we will then see the
- %% pending exit.
- %%
- %% Do something that takes
- %% relatively long time but
- %% consumes few reductions...
- repeat(fun() -> erlang:system_info(procs) end,10),
- %% ... then exit.
- Master ! {self(),
- pending_exit,
- have_pending_exit()},
- exit(exited_by_myself)
- end),
- ?line PendingExit = receive {Tester, pending_exit, PE} -> PE end,
- ?line receive
+ OTE = process_flag(trap_exit, true),
+ Master = self(),
+ Tester = spawn_link(
+ fun () ->
+ Opts = case {erlang:system_info(run_queues),
+ erlang:system_info(schedulers_online)} of
+ {RQ, SO} when RQ =:= 1; SO =:= 1 -> [];
+ _ ->
+ process_flag(scheduler, 1),
+ [{scheduler, 2}]
+ end,
+ P = self(),
+ Exiter = spawn_opt(fun () ->
+ receive
+ {exit_me, P, R} ->
+ exit(P, R)
+ end
+ end, Opts),
+ erlang:yield(),
+ Exiter ! {exit_me, self(), exited_by_exiter},
+ %% We want to get a pending exit
+ %% before we exit ourselves. We
+ %% don't want to be scheduled out
+ %% since we will then see the
+ %% pending exit.
+ %%
+ %% Do something that takes
+ %% relatively long time but
+ %% consumes few reductions...
+ repeat(fun() -> erlang:system_info(procs) end,10),
+ %% ... then exit.
+ Master ! {self(),
+ pending_exit,
+ have_pending_exit()},
+ exit(exited_by_myself)
+ end),
+ PendingExit = receive {Tester, pending_exit, PE} -> PE end,
+ receive
{'EXIT', Tester, exited_by_myself} ->
- ?line process_flag(trap_exit, OTE),
- ?line ok;
+ process_flag(trap_exit, OTE),
+ ok;
Msg ->
- ?line ?t:fail({unexpected_message, Msg})
+ ct:fail({unexpected_message, Msg})
end,
NoScheds = integer_to_list(erlang:system_info(schedulers_online)),
{comment,
@@ -304,101 +270,101 @@ exit_before_pending_exit(Config) when is_list(Config) ->
-define(PE_INFO_REPEAT, 100).
pending_exit_is_process_alive(Config) when is_list(Config) ->
- ?line S = exit_op_test_init(),
- ?line TestFun = fun (P) -> false = is_process_alive(P) end,
- ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
- ?line verify_pending_exit_success(S),
- ?line comment().
+ S = exit_op_test_init(),
+ TestFun = fun (P) -> false = is_process_alive(P) end,
+ repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
+ verify_pending_exit_success(S),
+ comment().
pending_exit_process_info_1(Config) when is_list(Config) ->
- ?line S = exit_op_test_init(),
- ?line TestFun = fun (P) ->
+ S = exit_op_test_init(),
+ TestFun = fun (P) ->
undefined = process_info(P)
end,
- ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
- ?line verify_pending_exit_success(S),
- ?line comment().
+ repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
+ verify_pending_exit_success(S),
+ comment().
pending_exit_process_info_2(Config) when is_list(Config) ->
- ?line S0 = exit_op_test_init(),
- ?line repeated_exit_op_test(fun (P) ->
+ S0 = exit_op_test_init(),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, messages)
end, ?PE_INFO_REPEAT),
- ?line S1 = verify_pending_exit_success(S0),
- ?line repeated_exit_op_test(fun (P) ->
+ S1 = verify_pending_exit_success(S0),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, status)
end, ?PE_INFO_REPEAT),
- ?line S2 = verify_pending_exit_success(S1),
- ?line repeated_exit_op_test(fun (P) ->
+ S2 = verify_pending_exit_success(S1),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, links)
end, ?PE_INFO_REPEAT),
- ?line S3 = verify_pending_exit_success(S2),
- ?line repeated_exit_op_test(fun (P) ->
+ S3 = verify_pending_exit_success(S2),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, [messages])
end, ?PE_INFO_REPEAT),
- ?line S4 = verify_pending_exit_success(S3),
- ?line repeated_exit_op_test(fun (P) ->
+ S4 = verify_pending_exit_success(S3),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, [status])
end, ?PE_INFO_REPEAT),
- ?line S5 = verify_pending_exit_success(S4),
- ?line repeated_exit_op_test(fun (P) ->
+ S5 = verify_pending_exit_success(S4),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, [links])
end, ?PE_INFO_REPEAT),
- ?line S6 = verify_pending_exit_success(S5),
- ?line repeated_exit_op_test(fun (P) ->
+ S6 = verify_pending_exit_success(S5),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, [status,
links])
end, ?PE_INFO_REPEAT),
- ?line S7 = verify_pending_exit_success(S6),
- ?line repeated_exit_op_test(fun (P) ->
+ S7 = verify_pending_exit_success(S6),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, [messages,
status])
end, ?PE_INFO_REPEAT),
- ?line S8 = verify_pending_exit_success(S7),
- ?line repeated_exit_op_test(fun (P) ->
+ S8 = verify_pending_exit_success(S7),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, [messages,
links])
end, ?PE_INFO_REPEAT),
- ?line S9 = verify_pending_exit_success(S8),
- ?line repeated_exit_op_test(
+ S9 = verify_pending_exit_success(S8),
+ repeated_exit_op_test(
fun (P) ->
undefined = process_info(P, [message_queue_len,
status])
end, ?PE_INFO_REPEAT),
- ?line S10 = verify_pending_exit_success(S9),
- ?line repeated_exit_op_test(fun (P) ->
+ S10 = verify_pending_exit_success(S9),
+ repeated_exit_op_test(fun (P) ->
undefined = process_info(P, [messages,
links,
status])
end, ?PE_INFO_REPEAT),
- ?line verify_pending_exit_success(S10),
- ?line comment().
+ verify_pending_exit_success(S10),
+ comment().
pending_exit_process_display(Config) when is_list(Config) ->
- ?line S = exit_op_test_init(),
- ?line TestFun = fun (P) ->
+ S = exit_op_test_init(),
+ TestFun = fun (P) ->
badarg = try
erlang:process_display(P, backtrace)
catch
error:badarg -> badarg
end
end,
- ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
- ?line verify_pending_exit_success(S),
- ?line comment().
+ repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
+ verify_pending_exit_success(S),
+ comment().
pending_exit_group_leader(Config) when is_list(Config) ->
- ?line S = exit_op_test_init(),
- ?line TestFun = fun (P) ->
+ S = exit_op_test_init(),
+ TestFun = fun (P) ->
badarg = try
group_leader(self(), P)
catch
error:badarg -> badarg
end
end,
- ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
- ?line verify_pending_exit_success(S),
- ?line comment().
+ repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT),
+ verify_pending_exit_success(S),
+ comment().
%%
%% -- Internal utils --------------------------------------------------------
@@ -517,14 +483,14 @@ repeat(Fun, N) when is_integer(N) ->
start_node(Config) ->
Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-" ++ atom_to_list(?config(testcase, Config))
+ ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config))
++ "-" ++ integer_to_list(erlang:system_time(seconds))
++ "-" ++ integer_to_list(erlang:unique_integer([positive]))),
Pa = filename:dirname(code:which(?MODULE)),
- ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]).
+ test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
have_pending_exit() ->
have_pending_exit(self()).
@@ -540,15 +506,15 @@ fake_exit(From, To, Reason) ->
available_internal_state(Bool) when Bool == true; Bool == false ->
case {Bool,
- (catch erts_debug:get_internal_state(available_internal_state))} of
- {true, true} ->
- true;
- {false, true} ->
- erts_debug:set_internal_state(available_internal_state, false),
- true;
- {true, _} ->
- erts_debug:set_internal_state(available_internal_state, true),
- false;
- {false, _} ->
- false
+ (catch erts_debug:get_internal_state(available_internal_state))} of
+ {true, true} ->
+ true;
+ {false, true} ->
+ erts_debug:set_internal_state(available_internal_state, false),
+ true;
+ {true, _} ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ false;
+ {false, _} ->
+ false
end.
diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl
index 5bb98e5ad9..900dd124c0 100644
--- a/erts/emulator/test/smoke_test_SUITE.erl
+++ b/erts/emulator/test/smoke_test_SUITE.erl
@@ -20,38 +20,21 @@
-module(smoke_test_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%-compile(export_all).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
init_per_testcase/2, end_per_testcase/2]).
-export([boot_combo/1, native_atomics/1, jump_table/1]).
--define(DEFAULT_TIMEOUT, ?t:minutes(2)).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
all() ->
[boot_combo, native_atomics, jump_table].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
init_per_testcase(boot_combo = Case, Config) when is_list(Config) ->
case erlang:system_info(build_type) of
opt ->
@@ -63,12 +46,9 @@ init_per_testcase(Case, Config) when is_list(Config) ->
init_per_tc(Case, Config).
init_per_tc(Case, Config) ->
- Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
- [{testcase, Case},{watchdog, Dog}|Config].
+ [{testcase, Case}|Config].
end_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
ok.
%%%
@@ -111,13 +91,13 @@ native_atomics(Config) when is_list(Config) ->
NA64Key = "64-bit native atomics",
DWNAKey = "Double word native atomics",
EthreadInfo = erlang:system_info(ethread_info),
- ?t:format("~p~n", [EthreadInfo]),
+ io:format("~p~n", [EthreadInfo]),
{value,{NA32Key, NA32, _}} = lists:keysearch(NA32Key, 1, EthreadInfo),
{value,{NA64Key, NA64, _}} = lists:keysearch(NA64Key, 1, EthreadInfo),
{value,{DWNAKey, DWNA, _}} = lists:keysearch(DWNAKey, 1, EthreadInfo),
case {erlang:system_info(build_type), erlang:system_info(smp_support), NA32, NA64, DWNA} of
{opt, true, "no", "no", _} ->
- ?t:fail(optimized_smp_runtime_without_native_atomics);
+ ct:fail(optimized_smp_runtime_without_native_atomics);
{_, false, "no", "no", _} ->
{comment, "No native atomics"};
_ ->
@@ -134,7 +114,7 @@ jump_table(Config) when is_list(Config) ->
false ->
case erlang:system_info(build_type) of
opt ->
- ?t:fail(optimized_without_beam_jump_table);
+ ct:fail(optimized_without_beam_jump_table);
BT ->
{comment, "No beam jump table, but build type is " ++ atom_to_list(BT)}
end
@@ -149,7 +129,7 @@ chk_boot(Config, Args, Fun) ->
true = os:putenv("ERL_ZFLAGS", Args),
Success = make_ref(),
Parent = self(),
- ?t:format("--- Testing ~s~n", [Args]),
+ io:format("--- Testing ~s~n", [Args]),
{ok, Node} = start_node(Config),
Pid = spawn_link(Node, fun () ->
Fun(),
@@ -159,7 +139,7 @@ chk_boot(Config, Args, Fun) ->
{Pid, Success} ->
Node = node(Pid),
stop_node(Node),
- ?t:format("--- Success!~n", []),
+ io:format("--- Success!~n", []),
ok
end.
@@ -170,14 +150,14 @@ start_node(Config, Args) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
- ++ atom_to_list(?config(testcase, Config))
+ ++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
++ integer_to_list(erlang:system_time(seconds))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
Opts = [{args, "-pa "++Pa++" "++Args}],
- ?t:start_node(Name, slave, Opts).
+ test_server:start_node(Name, slave, Opts).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl
index 56ecf4195a..7d5b07f21f 100644
--- a/erts/emulator/test/statistics_SUITE.erl
+++ b/erts/emulator/test/statistics_SUITE.erl
@@ -22,39 +22,31 @@
%% Tests the statistics/1 bif.
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,
- end_per_testcase/2,
+-export([all/0, suite/0, groups/0,
wall_clock_zero_diff/1, wall_clock_update/1,
runtime_zero_diff/1,
runtime_update/1, runtime_diff/1,
run_queue_one/1,
scheduler_wall_time/1,
reductions/1, reductions_big/1, garbage_collection/1, io/1,
- badarg/1]).
+ badarg/1, run_queues_lengths_active_tasks/1, msacc/1]).
%% Internal exports.
-export([hog/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-init_per_testcase(_, Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(300)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_, Config) ->
- Dog = ?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
[{group, wall_clock}, {group, runtime}, reductions,
reductions_big, {group, run_queue}, scheduler_wall_time,
- garbage_collection, io, badarg].
+ garbage_collection, io, badarg,
+ run_queues_lengths_active_tasks,
+ msacc].
groups() ->
[{wall_clock, [],
@@ -63,61 +55,42 @@ groups() ->
[runtime_zero_diff, runtime_update, runtime_diff]},
{run_queue, [], [run_queue_one]}].
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-
%%% Testing statistics(wall_clock).
-
-
-wall_clock_zero_diff(doc) ->
- "Tests that the 'Wall clock since last call' element of the result "
- "is zero when statistics(runtime) is called twice in succession.";
+%% Tests that the 'Wall clock since last call' element of the result
+%% is zero when statistics(runtime) is called twice in succession.
wall_clock_zero_diff(Config) when is_list(Config) ->
wall_clock_zero_diff1(16).
wall_clock_zero_diff1(N) when N > 0 ->
- ?line {Time, _} = statistics(wall_clock),
- ?line case statistics(wall_clock) of
- {Time, 0} -> ok;
- _ -> wall_clock_zero_diff1(N-1)
+ {Time, _} = statistics(wall_clock),
+ case statistics(wall_clock) of
+ {Time, 0} -> ok;
+ _ -> wall_clock_zero_diff1(N-1)
end;
wall_clock_zero_diff1(0) ->
- ?line test_server:fail("Difference never zero.").
+ ct:fail("Difference never zero.").
-wall_clock_update(doc) ->
- "Test that the time differences returned by two calls to "
- "statistics(wall_clock) are compatible, and are within a small number "
- "of ms of the amount of real time we waited for.";
+%% Test that the time differences returned by two calls to
+%% statistics(wall_clock) are compatible, and are within a small number
+%% of ms of the amount of real time we waited for.
wall_clock_update(Config) when is_list(Config) ->
wall_clock_update1(6).
wall_clock_update1(N) when N > 0 ->
- ?line {T1_wc_time, _} = statistics(wall_clock),
- ?line receive after 1000 -> ok end,
- ?line {T2_wc_time, Wc_Diff} = statistics(wall_clock),
-
- ?line Wc_Diff = T2_wc_time - T1_wc_time,
- ?line test_server:format("Wall clock diff = ~p; should be = 1000..1040~n",
- [Wc_Diff]),
- case ?t:is_debug() of
- false ->
- ?line true = Wc_Diff =< 1040;
- true ->
- ?line true = Wc_Diff =< 2000 %Be more tolerant in debug-compiled emulator.
+ {T1_wc_time, _} = statistics(wall_clock),
+ receive after 1000 -> ok end,
+ {T2_wc_time, Wc_Diff} = statistics(wall_clock),
+
+ Wc_Diff = T2_wc_time - T1_wc_time,
+ io:format("Wall clock diff = ~p; should be = 1000..1040~n", [Wc_Diff]),
+ case test_server:is_debug() of
+ false ->
+ true = Wc_Diff =< 1040;
+ true ->
+ true = Wc_Diff =< 2000 %Be more tolerant in debug-compiled emulator.
end,
- ?line true = Wc_Diff >= 1000,
+ true = Wc_Diff >= 1000,
wall_clock_update1(N-1);
wall_clock_update1(0) ->
ok.
@@ -126,64 +99,60 @@ wall_clock_update1(0) ->
%%% Test statistics(runtime).
-runtime_zero_diff(doc) ->
- "Tests that the difference between the times returned from two consectuitive "
- "calls to statistics(runtime) is zero.";
+%% Tests that the difference between the times returned from two consectuitive
+%% calls to statistics(runtime) is zero.
runtime_zero_diff(Config) when is_list(Config) ->
- ?line runtime_zero_diff1(16).
+ runtime_zero_diff1(16).
runtime_zero_diff1(N) when N > 0 ->
- ?line {T1, _} = statistics(runtime),
- ?line case statistics(runtime) of
- {T1, 0} -> ok;
- _ -> runtime_zero_diff1(N-1)
- end;
+ {T1, _} = statistics(runtime),
+ case statistics(runtime) of
+ {T1, 0} -> ok;
+ _ -> runtime_zero_diff1(N-1)
+ end;
runtime_zero_diff1(0) ->
- ?line test_server:fail("statistics(runtime) never returned zero difference").
+ ct:fail("statistics(runtime) never returned zero difference").
-runtime_update(doc) ->
- "Test that the statistics(runtime) returns a substanstially "
- "updated difference after running a process that takes all CPU "
- " power of the Erlang process for a second.";
+%% Test that the statistics(runtime) returns a substanstially
+%% updated difference after running a process that takes all CPU
+%% power of the Erlang process for a second.
runtime_update(Config) when is_list(Config) ->
- case ?t:is_cover() of
- false ->
- ?line process_flag(priority, high),
- do_runtime_update(10);
- true ->
- {skip,"Cover-compiled"}
+ case test_server:is_cover() of
+ false ->
+ process_flag(priority, high),
+ do_runtime_update(10);
+ true ->
+ {skip,"Cover-compiled"}
end.
do_runtime_update(0) ->
{comment,"Never close enough"};
do_runtime_update(N) ->
- ?line {T1,Diff0} = statistics(runtime),
- ?line spawn_link(fun cpu_heavy/0),
+ {T1,Diff0} = statistics(runtime),
+ spawn_link(fun cpu_heavy/0),
receive after 1000 -> ok end,
- ?line {T2,Diff} = statistics(runtime),
- ?line true = is_integer(T1+T2+Diff0+Diff),
- ?line test_server:format("T1 = ~p, T2 = ~p, Diff = ~p, T2-T1 = ~p",
- [T1,T2,Diff,T2-T1]),
- ?line if
- T2 - T1 =:= Diff, 900 =< Diff, Diff =< 1500 -> ok;
- true -> do_runtime_update(N-1)
- end.
-
+ {T2,Diff} = statistics(runtime),
+ true = is_integer(T1+T2+Diff0+Diff),
+ io:format("T1 = ~p, T2 = ~p, Diff = ~p, T2-T1 = ~p", [T1,T2,Diff,T2-T1]),
+ if
+ T2 - T1 =:= Diff, 900 =< Diff, Diff =< 1500 -> ok;
+ true -> do_runtime_update(N-1)
+ end.
+
cpu_heavy() ->
cpu_heavy().
-runtime_diff(doc) ->
- "Test that the difference between two consecutive absolute runtimes is "
- "equal to the last relative runtime. The loop runs a lot of times since "
- "the bug which this test case tests for showed up only rarely.";
+%% Test that the difference between two consecutive absolute runtimes is
+%% equal to the last relative runtime. The loop runs a lot of times since
+%% the bug which this test case tests for showed up only rarely.
runtime_diff(Config) when is_list(Config) ->
runtime_diff1(1000).
runtime_diff1(N) when N > 0 ->
- ?line {T1_wc_time, _} = statistics(runtime),
- ?line do_much(),
- ?line {T2_wc_time, Wc_Diff} = statistics(runtime),
- ?line Wc_Diff = T2_wc_time - T1_wc_time,
+ {T1_wc_time, _} = statistics(runtime),
+ do_much(),
+ {T2_wc_time, Wc_Diff} = statistics(runtime),
+ Wc_Diff = T2_wc_time - T1_wc_time,
runtime_diff1(N-1);
runtime_diff1(0) ->
ok.
@@ -201,10 +170,9 @@ do_much(N) ->
do_much(N-1).
-reductions(doc) ->
- "Test that statistics(reductions) is callable, and that "
- "Total_Reductions and Reductions_Since_Last_Call make sense. "
- "(This to fail on pre-R3A version of JAM.";
+%% Test that statistics(reductions) is callable, and that
+%% Total_Reductions and Reductions_Since_Last_Call make sense.
+%% This to fail on pre-R3A version of JAM.
reductions(Config) when is_list(Config) ->
{Reductions, _} = statistics(reductions),
@@ -217,13 +185,13 @@ reductions(Config) when is_list(Config) ->
reductions(300, Reductions, Mask).
reductions(N, Previous, Mask) when N > 0 ->
- ?line {Reductions, Diff} = statistics(reductions),
- ?line build_some_garbage(),
- ?line if Reductions > 0 -> ok end,
- ?line if Diff >= 0 -> ok end,
+ {Reductions, Diff} = statistics(reductions),
+ build_some_garbage(),
+ if Reductions > 0 -> ok end,
+ if Diff >= 0 -> ok end,
io:format("Previous = ~p, Reductions = ~p, Diff = ~p, DiffShouldBe = ~p",
- [Previous, Reductions, Diff, (Reductions-Previous) band Mask]),
- ?line if Reductions == ((Previous+Diff) band Mask) -> reductions(N-1, Reductions, Mask) end;
+ [Previous, Reductions, Diff, (Reductions-Previous) band Mask]),
+ if Reductions == ((Previous+Diff) band Mask) -> reductions(N-1, Reductions, Mask) end;
reductions(0, _, _) ->
ok.
@@ -232,126 +200,123 @@ build_some_garbage() ->
%% a garbage collection in the scheduler.
processes().
-reductions_big(doc) ->
- "Test that the number of reductions can be returned as a big number.";
+%% Test that the number of reductions can be returned as a big number.
reductions_big(Config) when is_list(Config) ->
- ?line reductions_big_loop(),
+ reductions_big_loop(),
ok.
reductions_big_loop() ->
erlang:yield(),
case statistics(reductions) of
- {Red, Diff} when Red >= 16#7ffFFFF ->
- ok = io:format("Reductions = ~w, Diff = ~w", [Red, Diff]);
- _ ->
- reductions_big_loop()
+ {Red, Diff} when Red >= 16#7ffFFFF ->
+ ok = io:format("Reductions = ~w, Diff = ~w", [Red, Diff]);
+ _ ->
+ reductions_big_loop()
end.
%%% Tests of statistics(run_queue).
-run_queue_one(doc) ->
- "Tests that statistics(run_queue) returns 1 if we start a "
- "CPU-bound process.";
+%% Tests that statistics(run_queue) returns 1 if we start a
+%% CPU-bound process.
run_queue_one(Config) when is_list(Config) ->
- ?line MS = erlang:system_flag(multi_scheduling, block),
- ?line run_queue_one_test(Config),
- ?line erlang:system_flag(multi_scheduling, unblock),
+ MS = erlang:system_flag(multi_scheduling, block),
+ run_queue_one_test(Config),
+ erlang:system_flag(multi_scheduling, unblock),
case MS of
- blocked ->
- {comment,
- "Multi-scheduling blocked during test. This test-case "
- "was not written to work with multiple schedulers."};
- _ -> ok
+ blocked ->
+ {comment,
+ "Multi-scheduling blocked during test. This test-case "
+ "was not written to work with multiple schedulers."};
+ _ -> ok
end.
-
+
run_queue_one_test(Config) when is_list(Config) ->
- ?line _Hog = spawn_link(?MODULE, hog, [self()]),
- ?line receive
- hog_started -> ok
- end,
- ?line receive after 100 -> ok end, % Give hog a head start.
- ?line case statistics(run_queue) of
- N when N >= 1 -> ok;
- Other -> ?line ?t:fail({unexpected,Other})
- end,
+ _Hog = spawn_link(?MODULE, hog, [self()]),
+ receive
+ hog_started -> ok
+ end,
+ receive after 100 -> ok end, % Give hog a head start.
+ case statistics(run_queue) of
+ N when N >= 1 -> ok;
+ Other -> ct:fail({unexpected,Other})
+ end,
ok.
%% CPU-bound process, going at low priority. It will always be ready
%% to run.
hog(Pid) ->
- ?line process_flag(priority, low),
- ?line Pid ! hog_started,
- ?line Mon = erlang:monitor(process, Pid),
- ?line hog_iter(0, Mon).
+ process_flag(priority, low),
+ Pid ! hog_started,
+ Mon = erlang:monitor(process, Pid),
+ hog_iter(0, Mon).
hog_iter(N, Mon) when N > 0 ->
receive
- {'DOWN', Mon, _, _, _} -> ok
+ {'DOWN', Mon, _, _, _} -> ok
after 0 ->
- ?line hog_iter(N-1, Mon)
+ hog_iter(N-1, Mon)
end;
hog_iter(0, Mon) ->
- ?line hog_iter(10000, Mon).
+ hog_iter(10000, Mon).
%%% Tests of statistics(scheduler_wall_time).
-scheduler_wall_time(doc) ->
- "Tests that statistics(scheduler_wall_time) works as intended";
+%% Tests that statistics(scheduler_wall_time) works as intended
scheduler_wall_time(Config) when is_list(Config) ->
%% Should return undefined if system_flag is not turned on yet
undefined = statistics(scheduler_wall_time),
%% Turn on statistics
false = erlang:system_flag(scheduler_wall_time, true),
try
- Schedulers = erlang:system_info(schedulers_online),
- %% Let testserver and everyone else finish their work
- timer:sleep(1500),
- %% Empty load
- EmptyLoad = get_load(),
- {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad},
- MeMySelfAndI = self(),
- StartHog = fun() ->
- Pid = spawn(?MODULE, hog, [self()]),
- receive hog_started -> MeMySelfAndI ! go end,
- Pid
- end,
- P1 = StartHog(),
- %% Max on one, the other schedulers empty (hopefully)
- %% Be generous the process can jump between schedulers
- %% which is ok and we don't want the test to fail for wrong reasons
- _L1 = [S1Load|EmptyScheds1] = get_load(),
- {true,_} = {S1Load > 50,S1Load},
- {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1},
- {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1},
-
- %% 50% load
- HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)],
- HalfLoad = lists:sum(get_load()) div Schedulers,
- if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog
- %% We want roughly 50% load
- HalfLoad > 40, HalfLoad < 60 -> ok;
- true -> exit({halfload, HalfLoad})
- end,
-
- %% 100% load
- LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)],
- FullScheds = get_load(),
- {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds},
- FullLoad = lists:sum(FullScheds) div Schedulers,
- if FullLoad > 90 -> ok;
- true -> exit({fullload, FullLoad})
- end,
-
- [exit(Pid, kill) || Pid <- [P1|HalfHogs++LastHogs]],
- AfterLoad = get_load(),
- {false,_} = {lists:any(fun(Load) -> Load > 25 end, AfterLoad),AfterLoad},
- true = erlang:system_flag(scheduler_wall_time, false)
+ Schedulers = erlang:system_info(schedulers_online),
+ %% Let testserver and everyone else finish their work
+ timer:sleep(1500),
+ %% Empty load
+ EmptyLoad = get_load(),
+ {false, _} = {lists:any(fun(Load) -> Load > 50 end, EmptyLoad),EmptyLoad},
+ MeMySelfAndI = self(),
+ StartHog = fun() ->
+ Pid = spawn(?MODULE, hog, [self()]),
+ receive hog_started -> MeMySelfAndI ! go end,
+ Pid
+ end,
+ P1 = StartHog(),
+ %% Max on one, the other schedulers empty (hopefully)
+ %% Be generous the process can jump between schedulers
+ %% which is ok and we don't want the test to fail for wrong reasons
+ _L1 = [S1Load|EmptyScheds1] = get_load(),
+ {true,_} = {S1Load > 50,S1Load},
+ {false,_} = {lists:any(fun(Load) -> Load > 50 end, EmptyScheds1),EmptyScheds1},
+ {true,_} = {lists:sum(EmptyScheds1) < 60,EmptyScheds1},
+
+ %% 50% load
+ HalfHogs = [StartHog() || _ <- lists:seq(1, (Schedulers-1) div 2)],
+ HalfLoad = lists:sum(get_load()) div Schedulers,
+ if Schedulers < 2, HalfLoad > 80 -> ok; %% Ok only one scheduler online and one hog
+ %% We want roughly 50% load
+ HalfLoad > 40, HalfLoad < 60 -> ok;
+ true -> exit({halfload, HalfLoad})
+ end,
+
+ %% 100% load
+ LastHogs = [StartHog() || _ <- lists:seq(1, Schedulers div 2)],
+ FullScheds = get_load(),
+ {false,_} = {lists:any(fun(Load) -> Load < 80 end, FullScheds),FullScheds},
+ FullLoad = lists:sum(FullScheds) div Schedulers,
+ if FullLoad > 90 -> ok;
+ true -> exit({fullload, FullLoad})
+ end,
+
+ [exit(Pid, kill) || Pid <- [P1|HalfHogs++LastHogs]],
+ AfterLoad = get_load(),
+ {false,_} = {lists:any(fun(Load) -> Load > 25 end, AfterLoad),AfterLoad},
+ true = erlang:system_flag(scheduler_wall_time, false)
after
- erlang:system_flag(scheduler_wall_time, false)
+ erlang:system_flag(scheduler_wall_time, false)
end.
get_load() ->
@@ -365,47 +330,214 @@ load_percentage([{Id, WN, TN}|Ss], [{Id, WP, TP}|Ps]) ->
load_percentage([], []) -> [].
-garbage_collection(doc) ->
- "Tests that statistics(garbage_collection) is callable. "
- "It is not clear how to test anything more.";
+%% Tests that statistics(garbage_collection) is callable.
+%% It is not clear how to test anything more.
garbage_collection(Config) when is_list(Config) ->
- ?line Bin = list_to_binary(lists:duplicate(19999, 42)),
- ?line case statistics(garbage_collection) of
- {Gcs0,R,0} when is_integer(Gcs0), is_integer(R) ->
- ?line io:format("Reclaimed: ~p", [R]),
- ?line Gcs = garbage_collection_1(Gcs0, Bin),
- ?line io:format("Reclaimed: ~p",
- [element(2, statistics(garbage_collection))]),
- {comment,integer_to_list(Gcs-Gcs0)++" GCs"}
- end.
+ Bin = list_to_binary(lists:duplicate(19999, 42)),
+ case statistics(garbage_collection) of
+ {Gcs0,R,0} when is_integer(Gcs0), is_integer(R) ->
+ io:format("Reclaimed: ~p", [R]),
+ Gcs = garbage_collection_1(Gcs0, Bin),
+ io:format("Reclaimed: ~p",
+ [element(2, statistics(garbage_collection))]),
+ {comment,integer_to_list(Gcs-Gcs0)++" GCs"}
+ end.
garbage_collection_1(Gcs0, Bin) ->
case statistics(garbage_collection) of
- {Gcs,Reclaimed,0} when Gcs >= Gcs0 ->
- if
- Reclaimed > 16#7ffffff ->
- Gcs;
- true ->
- _ = binary_to_list(Bin),
- erlang:garbage_collect(),
- garbage_collection_1(Gcs, Bin)
- end
+ {Gcs,Reclaimed,0} when Gcs >= Gcs0 ->
+ if
+ Reclaimed > 16#7ffffff ->
+ Gcs;
+ true ->
+ _ = binary_to_list(Bin),
+ erlang:garbage_collect(),
+ garbage_collection_1(Gcs, Bin)
+ end
end.
-io(doc) ->
- "Tests that statistics(io) is callable. "
- "This could be improved to test something more.";
+%% Tests that statistics(io) is callable.
+%% This could be improved to test something more.
io(Config) when is_list(Config) ->
- ?line case statistics(io) of
- {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> ok
- end.
+ case statistics(io) of
+ {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> ok
+ end.
-badarg(doc) ->
- "Tests that some illegal arguments to statistics fails.";
+%% Tests that some illegal arguments to statistics fails.
badarg(Config) when is_list(Config) ->
- ?line case catch statistics(1) of
- {'EXIT', {badarg, _}} -> ok
- end,
- ?line case catch statistics(bad_atom) of
- {'EXIT', {badarg, _}} -> ok
- end.
+ case catch statistics(1) of
+ {'EXIT', {badarg, _}} -> ok
+ end,
+ case catch statistics(bad_atom) of
+ {'EXIT', {badarg, _}} -> ok
+ end.
+
+tok_loop() ->
+ tok_loop().
+
+run_queues_lengths_active_tasks(Config) ->
+ TokLoops = lists:map(fun (_) ->
+ spawn_opt(fun () ->
+ tok_loop()
+ end,
+ [link, {priority, low}])
+ end,
+ lists:seq(1,10)),
+
+ TRQLs0 = statistics(total_run_queue_lengths),
+ TATs0 = statistics(total_active_tasks),
+ true = is_integer(TRQLs0),
+ true = is_integer(TATs0),
+ true = TRQLs0 >= 0,
+ true = TATs0 >= 11,
+
+ NoScheds = erlang:system_info(schedulers),
+ RQLs0 = statistics(run_queue_lengths),
+ ATs0 = statistics(active_tasks),
+ NoScheds = length(RQLs0),
+ NoScheds = length(ATs0),
+ true = lists:sum(RQLs0) >= 0,
+ true = lists:sum(ATs0) >= 11,
+
+ SO = erlang:system_flag(schedulers_online, 1),
+
+ %% Give newly suspended schedulers some time to
+ %% migrate away work from their run queues...
+ receive after 1000 -> ok end,
+
+ TRQLs1 = statistics(total_run_queue_lengths),
+ TATs1 = statistics(total_active_tasks),
+ true = TRQLs1 >= 10,
+ true = TATs1 >= 11,
+ NoScheds = erlang:system_info(schedulers),
+
+ RQLs1 = statistics(run_queue_lengths),
+ ATs1 = statistics(active_tasks),
+ NoScheds = length(RQLs1),
+ NoScheds = length(ATs1),
+ TRQLs2 = lists:sum(RQLs1),
+ TATs2 = lists:sum(ATs1),
+ true = TRQLs2 >= 10,
+ true = TATs2 >= 11,
+ [TRQLs2|_] = RQLs1,
+ [TATs2|_] = ATs1,
+
+ erlang:system_flag(schedulers_online, SO),
+
+ lists:foreach(fun (P) ->
+ unlink(P),
+ exit(P, bang)
+ end,
+ TokLoops),
+
+ ok.
+
+%% Tests that statistics(microstate_statistics) works.
+msacc(Config) ->
+
+ %% Test if crypto nif is available
+ Niff = try crypto:strong_rand_bytes(1), ok catch _:_ -> nok end,
+ TmpFile = filename:join(proplists:get_value(priv_dir,Config),"file.tmp"),
+
+ false = erlang:system_flag(microstate_accounting, true),
+
+ msacc_test(TmpFile),
+
+ true = erlang:system_flag(microstate_accounting, false),
+
+ MsaccStats = erlang:statistics(microstate_accounting),
+
+ case os:type() of
+ {win32, _} ->
+ %% Some windows have a very poor accuracy on their
+ %% timing primitives, so we just make sure that
+ %% some state besides sleep has been triggered.
+ Sum = lists:sum(
+ lists:map(fun({sleep, _V}) -> 0;
+ ({_, V}) -> V
+ end, maps:to_list(msacc_sum_states()))
+ ),
+ if Sum > 0 ->
+ ok;
+ true ->
+ ct:fail({no_states_triggered, MsaccStats})
+ end;
+ _ ->
+
+ %% Make sure that all states were triggered at least once
+ maps:map(fun(nif, 0) ->
+ case Niff of
+ ok ->
+ ct:fail({zero_state,nif});
+ nok ->
+ ok
+ end;
+ (aux, 0) ->
+ %% aux will be zero if we do not have smp support
+ %% or no async threads
+ case erlang:system_info(smp_support) orelse
+ erlang:system_info(thread_pool_size) > 0
+ of
+ false ->
+ ok;
+ true ->
+ ct:log("msacc: ~p",[MsaccStats]),
+ ct:fail({zero_state,aux})
+ end;
+ (Key, 0) ->
+ ct:log("msacc: ~p",[MsaccStats]),
+ ct:fail({zero_state,Key});
+ (_,_) -> ok
+ end, msacc_sum_states())
+ end,
+
+ erlang:system_flag(microstate_accounting, reset),
+
+ msacc_test(TmpFile),
+
+ %% Make sure all counters are zero after stopping and resetting
+ maps:map(fun(_Key, 0) -> ok;
+ (Key,_) ->
+ ct:log("msacc: ~p",[erlang:statistics(microstate_accounting)]),
+ ct:fail({non_zero_state,Key})
+ end,msacc_sum_states()).
+
+%% This test tries to make sure to trigger all of the different available states
+msacc_test(TmpFile) ->
+
+ %% We write some data
+ [file:write_file(TmpFile,<<0:(1024*1024*8)>>,[raw]) || _ <- lists:seq(1,100)],
+
+ %% Do some ETS operations
+ Tid = ets:new(table, []),
+ ets:insert(Tid, {1, hello}),
+ ets:delete(Tid),
+
+ %% Collect some garbage
+ [erlang:garbage_collect() || _ <- lists:seq(1,100)],
+
+ %% Send some messages
+ [begin self() ! {hello},receive _ -> ok end end || _ <- lists:seq(1,100)],
+
+ %% Setup some timers
+ Refs = [erlang:send_after(10000,self(),ok) || _ <- lists:seq(1,100)],
+
+ %% Do some nif work
+ catch [crypto:strong_rand_bytes(128) || _ <- lists:seq(1,100)],
+
+ %% Cancel some timers
+ [erlang:cancel_timer(R) || R <- Refs],
+
+ %% Wait for a while
+ timer:sleep(100).
+
+msacc_sum_states() ->
+ Stats = erlang:statistics(microstate_accounting),
+ [#{ counters := C }|_] = Stats,
+ InitialCounters = maps:map(fun(_,_) -> 0 end,C),
+ lists:foldl(fun(#{ counters := Counters }, Cnt) ->
+ maps:fold(fun(Key, Value, Acc) ->
+ NewValue = Value+maps:get(Key,Acc),
+ maps:update(Key, NewValue, Acc)
+ end, Cnt, Counters)
+ end,InitialCounters,Stats).
diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl
index bee42c07d9..ffea5bc15b 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -31,55 +31,25 @@
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-%-compile(export_all).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2, end_per_testcase/2]).
+-export([all/0, suite/0]).
--export([process_count/1, system_version/1, misc_smoke_tests/1, heap_size/1, wordsize/1, memory/1,
- ets_limit/1]).
+-export([process_count/1, system_version/1, misc_smoke_tests/1,
+ heap_size/1, wordsize/1, memory/1, ets_limit/1]).
--define(DEFAULT_TIMEOUT, ?t:minutes(2)).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
all() ->
[process_count, system_version, misc_smoke_tests,
heap_size, wordsize, memory, ets_limit].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
- ok.
-
%%%
%%% The test cases -------------------------------------------------------------
%%%
-process_count(doc) -> [];
-process_count(suite) -> [];
process_count(Config) when is_list(Config) ->
case catch erlang:system_info(modified_timing_level) of
Level when is_integer(Level) ->
@@ -92,37 +62,37 @@ process_count(Config) when is_list(Config) ->
end.
process_count_test() ->
- ?line OldPrio = process_flag(priority, max),
- ?line check_procs(10),
- ?line check_procs(11234),
- ?line check_procs(57),
- ?line check_procs(1030),
- ?line check_procs(687),
- ?line check_procs(7923),
- ?line check_procs(5302),
- ?line check_procs(12456),
- ?line check_procs(14),
- ?line check_procs(1125),
- ?line check_procs(236),
- ?line check_procs(125),
- ?line check_procs(2346),
- ?line process_flag(priority, OldPrio),
- ?line ok.
+ OldPrio = process_flag(priority, max),
+ check_procs(10),
+ check_procs(11234),
+ check_procs(57),
+ check_procs(1030),
+ check_procs(687),
+ check_procs(7923),
+ check_procs(5302),
+ check_procs(12456),
+ check_procs(14),
+ check_procs(1125),
+ check_procs(236),
+ check_procs(125),
+ check_procs(2346),
+ process_flag(priority, OldPrio),
+ ok.
check_procs(N) ->
- ?line CP = length(processes()),
- ?line Procs = start_procs(N),
- ?line check_pc(CP+N),
- ?line stop_procs(Procs),
- ?line check_pc(CP).
+ CP = length(processes()),
+ Procs = start_procs(N),
+ check_pc(CP+N),
+ stop_procs(Procs),
+ check_pc(CP).
check_pc(E) ->
- ?line P = length(processes()),
- ?line SI = erlang:system_info(process_count),
- ?line ?t:format("E=~p; P=~p; SI=~p~n", [E, P, SI]),
- ?line E = P,
- ?line P = SI.
+ P = length(processes()),
+ SI = erlang:system_info(process_count),
+ io:format("E=~p; P=~p; SI=~p~n", [E, P, SI]),
+ E = P,
+ P = SI.
start_procs(N) ->
lists:map(fun (_) ->
@@ -143,55 +113,44 @@ stop_procs(PMs) ->
end, PMs).
-system_version(doc) -> [];
-system_version(suite) -> [];
system_version(Config) when is_list(Config) ->
- ?line {comment, erlang:system_info(system_version)}.
+ {comment, erlang:system_info(system_version)}.
-misc_smoke_tests(doc) -> [];
-misc_smoke_tests(suite) -> [];
misc_smoke_tests(Config) when is_list(Config) ->
- ?line true = is_binary(erlang:system_info(info)),
- ?line true = is_binary(erlang:system_info(procs)),
- ?line true = is_binary(erlang:system_info(loaded)),
- ?line true = is_binary(erlang:system_info(dist)),
- ?line ok = try erlang:system_info({cpu_topology,erts_get_cpu_topology_error_case}), fail catch error:badarg -> ok end,
+ true = is_binary(erlang:system_info(info)),
+ true = is_binary(erlang:system_info(procs)),
+ true = is_binary(erlang:system_info(loaded)),
+ true = is_binary(erlang:system_info(dist)),
+ ok = try erlang:system_info({cpu_topology,erts_get_cpu_topology_error_case}), fail catch error:badarg -> ok end,
true = lists:member(erlang:system_info(tolerant_timeofday), [enabled, disabled]),
- ?line ok.
+ ok.
-heap_size(doc) -> [];
-heap_size(suite) -> [];
heap_size(Config) when is_list(Config) ->
- ?line {min_bin_vheap_size, VHmin} = erlang:system_info(min_bin_vheap_size),
- ?line {min_heap_size, Hmin} = erlang:system_info(min_heap_size),
- ?line GCinf = erlang:system_info(garbage_collection),
- ?line VHmin = proplists:get_value(min_bin_vheap_size, GCinf),
- ?line Hmin = proplists:get_value(min_heap_size, GCinf),
+ {min_bin_vheap_size, VHmin} = erlang:system_info(min_bin_vheap_size),
+ {min_heap_size, Hmin} = erlang:system_info(min_heap_size),
+ GCinf = erlang:system_info(garbage_collection),
+ VHmin = proplists:get_value(min_bin_vheap_size, GCinf),
+ Hmin = proplists:get_value(min_heap_size, GCinf),
ok.
-wordsize(suite) ->
- [];
-wordsize(doc) ->
- ["Tests the various wordsize variants"];
+%% Tests the various wordsize variants
wordsize(Config) when is_list(Config) ->
- ?line A = erlang:system_info(wordsize),
- ?line true = is_integer(A),
- ?line A = erlang:system_info({wordsize,internal}),
- ?line B = erlang:system_info({wordsize,external}),
- ?line true = A =< B,
+ A = erlang:system_info(wordsize),
+ true = is_integer(A),
+ A = erlang:system_info({wordsize,internal}),
+ B = erlang:system_info({wordsize,external}),
+ true = A =< B,
case {B,A} of
{4,4} ->
{comment, "True 32-bit emulator"};
{8,8} ->
{comment, "True 64-bit emulator"};
- {8,4} ->
- {comment, "Halfword 64-bit emulator"};
Other ->
exit({unexpected_wordsizes,Other})
end.
-memory(doc) -> ["Verify that erlang:memory/0 and memory results in crashdump produce are similar"];
+%% Verify that erlang:memory/0 and memory results in crashdump produce are similar
memory(Config) when is_list(Config) ->
%%
%% Verify that erlang:memory/0 and memory results in
@@ -246,8 +205,7 @@ memory_test(_Config) ->
end)
end,
1000 div erlang:system_info(schedulers_online))
- end,
- []),
+ end, []),
cmp_memory(MWs, "spawn procs"),
Ps = lists:flatten(DPs),
@@ -255,14 +213,12 @@ memory_test(_Config) ->
mem_workers_call(MWs,
fun () ->
lists:foreach(fun (P) -> link(P) end, Ps)
- end,
- []),
+ end, []),
cmp_memory(MWs, "link procs"),
mem_workers_call(MWs,
fun () ->
lists:foreach(fun (P) -> unlink(P) end, Ps)
- end,
- []),
+ end, []),
cmp_memory(MWs, "unlink procs"),
mem_workers_call(MWs,
@@ -279,8 +235,7 @@ memory_test(_Config) ->
true = is_reference(Tmr),
put('BIF_TMRS', [Tmr|Tmrs])
end, Ps)
- end,
- []),
+ end, []),
cmp_memory(MWs, "start BIF timer procs"),
mem_workers_call(MWs,
@@ -291,8 +246,7 @@ memory_test(_Config) ->
end, get('BIF_TMRS')),
put('BIF_TMRS', undefined),
garbage_collect()
- end,
- []),
+ end, []),
erts_debug:set_internal_state(wait, deallocations),
cmp_memory(MWs, "cancel BIF timer procs"),
@@ -301,8 +255,7 @@ memory_test(_Config) ->
lists:map(fun (P) ->
monitor(process, P)
end, Ps)
- end,
- []),
+ end, []),
cmp_memory(MWs, "monitor procs"),
Ms = lists:flatten(DMs),
mem_workers_call(MWs,
@@ -310,8 +263,7 @@ memory_test(_Config) ->
lists:foreach(fun (M) ->
demonitor(M)
end, Ms)
- end,
- []),
+ end, []),
cmp_memory(MWs, "demonitor procs"),
mem_workers_call(MWs,
@@ -319,8 +271,7 @@ memory_test(_Config) ->
lists:foreach(fun (P) ->
P ! {a, "message", make_ref()}
end, Ps)
- end,
- []),
+ end, []),
cmp_memory(MWs, "message procs"),
mem_workers_call(MWs,
@@ -343,8 +294,7 @@ memory_test(_Config) ->
fun () ->
put(binary_data,
mapn(fun (_) -> list_to_binary(lists:duplicate(256,$?)) end, 100))
- end,
- []),
+ end, []),
cmp_memory(MWs, "store binary data"),
@@ -352,8 +302,7 @@ memory_test(_Config) ->
fun () ->
put(binary_data, false),
garbage_collect()
- end,
- []),
+ end, []),
cmp_memory(MWs, "release binary data"),
mem_workers_call(MWs,
@@ -361,8 +310,7 @@ memory_test(_Config) ->
list_to_atom("an ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
list_to_atom("another ugly atom "++integer_to_list(erlang:system_info(scheduler_id))),
list_to_atom("yet another ugly atom "++integer_to_list(erlang:system_info(scheduler_id)))
- end,
- []),
+ end, []),
cmp_memory(MWs, "new atoms"),
@@ -373,16 +321,14 @@ memory_test(_Config) ->
ets:insert(T, {banan, lists:seq(1,1024)}),
ets:insert(T, {appelsin, make_ref()}),
put(ets_id, T)
- end,
- []),
+ end, []),
cmp_memory(MWs, "store ets data"),
mem_workers_call(MWs,
fun () ->
ets:delete(get(ets_id)),
put(ets_id, false)
- end,
- []),
+ end, []),
cmp_memory(MWs, "remove ets data"),
lists:foreach(fun (MW) ->
@@ -392,8 +338,7 @@ memory_test(_Config) ->
receive
{'DOWN', Mon, _, _, _} -> ok
end
- end,
- MWs),
+ end, MWs),
ok.
mem_worker() ->
@@ -408,22 +353,19 @@ mem_worker() ->
mem_workers_call(MWs, Fun, Args) ->
lists:foreach(fun (MW) ->
- MW ! {call, self(), Fun, Args}
- end,
- MWs),
+ MW ! {call, self(), Fun, Args}
+ end, MWs),
lists:map(fun (MW) ->
- receive
- {reply, MW, Res} ->
- Res
- end
- end,
- MWs).
+ receive
+ {reply, MW, Res} ->
+ Res
+ end
+ end, MWs).
mem_workers_cast(MWs, Fun, Args) ->
lists:foreach(fun (MW) ->
MW ! {cast, self(), Fun, Args}
- end,
- MWs).
+ end, MWs).
spawn_mem_workers() ->
spawn_mem_workers(erlang:system_info(schedulers_online)).
@@ -436,7 +378,6 @@ spawn_mem_workers(N) ->
link]) | spawn_mem_workers(N-1)].
-
mem_get(X, Mem) ->
case lists:keyfind(X, 1, Mem) of
{X, Val} -> Val;
@@ -504,25 +445,25 @@ cmp_memory(MWs, Str) ->
"crash dump memory = ~p~n",
[Str, EM, EDM]),
- ?line check_sane_memory(EM),
- ?line check_sane_memory(EDM),
+ check_sane_memory(EM),
+ check_sane_memory(EDM),
%% We expect these to always give us exactly the same result
- ?line cmp_memory(atom, EM, EDM, 1),
- ?line cmp_memory(atom_used, EM, EDM, 1),
- ?line cmp_memory(binary, EM, EDM, 1),
- ?line cmp_memory(code, EM, EDM, 1),
- ?line cmp_memory(ets, EM, EDM, 1),
+ cmp_memory(atom, EM, EDM, 1),
+ cmp_memory(atom_used, EM, EDM, 1),
+ cmp_memory(binary, EM, EDM, 1),
+ cmp_memory(code, EM, EDM, 1),
+ cmp_memory(ets, EM, EDM, 1),
%% Total, processes, processes_used, and system will seldom
%% give us exactly the same result since the two readings
%% aren't taken atomically.
- ?line cmp_memory(total, EM, EDM, 1.05),
- ?line cmp_memory(processes, EM, EDM, 1.05),
- ?line cmp_memory(processes_used, EM, EDM, 1.05),
- ?line cmp_memory(system, EM, EDM, 1.05),
+ cmp_memory(total, EM, EDM, 1.05),
+ cmp_memory(processes, EM, EDM, 1.05),
+ cmp_memory(processes_used, EM, EDM, 1.05),
+ cmp_memory(system, EM, EDM, 1.05),
ok.
@@ -531,9 +472,7 @@ mapn(_Fun, 0) ->
mapn(Fun, N) ->
[Fun(N) | mapn(Fun, N-1)].
-ets_limit(doc) ->
- "Verify system_info(ets_limit) reflects max ETS table settings.";
-ets_limit(suite) -> [];
+%% Verify system_info(ets_limit) reflects max ETS table settings.
ets_limit(Config0) when is_list(Config0) ->
Config = [{testcase,ets_limit}|Config0],
true = is_integer(get_ets_limit(Config)),
@@ -567,12 +506,12 @@ start_node(Config, Envs) when is_list(Config) ->
Pa = filename:dirname(code:which(?MODULE)),
Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
- ++ atom_to_list(?config(testcase, Config))
+ ++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
++ integer_to_list(erlang:system_time(seconds))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
- ?t:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]).
+ test_server:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl
index e4b6511d1f..6d80d436ba 100644
--- a/erts/emulator/test/system_profile_SUITE.erl
+++ b/erts/emulator/test/system_profile_SUITE.erl
@@ -23,61 +23,28 @@
-module(system_profile_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
system_profile_on_and_off/1,
- runnable_procs/1,
- runnable_ports/1,
+ runnable_procs/1, runnable_ports/1,
dont_profile_profiler/1,
- scheduler/1
- ]).
-
--export([init_per_testcase/2, end_per_testcase/2]).
+ scheduler/1]).
-export([profiler_process/1, ring_loop/1, port_echo_start/0,
list_load/0, run_load/2]).
--include_lib("test_server/include/test_server.hrl").
-
--define(default_timeout, ?t:minutes(1)).
-
-init_per_testcase(_Case, Config) ->
- Dog=?t:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
- ok.
+-include_lib("common_test/include/ct.hrl").
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 1}}].
all() ->
[system_profile_on_and_off, runnable_procs,
runnable_ports, scheduler, dont_profile_profiler].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
%% No specification clause needed for an init function in a conf case!!!
%% Test switching system_profiling on and off.
-system_profile_on_and_off(suite) ->
- [];
-system_profile_on_and_off(doc) ->
- ["Tests switching system_profiling on and off."];
system_profile_on_and_off(Config) when is_list(Config) ->
Pid = start_profiler_process(),
@@ -106,20 +73,29 @@ system_profile_on_and_off(Config) when is_list(Config) ->
exit(Pid,kill),
ok.
-%% Test runnable_procs
-
-runnable_procs(suite) ->
- [];
-runnable_procs(doc) ->
- ["Tests system_profiling with runnable_procs."];
+%% Tests system_profiling with runnable_procs.
runnable_procs(Config) when is_list(Config) ->
+ lists:foreach(fun (TsType) ->
+ Arg = case TsType of
+ no_timestamp ->
+ {timestamp, []};
+ _ ->
+ {TsType, [TsType]}
+ end,
+ do_runnable_procs(Arg),
+ receive after 1000 -> ok end
+ end,
+ [no_timestamp, timestamp, monotonic_timestamp,
+ strict_monotonic_timestamp]).
+
+do_runnable_procs({TsType, TsTypeFlag}) ->
Pid = start_profiler_process(),
% start a ring of processes
% FIXME: Set #laps and #nodes in config file
Nodes = 10,
Laps = 10,
Master = ring(Nodes),
- undefined = erlang:system_profile(Pid, [runnable_procs]),
+ undefined = erlang:system_profile(Pid, [runnable_procs]++TsTypeFlag),
% loop a message
ok = ring_message(Master, message, Laps),
Events = get_profiler_events(),
@@ -127,20 +103,31 @@ runnable_procs(Config) when is_list(Config) ->
erlang:system_profile(undefined, []),
put(master, Master),
put(laps, Laps),
- true = has_runnable_event(Events),
+ true = has_runnable_event(TsType, Events),
Pids = sort_events_by_pid(Events),
- ok = check_events(Pids),
+ ok = check_events(TsType, Pids),
erase(),
exit(Pid,kill),
ok.
-runnable_ports(suite) ->
- [];
-runnable_ports(doc) ->
- ["Tests system_profiling with runnable_port."];
+%% Tests system_profiling with runnable_port.
runnable_ports(Config) when is_list(Config) ->
+ lists:foreach(fun (TsType) ->
+ Arg = case TsType of
+ no_timestamp ->
+ {timestamp, []};
+ _ ->
+ {TsType, [TsType]}
+ end,
+ do_runnable_ports(Arg, Config),
+ receive after 1000 -> ok end
+ end,
+ [no_timestamp, timestamp, monotonic_timestamp,
+ strict_monotonic_timestamp]).
+
+do_runnable_ports({TsType, TsTypeFlag}, Config) ->
Pid = start_profiler_process(),
- undefined = erlang:system_profile(Pid, [runnable_ports]),
+ undefined = erlang:system_profile(Pid, [runnable_ports]++TsTypeFlag),
EchoPid = echo(Config),
% FIXME: Set config to number_of_echos
Laps = 10,
@@ -149,32 +136,36 @@ runnable_ports(Config) when is_list(Config) ->
Events = get_profiler_events(),
kill_em_all = kill_echo(EchoPid),
erlang:system_profile(undefined, []),
- true = has_runnable_event(Events),
+ true = has_runnable_event(TsType, Events),
Pids = sort_events_by_pid(Events),
- ok = check_events(Pids),
+ ok = check_events(TsType, Pids),
erase(),
exit(Pid,kill),
ok.
-scheduler(suite) ->
- [];
-scheduler(doc) ->
- ["Tests system_profiling with scheduler."];
+%% Tests system_profiling with scheduler.
scheduler(Config) when is_list(Config) ->
case {erlang:system_info(smp_support), erlang:system_info(schedulers_online)} of
{false,_} -> {skipped, "No need for scheduler test when smp support is disabled."};
{_, 1} -> {skipped, "No need for scheduler test when only one scheduler online."};
_ ->
Nodes = 10,
- ok = check_block_system(Nodes),
- ok = check_multi_scheduling_block(Nodes)
+ lists:foreach(fun (TsType) ->
+ Arg = case TsType of
+ no_timestamp ->
+ {timestamp, []};
+ _ ->
+ {TsType, [TsType]}
+ end,
+ ok = check_block_system(Arg, Nodes),
+ ok = check_multi_scheduling_block(Arg, Nodes),
+ receive after 1000 -> ok end
+ end,
+ [no_timestamp, timestamp, monotonic_timestamp,
+ strict_monotonic_timestamp])
end.
-% the profiler pid should not be profiled
-dont_profile_profiler(suite) ->
- [];
-dont_profile_profiler(doc) ->
- ["Ensure system profiler process is not profiled."];
+%% Ensure system profiler process is not profiled.
dont_profile_profiler(Config) when is_list(Config) ->
Pid = start_profiler_process(),
@@ -195,9 +186,9 @@ dont_profile_profiler(Config) when is_list(Config) ->
%%% Check scheduler profiling
-check_multi_scheduling_block(Nodes) ->
+check_multi_scheduling_block({TsType, TsTypeFlag}, Nodes) ->
Pid = start_profiler_process(),
- undefined = erlang:system_profile(Pid, [scheduler]),
+ undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag),
{ok, Supervisor} = start_load(Nodes),
wait(600),
erlang:system_flag(multi_scheduling, block),
@@ -205,23 +196,23 @@ check_multi_scheduling_block(Nodes) ->
erlang:system_flag(multi_scheduling, unblock),
{Pid, [scheduler]} = erlang:system_profile(undefined, []),
Events = get_profiler_events(),
- true = has_scheduler_event(Events),
+ true = has_scheduler_event(TsType, Events),
stop_load(Supervisor),
exit(Pid,kill),
erase(),
ok.
-check_block_system(Nodes) ->
+check_block_system({TsType, TsTypeFlag}, Nodes) ->
Dummy = spawn(?MODULE, profiler_process, [[]]),
Pid = start_profiler_process(),
- undefined = erlang:system_profile(Pid, [scheduler]),
+ undefined = erlang:system_profile(Pid, [scheduler]++TsTypeFlag),
{ok, Supervisor} = start_load(Nodes),
wait(300),
undefined = erlang:system_monitor(Dummy, [busy_port]),
{Dummy, [busy_port]} = erlang:system_monitor(undefined, []),
{Pid, [scheduler]} = erlang:system_profile(undefined, []),
Events = get_profiler_events(),
- true = has_scheduler_event(Events),
+ true = has_scheduler_event(TsType, Events),
stop_load(Supervisor),
exit(Pid,kill),
exit(Dummy,kill),
@@ -230,40 +221,49 @@ check_block_system(Nodes) ->
%%% Check events
-check_events([]) -> ok;
-check_events([Pid | Pids]) ->
+check_events(_TsType, []) -> ok;
+check_events(TsType, [Pid | Pids]) ->
Master = get(master),
Laps = get(laps),
CheckPids = get(pids),
{Events, N} = get_pid_events(Pid),
ok = check_event_flow(Events),
- ok = check_event_ts(Events),
+ ok = check_event_ts(TsType, Events),
IsMember = lists:member(Pid, CheckPids),
case Pid of
Master ->
io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2+2, N, Pid]),
N = Laps*2 + 2,
- check_events(Pids);
+ check_events(TsType, Pids);
Pid when IsMember == true ->
io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2, N, Pid]),
N = Laps*2,
- check_events(Pids);
+ check_events(TsType, Pids);
Pid ->
- check_events(Pids)
+ check_events(TsType, Pids)
end.
%% timestamp consistency check for descending timestamps
-check_event_ts(Events) ->
- check_event_ts(Events, undefined).
-check_event_ts([], _) -> ok;
-check_event_ts([Event | Events], undefined) ->
- check_event_ts(Events, Event);
-check_event_ts([{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) ->
- Time = timer:now_diff(TS1, TS0),
+check_event_ts(TsType, Events) ->
+ check_event_ts(TsType, Events, undefined).
+check_event_ts(_TsType, [], _) -> ok;
+check_event_ts(TsType, [Event | Events], undefined) ->
+ check_event_ts(TsType, Events, Event);
+check_event_ts(TsType, [{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) ->
+ Time = case TsType of
+ timestamp ->
+ timer:now_diff(TS1, TS0);
+ monotonic_timestamp ->
+ TS1 - TS0;
+ strict_monotonic_timestamp ->
+ {MT1, _} = TS1,
+ {MT0, _} = TS0,
+ MT1 - MT0
+ end,
if
Time < 0.0 -> timestamp_error;
- true -> check_event_ts(Events, Event)
+ true -> check_event_ts(TsType, Events, Event)
end.
%% consistency check for active vs. inactive activity (runnable)
@@ -373,7 +373,7 @@ ring_loop(RelayTo) ->
%% API
echo(Config) ->
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
erl_ddll:load_driver(Path, echo_drv),
Pid = spawn_link(?MODULE, port_echo_start, []),
Pid ! {self(), get_ports},
@@ -428,6 +428,44 @@ port_echo_loop(Port) ->
%% Helpers
%%%
+check_ts(no_timestamp, Ts) ->
+ try
+ no_timestamp = Ts
+ catch
+ _ : _ ->
+ ct:fail({unexpected_timestamp, Ts})
+ end,
+ ok;
+check_ts(timestamp, Ts) ->
+ try
+ {Ms,S,Us} = Ts,
+ true = is_integer(Ms),
+ true = is_integer(S),
+ true = is_integer(Us)
+ catch
+ _ : _ ->
+ ct:fail({unexpected_timestamp, Ts})
+ end,
+ ok;
+check_ts(monotonic_timestamp, Ts) ->
+ try
+ true = is_integer(Ts)
+ catch
+ _ : _ ->
+ ct:fail({unexpected_timestamp, Ts})
+ end,
+ ok;
+check_ts(strict_monotonic_timestamp, Ts) ->
+ try
+ {MT, UMI} = Ts,
+ true = is_integer(MT),
+ true = is_integer(UMI)
+ catch
+ _ : _ ->
+ ct:fail({unexpected_timestamp, Ts})
+ end,
+ ok.
+
start_load(N) ->
Pid = spawn_link(?MODULE, run_load, [N, []]),
{ok, Pid}.
@@ -448,27 +486,30 @@ run_load(N, Pids) ->
run_load(N - 1, [Pid | Pids]).
list_load() ->
- ok = case math:sin(random:uniform(32451)) of
+ ok = case math:sin(rand:uniform(32451)) of
A when is_float(A) -> ok;
_ -> ok
end,
list_load().
-
-has_scheduler_event(Events) ->
+has_scheduler_event(TsType, Events) ->
lists:any(
fun (Pred) ->
case Pred of
- {profile, scheduler, _ID, _Activity, _NR, _TS} -> true;
+ {profile, scheduler, _ID, _Activity, _NR, TS} ->
+ check_ts(TsType, TS),
+ true;
_ -> false
end
end, Events).
-has_runnable_event(Events) ->
+has_runnable_event(TsType, Events) ->
lists:any(
fun (Pred) ->
case Pred of
- {profile, _Pid, _Activity, _MFA, _TS} -> true;
+ {profile, _Pid, _Activity, _MFA, TS} ->
+ check_ts(TsType, TS),
+ true;
_ -> false
end
end, Events).
diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl
index 33076c7461..e6da5e89fa 100644
--- a/erts/emulator/test/time_SUITE.erl
+++ b/erts/emulator/test/time_SUITE.erl
@@ -48,7 +48,7 @@
-export([local_to_univ_utc/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([linear_time/1]).
@@ -69,7 +69,7 @@
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
[{testcase, Func}|Config].
-end_per_testcase(_Func, Config) ->
+end_per_testcase(_Func, _Config) ->
ok.
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -103,32 +103,29 @@ end_per_group(_GroupName, Config) ->
Config.
-local_to_univ_utc(suite) ->
- [];
-local_to_univ_utc(doc) ->
- ["Test that DST = true on timezones without DST is ignored"];
+%% Test that DST = true on timezones without DST is ignored
local_to_univ_utc(Config) when is_list(Config) ->
case os:type() of
{unix,_} ->
%% TZ variable has a meaning
- ?line {ok, Node} =
+ {ok, Node} =
test_server:start_node(local_univ_utc,peer,
[{args, "-env TZ UTC"}]),
- ?line {{2008,8,1},{0,0,0}} =
+ {{2008,8,1},{0,0,0}} =
rpc:call(Node,
erlang,localtime_to_universaltime,
[{{2008, 8, 1}, {0, 0, 0}},
false]),
- ?line {{2008,8,1},{0,0,0}} =
+ {{2008,8,1},{0,0,0}} =
rpc:call(Node,
erlang,localtime_to_universaltime,
[{{2008, 8, 1}, {0, 0, 0}},
true]),
- ?line [{{2008,8,1},{0,0,0}}] =
+ [{{2008,8,1},{0,0,0}}] =
rpc:call(Node,
calendar,local_time_to_universal_time_dst,
[{{2008, 8, 1}, {0, 0, 0}}]),
- ?line test_server:stop_node(Node),
+ test_server:stop_node(Node),
ok;
_ ->
{skip,"Only valid on Unix"}
@@ -138,24 +135,24 @@ local_to_univ_utc(Config) when is_list(Config) ->
%% Tests conversion from univeral to local time.
univ_to_local(Config) when is_list(Config) ->
- ?line test_univ_to_local(test_data()).
+ test_univ_to_local(test_data()).
test_univ_to_local([{Utc, Local}|Rest]) ->
- ?line io:format("Testing ~p => ~p~n", [Local, Utc]),
- ?line Local = erlang:universaltime_to_localtime(Utc),
- ?line test_univ_to_local(Rest);
+ io:format("Testing ~p => ~p~n", [Local, Utc]),
+ Local = erlang:universaltime_to_localtime(Utc),
+ test_univ_to_local(Rest);
test_univ_to_local([]) ->
ok.
%% Tests conversion from local to universal time.
local_to_univ(Config) when is_list(Config) ->
- ?line test_local_to_univ(test_data()).
+ test_local_to_univ(test_data()).
test_local_to_univ([{Utc, Local}|Rest]) ->
- ?line io:format("Testing ~p => ~p~n", [Utc, Local]),
- ?line Utc = erlang:localtime_to_universaltime(Local),
- ?line test_local_to_univ(Rest);
+ io:format("Testing ~p => ~p~n", [Utc, Local]),
+ Utc = erlang:localtime_to_universaltime(Local),
+ test_local_to_univ(Rest);
test_local_to_univ([]) ->
ok.
@@ -163,11 +160,11 @@ test_local_to_univ([]) ->
%% generate a badarg.
bad_univ_to_local(Config) when is_list(Config) ->
- ?line bad_test_univ_to_local(bad_dates()).
+ bad_test_univ_to_local(bad_dates()).
bad_test_univ_to_local([Utc|Rest]) ->
- ?line io:format("Testing ~p~n", [Utc]),
- ?line case catch erlang:universaltime_to_localtime(Utc) of
+ io:format("Testing ~p~n", [Utc]),
+ case catch erlang:universaltime_to_localtime(Utc) of
{'EXIT', {badarg, _}} -> bad_test_univ_to_local(Rest)
end;
bad_test_univ_to_local([]) ->
@@ -177,11 +174,11 @@ bad_test_univ_to_local([]) ->
%% generate a badarg.
bad_local_to_univ(Config) when is_list(Config) ->
- ?line bad_test_local_to_univ(bad_dates()).
+ bad_test_local_to_univ(bad_dates()).
bad_test_local_to_univ([Local|Rest]) ->
- ?line io:format("Testing ~p~n", [Local]),
- ?line case catch erlang:localtime_to_universaltime(Local) of
+ io:format("Testing ~p~n", [Local]),
+ case catch erlang:localtime_to_universaltime(Local) of
{'EXIT', {badarg, _}} -> bad_test_local_to_univ(Rest)
end;
bad_test_local_to_univ([]) ->
@@ -227,13 +224,13 @@ consistency(Config) when is_list(Config) ->
%% Daylight-saving calculations are incorrect from the last
%% Sunday of March and October to the end of the month.
- ?line ok = compare_date_time_and_localtime(16),
- ?line ok = compare_local_and_universal(16).
+ ok = compare_date_time_and_localtime(16),
+ ok = compare_local_and_universal(16).
compare_date_time_and_localtime(Times) when Times > 0 ->
- ?line {Year, Mon, Day} = date(),
- ?line {Hour, Min, Sec} = time(),
- ?line case erlang:localtime() of
+ {Year, Mon, Day} = date(),
+ {Hour, Min, Sec} = time(),
+ case erlang:localtime() of
{{Year, Mon, Day}, {Hour, Min, Sec}} -> ok;
_ -> compare_date_time_and_localtime(Times-1)
end;
@@ -315,12 +312,43 @@ effective_timezone1(_) ->
%% Test (the bif) os:timestamp/0, which is something quite like, but not
%% similar to erlang:now...
-timestamp(suite) ->
- [];
-timestamp(doc) ->
- ["Test that os:timestamp works."];
+%% Test that os:timestamp works.
timestamp(Config) when is_list(Config) ->
- repeating_timestamp_check(100000).
+ try
+ repeating_timestamp_check(100000)
+ catch
+ throw : {fail, Failure} ->
+ %%
+ %% Our time warping test machines currently warps
+ %% time every 6:th second. If we get a warp during
+ %% 10 seconds, assume this is a time warping test
+ %% and ignore the failure.
+ %%
+ case had_time_warp(10) of
+ true ->
+ {skip, "Seems to be time warp test run..."};
+ false ->
+ ct:fail(Failure)
+ end
+ end.
+
+os_system_time_offset() ->
+ erlang:convert_time_unit(os:system_time() - erlang:monotonic_time(),
+ native, micro_seconds).
+
+had_time_warp(Secs) ->
+ had_time_warp(os_system_time_offset(), Secs).
+
+had_time_warp(OrigOffs, 0) ->
+ false;
+had_time_warp(OrigOffs, N) ->
+ receive after 1000 -> ok end,
+ case OrigOffs - os_system_time_offset() of
+ Diff when Diff > 500000; Diff < -500000 ->
+ true;
+ _Diff ->
+ had_time_warp(OrigOffs, N-1)
+ end.
repeating_timestamp_check(0) ->
ok;
@@ -334,9 +362,7 @@ repeating_timestamp_check(N) ->
C < 1000000 ->
ok;
true ->
- test_server:fail(
- lists:flatten(
- io_lib:format("Strange return from os:timestamp/0 ~w~n",[TS])))
+ ct:fail("Strange return from os:timestamp/0 ~w~n",[TS])
end,
%% I assume the now and timestamp should not differ more than 1 hour,
%% which is safe assuming the system has not had a large time-warp
@@ -346,15 +372,15 @@ repeating_timestamp_check(N) ->
NSecs = NA*1000000+NB+round(NC/1000000),
case Secs - NSecs of
TooLarge when TooLarge > 3600 ->
- test_server:fail(
- lists:flatten(
+ throw({fail,
+ lists:flatten(
io_lib:format("os:timestamp/0 is ~w s more than erlang:now/0",
- [TooLarge])));
+ [TooLarge]))});
TooSmall when TooSmall < -3600 ->
- test_server:fail(
+ throw({fail,
lists:flatten(
io_lib:format("os:timestamp/0 is ~w s less than erlang:now/0",
- [-TooSmall])));
+ [-TooSmall]))});
_ ->
ok
end,
@@ -369,22 +395,22 @@ repeating_timestamp_check(N) ->
%% times (in microseconds).
now_unique(Config) when is_list(Config) ->
- ?line now_unique(1000, now(), []),
- ?line fast_now_unique(100000, now()).
+ now_unique(1000, now(), []),
+ fast_now_unique(100000, now()).
now_unique(N, Previous, Result) when N > 0 ->
- ?line case now() of
+ case now() of
Previous ->
- test_server:fail("now/0 returned the same value twice");
+ ct:fail("now/0 returned the same value twice");
New ->
now_unique(N-1, New, [New|Result])
end;
now_unique(0, _, [Then|Rest]) ->
- ?line now_calc_increment(Rest, microsecs(Then), []).
+ now_calc_increment(Rest, microsecs(Then), []).
now_calc_increment([Then|Rest], Previous, _Result) ->
- ?line This = microsecs(Then),
- ?line now_calc_increment(Rest, This, [Previous-This]);
+ This = microsecs(Then),
+ now_calc_increment(Rest, This, [Previous-This]);
now_calc_increment([], _, Differences) ->
{comment, "Median increment: " ++ integer_to_list(median(Differences))}.
@@ -392,15 +418,15 @@ fast_now_unique(0, _) -> ok;
fast_now_unique(N, Then) ->
case now() of
Then ->
- ?line ?t:fail("now/0 returned the same value twice");
+ ct:fail("now/0 returned the same value twice");
Now ->
fast_now_unique(N-1, Now)
end.
median(Unsorted_List) ->
- ?line Length = length(Unsorted_List),
- ?line List = lists:sort(Unsorted_List),
- ?line case Length rem 2 of
+ Length = length(Unsorted_List),
+ List = lists:sort(Unsorted_List),
+ case Length rem 2 of
0 -> % Even length.
[A, B] = lists:nthtail((Length div 2)-1, List),
(A+B)/2;
@@ -416,31 +442,30 @@ microsecs({Mega_Secs, Secs, Microsecs}) ->
%% calls to erlang:localtime().
now_update(Config) when is_list(Config) ->
- case ?t:is_debug() of
- false -> ?line now_update1(10);
+ case test_server:is_debug() of
+ false -> now_update1(10);
true -> {skip,"Unreliable in DEBUG build"}
end.
now_update1(N) when N > 0 ->
- ?line T1_linear = linear_time(erlang:localtime()),
- ?line T1_now = microsecs(now()),
+ T1_linear = linear_time(erlang:localtime()),
+ T1_now = microsecs(now()),
- ?line receive after 1008 -> ok end,
+ receive after 1008 -> ok end,
- ?line T2_linear = linear_time(erlang:localtime()),
- ?line T2_now = microsecs(now()),
+ T2_linear = linear_time(erlang:localtime()),
+ T2_now = microsecs(now()),
- ?line Linear_Diff = (T2_linear-T1_linear)*1000000,
- ?line Now_Diff = T2_now-T1_now,
- test_server:format("Localtime diff = ~p; now() diff = ~p",
- [Linear_Diff, Now_Diff]),
- ?line case abs(Linear_Diff - Now_Diff) of
+ Linear_Diff = (T2_linear-T1_linear)*1000000,
+ Now_Diff = T2_now-T1_now,
+ io:format("Localtime diff = ~p; now() diff = ~p", [Linear_Diff, Now_Diff]),
+ case abs(Linear_Diff - Now_Diff) of
Abs_Delta when Abs_Delta =< 40000 -> ok;
_ -> now_update1(N-1)
end;
now_update1(0) ->
- ?line test_server:fail().
+ ct:fail("now_update zero").
time_warp_modes(Config) when is_list(Config) ->
%% All time warp modes always supported in
@@ -517,14 +542,14 @@ check_time_warp_mode(Config, TimeCorrection, TimeWarpMode) ->
io:format("Uptime inconsistency", []),
case {TimeCorrection, erlang:system_info(time_correction)} of
{true, true} ->
- ?t:fail(uptime_inconsistency);
+ ct:fail(uptime_inconsistency);
{true, false} ->
_ = erlang:time_offset(),
receive
{'CHANGE', Mon, time_offset, clock_service, _} ->
ignore
after 1000 ->
- ?t:fail(uptime_inconsistency)
+ ct:fail(uptime_inconsistency)
end;
_ ->
ignore
@@ -694,10 +719,10 @@ check_time_offset_res_conv(Mon, Res) ->
TORes2 ->
case check_time_offset_change(Mon, TO, 1000) of
{TO, false} ->
- ?t:fail({time_unit_conversion_inconsistency,
+ ct:fail({time_unit_conversion_inconsistency,
TO, TORes, TORes2});
{_NewTO, true} ->
- ?t:format("time_offset changed", []),
+ io:format("time_offset changed", []),
check_time_offset_res_conv(Mon, Res)
end
end.
@@ -742,25 +767,21 @@ chk_strc(Res0, Res1) ->
ok.
chk_random_values(FR, TR) ->
-% case (FR rem TR == 0) orelse (TR rem FR == 0) of
-% true ->
- io:format("rand values ~p -> ~p~n", [FR, TR]),
- random:seed(268438039, 268440479, 268439161),
- Values = lists:map(fun (_) -> random:uniform(1 bsl 65) - (1 bsl 64) end,
- lists:seq(1, 100000)),
- CheckFun = fun (V) ->
- CV = erlang:convert_time_unit(V, FR, TR),
- case {(FR*CV) div TR =< V,
- (FR*(CV+1)) div TR >= V} of
- {true, true} ->
- ok;
- Failure ->
- ?t:fail({Failure, CV, V, FR, TR})
- end
- end,
- lists:foreach(CheckFun, Values).%;
-% false -> ok
-% end.
+ io:format("rand values ~p -> ~p~n", [FR, TR]),
+ rand:seed(exsplus, {268438039,268440479,268439161}),
+ Values = lists:map(fun (_) -> rand:uniform(1 bsl 65) - (1 bsl 64) end,
+ lists:seq(1, 100000)),
+ CheckFun = fun (V) ->
+ CV = erlang:convert_time_unit(V, FR, TR),
+ case {(FR*CV) div TR =< V,
+ (FR*(CV+1)) div TR >= V} of
+ {true, true} ->
+ ok;
+ Failure ->
+ ct:fail({Failure, CV, V, FR, TR})
+ end
+ end,
+ lists:foreach(CheckFun, Values).
chk_values_per_value(_FromRes, _ToRes,
@@ -771,7 +792,7 @@ chk_values_per_value(_FromRes, _ToRes,
case ((MinFromValuesPerToValue =< FromValueCount)
andalso (FromValueCount =< MaxFromValuesPerToValue)) of
false ->
- ?t:fail({MinFromValuesPerToValue,
+ ct:fail({MinFromValuesPerToValue,
FromValueCount,
MaxFromValuesPerToValue});
true ->
@@ -781,28 +802,28 @@ chk_values_per_value(FromRes, ToRes, Value, EndValue,
MinFromValuesPerToValue, MaxFromValuesPerToValue,
ToValue, FromValueCount) ->
case erlang:convert_time_unit(Value, FromRes, ToRes) of
- ToValue ->
- chk_values_per_value(FromRes, ToRes,
- Value+1, EndValue,
- MinFromValuesPerToValue,
- MaxFromValuesPerToValue,
- ToValue, FromValueCount+1);
- NewToValue ->
- case ((MinFromValuesPerToValue =< FromValueCount)
- andalso (FromValueCount =< MaxFromValuesPerToValue)) of
- false ->
- ?t:fail({MinFromValuesPerToValue,
- FromValueCount,
- MaxFromValuesPerToValue});
- true ->
-% io:format("~p -> ~p [~p]~n",
-% [Value, NewToValue, FromValueCount]),
- chk_values_per_value(FromRes, ToRes,
- Value+1, EndValue,
- MinFromValuesPerToValue,
- MaxFromValuesPerToValue,
- NewToValue, 1)
- end
+ ToValue ->
+ chk_values_per_value(FromRes, ToRes,
+ Value+1, EndValue,
+ MinFromValuesPerToValue,
+ MaxFromValuesPerToValue,
+ ToValue, FromValueCount+1);
+ NewToValue ->
+ case ((MinFromValuesPerToValue =< FromValueCount)
+ andalso (FromValueCount =< MaxFromValuesPerToValue)) of
+ false ->
+ ct:fail({MinFromValuesPerToValue,
+ FromValueCount,
+ MaxFromValuesPerToValue});
+ true ->
+ % io:format("~p -> ~p [~p]~n",
+ % [Value, NewToValue, FromValueCount]),
+ chk_values_per_value(FromRes, ToRes,
+ Value+1, EndValue,
+ MinFromValuesPerToValue,
+ MaxFromValuesPerToValue,
+ NewToValue, 1)
+ end
end.
erlang_timestamp(Config) when is_list(Config) ->
@@ -815,11 +836,11 @@ erlang_timestamp(Config) when is_list(Config) ->
check_erlang_timestamp(Done, Mon, TO) ->
receive
- {timeout, Done, timeout} ->
- erlang:demonitor(Mon, [flush]),
- ok
+ {timeout, Done, timeout} ->
+ erlang:demonitor(Mon, [flush]),
+ ok
after 0 ->
- do_check_erlang_timestamp(Done, Mon, TO)
+ do_check_erlang_timestamp(Done, Mon, TO)
end.
do_check_erlang_timestamp(Done, Mon, TO) ->
@@ -844,13 +865,13 @@ do_check_erlang_timestamp(Done, Mon, TO) ->
check_erlang_timestamp(Done, Mon, NewTO);
false ->
io:format("TsMin=~p TsTime=~p TsMax=~p~n", [TsMin, TsTime, TsMax]),
- ?t:format("Detected inconsistency; "
+ io:format("Detected inconsistency; "
"checking for time_offset change...", []),
case check_time_offset_change(Mon, TO, 1000) of
{TO, false} ->
- ?t:fail(timestamp_inconsistency);
+ ct:fail(timestamp_inconsistency);
{NewTO, true} ->
- ?t:format("time_offset changed", []),
+ io:format("time_offset changed", []),
check_erlang_timestamp(Done, Mon, NewTO)
end
end.
@@ -891,13 +912,13 @@ test_data() ->
_ ->
{?timezone,?dst_timezone}
end,
- ?line test_data(nondst_dates(), TZ) ++
+ test_data(nondst_dates(), TZ) ++
test_data(dst_dates(), DSTTZ) ++
crossover_test_data(crossover_dates(), TZ).
%% test_data1() ->
-%% ?line test_data(nondst_dates(), ?timezone) ++
+%% test_data(nondst_dates(), ?timezone) ++
%% test_data(dst_dates(), ?dst_timezone) ++
%% crossover_test_data(crossover_dates(), ?timezone).
@@ -905,16 +926,16 @@ crossover_test_data([{Year, Month, Day}|Rest], TimeZone) when TimeZone > 0 ->
Hour = 23,
Min = 35,
Sec = 55,
- ?line Utc = {{Year, Month, Day}, {Hour, Min, Sec}},
- ?line Local = {{Year, Month, Day+1}, {Hour+TimeZone-24, Min, Sec}},
- ?line [{Utc, Local}|crossover_test_data(Rest, TimeZone)];
+ Utc = {{Year, Month, Day}, {Hour, Min, Sec}},
+ Local = {{Year, Month, Day+1}, {Hour+TimeZone-24, Min, Sec}},
+ [{Utc, Local}|crossover_test_data(Rest, TimeZone)];
crossover_test_data([{Year, Month, Day}|Rest], TimeZone) when TimeZone < 0 ->
Hour = 0,
Min = 23,
Sec = 12,
- ?line Utc = {{Year, Month, Day}, {Hour, Min, Sec}},
- ?line Local = {{Year, Month, Day-1}, {Hour+TimeZone+24, Min, Sec}},
- ?line [{Utc, Local}|crossover_test_data(Rest, TimeZone)];
+ Utc = {{Year, Month, Day}, {Hour, Min, Sec}},
+ Local = {{Year, Month, Day-1}, {Hour+TimeZone+24, Min, Sec}},
+ [{Utc, Local}|crossover_test_data(Rest, TimeZone)];
crossover_test_data([], _) ->
[].
@@ -922,9 +943,9 @@ test_data([Date|Rest], TimeZone) ->
Hour = 12,
Min = 45,
Sec = 7,
- ?line Utc = {Date, {Hour, Min, Sec}},
- ?line Local = {Date, {Hour+TimeZone, Min, Sec}},
- ?line [{Utc, Local}|test_data(Rest, TimeZone)];
+ Utc = {Date, {Hour, Min, Sec}},
+ Local = {Date, {Hour+TimeZone, Min, Sec}},
+ [{Utc, Local}|test_data(Rest, TimeZone)];
test_data([], _) ->
[].
@@ -1015,7 +1036,7 @@ start_node(Config) ->
start_node(Config, "").
start_node(Config, Args) ->
- TestCase = ?config(testcase, Config),
+ TestCase = proplists:get_value(testcase, Config),
PA = filename:dirname(code:which(?MODULE)),
ESTime = erlang:monotonic_time(1) + erlang:time_offset(1),
Unique = erlang:unique_integer([positive]),
diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl
index 51d59f09f3..fa72700604 100644
--- a/erts/emulator/test/timer_bif_SUITE.erl
+++ b/erts/emulator/test/timer_bif_SUITE.erl
@@ -20,8 +20,7 @@
-module(timer_bif_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0, init_per_suite/1, end_per_suite/1,
init_per_testcase/2,end_per_testcase/2]).
-export([start_timer_1/1, send_after_1/1, send_after_2/1, send_after_3/1,
cancel_timer_1/1,
@@ -33,23 +32,20 @@
% same_time_yielding_with_cancel_other_accessor/1,
auto_cancel_yielding/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(SHORT_TIMEOUT, 5000). %% Bif timers as short as this may be pre-allocated
-define(TIMEOUT_YIELD_LIMIT, 100).
-define(AUTO_CANCEL_YIELD_LIMIT, 100).
init_per_testcase(_Case, Config) ->
- ?line Dog=test_server:timetrap(test_server:seconds(30)),
case catch erts_debug:get_internal_state(available_internal_state) of
true -> ok;
_ -> erts_debug:set_internal_state(available_internal_state, true)
end,
- [{watchdog, Dog}|Config].
+ Config.
-end_per_testcase(_Case, Config) ->
- Dog = ?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
+end_per_testcase(_Case, _Config) ->
ok.
init_per_suite(Config) ->
@@ -59,7 +55,9 @@ init_per_suite(Config) ->
end_per_suite(_Config) ->
catch erts_debug:set_internal_state(available_internal_state, false).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 5}}].
all() ->
[start_timer_1, send_after_1, send_after_2,
@@ -72,17 +70,8 @@ all() ->
% same_time_yielding_with_cancel_other_accessor,
auto_cancel_yielding].
-groups() ->
- [].
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-start_timer_1(doc) -> ["Basic start_timer/3 functionality"];
+%% Basic start_timer/3 functionality
start_timer_1(Config) when is_list(Config) ->
Ref1 = erlang:start_timer(1000, self(), plopp),
ok = get(1100, {timeout, Ref1, plopp}),
@@ -102,54 +91,54 @@ start_timer_1(Config) when is_list(Config) ->
no_message = get(900, {timeout, Ref3, plopp}),
ok.
-send_after_1(doc) -> ["Basic send_after/3 functionality"];
+%% Basic send_after/3 functionality
send_after_1(Config) when is_list(Config) ->
- ?line Ref3 = erlang:send_after(1000, self(), plipp),
- ?line ok = get(1500, plipp),
- ?line false = erlang:read_timer(Ref3),
+ Ref3 = erlang:send_after(1000, self(), plipp),
+ ok = get(1500, plipp),
+ false = erlang:read_timer(Ref3),
ok.
-start_timer_big(doc) -> ["Big timeouts for start_timer/3"];
+%% Big timeouts for start_timer/3
start_timer_big(Config) when is_list(Config) ->
- ?line Big = 1 bsl 31,
- ?line R = erlang:start_timer(Big, self(), hej),
- ?line timer:sleep(200),
- ?line Left = erlang:cancel_timer(R),
- ?line case Big - Left of
- Diff when Diff >= 200, Diff < 10000 ->
- ok;
- _Diff ->
- test_server:fail({big, Big, Left})
- end,
+ Big = 1 bsl 31,
+ R = erlang:start_timer(Big, self(), hej),
+ timer:sleep(200),
+ Left = erlang:cancel_timer(R),
+ case Big - Left of
+ Diff when Diff >= 200, Diff < 10000 ->
+ ok;
+ _Diff ->
+ ct:fail({big, Big, Left})
+ end,
ok.
-send_after_big(doc) -> ["Big timeouts for send_after/3"];
+%% Big timeouts for send_after/3
send_after_big(Config) when is_list(Config) ->
- ?line Big = 1 bsl 31,
- ?line R = erlang:send_after(Big, self(), hej),
- ?line timer:sleep(200),
- ?line Left = erlang:cancel_timer(R),
- ?line case Big - Left of
- Diff when Diff >= 200, Diff < 10000 ->
- ok;
- _Diff ->
- test_server:fail({big, Big, Left})
- end,
+ Big = 1 bsl 31,
+ R = erlang:send_after(Big, self(), hej),
+ timer:sleep(200),
+ Left = erlang:cancel_timer(R),
+ case Big - Left of
+ Diff when Diff >= 200, Diff < 10000 ->
+ ok;
+ _Diff ->
+ ct:fail({big, Big, Left})
+ end,
ok.
-send_after_2(doc) -> ["send_after/3: messages in the right order, kind version"];
+%% send_after/3: messages in the right order, kind version
send_after_2(Config) when is_list(Config) ->
- ?line _ = erlang:send_after(5000, self(), last),
- ?line _ = erlang:send_after(0, self(), a0),
- ?line _ = erlang:send_after(200, self(), a2),
- ?line _ = erlang:send_after(100, self(), a1),
- ?line _ = erlang:send_after(500, self(), a5),
- ?line _ = erlang:send_after(300, self(), a3),
- ?line _ = erlang:send_after(400, self(), a4),
- ?line [a0,a1,a2,a3,a4,a5,last] = collect(last),
+ _ = erlang:send_after(5000, self(), last),
+ _ = erlang:send_after(0, self(), a0),
+ _ = erlang:send_after(200, self(), a2),
+ _ = erlang:send_after(100, self(), a1),
+ _ = erlang:send_after(500, self(), a5),
+ _ = erlang:send_after(300, self(), a3),
+ _ = erlang:send_after(400, self(), a4),
+ [a0,a1,a2,a3,a4,a5,last] = collect(last),
ok.
-send_after_3(doc) -> ["send_after/3: messages in the right order, worse than send_after_2"];
+%% send_after/3: messages in the right order, worse than send_after_2
send_after_3(Config) when is_list(Config) ->
_ = erlang:send_after(100, self(), b1),
_ = erlang:send_after(101, self(), b2),
@@ -157,74 +146,70 @@ send_after_3(Config) when is_list(Config) ->
_ = erlang:send_after(103, self(), last),
[b1, b2, b3, last] = collect(last),
-% This behaviour is not guaranteed:
-% ?line _ = erlang:send_after(100, self(), c1),
-% ?line _ = erlang:send_after(100, self(), c2),
-% ?line _ = erlang:send_after(100, self(), c3),
-% ?line _ = erlang:send_after(100, self(), last),
-% ?line [c1, c2, c3, last] = collect(last),
+ % This behaviour is not guaranteed:
+ % _ = erlang:send_after(100, self(), c1),
+ % _ = erlang:send_after(100, self(), c2),
+ % _ = erlang:send_after(100, self(), c3),
+ % _ = erlang:send_after(100, self(), last),
+ % [c1, c2, c3, last] = collect(last),
ok.
-cancel_timer_1(doc) -> ["Check trivial cancel_timer/1 behaviour"];
+%% Check trivial cancel_timer/1 behaviour
cancel_timer_1(Config) when is_list(Config) ->
- ?line false = erlang:cancel_timer(make_ref()),
+ false = erlang:cancel_timer(make_ref()),
ok.
-start_timer_e(doc) -> ["Error cases for start_timer/3"];
+%% Error cases for start_timer/3
start_timer_e(Config) when is_list(Config) ->
- ?line {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)),
- ?line {'EXIT', _} = (catch erlang:start_timer(1 bsl 64,
- self(), hej)),
+ {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)),
+ {'EXIT', _} = (catch erlang:start_timer(1 bsl 64,
+ self(), hej)),
- ?line {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)),
- ?line {'EXIT', _} = (catch erlang:start_timer(a, self(), hej)),
+ {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)),
+ {'EXIT', _} = (catch erlang:start_timer(a, self(), hej)),
- ?line Node = start_slave(),
- ?line Pid = spawn(Node, timer, sleep, [10000]),
- ?line {'EXIT', _} = (catch erlang:start_timer(1000, Pid, hej)),
- ?line stop_slave(Node),
+ Node = start_slave(),
+ Pid = spawn(Node, timer, sleep, [10000]),
+ {'EXIT', _} = (catch erlang:start_timer(1000, Pid, hej)),
+ stop_slave(Node),
ok.
-send_after_e(doc) -> ["Error cases for send_after/3"];
-send_after_e(suite) -> [];
+%% Error cases for send_after/3
send_after_e(Config) when is_list(Config) ->
- ?line {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)),
- ?line {'EXIT', _} = (catch erlang:send_after(1 bsl 64,
- self(), hej)),
+ {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)),
+ {'EXIT', _} = (catch erlang:send_after(1 bsl 64,
+ self(), hej)),
- ?line {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)),
- ?line {'EXIT', _} = (catch erlang:send_after(a, self(), hej)),
+ {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)),
+ {'EXIT', _} = (catch erlang:send_after(a, self(), hej)),
- ?line Node = start_slave(),
- ?line Pid = spawn(Node, timer, sleep, [10000]),
- ?line {'EXIT', _} = (catch erlang:send_after(1000, Pid, hej)),
- ?line stop_slave(Node),
+ Node = start_slave(),
+ Pid = spawn(Node, timer, sleep, [10000]),
+ {'EXIT', _} = (catch erlang:send_after(1000, Pid, hej)),
+ stop_slave(Node),
ok.
-cancel_timer_e(doc) -> ["Error cases for cancel_timer/1"];
-cancel_timer_e(suite) -> [];
+%% Error cases for cancel_timer/1
cancel_timer_e(Config) when is_list(Config) ->
- ?line {'EXIT', _} = (catch erlang:cancel_timer(1)),
- ?line {'EXIT', _} = (catch erlang:cancel_timer(self())),
- ?line {'EXIT', _} = (catch erlang:cancel_timer(a)),
+ {'EXIT', _} = (catch erlang:cancel_timer(1)),
+ {'EXIT', _} = (catch erlang:cancel_timer(self())),
+ {'EXIT', _} = (catch erlang:cancel_timer(a)),
ok.
-read_timer_trivial(doc) -> ["Trivial and error test cases for read_timer/1."];
-read_timer_trivial(suite) -> [];
+%% Trivial and error test cases for read_timer/1.
read_timer_trivial(Config) when is_list(Config) ->
- ?line false = erlang:read_timer(make_ref()),
- ?line {'EXIT', _} = (catch erlang:read_timer(42)),
- ?line {'EXIT', _} = (catch erlang:read_timer(423497834744444444457667444444)),
- ?line {'EXIT', _} = (catch erlang:read_timer(self())),
- ?line {'EXIT', _} = (catch erlang:read_timer(ab)),
+ false = erlang:read_timer(make_ref()),
+ {'EXIT', _} = (catch erlang:read_timer(42)),
+ {'EXIT', _} = (catch erlang:read_timer(423497834744444444457667444444)),
+ {'EXIT', _} = (catch erlang:read_timer(self())),
+ {'EXIT', _} = (catch erlang:read_timer(ab)),
ok.
-read_timer(doc) -> ["Test that read_timer/1 seems to return the correct values."];
-read_timer(suite) -> [];
+%% Test that read_timer/1 seems to return the correct values.
read_timer(Config) when is_list(Config) ->
process_flag(scheduler, 1),
Big = 1 bsl 31,
@@ -234,22 +219,21 @@ read_timer(Config) when is_list(Config) ->
Left = erlang:read_timer(R),
Left2 = erlang:cancel_timer(R),
case Left == Left2 of
- true -> ok;
- false -> Left = Left2 + 1
+ true -> ok;
+ false -> Left = Left2 + 1
end,
false = erlang:read_timer(R),
case Big - Left of
- Diff when Diff >= 200, Diff < 10000 ->
- ok;
- _Diff ->
- test_server:fail({big, Big, Left})
+ Diff when Diff >= 200, Diff < 10000 ->
+ ok;
+ _Diff ->
+ ct:fail({big, Big, Left})
end,
process_flag(scheduler, 0),
ok.
-read_timer_async(doc) -> ["Test that read_timer/1 seems to return the correct values."];
-read_timer_async(suite) -> [];
+%% Test that read_timer/1 seems to return the correct values.
read_timer_async(Config) when is_list(Config) ->
process_flag(scheduler, 1),
Big = 1 bsl 33,
@@ -266,73 +250,69 @@ read_timer_async(Config) when is_list(Config) ->
{read_timer, R, Left} = receive_one(),
{cancel_timer, R, Left2} = receive_one(),
case Left == Left2 of
- true -> ok;
- false -> Left = Left2 + 1
+ true -> ok;
+ false -> Left = Left2 + 1
end,
{read_timer, R, false} = receive_one(),
case Big - Left of
- Diff when Diff >= 200, Diff < 10000 ->
- ok;
- _Diff ->
- test_server:fail({big, Big, Left})
+ Diff when Diff >= 200, Diff < 10000 ->
+ ok;
+ _Diff ->
+ ct:fail({big, Big, Left})
end,
process_flag(scheduler, 0),
ok.
-cleanup(doc) -> [];
-cleanup(suite) -> [];
cleanup(Config) when is_list(Config) ->
- ?line Mem = mem(),
+ Mem = mem(),
%% Timer on dead process
- ?line P1 = spawn(fun () -> ok end),
- ?line wait_until(fun () -> process_is_cleaned_up(P1) end),
- ?line T1 = erlang:start_timer(?SHORT_TIMEOUT*2, P1, "hej"),
- ?line T2 = erlang:send_after(?SHORT_TIMEOUT*2, P1, "hej"),
+ P1 = spawn(fun () -> ok end),
+ wait_until(fun () -> process_is_cleaned_up(P1) end),
+ T1 = erlang:start_timer(?SHORT_TIMEOUT*2, P1, "hej"),
+ T2 = erlang:send_after(?SHORT_TIMEOUT*2, P1, "hej"),
receive after 1000 -> ok end,
- ?line Mem = mem(),
- ?line false = erlang:read_timer(T1),
- ?line false = erlang:read_timer(T2),
- ?line Mem = mem(),
+ Mem = mem(),
+ false = erlang:read_timer(T1),
+ false = erlang:read_timer(T2),
+ Mem = mem(),
%% Process dies before timeout
- ?line P2 = spawn(fun () -> receive after (?SHORT_TIMEOUT div 10) -> ok end end),
- ?line T3 = erlang:start_timer(?SHORT_TIMEOUT*2, P2, "hej"),
- ?line T4 = erlang:send_after(?SHORT_TIMEOUT*2, P2, "hej"),
- ?line true = mem_larger_than(Mem),
- ?line true = is_integer(erlang:read_timer(T3)),
- ?line true = is_integer(erlang:read_timer(T4)),
- ?line wait_until(fun () -> process_is_cleaned_up(P2) end),
+ P2 = spawn(fun () -> receive after (?SHORT_TIMEOUT div 10) -> ok end end),
+ T3 = erlang:start_timer(?SHORT_TIMEOUT*2, P2, "hej"),
+ T4 = erlang:send_after(?SHORT_TIMEOUT*2, P2, "hej"),
+ true = mem_larger_than(Mem),
+ true = is_integer(erlang:read_timer(T3)),
+ true = is_integer(erlang:read_timer(T4)),
+ wait_until(fun () -> process_is_cleaned_up(P2) end),
receive after 1000 -> ok end,
- ?line false = erlang:read_timer(T3),
- ?line false = erlang:read_timer(T4),
- ?line Mem = mem(),
+ false = erlang:read_timer(T3),
+ false = erlang:read_timer(T4),
+ Mem = mem(),
%% Cancel timer
- ?line P3 = spawn(fun () -> receive after ?SHORT_TIMEOUT*4 -> ok end end),
- ?line T5 = erlang:start_timer(?SHORT_TIMEOUT*2, P3, "hej"),
- ?line T6 = erlang:send_after(?SHORT_TIMEOUT*2, P3, "hej"),
- ?line true = mem_larger_than(Mem),
- ?line true = is_integer(erlang:cancel_timer(T5)),
- ?line true = is_integer(erlang:cancel_timer(T6)),
- ?line false = erlang:read_timer(T5),
- ?line false = erlang:read_timer(T6),
- ?line exit(P3, kill),
- ?line wait_until(fun () -> process_is_cleaned_up(P3) end),
- ?line Mem = mem(),
+ P3 = spawn(fun () -> receive after ?SHORT_TIMEOUT*4 -> ok end end),
+ T5 = erlang:start_timer(?SHORT_TIMEOUT*2, P3, "hej"),
+ T6 = erlang:send_after(?SHORT_TIMEOUT*2, P3, "hej"),
+ true = mem_larger_than(Mem),
+ true = is_integer(erlang:cancel_timer(T5)),
+ true = is_integer(erlang:cancel_timer(T6)),
+ false = erlang:read_timer(T5),
+ false = erlang:read_timer(T6),
+ exit(P3, kill),
+ wait_until(fun () -> process_is_cleaned_up(P3) end),
+ Mem = mem(),
%% Timeout
- ?line Ref = make_ref(),
- ?line T7 = erlang:start_timer(?SHORT_TIMEOUT+1, self(), Ref),
- ?line T8 = erlang:send_after(?SHORT_TIMEOUT+1, self(), Ref),
- ?line true = mem_larger_than(Mem),
- ?line true = is_integer(erlang:read_timer(T7)),
- ?line true = is_integer(erlang:read_timer(T8)),
- ?line receive {timeout, T7, Ref} -> ok end,
- ?line receive Ref -> ok end,
- ?line Mem = mem(),
- ?line ok.
-
-
-evil_timers(doc) -> [];
-evil_timers(suite) -> [];
+ Ref = make_ref(),
+ T7 = erlang:start_timer(?SHORT_TIMEOUT+1, self(), Ref),
+ T8 = erlang:send_after(?SHORT_TIMEOUT+1, self(), Ref),
+ true = mem_larger_than(Mem),
+ true = is_integer(erlang:read_timer(T7)),
+ true = is_integer(erlang:read_timer(T8)),
+ receive {timeout, T7, Ref} -> ok end,
+ receive Ref -> ok end,
+ Mem = mem(),
+ ok.
+
+
evil_timers(Config) when is_list(Config) ->
%% Create a composite term consisting of at least:
%% * externals (remote pids, ports, and refs)
@@ -344,38 +324,38 @@ evil_timers(Config) when is_list(Config) ->
%% * lists
%% since data of these types have to be adjusted if moved
%% in memory
- ?line Self = self(),
- ?line R1 = make_ref(),
- ?line Node = start_slave(),
- ?line spawn_link(Node,
- fun () ->
- Self ! {R1,
- [lists:sublist(erlang:ports(), 3),
- [make_ref(), make_ref(), make_ref()],
- lists:sublist(processes(), 3),
- [fun () -> gurka end,
- fun (A) -> A + 1 end,
- fun (A, B) -> A + B end]]}
- end),
- ?line ExtList = receive {R1, L} -> L end,
- ?line stop_slave(Node),
- ?line BinList = [<<"bla">>,
- <<"blipp">>,
- <<"blupp">>,
- list_to_binary(lists:duplicate(1000000,$a)),
- list_to_binary(lists:duplicate(1000000,$b)),
- list_to_binary(lists:duplicate(1000000,$c))],
- ?line FunList = [fun () -> gurka end,
- fun (A) -> A + 1 end,
- fun (A, B) -> A + B end],
- ?line PidList = lists:sublist(processes(), 3),
- ?line PortList = lists:sublist(erlang:ports(), 3),
- ?line RefList = [make_ref(), make_ref(), make_ref()],
- ?line BigList = [111111111111, 22222222222222, 333333333333333333],
- ?line Msg = {BinList,[FunList,{RefList,ExtList,PidList,PortList,BigList}]},
- %% ?line ?t:format("Msg=~p~n",[Msg]),
-
- ?line Prio = process_flag(priority, max),
+ Self = self(),
+ R1 = make_ref(),
+ Node = start_slave(),
+ spawn_link(Node,
+ fun () ->
+ Self ! {R1,
+ [lists:sublist(erlang:ports(), 3),
+ [make_ref(), make_ref(), make_ref()],
+ lists:sublist(processes(), 3),
+ [fun () -> gurka end,
+ fun (A) -> A + 1 end,
+ fun (A, B) -> A + B end]]}
+ end),
+ ExtList = receive {R1, L} -> L end,
+ stop_slave(Node),
+ BinList = [<<"bla">>,
+ <<"blipp">>,
+ <<"blupp">>,
+ list_to_binary(lists:duplicate(1000000,$a)),
+ list_to_binary(lists:duplicate(1000000,$b)),
+ list_to_binary(lists:duplicate(1000000,$c))],
+ FunList = [fun () -> gurka end,
+ fun (A) -> A + 1 end,
+ fun (A, B) -> A + B end],
+ PidList = lists:sublist(processes(), 3),
+ PortList = lists:sublist(erlang:ports(), 3),
+ RefList = [make_ref(), make_ref(), make_ref()],
+ BigList = [111111111111, 22222222222222, 333333333333333333],
+ Msg = {BinList,[FunList,{RefList,ExtList,PidList,PortList,BigList}]},
+ %% io:format("Msg=~p~n",[Msg]),
+
+ Prio = process_flag(priority, max),
%%
%% In the smp case there are four major cases we want to test:
%%
@@ -388,8 +368,8 @@ evil_timers(Config) when is_list(Config) ->
%% be allocated in the previously allocated message buffer along
%% with Msg, i.e. the previously allocated message buffer will be
%% reallocated and potentially moved.
- ?line TimeOutMsgs0 = evil_setup_timers(200, Self, Msg),
- ?line RecvTimeOutMsgs0 = evil_recv_timeouts(200),
+ TimeOutMsgs0 = evil_setup_timers(200, Self, Msg),
+ RecvTimeOutMsgs0 = evil_recv_timeouts(200),
%% 2. A timer started with erlang:start_timer(Time, Receiver, Msg),
%% where Msg is an immediate term, expires, and the receivers main
%% lock *can not* be acquired immediately (typically when the
@@ -397,8 +377,8 @@ evil_timers(Config) when is_list(Config) ->
%%
%% The wrap tuple will in this case be allocated in a new
%% message buffer.
- ?line TimeOutMsgs1 = evil_setup_timers(200, Self, immediate),
- ?line RecvTimeOutMsgs1 = evil_recv_timeouts(200),
+ TimeOutMsgs1 = evil_setup_timers(200, Self, immediate),
+ RecvTimeOutMsgs1 = evil_recv_timeouts(200),
%% 3. A timer started with erlang:start_timer(Time, Receiver, Msg),
%% where Msg is a composite term, expires, and the receivers main
%% lock *can* be acquired immediately (typically when the receiver
@@ -407,13 +387,13 @@ evil_timers(Config) when is_list(Config) ->
%% The wrap tuple will in this case be allocated on the receivers
%% heap, and Msg is passed in the previously allocated message
%% buffer.
- ?line R2 = make_ref(),
- ?line spawn_link(fun () ->
- Self ! {R2, evil_setup_timers(200, Self, Msg)}
- end),
- ?line receive after 1000 -> ok end,
- ?line TimeOutMsgs2 = receive {R2, TOM2} -> TOM2 end,
- ?line RecvTimeOutMsgs2 = evil_recv_timeouts(200),
+ R2 = make_ref(),
+ spawn_link(fun () ->
+ Self ! {R2, evil_setup_timers(200, Self, Msg)}
+ end),
+ receive after 1000 -> ok end,
+ TimeOutMsgs2 = receive {R2, TOM2} -> TOM2 end,
+ RecvTimeOutMsgs2 = evil_recv_timeouts(200),
%% 4. A timer started with erlang:start_timer(Time, Receiver, Msg),
%% where Msg is an immediate term, expires, and the Receivers main
%% lock *can* be acquired immediately (typically when the receiver
@@ -421,109 +401,107 @@ evil_timers(Config) when is_list(Config) ->
%%
%% The wrap tuple will in this case be allocated on the receivers
%% heap.
- ?line R3 = make_ref(),
- ?line spawn_link(fun () ->
- Self ! {R3, evil_setup_timers(200,Self,immediate)}
- end),
- ?line receive after 1000 -> ok end,
- ?line TimeOutMsgs3 = receive {R3, TOM3} -> TOM3 end,
- ?line RecvTimeOutMsgs3 = evil_recv_timeouts(200),
+ R3 = make_ref(),
+ spawn_link(fun () ->
+ Self ! {R3, evil_setup_timers(200,Self,immediate)}
+ end),
+ receive after 1000 -> ok end,
+ TimeOutMsgs3 = receive {R3, TOM3} -> TOM3 end,
+ RecvTimeOutMsgs3 = evil_recv_timeouts(200),
%% Garge collection will hopefully crash the emulator if something
%% is wrong...
- ?line garbage_collect(),
- ?line garbage_collect(),
- ?line garbage_collect(),
+ garbage_collect(),
+ garbage_collect(),
+ garbage_collect(),
%% Make sure we got the timeouts we expected
%%
%% Note timeouts are *not* guaranteed to be delivered in order
- ?line ok = match(lists:sort(RecvTimeOutMsgs0), lists:sort(TimeOutMsgs0)),
- ?line ok = match(lists:sort(RecvTimeOutMsgs1), lists:sort(TimeOutMsgs1)),
- ?line ok = match(lists:sort(RecvTimeOutMsgs2), lists:sort(TimeOutMsgs2)),
- ?line ok = match(lists:sort(RecvTimeOutMsgs3), lists:sort(TimeOutMsgs3)),
+ ok = match(lists:sort(RecvTimeOutMsgs0), lists:sort(TimeOutMsgs0)),
+ ok = match(lists:sort(RecvTimeOutMsgs1), lists:sort(TimeOutMsgs1)),
+ ok = match(lists:sort(RecvTimeOutMsgs2), lists:sort(TimeOutMsgs2)),
+ ok = match(lists:sort(RecvTimeOutMsgs3), lists:sort(TimeOutMsgs3)),
- ?line process_flag(priority, Prio),
- ?line ok.
+ process_flag(priority, Prio),
+ ok.
evil_setup_timers(N, Receiver, Msg) ->
- ?line evil_setup_timers(0, N, Receiver, Msg, []).
+ evil_setup_timers(0, N, Receiver, Msg, []).
evil_setup_timers(N, N, _Receiver, _Msg, TOs) ->
- ?line TOs;
+ TOs;
evil_setup_timers(N, Max, Receiver, Msg, TOs) ->
- ?line TRef = erlang:start_timer(N, Receiver, Msg),
- ?line evil_setup_timers(N+1, Max, Receiver, Msg, [{timeout,TRef,Msg}|TOs]).
+ TRef = erlang:start_timer(N, Receiver, Msg),
+ evil_setup_timers(N+1, Max, Receiver, Msg, [{timeout,TRef,Msg}|TOs]).
evil_recv_timeouts(M) ->
- ?line evil_recv_timeouts([], 0, M).
+ evil_recv_timeouts([], 0, M).
evil_recv_timeouts(TOs, N, N) ->
- ?line TOs;
+ TOs;
evil_recv_timeouts(TOs, N, M) ->
- ?line receive
- {timeout, _, _} = TO ->
- ?line evil_recv_timeouts([TO|TOs], N+1, M)
- after 0 ->
- ?line evil_recv_timeouts(TOs, N, M)
- end.
-
-registered_process(doc) -> [];
-registered_process(suite) -> [];
+ receive
+ {timeout, _, _} = TO ->
+ evil_recv_timeouts([TO|TOs], N+1, M)
+ after 0 ->
+ evil_recv_timeouts(TOs, N, M)
+ end.
+
registered_process(Config) when is_list(Config) ->
- ?line Mem = mem(),
+ Mem = mem(),
%% Cancel
- ?line T1 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, "hej"),
- ?line T2 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, "hej"),
- ?line undefined = whereis(?MODULE),
- ?line true = mem_larger_than(Mem),
- ?line true = is_integer(erlang:cancel_timer(T1)),
- ?line true = is_integer(erlang:cancel_timer(T2)),
- ?line false = erlang:read_timer(T1),
- ?line false = erlang:read_timer(T2),
- ?line Mem = mem(),
+ T1 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, "hej"),
+ T2 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, "hej"),
+ undefined = whereis(?MODULE),
+ true = mem_larger_than(Mem),
+ true = is_integer(erlang:cancel_timer(T1)),
+ true = is_integer(erlang:cancel_timer(T2)),
+ false = erlang:read_timer(T1),
+ false = erlang:read_timer(T2),
+ Mem = mem(),
%% Timeout register after start
- ?line Ref1 = make_ref(),
- ?line T3 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref1),
- ?line T4 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref1),
- ?line undefined = whereis(?MODULE),
- ?line true = mem_larger_than(Mem),
- ?line true = is_integer(erlang:read_timer(T3)),
- ?line true = is_integer(erlang:read_timer(T4)),
- ?line true = register(?MODULE, self()),
- ?line receive {timeout, T3, Ref1} -> ok end,
- ?line receive Ref1 -> ok end,
- ?line Mem = mem(),
+ Ref1 = make_ref(),
+ T3 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref1),
+ T4 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref1),
+ undefined = whereis(?MODULE),
+ true = mem_larger_than(Mem),
+ true = is_integer(erlang:read_timer(T3)),
+ true = is_integer(erlang:read_timer(T4)),
+ true = register(?MODULE, self()),
+ receive {timeout, T3, Ref1} -> ok end,
+ receive Ref1 -> ok end,
+ Mem = mem(),
%% Timeout register before start
- ?line Ref2 = make_ref(),
- ?line T5 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref2),
- ?line T6 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref2),
- ?line true = mem_larger_than(Mem),
- ?line true = is_integer(erlang:read_timer(T5)),
- ?line true = is_integer(erlang:read_timer(T6)),
- ?line receive {timeout, T5, Ref2} -> ok end,
- ?line receive Ref2 -> ok end,
- ?line Mem = mem(),
- ?line true = unregister(?MODULE),
- ?line ok.
+ Ref2 = make_ref(),
+ T5 = erlang:start_timer(?SHORT_TIMEOUT+1, ?MODULE, Ref2),
+ T6 = erlang:send_after(?SHORT_TIMEOUT+1, ?MODULE, Ref2),
+ true = mem_larger_than(Mem),
+ true = is_integer(erlang:read_timer(T5)),
+ true = is_integer(erlang:read_timer(T6)),
+ receive {timeout, T5, Ref2} -> ok end,
+ receive Ref2 -> ok end,
+ Mem = mem(),
+ true = unregister(?MODULE),
+ ok.
same_time_yielding(Config) when is_list(Config) ->
Mem = mem(),
SchdlrsOnln = erlang:system_info(schedulers_online),
Tmo = erlang:monotonic_time(milli_seconds) + 3000,
Tmrs = lists:map(fun (I) ->
- process_flag(scheduler, (I rem SchdlrsOnln) + 1),
- erlang:start_timer(Tmo, self(), hej, [{abs, true}])
- end,
- lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)),
+ process_flag(scheduler, (I rem SchdlrsOnln) + 1),
+ erlang:start_timer(Tmo, self(), hej, [{abs, true}])
+ end,
+ lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)),
true = mem_larger_than(Mem),
lists:foreach(fun (Tmr) -> receive {timeout, Tmr, hej} -> ok end end, Tmrs),
Done = erlang:monotonic_time(milli_seconds),
true = Done >= Tmo,
case erlang:system_info(build_type) of
- opt -> true = Done < Tmo + 200;
- _ -> true = Done < Tmo + 1000
+ opt -> true = Done < Tmo + 200;
+ _ -> true = Done < Tmo + 1000
end,
Mem = mem(),
ok.
@@ -539,19 +517,19 @@ same_time_yielding_with_cancel_other(Config) when is_list(Config) ->
do_cancel_tmrs(Tmo, Tmrs, Tester) ->
BeginCancel = erlang:convert_time_unit(Tmo,
- milli_seconds,
- micro_seconds) - 100,
+ milli_seconds,
+ micro_seconds) - 100,
busy_wait_until(fun () ->
- erlang:monotonic_time(micro_seconds) >= BeginCancel
- end),
+ erlang:monotonic_time(micro_seconds) >= BeginCancel
+ end),
lists:foreach(fun (Tmr) ->
- erlang:cancel_timer(Tmr,
- [{async, true},
- {info, true}])
- end, Tmrs),
+ erlang:cancel_timer(Tmr,
+ [{async, true},
+ {info, true}])
+ end, Tmrs),
case Tester == self() of
- true -> ok;
- false -> forward_msgs(Tester)
+ true -> ok;
+ false -> forward_msgs(Tester)
end.
same_time_yielding_with_cancel_test(Other, Accessor) ->
@@ -560,57 +538,57 @@ same_time_yielding_with_cancel_test(Other, Accessor) ->
Tmo = erlang:monotonic_time(milli_seconds) + 3000,
Tester = self(),
Cancelor = case Other of
- false ->
- Tester;
- true ->
- spawn(fun () ->
- receive
- {timers, Tmrs} ->
- do_cancel_tmrs(Tmo, Tmrs, Tester)
- end
- end)
- end,
+ false ->
+ Tester;
+ true ->
+ spawn(fun () ->
+ receive
+ {timers, Tmrs} ->
+ do_cancel_tmrs(Tmo, Tmrs, Tester)
+ end
+ end)
+ end,
Opts = case Accessor of
- false -> [{abs, true}];
- true -> [{accessor, Cancelor}, {abs, true}]
- end,
+ false -> [{abs, true}];
+ true -> [{accessor, Cancelor}, {abs, true}]
+ end,
Tmrs = lists:map(fun (I) ->
- process_flag(scheduler, (I rem SchdlrsOnln) + 1),
- erlang:start_timer(Tmo, self(), hej, Opts)
- end,
- lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)),
+ process_flag(scheduler, (I rem SchdlrsOnln) + 1),
+ erlang:start_timer(Tmo, self(), hej, Opts)
+ end,
+ lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)),
true = mem_larger_than(Mem),
case Other of
- false ->
- do_cancel_tmrs(Tmo, Tmrs, Tester);
- true ->
- Cancelor ! {timers, Tmrs}
+ false ->
+ do_cancel_tmrs(Tmo, Tmrs, Tester);
+ true ->
+ Cancelor ! {timers, Tmrs}
end,
{Tmos, Cncls} = lists:foldl(fun (Tmr, {T, C}) ->
- receive
- {timeout, Tmr, hej} ->
- receive
- {cancel_timer, Tmr, Info} ->
- false = Info,
- {T+1, C}
- end;
- {cancel_timer, Tmr, false} ->
- receive
- {timeout, Tmr, hej} ->
- {T+1, C}
- end;
- {cancel_timer, Tmr, TimeLeft} ->
- true = is_integer(TimeLeft),
- {T, C+1}
- end
- end,
- {0, 0},
- Tmrs),
+ receive
+ {timeout, Tmr, hej} ->
+ receive
+ {cancel_timer, Tmr, Info} ->
+ false = Info,
+ {T+1, C}
+ end;
+ {cancel_timer, Tmr, false} ->
+ receive
+ {timeout, Tmr, hej} ->
+ {T+1, C}
+ end;
+ {cancel_timer, Tmr, TimeLeft} ->
+ true = is_integer(TimeLeft),
+ {T, C+1}
+ end
+ end,
+ {0, 0},
+ Tmrs),
io:format("Timeouts: ~p Cancels: ~p~n", [Tmos, Cncls]),
Mem = mem(),
case Other of
- true -> exit(Cancelor, bang);
- false -> ok
+ true -> exit(Cancelor, bang);
+ false -> ok
end,
{comment,
"Timeouts: " ++ integer_to_list(Tmos) ++ " Cancels: "
@@ -620,16 +598,16 @@ auto_cancel_yielding(Config) when is_list(Config) ->
Mem = mem(),
SchdlrsOnln = erlang:system_info(schedulers_online),
P = spawn(fun () ->
- lists:foreach(
- fun (I) ->
- process_flag(scheduler, (I rem SchdlrsOnln)+1),
- erlang:start_timer((1 bsl 28)+I*10, self(), hej)
- end,
- lists:seq(1,
- ((?AUTO_CANCEL_YIELD_LIMIT*3+1)
- *SchdlrsOnln))),
- receive after infinity -> ok end
- end),
+ lists:foreach(
+ fun (I) ->
+ process_flag(scheduler, (I rem SchdlrsOnln)+1),
+ erlang:start_timer((1 bsl 28)+I*10, self(), hej)
+ end,
+ lists:seq(1,
+ ((?AUTO_CANCEL_YIELD_LIMIT*3+1)
+ *SchdlrsOnln))),
+ receive after infinity -> ok end
+ end),
true = mem_larger_than(Mem),
exit(P, bang),
wait_until(fun () -> process_is_cleaned_up(P) end),
@@ -641,46 +619,46 @@ process_is_cleaned_up(P) when is_pid(P) ->
wait_until(Pred) when is_function(Pred) ->
case catch Pred() of
- true -> ok;
- _ -> receive after 50 -> ok end, wait_until(Pred)
+ true -> ok;
+ _ -> receive after 50 -> ok end, wait_until(Pred)
end.
busy_wait_until(Pred) when is_function(Pred) ->
case catch Pred() of
- true -> ok;
- _ -> busy_wait_until(Pred)
+ true -> ok;
+ _ -> busy_wait_until(Pred)
end.
forward_msgs(To) ->
receive
- Msg ->
- To ! Msg
+ Msg ->
+ To ! Msg
end,
forward_msgs(To).
get(Time, Msg) ->
receive
- Msg ->
- ok
+ Msg ->
+ ok
after Time
- ->
- no_message
+ ->
+ no_message
end.
get_msg() ->
receive
- Msg ->
- {ok, Msg}
+ Msg ->
+ {ok, Msg}
after 0 ->
- empty
+ empty
end.
start_slave() ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line Name = atom_to_list(?MODULE)
- ++ "-" ++ integer_to_list(erlang:system_time(seconds))
- ++ "-" ++ integer_to_list(erlang:unique_integer([positive])),
- {ok, Node} = ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]),
+ Pa = filename:dirname(code:which(?MODULE)),
+ Name = atom_to_list(?MODULE)
+ ++ "-" ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-" ++ integer_to_list(erlang:unique_integer([positive])),
+ {ok, Node} = test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]),
Node.
stop_slave(Node) ->
@@ -691,18 +669,18 @@ collect(Last) ->
receive_one() ->
receive
- Msg ->
- Msg
+ Msg ->
+ Msg
end.
collect(Last, Msgs0) ->
Msg = receive_one(),
Msgs = Msgs0 ++ [Msg],
case Msg of
- Last ->
- Msgs;
- _ ->
- collect(Last, Msgs)
+ Last ->
+ Msgs;
+ _ ->
+ collect(Last, Msgs)
end.
match(X, X) ->
@@ -751,8 +729,8 @@ mem() ->
erts_debug:set_internal_state(wait, timer_cancellations),
erts_debug:set_internal_state(wait, deallocations),
case mem_get() of
- {-1, -1} -> no_fix_alloc;
- {A, U} -> io:format("mem = ~p ~p~n", [A, U]), U
+ {-1, -1} -> no_fix_alloc;
+ {A, U} -> io:format("mem = ~p ~p~n", [A, U]), U
end.
mem_get() ->
@@ -765,8 +743,8 @@ mem_recv(0, _Ref, AU) ->
AU;
mem_recv(N, Ref, AU) ->
receive
- {Ref, _, IL} ->
- mem_recv(N-1, Ref, mem_parse_ilists(IL, AU))
+ {Ref, _, IL} ->
+ mem_recv(N-1, Ref, mem_parse_ilists(IL, AU))
end.
@@ -779,19 +757,19 @@ mem_parse_ilist({fix_alloc, false}, _) ->
{-1, -1};
mem_parse_ilist({fix_alloc, _, IDL}, {A, U}) ->
case lists:keyfind(fix_types, 1, IDL) of
- {fix_types, TL} ->
- {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0),
- {ThisA + A, ThisU + U};
- {fix_types, Mask, TL} ->
- {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0),
- {(ThisA + A) band Mask , (ThisU + U) band Mask}
+ {fix_types, TL} ->
+ {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0),
+ {ThisA + A, ThisU + U};
+ {fix_types, Mask, TL} ->
+ {ThisA, ThisU} = mem_get_btm_aus(TL, 0, 0),
+ {(ThisA + A) band Mask , (ThisU + U) band Mask}
end.
mem_get_btm_aus([], A, U) ->
{A, U};
mem_get_btm_aus([{BtmType, BtmA, BtmU} | Types],
- A, U) when BtmType == bif_timer;
- BtmType == accessor_bif_timer ->
+ A, U) when BtmType == bif_timer;
+ BtmType == accessor_bif_timer ->
mem_get_btm_aus(Types, BtmA+A, BtmU+U);
mem_get_btm_aus([_|Types], A, U) ->
mem_get_btm_aus(Types, A, U).
diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl
index 6eae182e45..dcd5e95434 100644
--- a/erts/emulator/test/trace_SUITE.erl
+++ b/erts/emulator/test/trace_SUITE.erl
@@ -24,8 +24,8 @@
%%% Tests the trace BIF.
%%%
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, receive_trace/1, self_send/1,
+-export([all/0, suite/0,
+ receive_trace/1, self_send/1,
timeout_trace/1, send_trace/1,
procs_trace/1, dist_procs_trace/1,
suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1,
@@ -38,12 +38,14 @@
system_monitor_long_schedule/1,
bad_flag/1, trace_delivered/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%%% Internal exports
-export([process/1]).
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 5}}].
all() ->
[cpu_timestamp, receive_trace, self_send, timeout_trace,
@@ -54,133 +56,101 @@ all() ->
set_on_first_spawn, system_monitor_args,
more_system_monitor_args, system_monitor_long_gc_1,
system_monitor_long_gc_2, system_monitor_large_heap_1,
- system_monitor_long_schedule,
+ system_monitor_long_schedule,
system_monitor_large_heap_2, bad_flag, trace_delivered].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
%% No longer testing anything, just reporting whether cpu_timestamp
%% is enabled or not.
cpu_timestamp(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
-
%% Test whether cpu_timestamp is implemented on this platform.
- ?line Works = try erlang:trace(all, true, [cpu_timestamp]) of
- _ ->
- ?line erlang:trace(all, false, [cpu_timestamp]),
- true
- catch
- error:badarg -> false
- end,
-
- ?line test_server:timetrap_cancel(Dog),
+ Works = try erlang:trace(all, true, [cpu_timestamp]) of
+ _ ->
+ erlang:trace(all, false, [cpu_timestamp]),
+ true
+ catch
+ error:badarg -> false
+ end,
{comment,case Works of
- false -> "cpu_timestamp is NOT implemented/does not work";
- true -> "cpu_timestamp works"
- end}.
+ false -> "cpu_timestamp is NOT implemented/does not work";
+ true -> "cpu_timestamp works"
+ end}.
%% Tests that trace(Pid, How, ['receive']) works.
receive_trace(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
- ?line Receiver = fun_spawn(fun receiver/0),
- ?line process_flag(trap_exit, true),
+ Receiver = fun_spawn(fun receiver/0),
+ process_flag(trap_exit, true),
%% Trace the process; make sure that we receive the trace messages.
- ?line 1 = erlang:trace(Receiver, true, ['receive']),
- ?line Hello = {hello, world},
- ?line Receiver ! Hello,
- ?line {trace, Receiver, 'receive', Hello} = receive_first(),
- ?line Hello2 = {hello, again, world},
- ?line Receiver ! Hello2,
- ?line {trace, Receiver, 'receive', Hello2} = receive_first(),
- ?line receive_nothing(),
+ 1 = erlang:trace(Receiver, true, ['receive']),
+ Hello = {hello, world},
+ Receiver ! Hello,
+ {trace, Receiver, 'receive', Hello} = receive_first(),
+ Hello2 = {hello, again, world},
+ Receiver ! Hello2,
+ {trace, Receiver, 'receive', Hello2} = receive_first(),
+ receive_nothing(),
%% Another process should not be able to trace Receiver.
- ?line Intruder = fun_spawn(fun() -> erlang:trace(Receiver, true, ['receive']) end),
- ?line {'EXIT', Intruder, {badarg, _}} = receive_first(),
+ Intruder = fun_spawn(fun() -> erlang:trace(Receiver, true, ['receive']) end),
+ {'EXIT', Intruder, {badarg, _}} = receive_first(),
%% Untrace the process; we should not receive anything.
- ?line 1 = erlang:trace(Receiver, false, ['receive']),
- ?line Receiver ! {hello, there},
- ?line Receiver ! any_garbage,
- ?line receive_nothing(),
-
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ 1 = erlang:trace(Receiver, false, ['receive']),
+ Receiver ! {hello, there},
+ Receiver ! any_garbage,
+ receive_nothing(),
ok.
-self_send(doc) -> ["Test that traces are generated for messages sent ",
- "and received to/from self()."];
+%% Test that traces are generated for messages sent
+%% and received to/from self().
self_send(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
- ?line Fun =
- fun(Self, Parent) -> receive
- go_ahead ->
- self() ! from_myself,
- Self(Self, Parent);
- from_myself ->
- Parent ! done
- end
- end,
- ?line Self = self(),
- ?line SelfSender = fun_spawn(Fun, [Fun, Self]),
- ?line erlang:trace(SelfSender, true, ['receive', 'send']),
- ?line SelfSender ! go_ahead,
- ?line receive {trace, SelfSender, 'receive', go_ahead} -> ok end,
- ?line receive {trace, SelfSender, 'receive', from_myself} -> ok end,
- ?line receive
- {trace,SelfSender,send,from_myself,SelfSender} -> ok
- end,
- ?line receive {trace,SelfSender,send,done,Self} -> ok end,
- ?line receive done -> ok end,
-
- ?line test_server:timetrap_cancel(Dog),
+ Fun =
+ fun(Self, Parent) -> receive
+ go_ahead ->
+ self() ! from_myself,
+ Self(Self, Parent);
+ from_myself ->
+ Parent ! done
+ end
+ end,
+ Self = self(),
+ SelfSender = fun_spawn(Fun, [Fun, Self]),
+ erlang:trace(SelfSender, true, ['receive', 'send']),
+ SelfSender ! go_ahead,
+ receive {trace, SelfSender, 'receive', go_ahead} -> ok end,
+ receive {trace, SelfSender, 'receive', from_myself} -> ok end,
+ receive
+ {trace,SelfSender,send,from_myself,SelfSender} -> ok
+ end,
+ receive {trace,SelfSender,send,done,Self} -> ok end,
+ receive done -> ok end,
ok.
%% Test that we can receive timeout traces.
timeout_trace(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
-
- ?line Process = fun_spawn(fun process/0),
- ?line 1 = erlang:trace(Process, true, ['receive']),
- ?line Process ! timeout_please,
- ?line {trace, Process, 'receive', timeout_please} = receive_first(),
- ?line {trace, Process, 'receive', timeout} = receive_first(),
- ?line receive_nothing(),
-
- ?line test_server:timetrap_cancel(Dog),
+ Process = fun_spawn(fun process/0),
+ 1 = erlang:trace(Process, true, ['receive']),
+ Process ! timeout_please,
+ {trace, Process, 'receive', timeout_please} = receive_first(),
+ {trace, Process, 'receive', timeout} = receive_first(),
+ receive_nothing(),
ok.
%% Tests that trace(Pid, How, [send]) works.
send_trace(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
- ?line process_flag(trap_exit, true),
- ?line Sender = fun_spawn(fun sender/0),
- ?line Receiver = fun_spawn(fun receiver/0),
+ process_flag(trap_exit, true),
+ Sender = fun_spawn(fun sender/0),
+ Receiver = fun_spawn(fun receiver/0),
%% Check that a message sent to another process is traced.
- ?line 1 = erlang:trace(Sender, true, [send]),
- ?line Sender ! {send_please, Receiver, to_receiver},
- ?line {trace, Sender, send, to_receiver, Receiver} = receive_first(),
- ?line receive_nothing(),
+ 1 = erlang:trace(Sender, true, [send]),
+ Sender ! {send_please, Receiver, to_receiver},
+ {trace, Sender, send, to_receiver, Receiver} = receive_first(),
+ receive_nothing(),
%% Check that a message sent to another registered process is traced.
register(?MODULE,Receiver),
@@ -190,11 +160,11 @@ send_trace(Config) when is_list(Config) ->
unregister(?MODULE),
%% Check that a message sent to this process is traced.
- ?line Sender ! {send_please, self(), to_myself},
- ?line receive to_myself -> ok end,
- ?line Self = self(),
- ?line {trace, Sender, send, to_myself, Self} = receive_first(),
- ?line receive_nothing(),
+ Sender ! {send_please, self(), to_myself},
+ receive to_myself -> ok end,
+ Self = self(),
+ {trace, Sender, send, to_myself, Self} = receive_first(),
+ receive_nothing(),
%% Check that a message sent to dead process is traced.
{Pid,Ref} = spawn_monitor(fun() -> ok end),
@@ -212,174 +182,166 @@ send_trace(Config) when is_list(Config) ->
receive_nothing(),
%% Another process should not be able to trace Sender.
- ?line Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end),
- ?line {'EXIT', Intruder, {badarg, _}} = receive_first(),
+ Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end),
+ {'EXIT', Intruder, {badarg, _}} = receive_first(),
%% Untrace the sender process and make sure that we receive no more
%% trace messages.
- ?line 1 = erlang:trace(Sender, false, [send]),
- ?line Sender ! {send_please, Receiver, to_receiver},
- ?line Sender ! {send_please, self(), to_myself_again},
- ?line receive to_myself_again -> ok end,
- ?line receive_nothing(),
-
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ 1 = erlang:trace(Sender, false, [send]),
+ Sender ! {send_please, Receiver, to_receiver},
+ Sender ! {send_please, self(), to_myself_again},
+ receive to_myself_again -> ok end,
+ receive_nothing(),
ok.
%% Test trace(Pid, How, [procs]).
procs_trace(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
- ?line Name = list_to_atom(atom_to_list(?MODULE)++"_procs_trace"),
- ?line Self = self(),
- ?line process_flag(trap_exit, true),
+ Name = list_to_atom(atom_to_list(?MODULE)++"_procs_trace"),
+ Self = self(),
+ process_flag(trap_exit, true),
%%
- ?line Proc1 = spawn_link(?MODULE, process, [Self]),
- ?line io:format("Proc1 = ~p ~n", [Proc1]),
- ?line Proc2 = spawn(?MODULE, process, [Self]),
- ?line io:format("Proc2 = ~p ~n", [Proc2]),
+ Proc1 = spawn_link(?MODULE, process, [Self]),
+ io:format("Proc1 = ~p ~n", [Proc1]),
+ Proc2 = spawn(?MODULE, process, [Self]),
+ io:format("Proc2 = ~p ~n", [Proc2]),
%%
- ?line 1 = erlang:trace(Proc1, true, [procs]),
- ?line MFA = {?MODULE, process, [Self]},
+ 1 = erlang:trace(Proc1, true, [procs]),
+ MFA = {?MODULE, process, [Self]},
%%
%% spawn, link
- ?line Proc1 ! {spawn_link_please, Self, MFA},
- ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end,
- ?line {trace, Proc1, spawn, Proc3, MFA} = receive_first(),
- ?line io:format("Proc3 = ~p ~n", [Proc3]),
- ?line {trace, Proc1, link, Proc3} = receive_first(),
- ?line receive_nothing(),
+ Proc1 ! {spawn_link_please, Self, MFA},
+ Proc3 = receive {spawned, Proc1, P3} -> P3 end,
+ {trace, Proc1, spawn, Proc3, MFA} = receive_first(),
+ io:format("Proc3 = ~p ~n", [Proc3]),
+ {trace, Proc1, link, Proc3} = receive_first(),
+ receive_nothing(),
%%
%% getting_unlinked by exit()
- ?line Proc1 ! {trap_exit_please, true},
- ?line Reason3 = make_ref(),
- ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}},
- ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end,
- ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(),
- ?line Proc1 ! {trap_exit_please, false},
- ?line receive_nothing(),
+ Proc1 ! {trap_exit_please, true},
+ Reason3 = make_ref(),
+ Proc1 ! {send_please, Proc3, {exit_please, Reason3}},
+ receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end,
+ {trace, Proc1, getting_unlinked, Proc3} = receive_first(),
+ Proc1 ! {trap_exit_please, false},
+ receive_nothing(),
%%
%% link
- ?line Proc1 ! {link_please, Proc2},
- ?line {trace, Proc1, link, Proc2} = receive_first(),
- ?line receive_nothing(),
+ Proc1 ! {link_please, Proc2},
+ {trace, Proc1, link, Proc2} = receive_first(),
+ receive_nothing(),
%%
%% unlink
- ?line Proc1 ! {unlink_please, Proc2},
- ?line {trace, Proc1, unlink, Proc2} = receive_first(),
- ?line receive_nothing(),
+ Proc1 ! {unlink_please, Proc2},
+ {trace, Proc1, unlink, Proc2} = receive_first(),
+ receive_nothing(),
%%
%% getting_linked
- ?line Proc2 ! {link_please, Proc1},
- ?line {trace, Proc1, getting_linked, Proc2} = receive_first(),
- ?line receive_nothing(),
+ Proc2 ! {link_please, Proc1},
+ {trace, Proc1, getting_linked, Proc2} = receive_first(),
+ receive_nothing(),
%%
%% getting_unlinked
- ?line Proc2 ! {unlink_please, Proc1},
- ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(),
- ?line receive_nothing(),
+ Proc2 ! {unlink_please, Proc1},
+ {trace, Proc1, getting_unlinked, Proc2} = receive_first(),
+ receive_nothing(),
%%
%% register
- ?line true = register(Name, Proc1),
- ?line {trace, Proc1, register, Name} = receive_first(),
- ?line receive_nothing(),
+ true = register(Name, Proc1),
+ {trace, Proc1, register, Name} = receive_first(),
+ receive_nothing(),
%%
%% unregister
- ?line true = unregister(Name),
- ?line {trace, Proc1, unregister, Name} = receive_first(),
- ?line receive_nothing(),
+ true = unregister(Name),
+ {trace, Proc1, unregister, Name} = receive_first(),
+ receive_nothing(),
%%
%% exit (with registered name, due to link)
- ?line Reason4 = make_ref(),
- ?line Proc1 ! {spawn_link_please, Self, MFA},
- ?line Proc4 = receive {spawned, Proc1, P4} -> P4 end,
- ?line {trace, Proc1, spawn, Proc4, MFA} = receive_first(),
- ?line io:format("Proc4 = ~p ~n", [Proc4]),
- ?line {trace, Proc1, link, Proc4} = receive_first(),
- ?line Proc1 ! {register_please, Name, Proc1},
- ?line {trace, Proc1, register, Name} = receive_first(),
- ?line Proc4 ! {exit_please, Reason4},
- ?line receive {'EXIT', Proc1, Reason4} -> ok end,
- ?line {trace, Proc1, exit, Reason4} = receive_first(),
- ?line {trace, Proc1, unregister, Name} = receive_first(),
- ?line receive_nothing(),
+ Reason4 = make_ref(),
+ Proc1 ! {spawn_link_please, Self, MFA},
+ Proc4 = receive {spawned, Proc1, P4} -> P4 end,
+ {trace, Proc1, spawn, Proc4, MFA} = receive_first(),
+ io:format("Proc4 = ~p ~n", [Proc4]),
+ {trace, Proc1, link, Proc4} = receive_first(),
+ Proc1 ! {register_please, Name, Proc1},
+ {trace, Proc1, register, Name} = receive_first(),
+ Proc4 ! {exit_please, Reason4},
+ receive {'EXIT', Proc1, Reason4} -> ok end,
+ {trace, Proc1, exit, Reason4} = receive_first(),
+ {trace, Proc1, unregister, Name} = receive_first(),
+ receive_nothing(),
%%
%% exit (not linked to tracing process)
- ?line 1 = erlang:trace(Proc2, true, [procs]),
- ?line Reason2 = make_ref(),
- ?line Proc2 ! {exit_please, Reason2},
- ?line {trace, Proc2, exit, Reason2} = receive_first(),
- ?line receive_nothing(),
- %%
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ 1 = erlang:trace(Proc2, true, [procs]),
+ Reason2 = make_ref(),
+ Proc2 ! {exit_please, Reason2},
+ {trace, Proc2, exit, Reason2} = receive_first(),
+ receive_nothing(),
ok.
dist_procs_trace(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(15)),
- ?line OtherName = atom_to_list(?MODULE)++"_dist_procs_trace",
- ?line {ok, OtherNode} = start_node(OtherName),
- ?line Self = self(),
- ?line process_flag(trap_exit, true),
+ ct:timetrap({seconds, 15}),
+ OtherName = atom_to_list(?MODULE)++"_dist_procs_trace",
+ {ok, OtherNode} = start_node(OtherName),
+ Self = self(),
+ process_flag(trap_exit, true),
%%
- ?line Proc1 = spawn_link(?MODULE, process, [Self]),
- ?line io:format("Proc1 = ~p ~n", [Proc1]),
- ?line Proc2 = spawn(OtherNode, ?MODULE, process, [Self]),
- ?line io:format("Proc2 = ~p ~n", [Proc2]),
+ Proc1 = spawn_link(?MODULE, process, [Self]),
+ io:format("Proc1 = ~p ~n", [Proc1]),
+ Proc2 = spawn(OtherNode, ?MODULE, process, [Self]),
+ io:format("Proc2 = ~p ~n", [Proc2]),
%%
- ?line 1 = erlang:trace(Proc1, true, [procs]),
- ?line MFA = {?MODULE, process, [Self]},
+ 1 = erlang:trace(Proc1, true, [procs]),
+ MFA = {?MODULE, process, [Self]},
%%
%% getting_unlinked by exit()
- ?line Proc1 ! {spawn_link_please, Self, OtherNode, MFA},
- ?line Proc1 ! {trap_exit_please, true},
- ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end,
- ?line io:format("Proc3 = ~p ~n", [Proc3]),
- ?line {trace, Proc1, getting_linked, Proc3} = receive_first(),
- ?line Reason3 = make_ref(),
- ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}},
- ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end,
- ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(),
- ?line Proc1 ! {trap_exit_please, false},
- ?line receive_nothing(),
+ Proc1 ! {spawn_link_please, Self, OtherNode, MFA},
+ Proc1 ! {trap_exit_please, true},
+ Proc3 = receive {spawned, Proc1, P3} -> P3 end,
+ io:format("Proc3 = ~p ~n", [Proc3]),
+ {trace, Proc1, getting_linked, Proc3} = receive_first(),
+ Reason3 = make_ref(),
+ Proc1 ! {send_please, Proc3, {exit_please, Reason3}},
+ receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end,
+ {trace, Proc1, getting_unlinked, Proc3} = receive_first(),
+ Proc1 ! {trap_exit_please, false},
+ receive_nothing(),
%%
%% link
- ?line Proc1 ! {link_please, Proc2},
- ?line {trace, Proc1, link, Proc2} = receive_first(),
- ?line receive_nothing(),
+ Proc1 ! {link_please, Proc2},
+ {trace, Proc1, link, Proc2} = receive_first(),
+ receive_nothing(),
%%
%% unlink
- ?line Proc1 ! {unlink_please, Proc2},
- ?line {trace, Proc1, unlink, Proc2} = receive_first(),
- ?line receive_nothing(),
+ Proc1 ! {unlink_please, Proc2},
+ {trace, Proc1, unlink, Proc2} = receive_first(),
+ receive_nothing(),
%%
%% getting_linked
- ?line Proc2 ! {link_please, Proc1},
- ?line {trace, Proc1, getting_linked, Proc2} = receive_first(),
- ?line receive_nothing(),
+ Proc2 ! {link_please, Proc1},
+ {trace, Proc1, getting_linked, Proc2} = receive_first(),
+ receive_nothing(),
%%
%% getting_unlinked
- ?line Proc2 ! {unlink_please, Proc1},
- ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(),
- ?line receive_nothing(),
+ Proc2 ! {unlink_please, Proc1},
+ {trace, Proc1, getting_unlinked, Proc2} = receive_first(),
+ receive_nothing(),
%%
%% exit (with registered name, due to link)
- ?line Name = list_to_atom(OtherName),
- ?line Reason2 = make_ref(),
- ?line Proc1 ! {link_please, Proc2},
- ?line {trace, Proc1, link, Proc2} = receive_first(),
- ?line Proc1 ! {register_please, Name, Proc1},
- ?line {trace, Proc1, register, Name} = receive_first(),
- ?line Proc2 ! {exit_please, Reason2},
- ?line receive {'EXIT', Proc1, Reason2} -> ok end,
- ?line {trace, Proc1, exit, Reason2} = receive_first(),
- ?line {trace, Proc1, unregister, Name} = receive_first(),
- ?line receive_nothing(),
+ Name = list_to_atom(OtherName),
+ Reason2 = make_ref(),
+ Proc1 ! {link_please, Proc2},
+ {trace, Proc1, link, Proc2} = receive_first(),
+ Proc1 ! {register_please, Name, Proc1},
+ {trace, Proc1, register, Name} = receive_first(),
+ Proc2 ! {exit_please, Reason2},
+ receive {'EXIT', Proc1, Reason2} -> ok end,
+ {trace, Proc1, exit, Reason2} = receive_first(),
+ {trace, Proc1, unregister, Name} = receive_first(),
+ receive_nothing(),
%%
%% Done.
- ?line true = stop_node(OtherNode),
- ?line test_server:timetrap_cancel(Dog),
+ true = stop_node(OtherNode),
ok.
@@ -388,134 +350,117 @@ dist_procs_trace(Config) when is_list(Config) ->
%% Tests trace(Pid, How, [set_on_spawn]).
set_on_spawn(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
- ?line Listener = fun_spawn(fun process/0),
+ Listener = fun_spawn(fun process/0),
%% Create and trace a process with the set_on_spawn flag.
%% Make sure it is traced.
- ?line Father_SOS = fun_spawn(fun process/0),
- ?line 1 = erlang:trace(Father_SOS, true, [send, set_on_spawn]),
- ?line true = is_send_traced(Father_SOS, Listener, sos_father),
+ Father_SOS = fun_spawn(fun process/0),
+ 1 = erlang:trace(Father_SOS, true, [send, set_on_spawn]),
+ true = is_send_traced(Father_SOS, Listener, sos_father),
%% Have the process spawn of two children and test that they
%% are traced.
- ?line [Child1, Child2] = spawn_children(Father_SOS, 2),
- ?line true = is_send_traced(Child1, Listener, child1),
- ?line true = is_send_traced(Child2, Listener, child2),
+ [Child1, Child2] = spawn_children(Father_SOS, 2),
+ true = is_send_traced(Child1, Listener, child1),
+ true = is_send_traced(Child2, Listener, child2),
%% Second generation.
[Child11, Child12] = spawn_children(Child1, 2),
- ?line true = is_send_traced(Child11, Listener, child11),
- ?line true = is_send_traced(Child12, Listener, child12),
-
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ true = is_send_traced(Child11, Listener, child11),
+ true = is_send_traced(Child12, Listener, child12),
ok.
%% Tests trace(Pid, How, [set_on_first_spawn]).
set_on_first_spawn(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(10)),
- ?line Listener = fun_spawn(fun process/0),
+ ct:timetrap({seconds, 10}),
+ Listener = fun_spawn(fun process/0),
%% Create and trace a process with the set_on_first_spawn flag.
%% Make sure it is traced.
- ?line Parent = fun_spawn(fun process/0),
- ?line 1 = erlang:trace(Parent, true, [send, set_on_first_spawn]),
- ?line is_send_traced(Parent, Listener, sos_father),
+ Parent = fun_spawn(fun process/0),
+ 1 = erlang:trace(Parent, true, [send, set_on_first_spawn]),
+ is_send_traced(Parent, Listener, sos_father),
%% Have the process spawn off three children and test that the
%% first is traced.
- ?line [Child1, Child2, Child3] = spawn_children(Parent, 3),
- ?line true = is_send_traced(Child1, Listener, child1),
- ?line false = is_send_traced(Child2, Listener, child2),
- ?line false = is_send_traced(Child3, Listener, child3),
- ?line receive_nothing(),
-
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ [Child1, Child2, Child3] = spawn_children(Parent, 3),
+ true = is_send_traced(Child1, Listener, child1),
+ false = is_send_traced(Child2, Listener, child2),
+ false = is_send_traced(Child3, Listener, child3),
+ receive_nothing(),
ok.
-system_monitor_args(doc) ->
- ["Tests arguments to erlang:system_monitor/0-2)"];
+%% Tests arguments to erlang:system_monitor/0,1,2
system_monitor_args(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
- ?line Self = self(),
+ Self = self(),
%%
- ?line OldMonitor = erlang:system_monitor(undefined),
- ?line undefined = erlang:system_monitor(Self, [{long_gc,0}]),
- ?line MinT = case erlang:system_monitor() of
- {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T;
- Other1 -> test_server:fault(Other1)
- end,
- ?line {Self,[{long_gc,MinT}]} = erlang:system_monitor(),
- ?line {Self,[{long_gc,MinT}]} =
- erlang:system_monitor({Self,[{large_heap,0}]}),
- ?line MinN = case erlang:system_monitor() of
- {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N;
- Other2 -> test_server:fault(Other2)
- end,
- ?line {Self,[{large_heap,MinN}]} = erlang:system_monitor(),
- ?line {Self,[{large_heap,MinN}]} =
- erlang:system_monitor(Self, [busy_port]),
- ?line {Self,[busy_port]} = erlang:system_monitor(),
- ?line {Self,[busy_port]} =
- erlang:system_monitor({Self,[busy_dist_port]}),
- ?line {Self,[busy_dist_port]} = erlang:system_monitor(),
- ?line All = lists:sort([busy_port,busy_dist_port,
- {long_gc,1},{large_heap,65535}]),
- ?line {Self,[busy_dist_port]} = erlang:system_monitor(Self, All),
- ?line {Self,A1} = erlang:system_monitor(),
- ?line All = lists:sort(A1),
- ?line {Self,A1} = erlang:system_monitor(Self, []),
- ?line Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end),
- ?line Mref = erlang:monitor(process, Pid),
- ?line undefined = erlang:system_monitor(Pid, All),
- ?line {Pid,A2} = erlang:system_monitor(),
- ?line All = lists:sort(A2),
- ?line Pid ! {Self,die},
- ?line receive {'DOWN',Mref,_,_,_} -> ok end,
- ?line undefined = erlang:system_monitor(OldMonitor),
- ?line erlang:yield(),
- ?line OldMonitor = erlang:system_monitor(),
+ OldMonitor = erlang:system_monitor(undefined),
+ undefined = erlang:system_monitor(Self, [{long_gc,0}]),
+ MinT = case erlang:system_monitor() of
+ {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T;
+ Other1 -> test_server:fault(Other1)
+ end,
+ {Self,[{long_gc,MinT}]} = erlang:system_monitor(),
+ {Self,[{long_gc,MinT}]} =
+ erlang:system_monitor({Self,[{large_heap,0}]}),
+ MinN = case erlang:system_monitor() of
+ {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N;
+ Other2 -> test_server:fault(Other2)
+ end,
+ {Self,[{large_heap,MinN}]} = erlang:system_monitor(),
+ {Self,[{large_heap,MinN}]} =
+ erlang:system_monitor(Self, [busy_port]),
+ {Self,[busy_port]} = erlang:system_monitor(),
+ {Self,[busy_port]} =
+ erlang:system_monitor({Self,[busy_dist_port]}),
+ {Self,[busy_dist_port]} = erlang:system_monitor(),
+ All = lists:sort([busy_port,busy_dist_port,
+ {long_gc,1},{large_heap,65535}]),
+ {Self,[busy_dist_port]} = erlang:system_monitor(Self, All),
+ {Self,A1} = erlang:system_monitor(),
+ All = lists:sort(A1),
+ {Self,A1} = erlang:system_monitor(Self, []),
+ Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end),
+ Mref = erlang:monitor(process, Pid),
+ undefined = erlang:system_monitor(Pid, All),
+ {Pid,A2} = erlang:system_monitor(),
+ All = lists:sort(A2),
+ Pid ! {Self,die},
+ receive {'DOWN',Mref,_,_,_} -> ok end,
+ undefined = erlang:system_monitor(OldMonitor),
+ erlang:yield(),
+ OldMonitor = erlang:system_monitor(),
%%
- ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)),
- ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})),
- ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})),
- ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1,2,3})),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:system_monitor({Self,atom})),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:system_monitor(atom, atom)),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:system_monitor({Self,[busy_port|busy_dist_port]})),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:system_monitor(Self, [{long_gc,-1}])),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:system_monitor({Self,[{long_gc,atom}]})),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:system_monitor(Self,[{large_heap,-1}])),
- ?line {'EXIT',{badarg,_}} =
- (catch erlang:system_monitor({Self,[{large_heap,atom}]})),
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)),
+ {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})),
+ {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})),
+ {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1,2,3})),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:system_monitor({Self,atom})),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:system_monitor(atom, atom)),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:system_monitor({Self,[busy_port|busy_dist_port]})),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:system_monitor(Self, [{long_gc,-1}])),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:system_monitor({Self,[{long_gc,atom}]})),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:system_monitor(Self,[{large_heap,-1}])),
+ {'EXIT',{badarg,_}} =
+ (catch erlang:system_monitor({Self,[{large_heap,atom}]})),
ok.
-more_system_monitor_args(doc) ->
- ["Tests arguments to erlang:system_monitor/0-2)"];
+%% Tests arguments to erlang:system_monitor/0,1,2
more_system_monitor_args(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
-
- ?line try_l(64000),
- ?line try_l(16#7ffffff),
- ?line try_l(16#3fffffff),
- ?line try_l(16#7fffffff),
- ?line try_l(16#ffffffff),
-
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ try_l(64000),
+ try_l(16#7ffffff),
+ try_l(16#3fffffff),
+ try_l(16#7fffffff),
+ try_l(16#ffffffff),
ok.
try_l(Val) ->
@@ -523,29 +468,29 @@ try_l(Val) ->
Arbitrary1 = 77777,
Arbitrary2 = 88888,
- ?line erlang:system_monitor(undefined),
+ erlang:system_monitor(undefined),
- ?line undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]),
+ undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]),
- ?line {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]),
- ?line [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0),
+ {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]),
+ [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0),
- ?line {Self,Comb1} = erlang:system_monitor(undefined),
- ?line [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1).
+ {Self,Comb1} = erlang:system_monitor(undefined),
+ [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1).
monitor_sys(Parent) ->
receive
- {monitor,Pid,long_schedule,Data} when is_pid(Pid) ->
- io:format("Long schedule of ~w: ~w~n",[Pid,Data]),
- Parent ! {Pid,Data},
- monitor_sys(Parent);
- {monitor,Port,long_schedule,Data} when is_port(Port) ->
- {name,Name} = erlang:port_info(Port,name),
- io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]),
- Parent ! {Port,Data},
- monitor_sys(Parent);
- Other ->
- erlang:display(Other)
+ {monitor,Pid,long_schedule,Data} when is_pid(Pid) ->
+ io:format("Long schedule of ~w: ~w~n",[Pid,Data]),
+ Parent ! {Pid,Data},
+ monitor_sys(Parent);
+ {monitor,Port,long_schedule,Data} when is_port(Port) ->
+ {name,Name} = erlang:port_info(Port,name),
+ io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]),
+ Parent ! {Port,Data},
+ monitor_sys(Parent);
+ Other ->
+ erlang:display(Other)
end.
start_monitor() ->
@@ -555,18 +500,15 @@ start_monitor() ->
erlang:yield(), % Need to be rescheduled for the trace to take
ok.
-system_monitor_long_schedule(suite) ->
- [];
-system_monitor_long_schedule(doc) ->
- ["Tests erlang:system_monitor(Pid, [{long_schedule,Time}])"];
+%% Tests erlang:system_monitor(Pid, [{long_schedule,Time}])
system_monitor_long_schedule(Config) when is_list(Config) ->
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
erl_ddll:start(),
case (catch load_driver(Path, slow_drv)) of
- ok ->
- do_system_monitor_long_schedule();
- _Error ->
- {skip, "Unable to load slow_drv (windows or no usleep()?)"}
+ ok ->
+ do_system_monitor_long_schedule();
+ _Error ->
+ {skip, "Unable to load slow_drv (windows or no usleep()?)"}
end.
do_system_monitor_long_schedule() ->
start_monitor(),
@@ -574,18 +516,18 @@ do_system_monitor_long_schedule() ->
"ok" = erlang:port_control(Port,0,[]),
Self = self(),
receive
- {Self,L} when is_list(L) ->
- ok
+ {Self,L} when is_list(L) ->
+ ok
after 1000 ->
- ?t:fail(no_trace_of_pid)
+ ct:fail(no_trace_of_pid)
end,
"ok" = erlang:port_control(Port,1,[]),
"ok" = erlang:port_control(Port,2,[]),
receive
- {Port,LL} when is_list(LL) ->
- ok
+ {Port,LL} when is_list(LL) ->
+ ok
after 1000 ->
- ?t:fail(no_trace_of_port)
+ ct:fail(no_trace_of_port)
end,
port_close(Port),
erlang:system_monitor(undefined),
@@ -594,214 +536,200 @@ do_system_monitor_long_schedule() ->
-define(LONG_GC_SLEEP, 670).
-system_monitor_long_gc_1(suite) ->
- [];
-system_monitor_long_gc_1(doc) ->
- ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"];
+%% Tests erlang:system_monitor(Pid, [{long_gc,Time}])
system_monitor_long_gc_1(Config) when is_list(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
try
- case erts_debug:get_internal_state(force_heap_frags) of
- true ->
- {skip,"emulator with FORCE_HEAP_FRAGS defined"};
- false ->
- %% Add ?LONG_GC_SLEEP ms to all gc
- ?line erts_debug:set_internal_state(test_long_gc_sleep,
- ?LONG_GC_SLEEP),
- ?line LoadFun = fun () ->
- garbage_collect(),
- self()
- end,
- ?line long_gc(LoadFun, false)
- end
+ case erts_debug:get_internal_state(force_heap_frags) of
+ true ->
+ {skip,"emulator with FORCE_HEAP_FRAGS defined"};
+ false ->
+ %% Add ?LONG_GC_SLEEP ms to all gc
+ erts_debug:set_internal_state(test_long_gc_sleep,
+ ?LONG_GC_SLEEP),
+ LoadFun = fun () ->
+ garbage_collect(),
+ self()
+ end,
+ long_gc(LoadFun, false)
+ end
after
- erts_debug:set_internal_state(test_long_gc_sleep, 0),
- erts_debug:set_internal_state(available_internal_state, false)
+ erts_debug:set_internal_state(test_long_gc_sleep, 0),
+ erts_debug:set_internal_state(available_internal_state, false)
end.
-system_monitor_long_gc_2(suite) ->
- [];
-system_monitor_long_gc_2(doc) ->
- ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"];
+%% Tests erlang:system_monitor(Pid, [{long_gc,Time}])
system_monitor_long_gc_2(Config) when is_list(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
try
- case erts_debug:get_internal_state(force_heap_frags) of
- true ->
- {skip,"emulator with FORCE_HEAP_FRAGS defined"};
- false ->
- %% Add ?LONG_GC_SLEEP ms to all gc
- ?line erts_debug:set_internal_state(test_long_gc_sleep,
- ?LONG_GC_SLEEP),
- ?line Parent = self(),
- ?line LoadFun =
- fun () ->
- Ref = make_ref(),
- Pid =
- spawn_link(
- fun () ->
- garbage_collect(),
- Parent ! {Ref, self()}
- end),
- receive {Ref, Pid} -> Pid end
- end,
- ?line long_gc(LoadFun, true),
- ?line long_gc(LoadFun, true),
- ?line long_gc(LoadFun, true)
- end
+ case erts_debug:get_internal_state(force_heap_frags) of
+ true ->
+ {skip,"emulator with FORCE_HEAP_FRAGS defined"};
+ false ->
+ %% Add ?LONG_GC_SLEEP ms to all gc
+ erts_debug:set_internal_state(test_long_gc_sleep,
+ ?LONG_GC_SLEEP),
+ Parent = self(),
+ LoadFun =
+ fun () ->
+ Ref = make_ref(),
+ Pid =
+ spawn_link(
+ fun () ->
+ garbage_collect(),
+ Parent ! {Ref, self()}
+ end),
+ receive {Ref, Pid} -> Pid end
+ end,
+ long_gc(LoadFun, true),
+ long_gc(LoadFun, true),
+ long_gc(LoadFun, true)
+ end
after
- erts_debug:set_internal_state(test_long_gc_sleep, 0),
- erts_debug:set_internal_state(available_internal_state, false)
+ erts_debug:set_internal_state(test_long_gc_sleep, 0),
+ erts_debug:set_internal_state(available_internal_state, false)
end.
long_gc(LoadFun, ExpectMonMsg) ->
- ?line Self = self(),
- ?line Time = 1,
- ?line OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]),
- ?line Pid = LoadFun(),
- ?line Ref = erlang:trace_delivered(Pid),
- ?line receive {trace_delivered, Pid, Ref} -> ok end,
- ?line {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor),
- ?line case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of
- {ok, true} when Pid =/= Self ->
- ok;
- {ok, false} ->
- ?line ?t:fail(unexpected_system_monitor_message_received);
- {undefined, false} ->
- ok;
- {undefined, true} ->
- ?line ?t:fail(no_system_monitor_message_received)
- end.
+ Self = self(),
+ Time = 1,
+ OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]),
+ Pid = LoadFun(),
+ Ref = erlang:trace_delivered(Pid),
+ receive {trace_delivered, Pid, Ref} -> ok end,
+ {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor),
+ case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of
+ {ok, true} when Pid =/= Self ->
+ ok;
+ {ok, false} ->
+ ct:fail(unexpected_system_monitor_message_received);
+ {undefined, false} ->
+ ok;
+ {undefined, true} ->
+ ct:fail(no_system_monitor_message_received)
+ end.
long_gc_check(Pid, Time, Result) ->
receive
- {monitor,Pid,long_gc,L} = Monitor ->
- case lists:foldl(
- fun (_, error) ->
- error;
- ({timeout,T}, N) when is_integer(T),
- Time =< T, T =< 10*?LONG_GC_SLEEP ->
- %% OTP-7622. The time T must be within reasonable limits
- %% for the test to pass.
- N-1;
- ({heap_size,_}, N) ->
- N-1;
- ({old_heap_size,_}, N) ->
- N-1;
- ({stack_size,_}, N) ->
- N-1;
- ({mbuf_size,_}, N) ->
- N-1;
- ({heap_block_size,_}, N) ->
- N-1;
- ({old_heap_block_size,_}, N) ->
- N-1;
- (_, _) ->
- error
- end, 7, L) of
- 0 ->
- long_gc_check(Pid, Time, ok);
- error ->
- {error,Monitor}
- end;
- {monitor,_,long_gc,_} ->
- long_gc_check(Pid, Time, Result);
- Other ->
- {error,Other}
+ {monitor,Pid,long_gc,L} = Monitor ->
+ case lists:foldl(
+ fun (_, error) ->
+ error;
+ ({timeout,T}, N) when is_integer(T),
+ Time =< T, T =< 10*?LONG_GC_SLEEP ->
+ %% OTP-7622. The time T must be within reasonable limits
+ %% for the test to pass.
+ N-1;
+ ({heap_size,_}, N) ->
+ N-1;
+ ({old_heap_size,_}, N) ->
+ N-1;
+ ({stack_size,_}, N) ->
+ N-1;
+ ({mbuf_size,_}, N) ->
+ N-1;
+ ({heap_block_size,_}, N) ->
+ N-1;
+ ({old_heap_block_size,_}, N) ->
+ N-1;
+ (_, _) ->
+ error
+ end, 7, L) of
+ 0 ->
+ long_gc_check(Pid, Time, ok);
+ error ->
+ {error,Monitor}
+ end;
+ {monitor,_,long_gc,_} ->
+ long_gc_check(Pid, Time, Result);
+ Other ->
+ {error,Other}
after 0 ->
- Result
+ Result
end.
-system_monitor_large_heap_1(suite) ->
- [];
-system_monitor_large_heap_1(doc) ->
- ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"];
+%% Tests erlang:system_monitor(Pid, [{large_heap,Size}])
system_monitor_large_heap_1(Config) when is_list(Config) ->
- ?line LoadFun =
- fun (Size) ->
- List = seq(1,2*Size),
- garbage_collect(),
- true = lists:prefix([1], List),
- self()
- end,
- ?line large_heap(LoadFun, false).
-
-system_monitor_large_heap_2(suite) ->
- [];
-system_monitor_large_heap_2(doc) ->
- ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"];
+ LoadFun =
+ fun (Size) ->
+ List = seq(1,2*Size),
+ garbage_collect(),
+ true = lists:prefix([1], List),
+ self()
+ end,
+ large_heap(LoadFun, false).
+
+%% Tests erlang:system_monitor(Pid, [{large_heap,Size}])
system_monitor_large_heap_2(Config) when is_list(Config) ->
- ?line Parent = self(),
- ?line LoadFun =
- fun (Size) ->
- Ref = make_ref(),
- Pid =
- spawn_opt(fun () ->
- garbage_collect(),
- Parent ! {Ref, self()}
- end,
- [link, {min_heap_size, 2*Size}]),
- receive {Ref, Pid} -> Pid end
- end,
- ?line large_heap(LoadFun, true).
+ Parent = self(),
+ LoadFun =
+ fun (Size) ->
+ Ref = make_ref(),
+ Pid =
+ spawn_opt(fun () ->
+ garbage_collect(),
+ Parent ! {Ref, self()}
+ end,
+ [link, {min_heap_size, 2*Size}]),
+ receive {Ref, Pid} -> Pid end
+ end,
+ large_heap(LoadFun, true).
large_heap(LoadFun, ExpectMonMsg) ->
- ?line Dog = test_server:timetrap(test_server:seconds(20)),
+ ct:timetrap({seconds, 20}),
%%
- ?line Size = 65535,
- ?line Self = self(),
- ?line NewMonitor = {Self,[{large_heap,Size}]},
- ?line OldMonitor = erlang:system_monitor(NewMonitor),
- ?line Pid = LoadFun(Size),
- ?line Ref = erlang:trace_delivered(Pid),
- ?line receive {trace_delivered, Pid, Ref} -> ok end,
- ?line {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor),
- ?line case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of
- {ok, true} when Pid =/= Self ->
- ?line ok;
- {ok, false} ->
- ?line ?t:fail(unexpected_system_monitor_message_received);
- {undefined, false} ->
- ?line ok;
- {undefined, true} ->
- ?line ?t:fail(no_system_monitor_message_received)
- end,
- %%
- ?line test_server:timetrap_cancel(Dog),
+ Size = 65535,
+ Self = self(),
+ NewMonitor = {Self,[{large_heap,Size}]},
+ OldMonitor = erlang:system_monitor(NewMonitor),
+ Pid = LoadFun(Size),
+ Ref = erlang:trace_delivered(Pid),
+ receive {trace_delivered, Pid, Ref} -> ok end,
+ {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor),
+ case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of
+ {ok, true} when Pid =/= Self ->
+ ok;
+ {ok, false} ->
+ ct:fail(unexpected_system_monitor_message_received);
+ {undefined, false} ->
+ ok;
+ {undefined, true} ->
+ ct:fail(no_system_monitor_message_received)
+ end,
ok.
large_heap_check(Pid, Size, Result) ->
receive
- {monitor,Pid,large_heap,L} = Monitor ->
- case lists:foldl(
- fun (_, error) ->
- error;
- ({heap_size,_}, N) ->
- N-1;
- ({old_heap_size,_}, N) ->
- N-1;
- ({stack_size,_}, N) ->
- N-1;
- ({mbuf_size,_}, N) ->
- N-1;
- ({heap_block_size,_}, N) ->
- N-1;
- ({old_heap_block_size,_}, N) ->
- N-1;
- (_, _) ->
- error
- end, 6, L) of
- 0 ->
- large_heap_check(Pid, Size, ok);
- error ->
- {error,Monitor}
- end;
- {monitor,_,large_heap,_} ->
- large_heap_check(Pid, Size, Result);
- Other ->
- {error,Other}
+ {monitor,Pid,large_heap,L} = Monitor ->
+ case lists:foldl(
+ fun (_, error) ->
+ error;
+ ({heap_size,_}, N) ->
+ N-1;
+ ({old_heap_size,_}, N) ->
+ N-1;
+ ({stack_size,_}, N) ->
+ N-1;
+ ({mbuf_size,_}, N) ->
+ N-1;
+ ({heap_block_size,_}, N) ->
+ N-1;
+ ({old_heap_block_size,_}, N) ->
+ N-1;
+ (_, _) ->
+ error
+ end, 6, L) of
+ 0 ->
+ large_heap_check(Pid, Size, ok);
+ error ->
+ {error,Monitor}
+ end;
+ {monitor,_,large_heap,_} ->
+ large_heap_check(Pid, Size, Result);
+ Other ->
+ {error,Other}
after 0 ->
- Result
+ Result
end.
seq(N, M) ->
@@ -816,11 +744,11 @@ seq(N, M, R) ->
is_send_traced(Pid, Listener, Msg) ->
Pid ! {send_please, Listener, Msg},
receive
- Any ->
- {trace, Pid, send, Msg, Listener} = Any,
- true
+ Any ->
+ {trace, Pid, send, Msg, Listener} = Any,
+ true
after 1000 ->
- false
+ false
end.
%% This procedure assumes that the Parent process is send traced.
@@ -834,146 +762,131 @@ spawn_children(Parent, Number, Result) ->
Self = self(),
Parent ! {spawn_please, Self, fun process/0},
Child =
- receive
- {trace, Parent, send, {spawned, Pid}, Self} -> Pid
- end,
receive
- {spawned, Child} ->
- spawn_children(Parent, Number-1, [Child|Result])
+ {trace, Parent, send, {spawned, Pid}, Self} -> Pid
+ end,
+ receive
+ {spawned, Child} ->
+ spawn_children(Parent, Number-1, [Child|Result])
end.
-suspend(doc) -> "Test erlang:suspend/1 and erlang:resume/1.";
+%% Test erlang:suspend/1 and erlang:resume/1.
suspend(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(2)),
-
- ?line Worker = fun_spawn(fun worker/0),
+ ct:timetrap({minutes,2}),
+ Worker = fun_spawn(fun worker/0),
%% Suspend a process and test that it is suspended.
- ?line ok = do_suspend(Worker, 10000),
-
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ ok = do_suspend(Worker, 10000),
ok.
do_suspend(_Pid, 0) ->
- ?line ok;
+ ok;
do_suspend(Pid, N) ->
%% Suspend a process and test that it is suspended.
- ?line true = erlang:suspend_process(Pid),
- ?line {status, suspended} = process_info(Pid, status),
+ true = erlang:suspend_process(Pid),
+ {status, suspended} = process_info(Pid, status),
%% Unsuspend the process and make sure it starts working.
- ?line true = erlang:resume_process(Pid),
- ?line case process_info(Pid, status) of
- {status, runnable} -> ?line ok;
- {status, running} -> ?line ok;
- {status, garbage_collecting} -> ?line ok;
- ST -> ?line ?t:fail(ST)
- end,
- ?line erlang:yield(),
- ?line do_suspend(Pid, N-1).
-
-
-
-mutual_suspend(doc) ->
- [];
-mutual_suspend(suite) ->
- [];
+ true = erlang:resume_process(Pid),
+ case process_info(Pid, status) of
+ {status, runnable} -> ok;
+ {status, running} -> ok;
+ {status, garbage_collecting} -> ok;
+ ST -> ct:fail(ST)
+ end,
+ erlang:yield(),
+ do_suspend(Pid, N-1).
+
+
+
mutual_suspend(Config) when is_list(Config) ->
- ?line TimeoutSecs = 5*60,
- ?line Dog = test_server:timetrap(test_server:minutes(TimeoutSecs)),
- ?line Parent = self(),
- ?line Fun = fun () ->
- receive
- {go, Pid} ->
- do_mutual_suspend(Pid, 100000)
- end,
- Parent ! {done, self()},
- receive after infinity -> ok end
- end,
- ?line P1 = spawn_link(Fun),
- ?line P2 = spawn_link(Fun),
- ?line T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
- ?line T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
- ?line P1 ! {go, P2},
- ?line P2 ! {go, P1},
- ?line Res1 = receive
- {done, P1} -> done;
- {timeout,T1,_} -> timeout
- end,
- ?line Res2 = receive
- {done, P2} -> done;
- {timeout,T2,_} -> timeout
- end,
- ?line P1S = process_info(P1, status),
- ?line P2S = process_info(P2, status),
- ?line ?t:format("P1S=~p P2S=~p", [P1S, P2S]),
- ?line false = {status, suspended} == P1S,
- ?line false = {status, suspended} == P2S,
- ?line unlink(P1), exit(P1, bang),
- ?line unlink(P2), exit(P2, bang),
- ?line done = Res1,
- ?line done = Res2,
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
- ?line ok.
-
+ TimeoutSecs = 5*60,
+ ct:timetrap({seconds, TimeoutSecs}),
+ Parent = self(),
+ Fun = fun () ->
+ receive
+ {go, Pid} ->
+ do_mutual_suspend(Pid, 100000)
+ end,
+ Parent ! {done, self()},
+ receive after infinity -> ok end
+ end,
+ P1 = spawn_link(Fun),
+ P2 = spawn_link(Fun),
+ T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
+ T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops),
+ P1 ! {go, P2},
+ P2 ! {go, P1},
+ Res1 = receive
+ {done, P1} -> done;
+ {timeout,T1,_} -> timeout
+ end,
+ Res2 = receive
+ {done, P2} -> done;
+ {timeout,T2,_} -> timeout
+ end,
+ P1S = process_info(P1, status),
+ P2S = process_info(P2, status),
+ io:format("P1S=~p P2S=~p", [P1S, P2S]),
+ false = {status, suspended} == P1S,
+ false = {status, suspended} == P2S,
+ unlink(P1), exit(P1, bang),
+ unlink(P2), exit(P2, bang),
+ done = Res1,
+ done = Res2,
+ ok.
+
do_mutual_suspend(_Pid, 0) ->
- ?line ok;
+ ok;
do_mutual_suspend(Pid, N) ->
%% Suspend a process and test that it is suspended.
- ?line true = erlang:suspend_process(Pid),
- ?line {status, suspended} = process_info(Pid, status),
+ true = erlang:suspend_process(Pid),
+ {status, suspended} = process_info(Pid, status),
%% Unsuspend the process.
- ?line true = erlang:resume_process(Pid),
- ?line do_mutual_suspend(Pid, N-1).
+ true = erlang:resume_process(Pid),
+ do_mutual_suspend(Pid, N-1).
-suspend_exit(doc) ->
- [];
-suspend_exit(suite) ->
- [];
suspend_exit(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(2)),
- ?line random:seed(4711,17,4711),
- ?line do_suspend_exit(5000),
- ?line test_server:timetrap_cancel(Dog),
- ?line ok.
+ ct:timetrap({minutes, 2}),
+ rand:seed(exsplus, {4711,17,4711}),
+ do_suspend_exit(5000),
+ ok.
do_suspend_exit(0) ->
- ?line ok;
+ ok;
do_suspend_exit(N) ->
- ?line Work = random:uniform(50),
- ?line Parent = self(),
- ?line {Suspendee, Mon2}
- = spawn_monitor(fun () ->
- suspend_exit_work(Work),
- exit(normal)
- end),
- ?line {Suspender, Mon1}
- = spawn_monitor(
- fun () ->
- suspend_exit_work(Work div 2),
- Parent ! {doing_suspend, self()},
- case catch erlang:suspend_process(Suspendee) of
- {'EXIT', _} ->
- ok;
- true ->
- ?line erlang:resume_process(Suspendee)
- end
- end),
- ?line receive
- {doing_suspend, Suspender} ->
- case N rem 2 of
- 0 -> exit(Suspender, bang);
- 1 -> ok
- end
- end,
- ?line receive {'DOWN', Mon1, process, Suspender, _} -> ok end,
- ?line receive {'DOWN', Mon2, process, Suspendee, _} -> ok end,
- ?line do_suspend_exit(N-1).
-
-
-
-
+ Work = rand:uniform(50),
+ Parent = self(),
+ {Suspendee, Mon2}
+ = spawn_monitor(fun () ->
+ suspend_exit_work(Work),
+ exit(normal)
+ end),
+ {Suspender, Mon1}
+ = spawn_monitor(
+ fun () ->
+ suspend_exit_work(Work div 2),
+ Parent ! {doing_suspend, self()},
+ case catch erlang:suspend_process(Suspendee) of
+ {'EXIT', _} ->
+ ok;
+ true ->
+ erlang:resume_process(Suspendee)
+ end
+ end),
+ receive
+ {doing_suspend, Suspender} ->
+ case N rem 2 of
+ 0 -> exit(Suspender, bang);
+ 1 -> ok
+ end
+ end,
+ receive {'DOWN', Mon1, process, Suspender, _} -> ok end,
+ receive {'DOWN', Mon2, process, Suspendee, _} -> ok end,
+ do_suspend_exit(N-1).
+
+
+
+
suspend_exit_work(0) ->
ok;
suspend_exit_work(N) ->
@@ -985,320 +898,305 @@ suspend_exit_work(N) ->
chk_suspended(P, Bool, Line) ->
{Bool, Line} = {({status, suspended} == process_info(P, status)), Line}.
-suspender_exit(doc) ->
- [];
-suspender_exit(suite) ->
- [];
suspender_exit(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(3)),
- ?line P1 = spawn_link(fun () -> receive after infinity -> ok end end),
- ?line {'EXIT', _} = (catch erlang:resume_process(P1)),
- ?line {P2, M2} = spawn_monitor(
- fun () ->
- ?CHK_SUSPENDED(P1, false),
- erlang:suspend_process(P1),
- ?CHK_SUSPENDED(P1, true),
- erlang:suspend_process(P1),
- erlang:suspend_process(P1),
- erlang:suspend_process(P1),
- ?CHK_SUSPENDED(P1, true),
- erlang:resume_process(P1),
- erlang:resume_process(P1),
- erlang:resume_process(P1),
- ?CHK_SUSPENDED(P1, true),
- erlang:resume_process(P1),
- ?CHK_SUSPENDED(P1, false),
- erlang:suspend_process(P1),
- erlang:suspend_process(P1),
- erlang:suspend_process(P1),
- ?CHK_SUSPENDED(P1, true),
- exit(bang)
- end),
- ?line receive
- {'DOWN', M2,process,P2,R2} ->
- ?line bang = R2,
- ?line ?CHK_SUSPENDED(P1, false)
- end,
- ?line Parent = self(),
- ?line {P3, M3} = spawn_monitor(
- fun () ->
- erlang:suspend_process(P1),
- ?CHK_SUSPENDED(P1, true),
- Parent ! self(),
- receive after infinity -> ok end
- end),
- ?line {P4, M4} = spawn_monitor(
- fun () ->
- erlang:suspend_process(P1),
- ?CHK_SUSPENDED(P1, true),
- Parent ! self(),
- receive after infinity -> ok end
- end),
- ?line {P5, M5} = spawn_monitor(
- fun () ->
- erlang:suspend_process(P1),
- ?CHK_SUSPENDED(P1, true),
- Parent ! self(),
- receive after infinity -> ok end
- end),
- ?line {P6, M6} = spawn_monitor(
- fun () ->
- erlang:suspend_process(P1),
- ?CHK_SUSPENDED(P1, true),
- Parent ! self(),
- receive after infinity -> ok end
- end),
- ?line {P7, M7} = spawn_monitor(
- fun () ->
- erlang:suspend_process(P1),
- ?CHK_SUSPENDED(P1, true),
- Parent ! self(),
- receive after infinity -> ok end
- end),
- ?line receive P3 -> ok end,
- ?line receive P4 -> ok end,
- ?line receive P5 -> ok end,
- ?line receive P6 -> ok end,
- ?line receive P7 -> ok end,
- ?line ?CHK_SUSPENDED(P1, true),
- ?line exit(P3, bang),
- ?line receive
- {'DOWN',M3,process,P3,R3} ->
- ?line bang = R3,
- ?line ?CHK_SUSPENDED(P1, true)
- end,
- ?line exit(P4, bang),
- ?line receive
- {'DOWN',M4,process,P4,R4} ->
- ?line bang = R4,
- ?line ?CHK_SUSPENDED(P1, true)
- end,
- ?line exit(P5, bang),
- ?line receive
- {'DOWN',M5,process,P5,R5} ->
- ?line bang = R5,
- ?line ?CHK_SUSPENDED(P1, true)
- end,
- ?line exit(P6, bang),
- ?line receive
- {'DOWN',M6,process,P6,R6} ->
- ?line bang = R6,
- ?line ?CHK_SUSPENDED(P1, true)
- end,
- ?line exit(P7, bang),
- ?line receive
- {'DOWN',M7,process,P7,R7} ->
- ?line bang = R7,
- ?line ?CHK_SUSPENDED(P1, false)
- end,
- ?line unlink(P1),
- ?line exit(P1, bong),
- ?line test_server:timetrap_cancel(Dog),
- ?line ok.
-
-suspend_system_limit(doc) ->
- [];
-suspend_system_limit(suite) ->
- [];
+ ct:timetrap({minutes, 3}),
+ P1 = spawn_link(fun () -> receive after infinity -> ok end end),
+ {'EXIT', _} = (catch erlang:resume_process(P1)),
+ {P2, M2} = spawn_monitor(
+ fun () ->
+ ?CHK_SUSPENDED(P1, false),
+ erlang:suspend_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ erlang:suspend_process(P1),
+ erlang:suspend_process(P1),
+ erlang:suspend_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ erlang:resume_process(P1),
+ erlang:resume_process(P1),
+ erlang:resume_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ erlang:resume_process(P1),
+ ?CHK_SUSPENDED(P1, false),
+ erlang:suspend_process(P1),
+ erlang:suspend_process(P1),
+ erlang:suspend_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ exit(bang)
+ end),
+ receive
+ {'DOWN', M2,process,P2,R2} ->
+ bang = R2,
+ ?CHK_SUSPENDED(P1, false)
+ end,
+ Parent = self(),
+ {P3, M3} = spawn_monitor(
+ fun () ->
+ erlang:suspend_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ Parent ! self(),
+ receive after infinity -> ok end
+ end),
+ {P4, M4} = spawn_monitor(
+ fun () ->
+ erlang:suspend_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ Parent ! self(),
+ receive after infinity -> ok end
+ end),
+ {P5, M5} = spawn_monitor(
+ fun () ->
+ erlang:suspend_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ Parent ! self(),
+ receive after infinity -> ok end
+ end),
+ {P6, M6} = spawn_monitor(
+ fun () ->
+ erlang:suspend_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ Parent ! self(),
+ receive after infinity -> ok end
+ end),
+ {P7, M7} = spawn_monitor(
+ fun () ->
+ erlang:suspend_process(P1),
+ ?CHK_SUSPENDED(P1, true),
+ Parent ! self(),
+ receive after infinity -> ok end
+ end),
+ receive P3 -> ok end,
+ receive P4 -> ok end,
+ receive P5 -> ok end,
+ receive P6 -> ok end,
+ receive P7 -> ok end,
+ ?CHK_SUSPENDED(P1, true),
+ exit(P3, bang),
+ receive
+ {'DOWN',M3,process,P3,R3} ->
+ bang = R3,
+ ?CHK_SUSPENDED(P1, true)
+ end,
+ exit(P4, bang),
+ receive
+ {'DOWN',M4,process,P4,R4} ->
+ bang = R4,
+ ?CHK_SUSPENDED(P1, true)
+ end,
+ exit(P5, bang),
+ receive
+ {'DOWN',M5,process,P5,R5} ->
+ bang = R5,
+ ?CHK_SUSPENDED(P1, true)
+ end,
+ exit(P6, bang),
+ receive
+ {'DOWN',M6,process,P6,R6} ->
+ bang = R6,
+ ?CHK_SUSPENDED(P1, true)
+ end,
+ exit(P7, bang),
+ receive
+ {'DOWN',M7,process,P7,R7} ->
+ bang = R7,
+ ?CHK_SUSPENDED(P1, false)
+ end,
+ unlink(P1),
+ exit(P1, bong),
+ ok.
+
suspend_system_limit(Config) when is_list(Config) ->
case os:getenv("ERL_EXTREME_TESTING") of
- "true" ->
- ?line Dog = test_server:timetrap(test_server:minutes(3*60)),
- ?line P = spawn_link(fun () -> receive after infinity -> ok end end),
- ?line suspend_until_system_limit(P),
- ?line unlink(P),
- ?line exit(P, bye),
- ?line test_server:timetrap_cancel(Dog),
- ?line ok;
- _ ->
- {skip, "Takes too long time for normal testing"}
+ "true" ->
+ ct:timetrap({minutes, 3*60}),
+ P = spawn_link(fun () -> receive after infinity -> ok end end),
+ suspend_until_system_limit(P),
+ unlink(P),
+ exit(P, bye),
+ ok;
+ _ ->
+ {skip, "Takes too long time for normal testing"}
end.
suspend_until_system_limit(P) ->
- ?line suspend_until_system_limit(P, 0, 0).
+ suspend_until_system_limit(P, 0, 0).
suspend_until_system_limit(P, N, M) ->
NewM = case M of
- 1 ->
- ?line ?CHK_SUSPENDED(P, true), 2;
- 1000000 ->
- erlang:display(N), 1;
- _ ->
- M+1
- end,
- ?line case catch erlang:suspend_process(P) of
- true ->
- suspend_until_system_limit(P, N+1, NewM);
- {'EXIT', R} when R == system_limit;
- element(1, R) == system_limit ->
- ?line ?t:format("system limit at ~p~n", [N]),
- ?line resume_from_system_limit(P, N, 0);
- Error ->
- ?line ?t:fail(Error)
- end.
+ 1 ->
+ ?CHK_SUSPENDED(P, true), 2;
+ 1000000 ->
+ erlang:display(N), 1;
+ _ ->
+ M+1
+ end,
+ case catch erlang:suspend_process(P) of
+ true ->
+ suspend_until_system_limit(P, N+1, NewM);
+ {'EXIT', R} when R == system_limit;
+ element(1, R) == system_limit ->
+ io:format("system limit at ~p~n", [N]),
+ resume_from_system_limit(P, N, 0);
+ Error ->
+ ct:fail(Error)
+ end.
resume_from_system_limit(P, 0, _) ->
- ?line ?CHK_SUSPENDED(P, false),
- ?line {'EXIT', _} = (catch erlang:resume_process(P)),
- ?line ok;
+ ?CHK_SUSPENDED(P, false),
+ {'EXIT', _} = (catch erlang:resume_process(P)),
+ ok;
resume_from_system_limit(P, N, M) ->
- ?line NewM = case M of
- 1 ->
- ?line ?CHK_SUSPENDED(P, true), 2;
- 1000000 ->
- erlang:display(N), 1;
- _ ->
- M+1
- end,
- ?line erlang:resume_process(P),
- ?line resume_from_system_limit(P, N-1, NewM).
+ NewM = case M of
+ 1 ->
+ ?CHK_SUSPENDED(P, true), 2;
+ 1000000 ->
+ erlang:display(N), 1;
+ _ ->
+ M+1
+ end,
+ erlang:resume_process(P),
+ resume_from_system_limit(P, N-1, NewM).
-record(susp_info, {async = 0,
- dbl_async = 0,
- synced = 0,
- async_once = 0}).
-
-suspend_opts(doc) ->
- [];
-suspend_opts(suite) ->
- [];
+ dbl_async = 0,
+ synced = 0,
+ async_once = 0}).
+
suspend_opts(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:minutes(3)),
- ?line Self = self(),
- ?line wait_for_empty_runq(10),
- ?line Tok = spawn_link(fun () ->
- Self ! self(),
- tok_trace_loop(Self, 0, 1000000000)
- end),
- ?line TC = 1000,
- ?line receive Tok -> ok end,
- ?line SF = fun (N, #susp_info {async = A,
- dbl_async = AA,
- synced = S,
- async_once = AO} = Acc) ->
- ?line erlang:suspend_process(Tok, [asynchronous]),
- ?line Res = case {suspend_count(Tok), N rem 4} of
- {0, 2} ->
- ?line erlang:suspend_process(Tok,
- [asynchronous]),
- case suspend_count(Tok) of
- 2 ->
- ?line erlang:resume_process(Tok),
- ?line Acc#susp_info{async = A+1};
- 0 ->
- ?line erlang:resume_process(Tok),
- ?line Acc#susp_info{async = A+1,
- dbl_async = AA+1}
- end;
- {0, 1} ->
- ?line erlang:suspend_process(Tok,
- [asynchronous,
- unless_suspending]),
- case suspend_count(Tok) of
- 1 ->
- ?line Acc#susp_info{async = A+1};
- 0 ->
- ?line Acc#susp_info{async = A+1,
- async_once = AO+1}
- end;
- {0, 0} ->
- ?line erlang:suspend_process(Tok,
- [unless_suspending]),
- ?line 1 = suspend_count(Tok),
- ?line Acc#susp_info{async = A+1,
- synced = S+1};
- {0, _} ->
- ?line Acc#susp_info{async = A+1};
- _ ->
- Acc
- end,
- ?line erlang:resume_process(Tok),
- ?line erlang:yield(),
- ?line Res
- end,
- ?line SI = repeat_acc(SF, TC, #susp_info{}),
- ?line erlang:suspend_process(Tok, [asynchronous]),
+ ct:timetrap({minutes, 3}),
+ Self = self(),
+ wait_for_empty_runq(10),
+ Tok = spawn_link(fun () ->
+ Self ! self(),
+ tok_trace_loop(Self, 0, 1000000000)
+ end),
+ TC = 1000,
+ receive Tok -> ok end,
+ SF = fun (N, #susp_info {async = A,
+ dbl_async = AA,
+ synced = S,
+ async_once = AO} = Acc) ->
+ erlang:suspend_process(Tok, [asynchronous]),
+ Res = case {suspend_count(Tok), N rem 4} of
+ {0, 2} ->
+ erlang:suspend_process(Tok,
+ [asynchronous]),
+ case suspend_count(Tok) of
+ 2 ->
+ erlang:resume_process(Tok),
+ Acc#susp_info{async = A+1};
+ 0 ->
+ erlang:resume_process(Tok),
+ Acc#susp_info{async = A+1,
+ dbl_async = AA+1}
+ end;
+ {0, 1} ->
+ erlang:suspend_process(Tok,
+ [asynchronous,
+ unless_suspending]),
+ case suspend_count(Tok) of
+ 1 ->
+ Acc#susp_info{async = A+1};
+ 0 ->
+ Acc#susp_info{async = A+1,
+ async_once = AO+1}
+ end;
+ {0, 0} ->
+ erlang:suspend_process(Tok,
+ [unless_suspending]),
+ 1 = suspend_count(Tok),
+ Acc#susp_info{async = A+1,
+ synced = S+1};
+ {0, _} ->
+ Acc#susp_info{async = A+1};
+ _ ->
+ Acc
+ end,
+ erlang:resume_process(Tok),
+ erlang:yield(),
+ Res
+ end,
+ SI = repeat_acc(SF, TC, #susp_info{}),
+ erlang:suspend_process(Tok, [asynchronous]),
%% Verify that it eventually suspends
- ?line WaitTime0 = 10,
- ?line WaitTime1 = case {erlang:system_info(debug_compiled),
- erlang:system_info(lock_checking)} of
- {false, false} ->
- WaitTime0;
- {false, true} ->
- WaitTime0*5;
- _ ->
- WaitTime0*10
- end,
- ?line WaitTime = case {erlang:system_info(schedulers_online),
- erlang:system_info(logical_processors)} of
- {Schdlrs, CPUs} when is_integer(CPUs),
- Schdlrs =< CPUs ->
- WaitTime1;
- _ ->
- WaitTime1*10
- end,
- ?line receive after WaitTime -> ok end,
- ?line 1 = suspend_count(Tok),
- ?line erlang:suspend_process(Tok, [asynchronous]),
- ?line 2 = suspend_count(Tok),
- ?line erlang:suspend_process(Tok, [asynchronous]),
- ?line 3 = suspend_count(Tok),
- ?line erlang:suspend_process(Tok),
- ?line 4 = suspend_count(Tok),
- ?line erlang:suspend_process(Tok),
- ?line 5 = suspend_count(Tok),
- ?line erlang:suspend_process(Tok, [unless_suspending]),
- ?line 5 = suspend_count(Tok),
- ?line erlang:suspend_process(Tok, [unless_suspending,
- asynchronous]),
- ?line 5 = suspend_count(Tok),
- ?line erlang:resume_process(Tok),
- ?line erlang:resume_process(Tok),
- ?line erlang:resume_process(Tok),
- ?line erlang:resume_process(Tok),
- ?line 1 = suspend_count(Tok),
- ?line ?t:format("Main suspends: ~p~n"
- "Main async: ~p~n"
- "Double async: ~p~n"
- "Async once: ~p~n"
- "Synced: ~p~n",
- [TC,
- SI#susp_info.async,
- SI#susp_info.dbl_async,
- SI#susp_info.async_once,
- SI#susp_info.synced]),
- ?line case erlang:system_info(schedulers_online) of
- 1 ->
- ?line ok;
- _ ->
- ?line true = SI#susp_info.async =/= 0
- end,
- ?line unlink(Tok),
- ?line exit(Tok, bang),
- ?line test_server:timetrap_cancel(Dog),
- ?line ok.
+ WaitTime0 = 10,
+ WaitTime1 = case {erlang:system_info(debug_compiled),
+ erlang:system_info(lock_checking)} of
+ {false, false} ->
+ WaitTime0;
+ {false, true} ->
+ WaitTime0*5;
+ _ ->
+ WaitTime0*10
+ end,
+ WaitTime = case {erlang:system_info(schedulers_online),
+ erlang:system_info(logical_processors)} of
+ {Schdlrs, CPUs} when is_integer(CPUs),
+ Schdlrs =< CPUs ->
+ WaitTime1;
+ _ ->
+ WaitTime1*10
+ end,
+ receive after WaitTime -> ok end,
+ 1 = suspend_count(Tok),
+ erlang:suspend_process(Tok, [asynchronous]),
+ 2 = suspend_count(Tok),
+ erlang:suspend_process(Tok, [asynchronous]),
+ 3 = suspend_count(Tok),
+ erlang:suspend_process(Tok),
+ 4 = suspend_count(Tok),
+ erlang:suspend_process(Tok),
+ 5 = suspend_count(Tok),
+ erlang:suspend_process(Tok, [unless_suspending]),
+ 5 = suspend_count(Tok),
+ erlang:suspend_process(Tok, [unless_suspending,
+ asynchronous]),
+ 5 = suspend_count(Tok),
+ erlang:resume_process(Tok),
+ erlang:resume_process(Tok),
+ erlang:resume_process(Tok),
+ erlang:resume_process(Tok),
+ 1 = suspend_count(Tok),
+ io:format("Main suspends: ~p~n"
+ "Main async: ~p~n"
+ "Double async: ~p~n"
+ "Async once: ~p~n"
+ "Synced: ~p~n",
+ [TC,
+ SI#susp_info.async,
+ SI#susp_info.dbl_async,
+ SI#susp_info.async_once,
+ SI#susp_info.synced]),
+ case erlang:system_info(schedulers_online) of
+ 1 ->
+ ok;
+ _ ->
+ true = SI#susp_info.async =/= 0
+ end,
+ unlink(Tok),
+ exit(Tok, bang),
+ ok.
suspend_count(Suspendee) ->
suspend_count(self(), Suspendee).
suspend_count(Suspender, Suspendee) ->
{suspending, SList} = process_info(Suspender, suspending),
-
+
case lists:keysearch(Suspendee, 1, SList) of
- {value, {_Suspendee, 0, 0}} ->
- ?line ?t:fail({bad_suspendee_list, SList});
- {value, {Suspendee, Count, 0}} when is_integer(Count), Count > 0 ->
- {status, suspended} = process_info(Suspendee, status),
- Count;
- {value, {Suspendee, 0, Outstanding}} when is_integer(Outstanding),
- Outstanding > 0 ->
- 0;
- false ->
- 0;
- Error ->
- ?line ?t:fail({bad_suspendee_list, Error, SList})
+ {value, {_Suspendee, 0, 0}} ->
+ ct:fail({bad_suspendee_list, SList});
+ {value, {Suspendee, Count, 0}} when is_integer(Count), Count > 0 ->
+ {status, suspended} = process_info(Suspendee, status),
+ Count;
+ {value, {Suspendee, 0, Outstanding}} when is_integer(Outstanding),
+ Outstanding > 0 ->
+ 0;
+ false ->
+ 0;
+ Error ->
+ ct:fail({bad_suspendee_list, Error, SList})
end.
-
+
repeat_acc(Fun, N, Acc) ->
repeat_acc(Fun, 0, N, Acc).
@@ -1306,121 +1204,100 @@ repeat_acc(_Fun, N, N, Acc) ->
Acc;
repeat_acc(Fun, N, M, Acc) ->
repeat_acc(Fun, N+1, M, Fun(N, Acc)).
-
+
%% Tests that waiting process can be suspended
%% (bug in R2D and earlier; see OTP-1488).
-suspend_waiting(doc) -> "Test that a waiting process can be suspended.";
+%% Test that a waiting process can be suspended.
suspend_waiting(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
-
- ?line Process = fun_spawn(fun process/0),
- ?line receive after 1 -> ok end,
- ?line true = erlang:suspend_process(Process),
- ?line {status, suspended} = process_info(Process, status),
-
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ Process = fun_spawn(fun process/0),
+ receive after 1 -> ok end,
+ true = erlang:suspend_process(Process),
+ {status, suspended} = process_info(Process, status),
ok.
-
-new_clear(doc) ->
- "Test that erlang:trace(new, true, ...) is cleared when tracer dies.";
+%% Test that erlang:trace(new, true, ...) is cleared when tracer dies.
new_clear(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
-
- ?line Tracer = spawn(fun receiver/0),
- ?line 0 = erlang:trace(new, true, [send, {tracer, Tracer}]),
- ?line {flags, [send]} = erlang:trace_info(new, flags),
- ?line {tracer, Tracer} = erlang:trace_info(new, tracer),
- ?line Mref = erlang:monitor(process, Tracer),
- ?line true = exit(Tracer, done),
+ Tracer = spawn(fun receiver/0),
+ 0 = erlang:trace(new, true, [send, {tracer, Tracer}]),
+ {flags, [send]} = erlang:trace_info(new, flags),
+ {tracer, Tracer} = erlang:trace_info(new, tracer),
+ Mref = erlang:monitor(process, Tracer),
+ true = exit(Tracer, done),
receive
- {'DOWN',Mref,_,_,_} -> ok
+ {'DOWN',Mref,_,_,_} -> ok
end,
- ?line {flags, []} = erlang:trace_info(new, flags),
- ?line {tracer, []} = erlang:trace_info(new, tracer),
-
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
-
+ {flags, []} = erlang:trace_info(new, flags),
+ {tracer, []} = erlang:trace_info(new, tracer),
ok.
-existing_clear(doc) ->
- "Test that erlang:trace(all, false, ...) works without tracer.";
+%% Test that erlang:trace(all, false, ...) works without tracer.
existing_clear(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(5)),
- ?line Self = self(),
-
- ?line Tracer = fun_spawn(fun receiver/0),
- ?line N = erlang:trace(existing, true, [send, {tracer, Tracer}]),
- ?line {flags, [send]} = erlang:trace_info(Self, flags),
- ?line {tracer, Tracer} = erlang:trace_info(Self, tracer),
- ?line M = erlang:trace(all, false, [all]),
- ?line io:format("Started trace on ~p processes and stopped on ~p~n",
- [N, M]),
- ?line {flags, []} = erlang:trace_info(Self, flags),
- ?line {tracer, []} = erlang:trace_info(Self, tracer),
- ?line M = N + 1, % Since trace could not be enabled on the tracer.
+ Self = self(),
- %% Done.
- ?line test_server:timetrap_cancel(Dog),
+ Tracer = fun_spawn(fun receiver/0),
+ N = erlang:trace(existing, true, [send, {tracer, Tracer}]),
+ {flags, [send]} = erlang:trace_info(Self, flags),
+ {tracer, Tracer} = erlang:trace_info(Self, tracer),
+ M = erlang:trace(all, false, [all]),
+ io:format("Started trace on ~p processes and stopped on ~p~n",
+ [N, M]),
+ {flags, []} = erlang:trace_info(Self, flags),
+ {tracer, []} = erlang:trace_info(Self, tracer),
+ M = N + 1, % Since trace could not be enabled on the tracer.
ok.
-bad_flag(doc) -> "Test that an invalid flag cause badarg";
-bad_flag(suite) -> [];
+%% Test that an invalid flag cause badarg
bad_flag(Config) when is_list(Config) ->
%% A bad flag could deadlock the SMP emulator in erts-5.5
- ?line {'EXIT', {badarg, _}} = (catch erlang:trace(new,
- true,
- [not_a_valid_flag])),
- ?line ok.
+ {'EXIT', {badarg, _}} = (catch erlang:trace(new,
+ true,
+ [not_a_valid_flag])),
+ ok.
-trace_delivered(doc) -> "Test erlang:trace_delivered/1";
-trace_delivered(suite) -> [];
+%% Test erlang:trace_delivered/1
trace_delivered(Config) when is_list(Config) ->
- ?line Dog = test_server:timetrap(test_server:seconds(60)),
- ?line TokLoops = 10000,
- ?line Go = make_ref(),
- ?line Parent = self(),
- ?line Tok = spawn(fun () ->
- receive Go -> gone end,
- tok_trace_loop(Parent, 0, TokLoops)
- end),
- ?line 1 = erlang:trace(Tok, true, [procs]),
- ?line Mon = erlang:monitor(process, Tok),
- ?line NoOfTraceMessages = 4*TokLoops + 1,
- ?line io:format("Expect a total of ~p trace messages~n",
- [NoOfTraceMessages]),
- ?line Tok ! Go,
- ?line NoOfTraceMessages = drop_trace_until_down(Tok, Mon),
- ?line receive
- Msg ->
- ?line ?t:fail({unexpected_message, Msg})
- after 1000 ->
- ?line test_server:timetrap_cancel(Dog),
- ?line ok
- end.
+ ct:timetrap({minutes, 1}),
+ TokLoops = 10000,
+ Go = make_ref(),
+ Parent = self(),
+ Tok = spawn(fun () ->
+ receive Go -> gone end,
+ tok_trace_loop(Parent, 0, TokLoops)
+ end),
+ 1 = erlang:trace(Tok, true, [procs]),
+ Mon = erlang:monitor(process, Tok),
+ NoOfTraceMessages = 4*TokLoops + 1,
+ io:format("Expect a total of ~p trace messages~n",
+ [NoOfTraceMessages]),
+ Tok ! Go,
+ NoOfTraceMessages = drop_trace_until_down(Tok, Mon),
+ receive
+ Msg ->
+ ct:fail({unexpected_message, Msg})
+ after 1000 ->
+ ok
+ end.
drop_trace_until_down(Proc, Mon) ->
drop_trace_until_down(Proc, Mon, false, 0, 0).
drop_trace_until_down(Proc, Mon, TDRef, N, D) ->
case receive Msg -> Msg end of
- {trace_delivered, Proc, TDRef} ->
- io:format("~p trace messages on 'DOWN'~n", [D]),
- io:format("Got a total of ~p trace messages~n", [N]),
- N;
- {'DOWN', Mon, process, Proc, _} ->
- Ref = erlang:trace_delivered(Proc),
- drop_trace_until_down(Proc, Mon, Ref, N, N);
- Trace when is_tuple(Trace),
- element(1, Trace) == trace,
- element(2, Trace) == Proc ->
- drop_trace_until_down(Proc, Mon, TDRef, N+1, D)
+ {trace_delivered, Proc, TDRef} ->
+ io:format("~p trace messages on 'DOWN'~n", [D]),
+ io:format("Got a total of ~p trace messages~n", [N]),
+ N;
+ {'DOWN', Mon, process, Proc, _} ->
+ Ref = erlang:trace_delivered(Proc),
+ drop_trace_until_down(Proc, Mon, Ref, N, N);
+ Trace when is_tuple(Trace),
+ element(1, Trace) == trace,
+ element(2, Trace) == Proc ->
+ drop_trace_until_down(Proc, Mon, TDRef, N+1, D)
end.
tok_trace_loop(_, N, N) ->
@@ -1437,17 +1314,17 @@ tok_trace_loop(Parent, N, M) ->
receive_first() ->
receive
- Any -> Any
+ Any -> Any
end.
%% Ensures that there is no message in the message queue.
receive_nothing() ->
receive
- Any ->
- test_server:fail({unexpected_message, Any})
+ Any ->
+ ct:fail({unexpected_message, Any})
after 200 ->
- ok
+ ok
end.
@@ -1455,39 +1332,39 @@ receive_nothing() ->
process(Dest) ->
receive
- {send_please, To, What} ->
- To ! What,
- process(Dest);
- {spawn_link_please, ReplyTo, {M, F, A}} ->
- Pid = spawn_link(M, F, A),
- ReplyTo ! {spawned, self(), Pid},
- process(Dest);
- {spawn_link_please, ReplyTo, Node, {M, F, A}} ->
- Pid = spawn_link(Node, M, F, A),
- ReplyTo ! {spawned, self(), Pid},
- process(Dest);
- {link_please, Pid} ->
- link(Pid),
- process(Dest);
- {unlink_please, Pid} ->
- unlink(Pid),
- process(Dest);
- {register_please, Name, Pid} ->
- register(Name, Pid),
- process(Dest);
- {unregister_please, Name} ->
- unregister(Name),
- process(Dest);
- {exit_please, Reason} ->
- exit(Reason);
- {trap_exit_please, State} ->
- process_flag(trap_exit, State),
- process(Dest);
- Other ->
- Dest ! {self(), Other},
- process(Dest)
+ {send_please, To, What} ->
+ To ! What,
+ process(Dest);
+ {spawn_link_please, ReplyTo, {M, F, A}} ->
+ Pid = spawn_link(M, F, A),
+ ReplyTo ! {spawned, self(), Pid},
+ process(Dest);
+ {spawn_link_please, ReplyTo, Node, {M, F, A}} ->
+ Pid = spawn_link(Node, M, F, A),
+ ReplyTo ! {spawned, self(), Pid},
+ process(Dest);
+ {link_please, Pid} ->
+ link(Pid),
+ process(Dest);
+ {unlink_please, Pid} ->
+ unlink(Pid),
+ process(Dest);
+ {register_please, Name, Pid} ->
+ register(Name, Pid),
+ process(Dest);
+ {unregister_please, Name} ->
+ unregister(Name),
+ process(Dest);
+ {exit_please, Reason} ->
+ exit(Reason);
+ {trap_exit_please, State} ->
+ process_flag(trap_exit, State),
+ process(Dest);
+ Other ->
+ Dest ! {self(), Other},
+ process(Dest)
after 3000 ->
- exit(timeout)
+ exit(timeout)
end.
@@ -1495,17 +1372,17 @@ process(Dest) ->
process() ->
receive
- {spawn_please, ReplyTo, Fun} ->
- Pid = fun_spawn(Fun),
- ReplyTo ! {spawned, Pid},
- process();
- {send_please, To, What} ->
- To ! What,
- process();
- timeout_please ->
- receive after 1 -> process() end;
- _Other ->
- process()
+ {spawn_please, ReplyTo, Fun} ->
+ Pid = fun_spawn(Fun),
+ ReplyTo ! {spawned, Pid},
+ process();
+ {send_please, To, What} ->
+ To ! What,
+ process();
+ timeout_please ->
+ receive after 1 -> process() end;
+ _Other ->
+ process()
end.
@@ -1513,9 +1390,9 @@ process() ->
sender() ->
receive
- {send_please, To, What} ->
- To ! What,
- sender()
+ {send_please, To, What} ->
+ To ! What,
+ sender()
end.
@@ -1523,7 +1400,7 @@ sender() ->
receiver() ->
receive
- _Any -> receiver()
+ _Any -> receiver()
end.
%% Works as long as it receives CPU time. Will always be RUNNABLE.
@@ -1545,7 +1422,7 @@ start_node(Name) ->
Pa = filename:dirname(code:which(?MODULE)),
Cookie = atom_to_list(erlang:get_cookie()),
test_server:start_node(Name, slave,
- [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]).
+ [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]).
stop_node(Node) ->
test_server:stop_node(Node).
@@ -1553,11 +1430,11 @@ stop_node(Node) ->
wait_for_empty_runq(DeadLine) ->
case statistics(run_queue) of
- 0 -> true;
- RQLen ->
- erlang:display("Waiting for empty run queue"),
- MSDL = DeadLine*1000,
- wait_for_empty_runq(MSDL, MSDL, RQLen)
+ 0 -> true;
+ RQLen ->
+ erlang:display("Waiting for empty run queue"),
+ MSDL = DeadLine*1000,
+ wait_for_empty_runq(MSDL, MSDL, RQLen)
end.
wait_for_empty_runq(DeadLine, Left, RQLen) when Left =< 0 ->
@@ -1568,48 +1445,48 @@ wait_for_empty_runq(DeadLine, Left, _RQLen) ->
UntilDeadLine = Left - Wait,
receive after Wait -> ok end,
case statistics(run_queue) of
- 0 ->
- erlang:display("Waited for "
- ++ integer_to_list(DeadLine
- - UntilDeadLine)
- ++ " ms for empty run queue."),
- true;
- NewRQLen ->
- wait_for_empty_runq(DeadLine,
- UntilDeadLine,
- NewRQLen)
+ 0 ->
+ erlang:display("Waited for "
+ ++ integer_to_list(DeadLine
+ - UntilDeadLine)
+ ++ " ms for empty run queue."),
+ true;
+ NewRQLen ->
+ wait_for_empty_runq(DeadLine,
+ UntilDeadLine,
+ NewRQLen)
end.
issue_non_empty_runq_warning(DeadLine, RQLen) ->
PIs = lists:foldl(
- fun (P, Acc) ->
- case process_info(P,
- [status,
- initial_call,
- current_function,
- registered_name,
- reductions,
- message_queue_len]) of
- [{status, Runnable} | _] = PI when Runnable /= waiting,
- Runnable /= suspended ->
- [[{pid, P} | PI] | Acc];
- _ ->
- Acc
- end
- end,
- [],
- processes()),
- ?t:format("WARNING: Unexpected runnable processes in system (waited ~p sec).~n"
- " Run queue length: ~p~n"
- " Self: ~p~n"
- " Processes info: ~p~n",
- [DeadLine div 1000, RQLen, self(), PIs]),
+ fun (P, Acc) ->
+ case process_info(P,
+ [status,
+ initial_call,
+ current_function,
+ registered_name,
+ reductions,
+ message_queue_len]) of
+ [{status, Runnable} | _] = PI when Runnable /= waiting,
+ Runnable /= suspended ->
+ [[{pid, P} | PI] | Acc];
+ _ ->
+ Acc
+ end
+ end,
+ [],
+ processes()),
+ io:format("WARNING: Unexpected runnable processes in system (waited ~p sec).~n"
+ " Run queue length: ~p~n"
+ " Self: ~p~n"
+ " Processes info: ~p~n",
+ [DeadLine div 1000, RQLen, self(), PIs]),
receive after 1000 -> ok end.
load_driver(Dir, Driver) ->
case erl_ddll:load_driver(Dir, Driver) of
- ok -> ok;
- {error, Error} = Res ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- Res
+ ok -> ok;
+ {error, Error} = Res ->
+ io:format("~s\n", [erl_ddll:format_error(Error)]),
+ Res
end.
diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl
index a12c41a3aa..b774210456 100644
--- a/erts/emulator/test/trace_bif_SUITE.erl
+++ b/erts/emulator/test/trace_bif_SUITE.erl
@@ -20,10 +20,9 @@
-module(trace_bif_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
+-export([all/0, suite/0]).
-export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1,
trace_bif_local/1,
trace_bif_timestamp_local/1, trace_bif_return/1, not_run/1,
@@ -42,252 +41,307 @@ all() ->
trace_bif_return, trace_info_old_code]
end.
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
-trace_on_and_off(doc) ->
- "Tests switching tracing on and off.";
+%% Tests switching tracing on and off.
trace_on_and_off(Config) when is_list(Config) ->
- ?line Pid = spawn(?MODULE, bif_process, []),
- ?line Self = self(),
- ?line 1 = erlang:trace(Pid, true, [call,timestamp]),
- ?line {flags,[timestamp,call]} = erlang:trace_info(Pid,flags),
- ?line {tracer, Self} = erlang:trace_info(Pid,tracer),
- ?line 1 = erlang:trace(Pid, false, [timestamp]),
- ?line {flags,[call]} = erlang:trace_info(Pid,flags),
- ?line {tracer, Self} = erlang:trace_info(Pid,tracer),
- ?line 1 = erlang:trace(Pid, false, [call]),
- ?line {flags,[]} = erlang:trace_info(Pid,flags),
- ?line {tracer, []} = erlang:trace_info(Pid,tracer),
- ?line exit(Pid,kill),
+ Pid = spawn(?MODULE, bif_process, []),
+ Self = self(),
+ 1 = erlang:trace(Pid, true, [call,timestamp]),
+ {flags, Flags} = erlang:trace_info(Pid,flags),
+ [call,timestamp] = lists:sort(Flags),
+ {tracer, Self} = erlang:trace_info(Pid,tracer),
+ 1 = erlang:trace(Pid, false, [timestamp]),
+ {flags,[call]} = erlang:trace_info(Pid,flags),
+ {tracer, Self} = erlang:trace_info(Pid,tracer),
+ 1 = erlang:trace(Pid, false, [call]),
+ {flags,[]} = erlang:trace_info(Pid,flags),
+ {tracer, []} = erlang:trace_info(Pid,tracer),
+ exit(Pid,kill),
ok.
-trace_bif(doc) -> "Test tracing BIFs.";
+%% Test tracing BIFs.
trace_bif(Config) when is_list(Config) ->
do_trace_bif([]).
-trace_bif_local(doc) -> "Test tracing BIFs with local flag.";
+%% Test tracing BIFs with local flag.
trace_bif_local(Config) when is_list(Config) ->
do_trace_bif([local]).
do_trace_bif(Flags) ->
- ?line Pid = spawn(?MODULE, bif_process, []),
- ?line 1 = erlang:trace(Pid, true, [call]),
- ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags),
- ?line Pid ! {do_bif, time, []},
- ?line receive_trace_msg({trace,Pid,call,{erlang,time, []}}),
- ?line Pid ! {do_bif, statistics, [runtime]},
- ?line receive_trace_msg({trace,Pid,call,
- {erlang,statistics, [runtime]}}),
-
- ?line Pid ! {do_time_bif},
- ?line receive_trace_msg({trace,Pid,call,
- {erlang,time, []}}),
-
- ?line Pid ! {do_statistics_bif},
- ?line receive_trace_msg({trace,Pid,call,
- {erlang,statistics, [runtime]}}),
-
- ?line 1 = erlang:trace(Pid, false, [call]),
- ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags),
- ?line exit(Pid, die),
+ Pid = spawn(?MODULE, bif_process, []),
+ 1 = erlang:trace(Pid, true, [call]),
+ erlang:trace_pattern({erlang,'_','_'}, [], Flags),
+ Pid ! {do_bif, time, []},
+ receive_trace_msg({trace,Pid,call,{erlang,time, []}}),
+ Pid ! {do_bif, statistics, [runtime]},
+ receive_trace_msg({trace,Pid,call,
+ {erlang,statistics, [runtime]}}),
+
+ Pid ! {do_time_bif},
+ receive_trace_msg({trace,Pid,call,
+ {erlang,time, []}}),
+
+ Pid ! {do_statistics_bif},
+ receive_trace_msg({trace,Pid,call,
+ {erlang,statistics, [runtime]}}),
+
+ 1 = erlang:trace(Pid, false, [call]),
+ erlang:trace_pattern({erlang,'_','_'}, false, Flags),
+ exit(Pid, die),
ok.
-trace_bif_timestamp(doc) -> "Test tracing BIFs with timestamps.";
+%% Test tracing BIFs with timestamps.
trace_bif_timestamp(Config) when is_list(Config) ->
- do_trace_bif_timestamp([]).
-
-trace_bif_timestamp_local(doc) ->
- "Test tracing BIFs with timestamps and local flag.";
+ do_trace_bif_timestamp([], timestamp, [timestamp]),
+ do_trace_bif_timestamp([], timestamp,
+ [timestamp,
+ monotonic_timestamp,
+ strict_monotonic_timestamp]),
+ do_trace_bif_timestamp([], strict_monotonic_timestamp,
+ [strict_monotonic_timestamp]),
+ do_trace_bif_timestamp([], strict_monotonic_timestamp,
+ [monotonic_timestamp, strict_monotonic_timestamp]),
+ do_trace_bif_timestamp([], monotonic_timestamp, [monotonic_timestamp]).
+
+%% Test tracing BIFs with timestamps and local flag.
trace_bif_timestamp_local(Config) when is_list(Config) ->
- do_trace_bif_timestamp([local]).
-
-do_trace_bif_timestamp(Flags) ->
- ?line Pid=spawn(?MODULE, bif_process, []),
- ?line 1 = erlang:trace(Pid, true, [call,timestamp]),
- ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags),
-
- ?line Pid ! {do_bif, time, []},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}),
-
- ?line Pid ! {do_bif, statistics, [runtime]},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {erlang,statistics, [runtime]}}),
-
- ?line Pid ! {do_time_bif},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {erlang,time, []}}),
-
- ?line Pid ! {do_statistics_bif},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {erlang,statistics, [runtime]}}),
+ do_trace_bif_timestamp([local], timestamp, [timestamp]),
+ do_trace_bif_timestamp([local], timestamp,
+ [timestamp,
+ monotonic_timestamp,
+ strict_monotonic_timestamp]),
+ do_trace_bif_timestamp([local], strict_monotonic_timestamp,
+ [strict_monotonic_timestamp]),
+ do_trace_bif_timestamp([local], strict_monotonic_timestamp,
+ [monotonic_timestamp, strict_monotonic_timestamp]),
+ do_trace_bif_timestamp([local], monotonic_timestamp, [monotonic_timestamp]).
+
+do_trace_bif_timestamp(Flags, TsType, TsFlags) ->
+ io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]),
+ Pid=spawn(?MODULE, bif_process, []),
+ 1 = erlang:trace(Pid, true, [call]++TsFlags),
+ erlang:trace_pattern({erlang,'_','_'}, [], Flags),
+
+ Ts0 = make_ts(TsType),
+ Pid ! {do_bif, time, []},
+ Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}},
+ Ts0,TsType),
+
+ Pid ! {do_bif, statistics, [runtime]},
+ Ts2 = receive_trace_msg_ts({trace_ts,Pid,call,
+ {erlang,statistics, [runtime]}},
+ Ts1, TsType),
+
+ Pid ! {do_time_bif},
+ Ts3 = receive_trace_msg_ts({trace_ts,Pid,call,
+ {erlang,time, []}},
+ Ts2, TsType),
+
+ Pid ! {do_statistics_bif},
+ Ts4 = receive_trace_msg_ts({trace_ts,Pid,call,
+ {erlang,statistics, [runtime]}},
+ Ts3, TsType),
+
+ check_ts(TsType, Ts4, make_ts(TsType)),
%% We should be able to turn off the timestamp.
- ?line 1 = erlang:trace(Pid, false, [timestamp]),
+ 1 = erlang:trace(Pid, false, TsFlags),
- ?line Pid ! {do_statistics_bif},
- ?line receive_trace_msg({trace,Pid,call,
- {erlang,statistics, [runtime]}}),
+ Pid ! {do_statistics_bif},
+ receive_trace_msg({trace,Pid,call,
+ {erlang,statistics, [runtime]}}),
- ?line Pid ! {do_bif, statistics, [runtime]},
- ?line receive_trace_msg({trace,Pid,call,
- {erlang,statistics, [runtime]}}),
+ Pid ! {do_bif, statistics, [runtime]},
+ receive_trace_msg({trace,Pid,call,
+ {erlang,statistics, [runtime]}}),
- ?line 1 = erlang:trace(Pid, false, [call]),
- ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags),
+ 1 = erlang:trace(Pid, false, [call]),
+ erlang:trace_pattern({erlang,'_','_'}, false, Flags),
- ?line exit(Pid, die),
+ exit(Pid, die),
ok.
-trace_bif_return(doc) ->
- "Test tracing BIF's with return/return_to trace.";
+%% Test tracing BIF's with return/return_to trace.
trace_bif_return(Config) when is_list(Config) ->
- ?line Pid=spawn(?MODULE, bif_process, []),
- ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]),
- ?line erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}],
- [local]),
-
-
- ?line Pid ! {do_bif, time, []},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}),
- ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
- {erlang,time,0}}),
- ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
- {?MODULE, bif_process,0}}),
-
-
- ?line Pid ! {do_bif, statistics, [runtime]},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {erlang,statistics, [runtime]}}),
- ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
- {erlang,statistics,1}}),
- ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
- {?MODULE, bif_process,0}}),
-
-
- ?line Pid ! {do_time_bif},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {erlang,time, []}}),
- ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
- {erlang,time,0}}),
- ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
- {?MODULE, bif_process,0}}),
-
-
-
- ?line Pid ! {do_statistics_bif},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {erlang,statistics, [runtime]}}),
- ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
- {erlang,statistics,1}}),
- ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
- {?MODULE, bif_process,0}}),
+ do_trace_bif_return(timestamp, [timestamp]),
+ do_trace_bif_return(timestamp,
+ [timestamp,
+ monotonic_timestamp,
+ strict_monotonic_timestamp]),
+ do_trace_bif_return(strict_monotonic_timestamp,
+ [strict_monotonic_timestamp]),
+ do_trace_bif_return(strict_monotonic_timestamp,
+ [monotonic_timestamp, strict_monotonic_timestamp]),
+ do_trace_bif_return(monotonic_timestamp, [monotonic_timestamp]).
+
+do_trace_bif_return(TsType, TsFlags) ->
+ io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]),
+ Pid=spawn(?MODULE, bif_process, []),
+ 1 = erlang:trace(Pid, true, [call,return_to]++TsFlags),
+ erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}],
+ [local]),
+
+ Ts0 = make_ts(TsType),
+ Pid ! {do_bif, time, []},
+ Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}},
+ Ts0, TsType),
+ Ts2 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+ {erlang,time,0}},
+ Ts1, TsType),
+ Ts3 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
+ {?MODULE, bif_process,0}},
+ Ts2, TsType),
+
+
+ Pid ! {do_bif, statistics, [runtime]},
+ Ts4 = receive_trace_msg_ts({trace_ts,Pid,call,
+ {erlang,statistics, [runtime]}},
+ Ts3, TsType),
+ Ts5 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+ {erlang,statistics,1}},
+ Ts4, TsType),
+ Ts6 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
+ {?MODULE, bif_process,0}},
+ Ts5, TsType),
+
+
+ Pid ! {do_time_bif},
+ Ts7 = receive_trace_msg_ts({trace_ts,Pid,call,
+ {erlang,time, []}},
+ Ts6, TsType),
+ Ts8 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+ {erlang,time,0}},
+ Ts7, TsType),
+ Ts9 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
+ {?MODULE, bif_process,0}},
+ Ts8, TsType),
+
+
+
+ Pid ! {do_statistics_bif},
+ Ts10 = receive_trace_msg_ts({trace_ts,Pid,call,
+ {erlang,statistics, [runtime]}},
+ Ts9, TsType),
+ Ts11 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+ {erlang,statistics,1}},
+ Ts10, TsType),
+ Ts12 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
+ {?MODULE, bif_process,0}},
+ Ts11, TsType),
+ check_ts(TsType, Ts12, make_ts(TsType)),
ok.
-
-
+
+
receive_trace_msg(Mess) ->
receive
- Mess ->
- ok;
- Other ->
- io:format("Expected: ~p,~nGot: ~p~n", [Mess, Other]),
- ?t:fail()
+ Mess ->
+ ok;
+ Other ->
+ ct:fail("Expected: ~p,~nGot: ~p~n", [Mess, Other])
after 5000 ->
- io:format("Expected: ~p,~nGot: timeout~n", [Mess]),
- ?t:fail()
+ ct:fail("Expected: ~p,~nGot: timeout~n", [Mess])
end.
-receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) ->
+receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) ->
receive
- {trace_ts, Pid, call, {erlang, F, A}, _Ts} ->
- ok;
- Other ->
- io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n"
- "Got: ~p~n",
- [Pid, erlang, F, A, Other]),
- ?t:fail()
- after 5000 ->
- io:format("Got timeout~n", []),
- ?t:fail()
+ {trace_ts, Pid, call, {erlang, F, A}, Ts} ->
+ check_ts(TsType, PrevTs, Ts),
+ Ts;
+ Other ->
+ ct:fail("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n"
+ "Got: ~p~n",
+ [Pid, erlang, F, A, Other])
+ after 5000 ->
+ ct:fail("Got timeout~n", [])
end.
-receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) ->
+receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, PrevTs, TsType) ->
receive
- {trace_ts, Pid, return_from, {erlang, F, A}, _Value, _Ts} ->
- ok;
- Other ->
- io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n"
- "Got: ~p~n",
- [Pid, erlang, F, A, Other]),
- ?t:fail()
- after 5000 ->
- io:format("Got timeout~n", []),
- ?t:fail()
+ {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} ->
+ check_ts(TsType, PrevTs, Ts),
+ Ts;
+ Other ->
+ ct:fail("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n"
+ "Got: ~p~n", [Pid, erlang, F, A, Other])
+ after 5000 ->
+ ct:fail("Got timeout~n", [])
end.
-receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) ->
+receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsType) ->
receive
- {trace_ts, Pid, return_to, {M, F, A}, _Ts} ->
- ok;
- Other ->
- io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n"
- "Got: ~p~n",
- [Pid, M, F, A, Other]),
- ?t:fail()
- after 5000 ->
- io:format("Got timeout~n", []),
- ?t:fail()
+ {trace_ts, Pid, return_to, {M, F, A}, Ts} ->
+ check_ts(TsType, PrevTs, Ts),
+ Ts;
+ Other ->
+ ct:fail("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n"
+ "Got: ~p~n", [Pid, M, F, A, Other])
+ after 5000 ->
+ ct:fail("Got timeout~n", [])
end.
+make_ts(timestamp) ->
+ erlang:now();
+make_ts(monotonic_timestamp) ->
+ erlang:monotonic_time(nano_seconds);
+make_ts(strict_monotonic_timestamp) ->
+ MT = erlang:monotonic_time(nano_seconds),
+ UMI = erlang:unique_integer([monotonic]),
+ {MT, UMI}.
+
+check_ts(timestamp, PrevTs, Ts) ->
+ {Ms, S, Us} = Ts,
+ true = is_integer(Ms),
+ true = is_integer(S),
+ true = is_integer(Us),
+ true = PrevTs < Ts,
+ Ts;
+check_ts(monotonic_timestamp, PrevTs, Ts) ->
+ true = is_integer(Ts),
+ true = PrevTs =< Ts,
+ Ts;
+check_ts(strict_monotonic_timestamp, PrevTs, Ts) ->
+ {MT, UMI} = Ts,
+ true = is_integer(MT),
+ true = is_integer(UMI),
+ true = PrevTs < Ts,
+ Ts.
+
bif_process() ->
receive
- {do_bif, Name, Args} ->
- apply(erlang, Name, Args),
- bif_process();
- {do_time_bif} ->
- %% Match the return value to ensure that the time() call
- %% is not optimized away.
- {_,_,_} = time(),
- bif_process();
- {do_statistics_bif} ->
- statistics(runtime),
- bif_process();
- _Stuff ->
- bif_process()
+ {do_bif, Name, Args} ->
+ apply(erlang, Name, Args),
+ bif_process();
+ {do_time_bif} ->
+ %% Match the return value to ensure that the time() call
+ %% is not optimized away.
+ {_,_,_} = time(),
+ bif_process();
+ {do_statistics_bif} ->
+ statistics(runtime),
+ bif_process();
+ _Stuff ->
+ bif_process()
end.
-
-trace_info_old_code(doc) -> "trace_info on deleted module (OTP-5057).";
+
+%% trace_info on deleted module (OTP-5057).
trace_info_old_code(Config) when is_list(Config) ->
- ?line MFA = {M,F,0} = {test,foo,0},
- ?line Fname = atom_to_list(M)++".erl",
- ?line AbsForms =
- [{attribute,a(1),module,M}, % -module(M).
- {attribute,a(2),export,[{F,0}]}, % -export([F/0]).
- {function,a(3),F,0, % F() ->
- [{clause,a(4),[],[],[{atom,a(4),F}]}]}], % F.
+ MFA = {M,F,0} = {test,foo,0},
+ Fname = atom_to_list(M)++".erl",
+ AbsForms =
+ [{attribute,a(1),module,M}, % -module(M).
+ {attribute,a(2),export,[{F,0}]}, % -export([F/0]).
+ {function,a(3),F,0, % F() ->
+ [{clause,a(4),[],[],[{atom,a(4),F}]}]}], % F.
%%
- ?line {ok,M,Mbin} = compile:forms(AbsForms),
- ?line {module,M} = code:load_binary(M, Fname, Mbin),
- ?line true = erlang:delete_module(M),
- ?line {traced,undefined} = erlang:trace_info(MFA, traced),
+ {ok,M,Mbin} = compile:forms(AbsForms),
+ {module,M} = code:load_binary(M, Fname, Mbin),
+ true = erlang:delete_module(M),
+ {traced,undefined} = erlang:trace_info(MFA, traced),
ok.
a(L) ->
diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl
index c7881bbd70..c849668e84 100644
--- a/erts/emulator/test/trace_call_count_SUITE.erl
+++ b/erts/emulator/test/trace_call_count_SUITE.erl
@@ -43,7 +43,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
-ifdef(debug).
@@ -70,18 +70,17 @@ config(priv_dir,_) ->
pause_and_restart/1, combo/1]).
init_per_testcase(_Case, Config) ->
- ?line Dog=test_server:timetrap(test_server:seconds(30)),
- [{watchdog, Dog}|Config].
+ Config.
-end_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, _Config) ->
erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]),
erlang:trace_pattern(on_load, false, [local,meta,call_count]),
erlang:trace(all, false, [all]),
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
ok.
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
case test_server:is_native(trace_call_count_SUITE) of
@@ -109,38 +108,23 @@ end_per_group(_GroupName, Config) ->
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
-basic(suite) ->
- [];
-basic(doc) ->
- ["Tests basic call count trace"];
+%% Tests basic call count trace
basic(Config) when is_list(Config) ->
basic_test().
-on_and_off(suite) ->
- [];
-on_and_off(doc) ->
- ["Tests turning trace parameters on and off"];
+%% Tests turning trace parameters on and off
on_and_off(Config) when is_list(Config) ->
on_and_off_test().
-info(suite) ->
- [];
-info(doc) ->
- ["Tests the trace_info BIF"];
+%% Tests the trace_info BIF
info(Config) when is_list(Config) ->
info_test().
-pause_and_restart(suite) ->
- [];
-pause_and_restart(doc) ->
- ["Tests pausing and restarting call counters"];
+%% Tests pausing and restarting call counters
pause_and_restart(Config) when is_list(Config) ->
pause_and_restart_test().
-combo(suite) ->
- [];
-combo(doc) ->
- ["Tests combining local call trace and meta trace with call count trace"];
+%% Tests combining local call trace and meta trace with call count trace
combo(Config) when is_list(Config) ->
combo_test().
@@ -161,168 +145,168 @@ combo(Config) when is_list(Config) ->
%%%
basic_test() ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
- ?line M = 1000,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
+ M = 1000,
%%
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]),
- ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]),
- ?line L = seq(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line {call_count,0} = erlang:trace_info({?MODULE,seq_r,3}, call_count),
- ?line Lr = seq_r(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
- ?line L = lists:reverse(Lr),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]),
+ 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]),
+ L = seq(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ {call_count,0} = erlang:trace_info({?MODULE,seq_r,3}, call_count),
+ Lr = seq_r(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count),
+ {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
+ L = lists:reverse(Lr),
%%
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
on_and_off_test() ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
- ?line M = 100,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
+ M = 100,
%%
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]),
- ?line L = seq(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_count]),
- ?line L = seq(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line P = erlang:trace_pattern({'_','_','_'}, true, [call_count]),
- ?line L = seq(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]),
- ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line L = seq(1, M, fun(X) -> X+1 end),
- ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line {call_count,0} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
- ?line Lr = seq_r(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
- ?line N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_count]),
- ?line {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
- ?line Lr = seq_r(1, M, fun(X) -> X+1 end),
- ?line {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
- ?line L = lists:reverse(Lr),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]),
+ L = seq(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_count]),
+ L = seq(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ P = erlang:trace_pattern({'_','_','_'}, true, [call_count]),
+ L = seq(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]),
+ {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ L = seq(1, M, fun(X) -> X+1 end),
+ {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ {call_count,0} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
+ Lr = seq_r(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
+ N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_count]),
+ {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
+ Lr = seq_r(1, M, fun(X) -> X+1 end),
+ {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
+ L = lists:reverse(Lr),
%%
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
info_test() ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
%%
- ?line 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_count]),
- ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]),
- ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all),
- ?line {value,{call_count,0}} = lists:keysearch(call_count, 1, L),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]),
- ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]),
- ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line {all,false} = erlang:trace_info({?MODULE,seq,3}, all),
+ 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_count]),
+ {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]),
+ {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all),
+ {value,{call_count,0}} = lists:keysearch(call_count, 1, L),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]),
+ {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]),
+ {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ {all,false} = erlang:trace_info({?MODULE,seq,3}, all),
%%
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
pause_and_restart_test() ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
- ?line M = 100,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
+ M = 100,
%%
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]),
- ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line L = seq(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line L = seq(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]),
- ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
- ?line L = seq(1, M, fun(X) -> X+1 end),
- ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]),
+ {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ L = seq(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ L = seq(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]),
+ {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count),
+ L = seq(1, M, fun(X) -> X+1 end),
+ {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count),
%%
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_count]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
combo_test() ->
- ?line Self = self(),
-
- ?line MetaMatchSpec = [{'_',[],[{return_trace}]}],
- ?line Flags = lists:sort([call, return_to]),
- ?line LocalTracer = spawn_link(fun () -> relay_n(5, Self) end),
- ?line MetaTracer = spawn_link(fun () -> relay_n(9, Self) end),
- ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]),
- ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'},
- MetaMatchSpec,
- [{meta,MetaTracer}, call_count]),
- ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]),
+ Self = self(),
+
+ MetaMatchSpec = [{'_',[],[{return_trace}]}],
+ Flags = lists:sort([call, return_to]),
+ LocalTracer = spawn_link(fun () -> relay_n(5, Self) end),
+ MetaTracer = spawn_link(fun () -> relay_n(9, Self) end),
+ 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]),
+ 2 = erlang:trace_pattern({?MODULE,seq_r,'_'},
+ MetaMatchSpec,
+ [{meta,MetaTracer}, call_count]),
+ 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]),
%%
- ?line {traced,local} =
- erlang:trace_info({?MODULE,seq_r,3}, traced),
- ?line {match_spec,[]} =
- erlang:trace_info({?MODULE,seq_r,3}, match_spec),
- ?line {meta,MetaTracer} =
- erlang:trace_info({?MODULE,seq_r,3}, meta),
- ?line {meta_match_spec,MetaMatchSpec} =
- erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec),
- ?line {call_count,0} =
- erlang:trace_info({?MODULE,seq_r,3}, call_count),
+ {traced,local} =
+ erlang:trace_info({?MODULE,seq_r,3}, traced),
+ {match_spec,[]} =
+ erlang:trace_info({?MODULE,seq_r,3}, match_spec),
+ {meta,MetaTracer} =
+ erlang:trace_info({?MODULE,seq_r,3}, meta),
+ {meta_match_spec,MetaMatchSpec} =
+ erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec),
+ {call_count,0} =
+ erlang:trace_info({?MODULE,seq_r,3}, call_count),
%%
- ?line {all,[_|_]=TraceInfo} =
- erlang:trace_info({?MODULE,seq_r,3}, all),
- ?line {value,{traced,local}} =
- lists:keysearch(traced, 1, TraceInfo),
- ?line {value,{match_spec,[]}} =
- lists:keysearch(match_spec, 1, TraceInfo),
- ?line {value,{meta,MetaTracer}} =
- lists:keysearch(meta, 1, TraceInfo),
- ?line {value,{meta_match_spec,MetaMatchSpec}} =
- lists:keysearch(meta_match_spec, 1, TraceInfo),
- ?line {value,{call_count,0}} =
- lists:keysearch(call_count, 1, TraceInfo),
+ {all,[_|_]=TraceInfo} =
+ erlang:trace_info({?MODULE,seq_r,3}, all),
+ {value,{traced,local}} =
+ lists:keysearch(traced, 1, TraceInfo),
+ {value,{match_spec,[]}} =
+ lists:keysearch(match_spec, 1, TraceInfo),
+ {value,{meta,MetaTracer}} =
+ lists:keysearch(meta, 1, TraceInfo),
+ {value,{meta_match_spec,MetaMatchSpec}} =
+ lists:keysearch(meta_match_spec, 1, TraceInfo),
+ {value,{call_count,0}} =
+ lists:keysearch(call_count, 1, TraceInfo),
%%
- ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end),
+ [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end),
%%
- ?line List = collect(100),
- ?line {MetaR, LocalR} =
- lists:foldl(
- fun ({P,X}, {M,L}) when P == MetaTracer ->
- {[X|M],L};
- ({P,X}, {M,L}) when P == LocalTracer ->
- {M,[X|L]}
- end,
- {[],[]},
- List),
- ?line Meta = lists:reverse(MetaR),
- ?line Local = lists:reverse(LocalR),
- ?line [?CTT(Self,{?MODULE,seq_r,[1,3,_]}),
- ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}),
- ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}),
- ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}),
- ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
- ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
- ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
- ?RFT(Self,{?MODULE,seq_r,3},[3,2,1])] = Meta,
- ?line [?CT(Self,{?MODULE,seq_r,[1,3,_]}),
- ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}),
- ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}),
- ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}),
- ?RT(Self,{?MODULE,combo_test,0})] = Local,
- ?line {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count),
- ?line {call_count,3} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
+ List = collect(100),
+ {MetaR, LocalR} =
+ lists:foldl(
+ fun ({P,X}, {M,L}) when P == MetaTracer ->
+ {[X|M],L};
+ ({P,X}, {M,L}) when P == LocalTracer ->
+ {M,[X|L]}
+ end,
+ {[],[]},
+ List),
+ Meta = lists:reverse(MetaR),
+ Local = lists:reverse(LocalR),
+ [?CTT(Self,{?MODULE,seq_r,[1,3,_]}),
+ ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}),
+ ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}),
+ ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}),
+ ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
+ ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
+ ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
+ ?RFT(Self,{?MODULE,seq_r,3},[3,2,1])] = Meta,
+ [?CT(Self,{?MODULE,seq_r,[1,3,_]}),
+ ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}),
+ ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}),
+ ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}),
+ ?RT(Self,{?MODULE,combo_test,0})] = Local,
+ {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count),
+ {call_count,3} = erlang:trace_info({?MODULE,seq_r,4}, call_count),
%%
- ?line erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]),
- ?line erlang:trace_pattern(on_load, false, [local,meta,call_count]),
- ?line erlang:trace(all, false, [all]),
+ erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]),
+ erlang:trace_pattern(on_load, false, [local,meta,call_count]),
+ erlang:trace(all, false, [all]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -352,8 +336,8 @@ relay_n(0, _) ->
ok;
relay_n(N, Dest) ->
receive Msg ->
- Dest ! {self(), Msg},
- relay_n(N-1, Dest)
+ Dest ! {self(), Msg},
+ relay_n(N-1, Dest)
end.
@@ -367,15 +351,15 @@ collect(Time) ->
collect(A, 0) ->
receive
- Mess ->
- collect([Mess | A], 0)
+ Mess ->
+ collect([Mess | A], 0)
after 0 ->
- A
+ A
end;
collect(A, Ref) ->
receive
- {timeout, Ref, done} ->
- collect(A, 0);
- Mess ->
- collect([Mess | A], Ref)
+ {timeout, Ref, done} ->
+ collect(A, 0);
+ Mess ->
+ collect([Mess | A], Ref)
end.
diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl
index f359e1bd80..38972c9c02 100644
--- a/erts/emulator/test/trace_call_time_SUITE.erl
+++ b/erts/emulator/test/trace_call_time_SUITE.erl
@@ -58,32 +58,30 @@
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% When run in test server.
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
init_per_testcase/2, end_per_testcase/2, not_run/1]).
-export([basic/1, on_and_off/1, info/1,
pause_and_restart/1, scheduling/1, called_function/1, combo/1,
bif/1, nif/1]).
init_per_testcase(_Case, Config) ->
- ?line Dog=test_server:timetrap(test_server:seconds(400)),
erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]),
erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]),
timer:now_diff(now(),now()),
- [{watchdog, Dog}|Config].
+ Config.
-end_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, _Config) ->
erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time,call_count]),
erlang:trace_pattern(on_load, false, [local,meta,call_time,call_count]),
erlang:trace(all, false, [all]),
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
ok.
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 10}}].
all() ->
case test_server:is_native(trace_call_time_SUITE) of
@@ -93,382 +91,339 @@ all() ->
combo, bif, nif, called_function, dead_tracer]
end.
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
-basic(suite) ->
- [];
-basic(doc) ->
- ["Tests basic call count trace"];
+%% Tests basic call time trace
basic(Config) when is_list(Config) ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line M = 1000,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ M = 1000,
%%
- ?line 1 = erlang:trace_pattern({?MODULE,seq, '_'}, true, [call_time]),
- ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]),
- ?line Pid = setup(),
- ?line {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> (X+1) end) end),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1),
- ?line ok = check_trace_info({?MODULE, seq_r, 3}, [], none),
-
- ?line {Lr, T2} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> (X+1) end) end),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1),
- ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Pid, 1, 0, 0}], T2/M),
- ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid, M, 0, 0}], T2),
- ?line L = lists:reverse(Lr),
+ 1 = erlang:trace_pattern({?MODULE,seq, '_'}, true, [call_time]),
+ 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]),
+ Pid = setup(),
+ {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> (X+1) end) end),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1),
+ ok = check_trace_info({?MODULE, seq_r, 3}, [], none),
+
+ {Lr, T2} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> (X+1) end) end),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1),
+ ok = check_trace_info({?MODULE, seq_r, 3}, [{Pid, 1, 0, 0}], T2/M),
+ ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid, M, 0, 0}], T2),
+ L = lists:reverse(Lr),
%%
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line Pid ! quit,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ Pid ! quit,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-on_and_off(suite) ->
- [];
-on_and_off(doc) ->
- ["Tests turning trace parameters on and off"];
+%% "Tests turning trace parameters on and off
on_and_off(Config) when is_list(Config) ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line M = 100,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ M = 100,
%%
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]),
- ?line Pid = setup(),
- ?line {L, T1} = execute(Pid, {?MODULE, seq, [1, M, fun(X) -> X+1 end]}),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1),
-
- ?line N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_time]),
- ?line {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T2),
-
- ?line P = erlang:trace_pattern({'_','_','_'}, true, [call_time]),
- ?line {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T3),
-
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]),
- ?line ok = check_trace_info({?MODULE, seq, 3}, false, none),
- ?line {L, _T4} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
- ?line ok = check_trace_info({?MODULE, seq, 3}, false, none),
- ?line ok = check_trace_info({?MODULE, seq_r, 4}, [], none),
- ?line {Lr, T5} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end),
- ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid,M,0,0}], T5),
-
- ?line N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_time]),
- ?line ok = check_trace_info({?MODULE, seq_r, 4}, false, none),
- ?line {Lr, _T6} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end),
- ?line ok = check_trace_info({?MODULE, seq_r, 4}, false, none),
- ?line L = lists:reverse(Lr),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]),
+ Pid = setup(),
+ {L, T1} = execute(Pid, {?MODULE, seq, [1, M, fun(X) -> X+1 end]}),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T1),
+
+ N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_time]),
+ {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T2),
+
+ P = erlang:trace_pattern({'_','_','_'}, true, [call_time]),
+ {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid, M, 0, 0}], T3),
+
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]),
+ ok = check_trace_info({?MODULE, seq, 3}, false, none),
+ {L, _T4} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
+ ok = check_trace_info({?MODULE, seq, 3}, false, none),
+ ok = check_trace_info({?MODULE, seq_r, 4}, [], none),
+ {Lr, T5} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end),
+ ok = check_trace_info({?MODULE, seq_r, 4}, [{Pid,M,0,0}], T5),
+
+ N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_time]),
+ ok = check_trace_info({?MODULE, seq_r, 4}, false, none),
+ {Lr, _T6} = execute(Pid, fun() -> seq_r(1, M, fun(X) -> X+1 end) end),
+ ok = check_trace_info({?MODULE, seq_r, 4}, false, none),
+ L = lists:reverse(Lr),
%%
- ?line Pid ! quit,
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ Pid ! quit,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-info(suite) ->
- [];
-info(doc) ->
- ["Tests the trace_info BIF"];
+%% Tests the trace_info BIF
info(Config) when is_list(Config) ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
%%
- ?line 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_time]),
- ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]),
- ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time),
- ?line {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all),
- ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, L),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]),
- ?line {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]),
- ?line {call_time,false} = erlang:trace_info({?MODULE,seq,3}, call_time),
- ?line {all,false} = erlang:trace_info({?MODULE,seq,3}, all),
+ 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_time]),
+ {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]),
+ {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time),
+ {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all),
+ {value,{call_time,[]}} = lists:keysearch(call_time, 1, L),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]),
+ {call_time,[]} = erlang:trace_info({?MODULE,seq,3}, call_time),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_time]),
+ {call_time,false} = erlang:trace_info({?MODULE,seq,3}, call_time),
+ {all,false} = erlang:trace_info({?MODULE,seq,3}, all),
%%
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-pause_and_restart(suite) ->
- [];
-pause_and_restart(doc) ->
- ["Tests pausing and restarting call time counters"];
+%% Tests pausing and restarting call time counters
pause_and_restart(Config) when is_list(Config) ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line M = 100,
- ?line Pid = setup(),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ M = 100,
+ Pid = setup(),
%%
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [], none),
- ?line {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1),
- ?line {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T2),
- ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [], none),
- ?line {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
- ?line ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T3),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_time]),
+ ok = check_trace_info({?MODULE, seq, 3}, [], none),
+ {L, T1} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_time]),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T1),
+ {L, T2} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T2),
+ 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_time]),
+ ok = check_trace_info({?MODULE, seq, 3}, [], none),
+ {L, T3} = execute(Pid, fun() -> seq(1, M, fun(X) -> X+1 end) end),
+ ok = check_trace_info({?MODULE, seq, 3}, [{Pid,M,0,0}], T3),
%%
- ?line Pid ! quit,
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ Pid ! quit,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-scheduling(suite) ->
- [];
-scheduling(doc) ->
- ["Tests in/out scheduling of call time counters"];
+%% Tests in/out scheduling of call time counters
scheduling(Config) when is_list(Config) ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line M = 1000000,
- ?line Np = erlang:system_info(schedulers_online),
- ?line F = 12,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ M = 1000000,
+ Np = erlang:system_info(schedulers_online),
+ F = 12,
%% setup load processes
%% (single, no internal calls)
- ?line erlang:trace_pattern({?MODULE,loaded,1}, true, [call_time]),
+ erlang:trace_pattern({?MODULE,loaded,1}, true, [call_time]),
- ?line Pids = [setup() || _ <- lists:seq(1, F*Np)],
- ?line {_Ls,T1} = execute(Pids, {?MODULE,loaded,[M]}),
- ?line [Pid ! quit || Pid <- Pids],
+ Pids = [setup() || _ <- lists:seq(1, F*Np)],
+ {_Ls,T1} = execute(Pids, {?MODULE,loaded,[M]}),
+ [Pid ! quit || Pid <- Pids],
%% logic dictates that each process will get ~ 1/F of the schedulers time
- ?line {call_time, CT} = erlang:trace_info({?MODULE,loaded,1}, call_time),
-
- ?line lists:foreach(fun (Pid) ->
- ?line ok = case check_process_time(lists:keysearch(Pid, 1, CT), M, F, T1) of
- schedule_time_error ->
- test_server:comment("Warning: Failed time ratio"),
- ok;
- Other -> Other
- end
- end, Pids),
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ {call_time, CT} = erlang:trace_info({?MODULE,loaded,1}, call_time),
+
+ lists:foreach(fun (Pid) ->
+ ok = case check_process_time(lists:keysearch(Pid, 1, CT), M, F, T1) of
+ schedule_time_error ->
+ test_server:comment("Warning: Failed time ratio"),
+ ok;
+ Other -> Other
+ end
+ end, Pids),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-combo(suite) ->
- [];
-combo(doc) ->
- ["Tests combining local call trace and meta trace with call time trace"];
+%% "Tests combining local call trace and meta trace with call time trace
combo(Config) when is_list(Config) ->
- ?line Self = self(),
- ?line Nbc = 3,
- ?line MetaMs = [{'_',[],[{return_trace}]}],
- ?line Flags = lists:sort([call, return_to]),
- ?line LocalTracer = spawn_link(fun () -> relay_n(5 + Nbc + 3, Self) end),
- ?line MetaTracer = spawn_link(fun () -> relay_n(9 + Nbc + 3, Self) end),
- ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]),
- ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]),
- ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, MetaMs, [{meta,MetaTracer}]),
- ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]),
+ Self = self(),
+ Nbc = 3,
+ MetaMs = [{'_',[],[{return_trace}]}],
+ Flags = lists:sort([call, return_to]),
+ LocalTracer = spawn_link(fun () -> relay_n(5 + Nbc + 3, Self) end),
+ MetaTracer = spawn_link(fun () -> relay_n(9 + Nbc + 3, Self) end),
+ 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]),
+ 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_time]),
+ 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, MetaMs, [{meta,MetaTracer}]),
+ 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]),
% bifs
- ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, [], [local]),
- ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]),
- ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, MetaMs, [{meta,MetaTracer}]),
+ 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, [], [local]),
+ 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]),
+ 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, MetaMs, [{meta,MetaTracer}]),
%% not implemented
- %?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]),
+ %2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_count]),
- ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]),
+ 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]),
%%
- ?line {traced,local} =
- erlang:trace_info({?MODULE,seq_r,3}, traced),
- ?line {match_spec,[]} =
- erlang:trace_info({?MODULE,seq_r,3}, match_spec),
- ?line {meta,MetaTracer} =
- erlang:trace_info({?MODULE,seq_r,3}, meta),
- ?line {meta_match_spec,MetaMs} =
- erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec),
- ?line ok = check_trace_info({?MODULE, seq_r, 3}, [], none),
+ {traced,local} =
+ erlang:trace_info({?MODULE,seq_r,3}, traced),
+ {match_spec,[]} =
+ erlang:trace_info({?MODULE,seq_r,3}, match_spec),
+ {meta,MetaTracer} =
+ erlang:trace_info({?MODULE,seq_r,3}, meta),
+ {meta_match_spec,MetaMs} =
+ erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec),
+ ok = check_trace_info({?MODULE, seq_r, 3}, [], none),
%% check empty trace_info for ?MODULE:seq_r/3
- ?line {all,[_|_]=TraceInfo} = erlang:trace_info({?MODULE,seq_r,3}, all),
- ?line {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo),
- ?line {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfo),
- ?line {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo),
- ?line {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfo),
- ?line {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfo),
- ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfo),
+ {all,[_|_]=TraceInfo} = erlang:trace_info({?MODULE,seq_r,3}, all),
+ {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfo),
+ {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfo),
+ {value,{meta,MetaTracer}} = lists:keysearch(meta, 1, TraceInfo),
+ {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfo),
+ {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfo),
+ {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfo),
%% check empty trace_info for erlang:term_to_binary/1
- ?line {all, [_|_] = TraceInfoBif} = erlang:trace_info({erlang, term_to_binary, 1}, all),
- ?line {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfoBif),
- ?line {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfoBif),
- ?line {value,{meta, MetaTracer}} = lists:keysearch(meta, 1, TraceInfoBif),
- ?line {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfoBif),
+ {all, [_|_] = TraceInfoBif} = erlang:trace_info({erlang, term_to_binary, 1}, all),
+ {value,{traced,local}} = lists:keysearch(traced, 1, TraceInfoBif),
+ {value,{match_spec,[]}} = lists:keysearch(match_spec, 1, TraceInfoBif),
+ {value,{meta, MetaTracer}} = lists:keysearch(meta, 1, TraceInfoBif),
+ {value,{meta_match_spec,MetaMs}} = lists:keysearch(meta_match_spec, 1, TraceInfoBif),
%% not implemented
- ?line {value,{call_count,false}} = lists:keysearch(call_count, 1, TraceInfoBif),
- %?line {value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif),
- ?line {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfoBif),
+ {value,{call_count,false}} = lists:keysearch(call_count, 1, TraceInfoBif),
+ %{value,{call_count,0}} = lists:keysearch(call_count, 1, TraceInfoBif),
+ {value,{call_time,[]}} = lists:keysearch(call_time, 1, TraceInfoBif),
%%
- ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end),
- ?line T0 = erlang:monotonic_time(),
- ?line with_bif(Nbc),
- ?line T1 = erlang:monotonic_time(),
- ?line TimeB = erlang:convert_time_unit(T1-T0, native, micro_seconds),
+ [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end),
+ T0 = erlang:monotonic_time(),
+ with_bif(Nbc),
+ T1 = erlang:monotonic_time(),
+ TimeB = erlang:convert_time_unit(T1-T0, native, micro_seconds),
%%
- ?line List = collect(100),
- ?line {MetaR, LocalR} =
- lists:foldl(
- fun ({P,X}, {M,L}) when P == MetaTracer ->
- {[X|M],L};
- ({P,X}, {M,L}) when P == LocalTracer ->
- {M,[X|L]}
- end,
- {[],[]},
- List),
- ?line Meta = lists:reverse(MetaR),
- ?line Local = lists:reverse(LocalR),
-
- ?line [?CTT(Self,{?MODULE,seq_r,[1,3,_]}),
- ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}),
- ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}),
- ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}),
- ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
- ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
- ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
- ?RFT(Self,{?MODULE,seq_r,3},[3,2,1]),
- ?CTT(Self,{erlang,term_to_binary,[3]}), % bif
- ?RFT(Self,{erlang,term_to_binary,1},<<131,97,3>>),
- ?CTT(Self,{erlang,term_to_binary,[2]}),
- ?RFT(Self,{erlang,term_to_binary,1},<<131,97,2>>)
- ] = Meta,
-
- ?line [?CT(Self,{?MODULE,seq_r,[1,3,_]}),
- ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}),
- ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}),
- ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}),
- ?RT(Self,{?MODULE,combo,1}),
- ?CT(Self,{erlang,term_to_binary,[3]}), % bif
- ?RT(Self,{?MODULE,with_bif,1}),
- ?CT(Self,{erlang,term_to_binary,[2]}),
- ?RT(Self,{?MODULE,with_bif,1})
- ] = Local,
-
- ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1),
- ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1),
- ?line ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1),
- ?line ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1),
- ?line ok = check_trace_info({erlang, term_to_binary, 1}, [{self(), Nbc - 1, 0, 0}], TimeB),
+ List = collect(100),
+ {MetaR, LocalR} =
+ lists:foldl(
+ fun ({P,X}, {M,L}) when P == MetaTracer ->
+ {[X|M],L};
+ ({P,X}, {M,L}) when P == LocalTracer ->
+ {M,[X|L]}
+ end,
+ {[],[]},
+ List),
+ Meta = lists:reverse(MetaR),
+ Local = lists:reverse(LocalR),
+
+ [?CTT(Self,{?MODULE,seq_r,[1,3,_]}),
+ ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}),
+ ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}),
+ ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}),
+ ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
+ ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
+ ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]),
+ ?RFT(Self,{?MODULE,seq_r,3},[3,2,1]),
+ ?CTT(Self,{erlang,term_to_binary,[3]}), % bif
+ ?RFT(Self,{erlang,term_to_binary,1},<<131,97,3>>),
+ ?CTT(Self,{erlang,term_to_binary,[2]}),
+ ?RFT(Self,{erlang,term_to_binary,1},<<131,97,2>>)
+ ] = Meta,
+
+ [?CT(Self,{?MODULE,seq_r,[1,3,_]}),
+ ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}),
+ ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}),
+ ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}),
+ ?RT(Self,{?MODULE,combo,1}),
+ ?CT(Self,{erlang,term_to_binary,[3]}), % bif
+ ?RT(Self,{?MODULE,with_bif,1}),
+ ?CT(Self,{erlang,term_to_binary,[2]}),
+ ?RT(Self,{?MODULE,with_bif,1})
+ ] = Local,
+
+ ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1),
+ ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1),
+ ok = check_trace_info({?MODULE, seq_r, 3}, [{Self,1,0,0}], 1),
+ ok = check_trace_info({?MODULE, seq_r, 4}, [{Self,3,0,0}], 1),
+ ok = check_trace_info({erlang, term_to_binary, 1}, [{self(), Nbc - 1, 0, 0}], TimeB),
%%
- ?line erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time]),
- ?line erlang:trace_pattern(on_load, false, [local,meta,call_time]),
- ?line erlang:trace(all, false, [all]),
+ erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_time]),
+ erlang:trace_pattern(on_load, false, [local,meta,call_time]),
+ erlang:trace(all, false, [all]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-bif(suite) ->
- [];
-bif(doc) ->
- ["Tests tracing of bifs"];
+%% Tests tracing of bifs
bif(Config) when is_list(Config) ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line M = 1000000,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ M = 1000000,
%%
- ?line 2 = erlang:trace_pattern({erlang, binary_to_term, '_'}, true, [call_time]),
- ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]),
- ?line Pid = setup(),
- ?line {L, T1} = execute(Pid, fun() -> with_bif(M) end),
+ 2 = erlang:trace_pattern({erlang, binary_to_term, '_'}, true, [call_time]),
+ 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, true, [call_time]),
+ Pid = setup(),
+ {L, T1} = execute(Pid, fun() -> with_bif(M) end),
- ?line ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M - 1, 0, 0}], T1/2),
- ?line ok = check_trace_info({erlang, term_to_binary, 1}, [{Pid, M - 1, 0, 0}], T1/2),
+ ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M - 1, 0, 0}], T1/2),
+ ok = check_trace_info({erlang, term_to_binary, 1}, [{Pid, M - 1, 0, 0}], T1/2),
% disable term2binary
- ?line 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]),
+ 2 = erlang:trace_pattern({erlang, term_to_binary, '_'}, false, [call_time]),
- ?line {L, T2} = execute(Pid, fun() -> with_bif(M) end),
+ {L, T2} = execute(Pid, fun() -> with_bif(M) end),
- ?line ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1/2 + T2),
- ?line ok = check_trace_info({erlang, term_to_binary, 1}, false, none),
+ ok = check_trace_info({erlang, binary_to_term, 1}, [{Pid, M*2 - 2, 0, 0}], T1/2 + T2),
+ ok = check_trace_info({erlang, term_to_binary, 1}, false, none),
%%
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line Pid ! quit,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ Pid ! quit,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-nif(suite) ->
- [];
-nif(doc) ->
- ["Tests tracing of nifs"];
+%% Tests tracing of nifs
nif(Config) when is_list(Config) ->
load_nif(Config),
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line M = 1000000,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ M = 1000000,
%%
- ?line 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]),
- ?line 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]),
- ?line Pid = setup(),
- ?line {_, T1} = execute(Pid, fun() -> with_nif(M) end),
+ 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]),
+ 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]),
+ Pid = setup(),
+ {_, T1} = execute(Pid, fun() -> with_nif(M) end),
% the nif is called M - 1 times, the last time the function with 'with_nif'
% returns ok and does not call the nif.
- ?line ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1/5*4),
- ?line ok = check_trace_info({?MODULE, with_nif, 1}, [{Pid, M, 0, 0}], T1/5),
+ ok = check_trace_info({?MODULE, nif_dec, 1}, [{Pid, M-1, 0, 0}], T1/5*4),
+ ok = check_trace_info({?MODULE, with_nif, 1}, [{Pid, M, 0, 0}], T1/5),
%%
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line Pid ! quit,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ Pid ! quit,
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-called_function(suite) ->
- [];
-called_function(doc) ->
- ["Tests combining nested function calls and that the time accumulates to the right function"];
+%% Tests combining nested function calls and that the time accumulates to the right function
called_function(Config) when is_list(Config) ->
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
- ?line M = 2100,
- ?line Pid = setup(),
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ M = 2100,
+ Pid = setup(),
%%
- ?line 1 = erlang:trace_pattern({?MODULE,a_function,'_'}, true, [call_time]),
- ?line {L, T1} = execute(Pid, {?MODULE, a_function, [M]}),
- ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M, 0, 0}], T1),
+ 1 = erlang:trace_pattern({?MODULE,a_function,'_'}, true, [call_time]),
+ {L, T1} = execute(Pid, {?MODULE, a_function, [M]}),
+ ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M, 0, 0}], T1),
- ?line 1 = erlang:trace_pattern({?MODULE,a_called_function,'_'}, true, [call_time]),
- ?line {L, T2} = execute(Pid, {?MODULE, a_function, [M]}),
- ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M, 0, 0}], T1 + M*?SINGLE_CALL_US_TIME),
- ?line ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M, 0, 0}], T2),
+ 1 = erlang:trace_pattern({?MODULE,a_called_function,'_'}, true, [call_time]),
+ {L, T2} = execute(Pid, {?MODULE, a_function, [M]}),
+ ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M, 0, 0}], T1 + M*?SINGLE_CALL_US_TIME),
+ ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M, 0, 0}], T2),
- ?line 1 = erlang:trace_pattern({?MODULE,dec,'_'}, true, [call_time]),
- ?line {L, T3} = execute(Pid, {?MODULE, a_function, [M]}),
- ?line ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M+M, 0, 0}], T1 + (M+M)*?SINGLE_CALL_US_TIME),
- ?line ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M+M, 0, 0}], T2 + M*?SINGLE_CALL_US_TIME ),
- ?line ok = check_trace_info({?MODULE, dec, 1}, [{Pid, M, 0, 0}], T3),
+ 1 = erlang:trace_pattern({?MODULE,dec,'_'}, true, [call_time]),
+ {L, T3} = execute(Pid, {?MODULE, a_function, [M]}),
+ ok = check_trace_info({?MODULE, a_function, 1}, [{Pid, M+M+M, 0, 0}], T1 + (M+M)*?SINGLE_CALL_US_TIME),
+ ok = check_trace_info({?MODULE, a_called_function, 1}, [{Pid, M+M, 0, 0}], T2 + M*?SINGLE_CALL_US_TIME ),
+ ok = check_trace_info({?MODULE, dec, 1}, [{Pid, M, 0, 0}], T3),
- ?line Pid ! quit,
- ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
+ Pid ! quit,
+ P = erlang:trace_pattern({'_','_','_'}, false, [call_time]),
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -482,8 +437,8 @@ dead_tracer(Config) when is_list(Config) ->
Ref = erlang:monitor(process, FirstTracer),
FirstTracer ! quit,
receive
- {'DOWN',Ref,process,FirstTracer,normal} ->
- ok
+ {'DOWN',Ref,process,FirstTracer,normal} ->
+ ok
end,
erlang:yield(),
@@ -513,26 +468,26 @@ dead_tracer(Config) when is_list(Config) ->
other_than_self(Info) ->
[{Pid,MFA} || {MFA,[{Pid,_,_,_}]} <- Info,
- Pid =/= self()].
+ Pid =/= self()].
tell_tracer(Tracer, Fun) ->
Tracer ! {execute,self(),Fun},
receive
- {Tracer,executed} ->
- ok
+ {Tracer,executed} ->
+ ok
end.
tracer() ->
spawn_link(fun Loop() ->
- receive
- quit ->
- ok;
- {execute,From,Fun} ->
- Fun(),
- From ! {self(),executed},
- Loop()
- end
- end).
+ receive
+ quit ->
+ ok;
+ {execute,From,Fun} ->
+ Fun(),
+ From ! {self(),executed},
+ Loop()
+ end
+ end).
turn_on_tracing(Pid) ->
_ = erlang:trace(Pid, true, [call,set_on_spawn]),
@@ -542,18 +497,18 @@ turn_on_tracing(Pid) ->
collect_all_info() ->
collect_all_info([{?MODULE,F,A} || {F,A} <- module_info(functions)] ++
- erlang:system_info(snifs)).
+ erlang:system_info(snifs)).
collect_all_info([MFA|T]) ->
CallTime = erlang:trace_info(MFA, call_time),
erlang:trace_pattern(MFA, restart, [call_time]),
case CallTime of
- {call_time,false} ->
- collect_all_info(T);
- {call_time,[]} ->
- collect_all_info(T);
- {call_time,[_|_]=List} ->
- [{MFA,List}|collect_all_info(T)]
+ {call_time,false} ->
+ collect_all_info(T);
+ {call_time,[]} ->
+ collect_all_info(T);
+ {call_time,[_|_]=List} ->
+ [{MFA,List}|collect_all_info(T)]
end;
collect_all_info([]) -> [].
@@ -566,8 +521,8 @@ collect_all_info([]) -> [].
%% Local helpers
load_nif(Config) ->
- ?line Path = ?config(data_dir, Config),
- ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0).
+ Path = proplists:get_value(data_dir, Config),
+ ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0).
%% Stack recursive seq
@@ -614,39 +569,39 @@ seq_r(Start, Stop, Succ, R) ->
% Check call time tracing data and print mismatches
check_trace_info(Mfa, [{Pid, C,_,_}] = Expect, Time) ->
case erlang:trace_info(Mfa, call_time) of
- % Time tests are somewhat problematic. We want to know if Time (EXPECTED_TIME) and S*1000000 + Us (ACTUAL_TIME)
- % is the same.
- % If the ratio EXPECTED_TIME/ACTUAL_TIME is ~ 1 or if EXPECTED_TIME - ACTUAL_TIME is near zero, the test is ok.
- {call_time,[{Pid,C,S,Us}]} when S >= 0, Us >= 0, abs(1 - Time/(S*1000000 + Us)) < ?R_ERROR; abs(Time - S*1000000 - Us) < ?US_ERROR ->
- ok;
- {call_time,[{Pid,C,S,Us}]} ->
- Sum = S*1000000 + Us,
- io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~w s. ~w us. = ~w us. - ~w -> delta ~w (ratio ~.2f, should be 1.0)~n",
- [Mfa, Expect, Time, S, Us, Sum, Time, Sum - Time, Time/Sum]),
- time_error;
- Other ->
- io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~p~n", [ Mfa, Expect, Time, Other]),
- time_count_error
+ % Time tests are somewhat problematic. We want to know if Time (EXPECTED_TIME) and S*1000000 + Us (ACTUAL_TIME)
+ % is the same.
+ % If the ratio EXPECTED_TIME/ACTUAL_TIME is ~ 1 or if EXPECTED_TIME - ACTUAL_TIME is near zero, the test is ok.
+ {call_time,[{Pid,C,S,Us}]} when S >= 0, Us >= 0, abs(1 - Time/(S*1000000 + Us)) < ?R_ERROR; abs(Time - S*1000000 - Us) < ?US_ERROR ->
+ ok;
+ {call_time,[{Pid,C,S,Us}]} ->
+ Sum = S*1000000 + Us,
+ io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~w s. ~w us. = ~w us. - ~w -> delta ~w (ratio ~.2f, should be 1.0)~n",
+ [Mfa, Expect, Time, S, Us, Sum, Time, Sum - Time, Time/Sum]),
+ time_error;
+ Other ->
+ io:format("Expected ~p -> {call_time, ~p (Time ~p us)}~n - got ~p~n", [ Mfa, Expect, Time, Other]),
+ time_count_error
end;
check_trace_info(Mfa, Expect, _) ->
case erlang:trace_info(Mfa, call_time) of
- {call_time, Expect} ->
- ok;
- Other ->
- io:format("Expected ~p -> {call_time, ~p}~n - got ~p~n", [Mfa, Expect, Other]),
- result_not_expected_error
+ {call_time, Expect} ->
+ ok;
+ Other ->
+ io:format("Expected ~p -> {call_time, ~p}~n - got ~p~n", [Mfa, Expect, Other]),
+ result_not_expected_error
end.
%check process time
check_process_time({value,{Pid, M, S, Us}}, M, F, Time) ->
- ?line Sum = S*1000000 + Us,
+ Sum = S*1000000 + Us,
if
- abs(1 - (F/(Time/Sum))) < ?R_ERROR ->
- ok;
- true ->
- io:format("- Pid ~p, Got ratio ~.2f, expected ratio ~w~n", [Pid, Time/Sum,F]),
- schedule_time_error
+ abs(1 - (F/(Time/Sum))) < ?R_ERROR ->
+ ok;
+ true ->
+ io:format("- Pid ~p, Got ratio ~.2f, expected ratio ~w~n", [Pid, Time/Sum,F]),
+ schedule_time_error
end;
check_process_time(Other, M, _, _) ->
io:format(" - Got ~p, expected count ~w~n", [Other, M]),
@@ -659,8 +614,8 @@ relay_n(0, _) ->
ok;
relay_n(N, Dest) ->
receive Msg ->
- Dest ! {self(), Msg},
- relay_n(N-1, Dest)
+ Dest ! {self(), Msg},
+ relay_n(N-1, Dest)
end.
@@ -674,17 +629,17 @@ collect(Time) ->
collect(A, 0) ->
receive
- Mess ->
- collect([Mess | A], 0)
+ Mess ->
+ collect([Mess | A], 0)
after 0 ->
- A
+ A
end;
collect(A, Ref) ->
receive
- {timeout, Ref, done} ->
- collect(A, 0);
- Mess ->
- collect([Mess | A], Ref)
+ {timeout, Ref, done} ->
+ collect(A, 0);
+ Mess ->
+ collect([Mess | A], Ref)
end.
setup() ->
@@ -712,12 +667,12 @@ execute(P, Mfa) ->
loop() ->
receive
- quit ->
- ok;
- {Pid, execute, Fun } when is_function(Fun) ->
- Pid ! {self(), answer, erlang:apply(Fun, [])},
- loop();
- {Pid, execute, {M, F, A}} ->
- Pid ! {self(), answer, erlang:apply(M, F, A)},
- loop()
+ quit ->
+ ok;
+ {Pid, execute, Fun } when is_function(Fun) ->
+ Pid ! {self(), answer, erlang:apply(Fun, [])},
+ loop();
+ {Pid, execute, {M, F, A}} ->
+ Pid ! {self(), answer, erlang:apply(M, F, A)},
+ loop()
end.
diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl
index 7431099340..24864dcbef 100644
--- a/erts/emulator/test/trace_local_SUITE.erl
+++ b/erts/emulator/test/trace_local_SUITE.erl
@@ -29,69 +29,44 @@
-export([exported/1, exported_wrap/1, loop/4, apply_slave_async/5,
match/2, clause/2, id/1, undef/1, lists_reverse/2]).
-%%
-%% Define to run outside of test server
-%%
-%% (rotten feature)
-%%
-%%-define(STANDALONE,1).
-
+
%%
%% Define for debug output
%%
%%-define(debug,1).
--ifdef(STANDALONE).
--define(config(A,B),config(A,B)).
--export([config/2]).
--define(DEFAULT_RECEIVE_TIMEOUT, 1000).
--else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(DEFAULT_RECEIVE_TIMEOUT, infinity).
--endif.
-
+
-ifdef(debug).
--ifdef(STANDALONE).
--define(line, erlang:display({?MODULE,?LINE}), ).
--endif.
-define(dbgformat(A,B),io:format(A,B)).
-else.
--ifdef(STANDALONE).
--define(line, noop, ).
--endif.
-define(dbgformat(A,B),noop).
-endif.
-
--ifdef(STANDALONE).
-config(priv_dir,_) ->
- ".".
--else.
%%% When run in test server %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, basic/1, bit_syntax/1,
- return/1, on_and_off/1, systematic_on_off/1,
- stack_grow/1,info/1, delete/1,
- exception/1, exception_apply/1,
- exception_function/1, exception_apply_function/1,
- exception_nocatch/1, exception_nocatch_apply/1,
- exception_nocatch_function/1, exception_nocatch_apply_function/1,
- exception_meta/1, exception_meta_apply/1,
- exception_meta_function/1, exception_meta_apply_function/1,
- exception_meta_nocatch/1, exception_meta_nocatch_apply/1,
- exception_meta_nocatch_function/1,
- exception_meta_nocatch_apply_function/1,
- concurrency/1,
- init_per_testcase/2, end_per_testcase/2]).
+-export([all/0, suite/0,
+ basic/1, bit_syntax/1,
+ return/1, on_and_off/1, systematic_on_off/1,
+ stack_grow/1,info/1, delete/1,
+ exception/1, exception_apply/1,
+ exception_function/1, exception_apply_function/1,
+ exception_nocatch/1, exception_nocatch_apply/1,
+ exception_nocatch_function/1, exception_nocatch_apply_function/1,
+ exception_meta/1, exception_meta_apply/1,
+ exception_meta_function/1, exception_meta_apply_function/1,
+ exception_meta_nocatch/1, exception_meta_nocatch_apply/1,
+ exception_meta_nocatch_function/1,
+ exception_meta_nocatch_apply_function/1,
+ concurrency/1,
+ init_per_testcase/2, end_per_testcase/2]).
+
init_per_testcase(_Case, Config) ->
- ?line Dog=test_server:timetrap(test_server:minutes(2)),
- [{watchdog, Dog}|Config].
+ Config.
end_per_testcase(_Case, Config) ->
shutdown(),
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
%% Reloading the module will clear all trace patterns, and
%% in a debug-compiled emulator run assertions of the counters
@@ -99,168 +74,127 @@ end_per_testcase(_Case, Config) ->
c:l(?MODULE).
-
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 2}}].
all() ->
case test_server:is_native(trace_local_SUITE) of
- true -> [not_run];
- false ->
- [basic, bit_syntax, return, on_and_off, systematic_on_off,
- stack_grow,
- info, delete, exception, exception_apply,
- exception_function, exception_apply_function,
- exception_nocatch, exception_nocatch_apply,
- exception_nocatch_function,
- exception_nocatch_apply_function, exception_meta,
- exception_meta_apply, exception_meta_function,
- exception_meta_apply_function, exception_meta_nocatch,
- exception_meta_nocatch_apply,
- exception_meta_nocatch_function,
- exception_meta_nocatch_apply_function,
- concurrency]
+ true -> [not_run];
+ false ->
+ [basic, bit_syntax, return, on_and_off, systematic_on_off,
+ stack_grow,
+ info, delete, exception, exception_apply,
+ exception_function, exception_apply_function,
+ exception_nocatch, exception_nocatch_apply,
+ exception_nocatch_function,
+ exception_nocatch_apply_function, exception_meta,
+ exception_meta_apply, exception_meta_function,
+ exception_meta_apply_function, exception_meta_nocatch,
+ exception_meta_nocatch_apply,
+ exception_meta_nocatch_function,
+ exception_meta_nocatch_apply_function,
+ concurrency]
end.
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
-basic(doc) ->
- ["Tests basic local call-trace"];
+%% Tests basic local call-trace
basic(Config) when is_list(Config) ->
basic_test().
-bit_syntax(doc) ->
- "OTP-7399: Make sure that code that uses the optimized bit syntax matching "
- "can be traced without crashing the emulator.";
+%% OTP-7399: Make sure that code that uses the optimized bit syntax matching
+%% can be traced without crashing the emulator.
bit_syntax(Config) when is_list(Config) ->
bit_syntax_test().
-return(doc) ->
- ["Tests the different types of return trace"];
+%% Tests the different types of return trace
return(Config) when is_list(Config) ->
return_test().
-
-on_and_off(doc) ->
- ["Tests turning trace parameters on and off, "
- "both for trace and trace_pattern"];
+
+%% Tests turning trace parameters on and off,
+%% both for trace and trace_pattern
on_and_off(Config) when is_list(Config) ->
on_and_off_test().
-
-stack_grow(doc) ->
- ["Tests the stack growth during return traces"];
+
+%% Tests the stack growth during return traces
stack_grow(Config) when is_list(Config) ->
stack_grow_test().
-
-info(doc) ->
- ["Tests the trace_info BIF"];
+
+%% Tests the trace_info BIF
info(Config) when is_list(Config) ->
info_test().
-
-delete(doc) ->
- ["Tests putting trace on deleted modules"];
+
+%% Tests putting trace on deleted modules
delete(Config) when is_list(Config) ->
delete_test(Config).
-exception(doc) ->
- ["Tests exception_trace"];
+%% Tests exception_trace
exception(Config) when is_list(Config) ->
exception_test([]).
-exception_apply(doc) ->
- ["Tests exception_trace"];
+%% Tests exception_trace
exception_apply(Config) when is_list(Config) ->
exception_test([apply]).
-exception_function(doc) ->
- ["Tests exception_trace"];
+%% Tests exception_trace
exception_function(Config) when is_list(Config) ->
exception_test([function]).
-exception_apply_function(doc) ->
- ["Tests exception_trace"];
+%% Tests exception_trace
exception_apply_function(Config) when is_list(Config) ->
exception_test([apply,function]).
-exception_nocatch(doc) ->
- ["Tests exception_trace"];
+%% Tests exception_trace
exception_nocatch(Config) when is_list(Config) ->
exception_test([nocatch]).
-exception_nocatch_apply(doc) ->
- ["Tests exception_trace"];
+%% Tests exception_trace
exception_nocatch_apply(Config) when is_list(Config) ->
exception_test([nocatch,apply]).
-exception_nocatch_function(doc) ->
- ["Tests exception_trace"];
+%% Tests exception_trace
exception_nocatch_function(Config) when is_list(Config) ->
exception_test([nocatch,function]).
-exception_nocatch_apply_function(doc) ->
- ["Tests exception_trace"];
+%% Tests exception_trace
exception_nocatch_apply_function(Config) when is_list(Config) ->
exception_test([nocatch,apply,function]).
-exception_meta(doc) ->
- ["Tests meta exception_trace"];
+%% Tests meta exception_trace
exception_meta(Config) when is_list(Config) ->
exception_test([meta]).
-exception_meta_apply(doc) ->
- ["Tests meta exception_trace"];
+%% Tests meta exception_trace
exception_meta_apply(Config) when is_list(Config) ->
exception_test([meta,apply]).
-exception_meta_function(doc) ->
- ["Tests meta exception_trace"];
+%% Tests meta exception_trace
exception_meta_function(Config) when is_list(Config) ->
exception_test([meta,function]).
-exception_meta_apply_function(doc) ->
- ["Tests meta exception_trace"];
+%% Tests meta exception_trace
exception_meta_apply_function(Config) when is_list(Config) ->
exception_test([meta,apply,function]).
-exception_meta_nocatch(doc) ->
- ["Tests meta exception_trace"];
+%% Tests meta exception_trace
exception_meta_nocatch(Config) when is_list(Config) ->
exception_test([meta,nocatch]).
-exception_meta_nocatch_apply(doc) ->
- ["Tests meta exception_trace"];
+%% Tests meta exception_trace
exception_meta_nocatch_apply(Config) when is_list(Config) ->
exception_test([meta,nocatch,apply]).
-exception_meta_nocatch_function(doc) ->
- ["Tests meta exception_trace"];
+%% Tests meta exception_trace
exception_meta_nocatch_function(Config) when is_list(Config) ->
exception_test([meta,nocatch,function]).
-exception_meta_nocatch_apply_function(doc) ->
- ["Tests meta exception_trace"];
+%% Tests meta exception_trace
exception_meta_nocatch_apply_function(Config) when is_list(Config) ->
exception_test([meta,nocatch,apply,function]).
--endif.
-
-
%%% Message patterns and expect functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -309,28 +243,28 @@ expect_pid(Pid, Msg) when is_tuple(Msg) ->
same(Msg, expect_receive(Pid));
expect_pid(Pid, Fun) when is_function(Fun, 1) ->
case Fun(expect_receive(Pid)) of
- next ->
- expect_pid(Pid, Fun);
- done ->
- ok;
- Other ->
- expect_pid(Pid, Other)
+ next ->
+ expect_pid(Pid, Fun);
+ done ->
+ ok;
+ Other ->
+ expect_pid(Pid, Other)
end.
expect_receive(Pid) when is_pid(Pid) ->
receive
- Msg when is_tuple(Msg),
- element(1, Msg) == trace,
- element(2, Msg) =/= Pid;
- %%
- is_tuple(Msg),
- element(1, Msg) == trace_ts,
- element(2, Msg) =/= Pid ->
- expect_receive(Pid);
- Msg ->
- expect_msg(Pid, Msg)
+ Msg when is_tuple(Msg),
+ element(1, Msg) == trace,
+ element(2, Msg) =/= Pid;
+ %%
+ is_tuple(Msg),
+ element(1, Msg) == trace_ts,
+ element(2, Msg) =/= Pid ->
+ expect_receive(Pid);
+ Msg ->
+ expect_msg(Pid, Msg)
after 100 ->
- {nm}
+ {nm}
end.
expect_msg(P, ?pCT(P,M,F,Args)) -> {ct,{M,F},Args};
@@ -343,18 +277,18 @@ expect_msg(P, ?pRT(P,M,F,Arity)) -> {rt,{M,F,Arity}};
expect_msg(P, ?pRTT(P,M,F,Arity)) -> {rtt,{M,F,Arity}};
expect_msg(P, Msg) when is_tuple(Msg) ->
case tuple_to_list(Msg) of
- [trace,P|T] ->
- list_to_tuple([trace|T]);
- [trace_ts,P|[_|_]=T] ->
- list_to_tuple([trace_ts|reverse(tl(reverse(T)))]);
- _ ->
- Msg
+ [trace,P|T] ->
+ list_to_tuple([trace|T]);
+ [trace_ts,P|[_|_]=T] ->
+ list_to_tuple([trace_ts|reverse(tl(reverse(T)))]);
+ _ ->
+ Msg
end.
same(A, B) ->
case [A|B] of
- [X|X] ->
- ok
+ [X|X] ->
+ ok
end.
@@ -362,73 +296,73 @@ same(A, B) ->
%%% tests %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
basic_test() ->
- ?line setup([call]),
+ setup([call]),
NumMatches = erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
NumMatches = erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported,[1]),
- ?line ?CT(?MODULE,local,[1]),
- ?line ?CT(?MODULE,local2,[1]),
- ?line ?CT(?MODULE,local_tail,[1]),
- ?line erlang:trace_pattern({?MODULE,'_','_'},[],[]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line [1,1,1,1] = lambda_slave(fun() ->
- exported_wrap(1)
- end),
- ?line ?NM,
- ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line [1,1,1,1] = lambda_slave(fun() ->
- exported_wrap(1)
- end),
- ?line ?CT(?MODULE,_,_), %% The fun
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported,[1]),
- ?line ?CT(?MODULE,local,[1]),
- ?line ?CT(?MODULE,local2,[1]),
- ?line ?CT(?MODULE,local_tail,[1]),
- ?line erlang:trace_pattern({?MODULE,'_','_'},false,[local]),
- ?line shutdown(),
- ?line ?NM,
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported,[1]),
+ ?CT(?MODULE,local,[1]),
+ ?CT(?MODULE,local2,[1]),
+ ?CT(?MODULE,local_tail,[1]),
+ erlang:trace_pattern({?MODULE,'_','_'},[],[]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ [1,1,1,1] = lambda_slave(fun() ->
+ exported_wrap(1)
+ end),
+ ?NM,
+ erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,1] = lambda_slave(fun() ->
+ exported_wrap(1)
+ end),
+ ?CT(?MODULE,_,_), %% The fun
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported,[1]),
+ ?CT(?MODULE,local,[1]),
+ ?CT(?MODULE,local2,[1]),
+ ?CT(?MODULE,local_tail,[1]),
+ erlang:trace_pattern({?MODULE,'_','_'},false,[local]),
+ shutdown(),
+ ?NM,
ok.
%% OTP-7399.
bit_syntax_test() ->
- ?line setup([call]),
- ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
-
- ?line lambda_slave(fun() ->
- 6 = bs_sum_a(<<1,2,3>>, 0),
- 10 = bs_sum_b(0, <<1,2,3,4>>),
- 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0)
- end),
- ?line ?CT(?MODULE,_,[]), %Ignore call to the fun.
-
- ?line ?CT(?MODULE,bs_sum_a,[<<1,2,3>>,0]),
- ?line ?CT(?MODULE,bs_sum_a,[<<2,3>>,1]),
- ?line ?CT(?MODULE,bs_sum_a,[<<3>>,3]),
- ?line ?CT(?MODULE,bs_sum_a,[<<>>,6]),
-
- ?line ?CT(?MODULE,bs_sum_b,[0,<<1,2,3,4>>]),
- ?line ?CT(?MODULE,bs_sum_b,[1,<<2,3,4>>]),
- ?line ?CT(?MODULE,bs_sum_b,[3,<<3,4>>]),
- ?line ?CT(?MODULE,bs_sum_b,[6,<<4>>]),
- ?line ?CT(?MODULE,bs_sum_b,[10,<<>>]),
-
- ?line ?CT(?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>, 0]),
- ?line ?CT(?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>, 3]),
- ?line ?CT(?MODULE,bs_sum_c,[<<7:4,11:4>>, 8]),
- ?line ?CT(?MODULE,bs_sum_c,[<<11:4>>, 15]),
- ?line ?CT(?MODULE,bs_sum_c,[<<>>, 26]),
-
- ?line erlang:trace_pattern({?MODULE,'_','_'},false,[local]),
- ?line shutdown(),
- ?line ?NM,
+ setup([call]),
+ erlang:trace_pattern({?MODULE,'_','_'},[],[local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+
+ lambda_slave(fun() ->
+ 6 = bs_sum_a(<<1,2,3>>, 0),
+ 10 = bs_sum_b(0, <<1,2,3,4>>),
+ 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0)
+ end),
+ ?CT(?MODULE,_,[]), %Ignore call to the fun.
+
+ ?CT(?MODULE,bs_sum_a,[<<1,2,3>>,0]),
+ ?CT(?MODULE,bs_sum_a,[<<2,3>>,1]),
+ ?CT(?MODULE,bs_sum_a,[<<3>>,3]),
+ ?CT(?MODULE,bs_sum_a,[<<>>,6]),
+
+ ?CT(?MODULE,bs_sum_b,[0,<<1,2,3,4>>]),
+ ?CT(?MODULE,bs_sum_b,[1,<<2,3,4>>]),
+ ?CT(?MODULE,bs_sum_b,[3,<<3,4>>]),
+ ?CT(?MODULE,bs_sum_b,[6,<<4>>]),
+ ?CT(?MODULE,bs_sum_b,[10,<<>>]),
+
+ ?CT(?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>, 0]),
+ ?CT(?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>, 3]),
+ ?CT(?MODULE,bs_sum_c,[<<7:4,11:4>>, 8]),
+ ?CT(?MODULE,bs_sum_c,[<<11:4>>, 15]),
+ ?CT(?MODULE,bs_sum_c,[<<>>, 26]),
+
+ erlang:trace_pattern({?MODULE,'_','_'},false,[local]),
+ shutdown(),
+ ?NM,
ok.
@@ -442,149 +376,149 @@ bs_sum_c(<<H:4,T/bits>>, Acc) -> bs_sum_c(T, H+Acc);
bs_sum_c(<<>>, Acc) -> Acc.
return_test() ->
- ?line setup([call]),
- ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}],
- [local]),
- ?line erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}],
- [local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported,[1]),
- ?line ?CT(?MODULE,local,[1]),
- ?line ?CT(?MODULE,local2,[1]),
- ?line ?CT(?MODULE,local_tail,[1]),
- ?line ?CT(erlang,hash,[1,1]),
- ?line ?RF(erlang,hash,2,1),
- ?line ?RF(?MODULE,local_tail,1,[1,1]),
- ?line ?RF(?MODULE,local2,1,[1,1]),
- ?line ?RF(?MODULE,local,1,[1,1,1]),
- ?line ?RF(?MODULE,exported,1,[1,1,1,1]),
- ?line ?RF(?MODULE,exported_wrap,1,[1,1,1,1]),
- ?line shutdown(),
- ?line setup([call,return_to]),
- ?line erlang:trace_pattern({?MODULE,'_','_'},[],
- [local]),
- ?line erlang:trace_pattern({erlang,hash,'_'},[],
- [local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported,[1]),
- ?line ?CT(?MODULE,local,[1]),
- ?line ?CT(?MODULE,local2,[1]),
- ?line ?CT(?MODULE,local_tail,[1]),
- ?line ?CT(erlang,hash,[1,1]),
- ?line ?RT(?MODULE,local_tail,1),
- ?line ?RT(?MODULE,local,1),
- ?line ?RT(?MODULE,exported,1),
- ?line ?RT(?MODULE,slave,2),
- ?line shutdown(),
- ?line setup([call,return_to]),
- ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}],
- [local]),
- ?line erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}],
- [local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported,[1]),
- ?line ?CT(?MODULE,local,[1]),
- ?line ?CT(?MODULE,local2,[1]),
- ?line ?CT(?MODULE,local_tail,[1]),
- ?line ?CT(erlang,hash,[1,1]),
- ?line ?RF(erlang,hash,2,1),
- ?line ?RT(?MODULE,local_tail,1),
- ?line ?RF(?MODULE,local_tail,1,[1,1]),
- ?line ?RF(?MODULE,local2,1,[1,1]),
- ?line ?RT(?MODULE,local,1),
- ?line ?RF(?MODULE,local,1,[1,1,1]),
- ?line ?RT(?MODULE,exported,1),
- ?line ?RF(?MODULE,exported,1,[1,1,1,1]),
- ?line ?RF(?MODULE,exported_wrap,1,[1,1,1,1]),
- ?line ?RT(?MODULE,slave,2),
- ?line shutdown(),
- ?line ?NM,
+ setup([call]),
+ erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}],
+ [local]),
+ erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}],
+ [local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported,[1]),
+ ?CT(?MODULE,local,[1]),
+ ?CT(?MODULE,local2,[1]),
+ ?CT(?MODULE,local_tail,[1]),
+ ?CT(erlang,hash,[1,1]),
+ ?RF(erlang,hash,2,1),
+ ?RF(?MODULE,local_tail,1,[1,1]),
+ ?RF(?MODULE,local2,1,[1,1]),
+ ?RF(?MODULE,local,1,[1,1,1]),
+ ?RF(?MODULE,exported,1,[1,1,1,1]),
+ ?RF(?MODULE,exported_wrap,1,[1,1,1,1]),
+ shutdown(),
+ setup([call,return_to]),
+ erlang:trace_pattern({?MODULE,'_','_'},[],
+ [local]),
+ erlang:trace_pattern({erlang,hash,'_'},[],
+ [local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported,[1]),
+ ?CT(?MODULE,local,[1]),
+ ?CT(?MODULE,local2,[1]),
+ ?CT(?MODULE,local_tail,[1]),
+ ?CT(erlang,hash,[1,1]),
+ ?RT(?MODULE,local_tail,1),
+ ?RT(?MODULE,local,1),
+ ?RT(?MODULE,exported,1),
+ ?RT(?MODULE,slave,2),
+ shutdown(),
+ setup([call,return_to]),
+ erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}],
+ [local]),
+ erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}],
+ [local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported,[1]),
+ ?CT(?MODULE,local,[1]),
+ ?CT(?MODULE,local2,[1]),
+ ?CT(?MODULE,local_tail,[1]),
+ ?CT(erlang,hash,[1,1]),
+ ?RF(erlang,hash,2,1),
+ ?RT(?MODULE,local_tail,1),
+ ?RF(?MODULE,local_tail,1,[1,1]),
+ ?RF(?MODULE,local2,1,[1,1]),
+ ?RT(?MODULE,local,1),
+ ?RF(?MODULE,local,1,[1,1,1]),
+ ?RT(?MODULE,exported,1),
+ ?RF(?MODULE,exported,1,[1,1,1,1]),
+ ?RF(?MODULE,exported_wrap,1,[1,1,1,1]),
+ ?RT(?MODULE,slave,2),
+ shutdown(),
+ ?NM,
ok.
on_and_off_test() ->
- ?line Pid = setup([call]),
- ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line LocalTail = fun() ->
- local_tail(1)
- end,
- ?line [1,1] = lambda_slave(LocalTail),
- ?line ?CT(?MODULE,local_tail,[1]),
- ?line erlang:trace(Pid,true,[return_to]),
- ?line [1,1] = lambda_slave(LocalTail),
- ?line ?CT(?MODULE,local_tail,[1]),
- ?line ?RT(?MODULE,_,_),
- ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]),
- ?line [1,1] = lambda_slave(LocalTail),
- ?line ?NM,
- ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[local]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?RT(?MODULE,slave,2),
- ?line 1 = erlang:trace_pattern({erlang,hash,2},[],[local]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(erlang,hash,[1,1]),
- ?line ?RT(?MODULE,local_tail,1),
- ?line ?RT(?MODULE,slave,2),
- ?line erlang:trace(Pid,true,[timestamp]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CTT(?MODULE,exported_wrap,[1]),
- ?line ?CTT(erlang,hash,[1,1]),
- ?line ?RTT(?MODULE,local_tail,1),
- ?line ?RTT(?MODULE,slave,2),
- ?line erlang:trace(Pid,false,[return_to,timestamp]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(erlang,hash,[1,1]),
- ?line erlang:trace(Pid,true,[return_to]),
- ?line 1 = erlang:trace_pattern({erlang,hash,2},[],[]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(erlang,hash,[1,1]),
- ?line ?RT(?MODULE,slave,2),
- ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]),
- ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
- ?line ?CT(?MODULE,exported_wrap,[1]),
- ?line ?CT(erlang,hash,[1,1]),
- ?line shutdown(),
- ?line erlang:trace_pattern({'_','_','_'},false,[local]),
- ?line N = erlang:trace_pattern({erlang,'_','_'},true,[local]),
- ?line case erlang:trace_pattern({erlang,'_','_'},false,[local]) of
- N ->
- ok;
- Else ->
- exit({number_mismatch, {expected, N}, {got, Else}})
- end,
- ?line case erlang:trace_pattern({erlang,'_','_'},false,[local]) of
- N ->
- ok;
- Else2 ->
- exit({number_mismatch, {expected, N}, {got, Else2}})
- end,
- ?line M = erlang:trace_pattern({erlang,'_','_'},true,[]),
- ?line case erlang:trace_pattern({erlang,'_','_'},false,[]) of
- M ->
- ok;
- Else3 ->
- exit({number_mismatch, {expected, N}, {got, Else3}})
- end,
- ?line case erlang:trace_pattern({erlang,'_','_'},false,[]) of
- M ->
- ok;
- Else4 ->
- exit({number_mismatch, {expected, N}, {got, Else4}})
- end,
- ?line ?NM,
+ Pid = setup([call]),
+ 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ LocalTail = fun() ->
+ local_tail(1)
+ end,
+ [1,1] = lambda_slave(LocalTail),
+ ?CT(?MODULE,local_tail,[1]),
+ erlang:trace(Pid,true,[return_to]),
+ [1,1] = lambda_slave(LocalTail),
+ ?CT(?MODULE,local_tail,[1]),
+ ?RT(?MODULE,_,_),
+ 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]),
+ [1,1] = lambda_slave(LocalTail),
+ ?NM,
+ 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[local]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?RT(?MODULE,slave,2),
+ 1 = erlang:trace_pattern({erlang,hash,2},[],[local]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(erlang,hash,[1,1]),
+ ?RT(?MODULE,local_tail,1),
+ ?RT(?MODULE,slave,2),
+ erlang:trace(Pid,true,[timestamp]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CTT(?MODULE,exported_wrap,[1]),
+ ?CTT(erlang,hash,[1,1]),
+ ?RTT(?MODULE,local_tail,1),
+ ?RTT(?MODULE,slave,2),
+ erlang:trace(Pid,false,[return_to,timestamp]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(erlang,hash,[1,1]),
+ erlang:trace(Pid,true,[return_to]),
+ 1 = erlang:trace_pattern({erlang,hash,2},[],[]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(erlang,hash,[1,1]),
+ ?RT(?MODULE,slave,2),
+ 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]),
+ [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]),
+ ?CT(?MODULE,exported_wrap,[1]),
+ ?CT(erlang,hash,[1,1]),
+ shutdown(),
+ erlang:trace_pattern({'_','_','_'},false,[local]),
+ N = erlang:trace_pattern({erlang,'_','_'},true,[local]),
+ case erlang:trace_pattern({erlang,'_','_'},false,[local]) of
+ N ->
+ ok;
+ Else ->
+ exit({number_mismatch, {expected, N}, {got, Else}})
+ end,
+ case erlang:trace_pattern({erlang,'_','_'},false,[local]) of
+ N ->
+ ok;
+ Else2 ->
+ exit({number_mismatch, {expected, N}, {got, Else2}})
+ end,
+ M = erlang:trace_pattern({erlang,'_','_'},true,[]),
+ case erlang:trace_pattern({erlang,'_','_'},false,[]) of
+ M ->
+ ok;
+ Else3 ->
+ exit({number_mismatch, {expected, N}, {got, Else3}})
+ end,
+ case erlang:trace_pattern({erlang,'_','_'},false,[]) of
+ M ->
+ ok;
+ Else4 ->
+ exit({number_mismatch, {expected, N}, {got, Else4}})
+ end,
+ ?NM,
ok.
systematic_on_off(Config) when is_list(Config) ->
@@ -634,12 +568,12 @@ systematic_on_off_1(Local) ->
verify_trace_info(Global, Local) ->
case erlang:trace_info({?MODULE,exported_wrap,1}, all) of
- {all,false} ->
- false = Global,
- [] = Local;
- {all,Ps} ->
- io:format("~p\n", [Ps]),
- [verify_trace_info(P, Global, Local) || P <- Ps]
+ {all,false} ->
+ false = Global,
+ [] = Local;
+ {all,Ps} ->
+ io:format("~p\n", [Ps]),
+ [verify_trace_info(P, Global, Local) || P <- Ps]
end,
global_call(Global, Local),
local_call(Local),
@@ -651,12 +585,10 @@ verify_trace_info({match_spec,[]}, _, _) -> ok;
verify_trace_info({meta_match_spec,[]}, _, _) -> ok;
verify_trace_info({LocalFlag,Bool}, _, Local) when is_boolean(Bool) ->
try
- Bool = lists:member(LocalFlag, Local)
+ Bool = lists:member(LocalFlag, Local)
catch
- error:_ ->
- io:format("Line ~p: {~p,~p}, false, ~p\n",
- [?LINE,LocalFlag,Bool,Local]),
- ?t:fail()
+ error:_ ->
+ ct:fail("Line ~p: {~p,~p}, false, ~p\n", [?LINE,LocalFlag,Bool,Local])
end;
verify_trace_info({meta,Pid}, false, Local) when is_pid(Pid) ->
true = lists:member(meta, Local);
@@ -668,10 +600,10 @@ verify_trace_info({call_count,_}, false, Local) ->
global_call(Global, Local) ->
apply_slave(?MODULE, exported_wrap, [global_call]),
case Global of
- false ->
- recv_local_call(Local, [global_call]);
- true ->
- ?CT(?MODULE, exported_wrap, [global_call])
+ false ->
+ recv_local_call(Local, [global_call]);
+ true ->
+ ?CT(?MODULE, exported_wrap, [global_call])
end.
local_call(Local) ->
@@ -680,16 +612,16 @@ local_call(Local) ->
recv_local_call(Local, Args) ->
case lists:member(local, Local) of
- false ->
- ok;
- true ->
- ?CT(?MODULE, exported_wrap, Args)
+ false ->
+ ok;
+ true ->
+ ?CT(?MODULE, exported_wrap, Args)
end,
case lists:member(meta, Local) of
- false ->
- ok;
- true ->
- ?CTT(?MODULE, exported_wrap, Args)
+ false ->
+ ok;
+ true ->
+ ?CTT(?MODULE, exported_wrap, Args)
end,
ok.
@@ -698,99 +630,99 @@ combinations([_]=One) ->
combinations([H|T]) ->
Cs = combinations(T),
[[H|C] || C <- Cs] ++ Cs.
-
+
stack_grow_test() ->
- ?line setup([call,return_to]),
- ?line 1 = erlang:trace_pattern({?MODULE,loop,4},
- [{'_',[],[{return_trace}]}],[local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line Num = 1 bsl 15,
- ?line Fun =
- fun(_F,0) -> ok;
- (F,N) ->
- receive _A ->
- receive _B ->
- receive _C ->
- F(F,N-1)
- end
- end
- end
- end,
- ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]),
- ?line Fun(Fun,Num + 1),
- ?line ?NM,
+ setup([call,return_to]),
+ 1 = erlang:trace_pattern({?MODULE,loop,4},
+ [{'_',[],[{return_trace}]}],[local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ Num = 1 bsl 15,
+ Fun =
+ fun(_F,0) -> ok;
+ (F,N) ->
+ receive _A ->
+ receive _B ->
+ receive _C ->
+ F(F,N-1)
+ end
+ end
+ end
+ end,
+ apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]),
+ Fun(Fun,Num + 1),
+ ?NM,
ok.
info_test() ->
- ?line Flags1 = lists:sort([call,return_to]),
- ?line Pid = setup(Flags1),
- ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]},
- {'_',[],[]}],
- ?line erlang:trace_pattern({?MODULE,exported_wrap,1},Prog,[local]),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
- ?line Self = self(),
- ?line {flags,L} = erlang:trace_info(Pid,flags),
- ?line case lists:sort(L) of
- Flags1 ->
- ok;
- Wrong1 ->
- exit({bad_result, {erlang,trace_info,[Pid,flags]},
- {expected, Flags1}, {got, Wrong1}})
- end,
- ?line {tracer,Tracer} = erlang:trace_info(Pid,tracer),
- ?line case Tracer of
- Self ->
- ok;
- Wrong2 ->
- exit({bad_result, {erlang,trace_info,[Pid,tracer]},
- {expected, Self}, {got, Wrong2}})
- end,
- ?line {traced,local} = erlang:trace_info({?MODULE,exported_wrap,1},traced),
- ?line {match_spec, MS} =
- erlang:trace_info({?MODULE,exported_wrap,1},match_spec),
- ?line case MS of
- Prog ->
- ok;
- Wrong3 ->
- exit({bad_result, {erlang,trace_info,
- [{?MODULE,exported_wrap,1},
- match_spec]},
- {expected, Prog}, {got, Wrong3}})
- end,
- ?line erlang:garbage_collect(self()),
- ?line receive
- after 1 ->
- ok
- end,
- ?line io:format("~p~n",[MS]),
- ?line {match_spec,MS2} =
- erlang:trace_info({?MODULE,exported_wrap,1},match_spec),
- ?line io:format("~p~n",[MS2]),
- ?line erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]),
- ?line {traced,global} =
- erlang:trace_info({?MODULE,exported_wrap,1},traced),
- ?line {match_spec,[]} =
- erlang:trace_info({?MODULE,exported_wrap,1},match_spec),
- ?line {traced,undefined} =
- erlang:trace_info({?MODULE,exported_wrap,2},traced),
- ?line {match_spec,undefined} =
- erlang:trace_info({?MODULE,exported_wrap,2},match_spec),
- ?line {traced,false} = erlang:trace_info({?MODULE,exported,1},traced),
- ?line {match_spec,false} =
- erlang:trace_info({?MODULE,exported,1},match_spec),
- ?line shutdown(),
+ Flags1 = lists:sort([call,return_to]),
+ Pid = setup(Flags1),
+ Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]},
+ {'_',[],[]}],
+ erlang:trace_pattern({?MODULE,exported_wrap,1},Prog,[local]),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,[local]),
+ Self = self(),
+ {flags,L} = erlang:trace_info(Pid,flags),
+ case lists:sort(L) of
+ Flags1 ->
+ ok;
+ Wrong1 ->
+ exit({bad_result, {erlang,trace_info,[Pid,flags]},
+ {expected, Flags1}, {got, Wrong1}})
+ end,
+ {tracer,Tracer} = erlang:trace_info(Pid,tracer),
+ case Tracer of
+ Self ->
+ ok;
+ Wrong2 ->
+ exit({bad_result, {erlang,trace_info,[Pid,tracer]},
+ {expected, Self}, {got, Wrong2}})
+ end,
+ {traced,local} = erlang:trace_info({?MODULE,exported_wrap,1},traced),
+ {match_spec, MS} =
+ erlang:trace_info({?MODULE,exported_wrap,1},match_spec),
+ case MS of
+ Prog ->
+ ok;
+ Wrong3 ->
+ exit({bad_result, {erlang,trace_info,
+ [{?MODULE,exported_wrap,1},
+ match_spec]},
+ {expected, Prog}, {got, Wrong3}})
+ end,
+ erlang:garbage_collect(self()),
+ receive
+ after 1 ->
+ ok
+ end,
+ io:format("~p~n",[MS]),
+ {match_spec,MS2} =
+ erlang:trace_info({?MODULE,exported_wrap,1},match_spec),
+ io:format("~p~n",[MS2]),
+ erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]),
+ {traced,global} =
+ erlang:trace_info({?MODULE,exported_wrap,1},traced),
+ {match_spec,[]} =
+ erlang:trace_info({?MODULE,exported_wrap,1},match_spec),
+ {traced,undefined} =
+ erlang:trace_info({?MODULE,exported_wrap,2},traced),
+ {match_spec,undefined} =
+ erlang:trace_info({?MODULE,exported_wrap,2},match_spec),
+ {traced,false} = erlang:trace_info({?MODULE,exported,1},traced),
+ {match_spec,false} =
+ erlang:trace_info({?MODULE,exported,1},match_spec),
+ shutdown(),
ok.
delete_test(Config) ->
- ?line Priv = ?config(priv_dir, Config),
- ?line Data = ?config(data_dir, Config),
- ?line File = filename:join(Data, "trace_local_dummy"),
- ?line {ok,trace_local_dummy} = c:c(File, [{outdir,Priv}]),
- ?line code:purge(trace_local_dummy),
- ?line code:delete(trace_local_dummy),
- ?line 0 = erlang:trace_pattern({trace_local_dummy,'_','_'},true,[local]),
- ?line ?NM,
+ Priv = proplists:get_value(priv_dir, Config),
+ Data = proplists:get_value(data_dir, Config),
+ File = filename:join(Data, "trace_local_dummy"),
+ {ok,trace_local_dummy} = c:c(File, [{outdir,Priv}]),
+ code:purge(trace_local_dummy),
+ code:delete(trace_local_dummy),
+ 0 = erlang:trace_pattern({trace_local_dummy,'_','_'},true,[local]),
+ ?NM,
ok.
@@ -798,34 +730,34 @@ delete_test(Config) ->
%%% exception_test %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
exception_test(Opts) ->
- ?line {ProcFlags,PatFlags} =
- case proplists:get_bool(meta, Opts) of
- true -> {[timestamp],[meta]};
- false -> {[call,return_to,timestamp],[local]}
- end,
- ?line case proplists:get_bool(nocatch, Opts) of
- false ->
- ?line Exceptions = exceptions(),
- ?line exception_test_setup(ProcFlags, PatFlags),
- ?line lists:foreach(
- fun ({Func,Args}) ->
- ?line exception_test(Opts, Func, Args)
- end,
- Exceptions),
- ?line shutdown();
- true ->
- ?line Exceptions = exceptions(),
- ?line lists:foreach(
- fun ({Func,Args}) ->
- ?line exception_test_setup(
- [procs|ProcFlags],
- PatFlags),
- ?line exception_test(Opts, Func, Args),
- ?line shutdown()
- end,
- Exceptions)
- end,
- ?line ok.
+ {ProcFlags,PatFlags} =
+ case proplists:get_bool(meta, Opts) of
+ true -> {[timestamp],[meta]};
+ false -> {[call,return_to,timestamp],[local]}
+ end,
+ case proplists:get_bool(nocatch, Opts) of
+ false ->
+ Exceptions = exceptions(),
+ exception_test_setup(ProcFlags, PatFlags),
+ lists:foreach(
+ fun ({Func,Args}) ->
+ exception_test(Opts, Func, Args)
+ end,
+ Exceptions),
+ shutdown();
+ true ->
+ Exceptions = exceptions(),
+ lists:foreach(
+ fun ({Func,Args}) ->
+ exception_test_setup(
+ [procs|ProcFlags],
+ PatFlags),
+ exception_test(Opts, Func, Args),
+ shutdown()
+ end,
+ Exceptions)
+ end,
+ ok.
exceptions() ->
Ref = make_ref(),
@@ -848,65 +780,65 @@ exceptions() ->
{{?MODULE,lists_reverse}, [LL,[]]}].
exception_test_setup(ProcFlags, PatFlags) ->
- ?line Pid = setup(ProcFlags),
- ?line io:format("=== exception_test_setup(~p, ~p): ~p~n",
- [ProcFlags,PatFlags,Pid]),
- ?line Mprog = [{'_',[],[{exception_trace}]}],
- ?line erlang:trace_pattern({?MODULE,'_','_'}, Mprog, PatFlags),
- ?line erlang:trace_pattern({?MODULE,slave,'_'},false,PatFlags),
- ?line [1,1,1,1,1] =
- [erlang:trace_pattern({erlang,F,A}, Mprog, PatFlags)
- || {F,A} <- [{exit,1},{error,1},{error,2},{throw,1},{'++',2}]],
- ?line 1 = erlang:trace_pattern({lists,reverse,2}, Mprog, PatFlags),
- ?line ok.
+ Pid = setup(ProcFlags),
+ io:format("=== exception_test_setup(~p, ~p): ~p~n",
+ [ProcFlags,PatFlags,Pid]),
+ Mprog = [{'_',[],[{exception_trace}]}],
+ erlang:trace_pattern({?MODULE,'_','_'}, Mprog, PatFlags),
+ erlang:trace_pattern({?MODULE,slave,'_'},false,PatFlags),
+ [1,1,1,1,1] =
+ [erlang:trace_pattern({erlang,F,A}, Mprog, PatFlags)
+ || {F,A} <- [{exit,1},{error,1},{error,2},{throw,1},{'++',2}]],
+ 1 = erlang:trace_pattern({lists,reverse,2}, Mprog, PatFlags),
+ ok.
-record(exc_opts, {nocatch=false, meta=false}).
exception_test(Opts, Func0, Args0) ->
- ?line io:format("=== exception_test(~p, ~p, ~p)~n",
- [Opts,Func0,abbr(Args0)]),
- ?line Apply = proplists:get_bool(apply, Opts),
- ?line Function = proplists:get_bool(function, Opts),
- ?line Nocatch = proplists:get_bool(nocatch, Opts),
- ?line Meta = proplists:get_bool(meta, Opts),
- ?line ExcOpts = #exc_opts{nocatch=Nocatch,meta=Meta},
-
+ io:format("=== exception_test(~p, ~p, ~p)~n",
+ [Opts,Func0,abbr(Args0)]),
+ Apply = proplists:get_bool(apply, Opts),
+ Function = proplists:get_bool(function, Opts),
+ Nocatch = proplists:get_bool(nocatch, Opts),
+ Meta = proplists:get_bool(meta, Opts),
+ ExcOpts = #exc_opts{nocatch=Nocatch,meta=Meta},
+
%% Func0 and Args0 are for the innermost call, now we will
%% wrap them in wrappers...
- ?line {Func1,Args1} =
- case Function of
- true -> {fun exc/2,[Func0,Args0]};
- false -> {Func0,Args0}
- end,
-
- ?line {Func,Args} =
- case Apply of
- true -> {{erlang,apply},[Func1,Args1]};
- false -> {Func1,Args1}
- end,
-
- ?line R1 = exc_slave(ExcOpts, Func, Args),
- ?line Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}],
- ?line Stack3 = [{?MODULE,exc,2,[]}|Stack2],
- ?line Rs =
- case x_exc_top(ExcOpts, Func, Args) of % Emulation
- {crash,{Reason,Stack}}=R when is_list(Stack) ->
- [R,
- {crash,{Reason,Stack++Stack2}},
- {crash,{Reason,Stack++Stack3}}];
- R ->
- [R]
- end,
- ?line exception_validate(R1, Rs),
- ?line case R1 of
- {crash,Crash} ->
- ?line expect({trace_ts,exit,Crash});
- _ when not Meta ->
- ?line expect({rtt,{?MODULE,slave,2}});
- _ ->
- ok
- end,
- ?line expect({nm}).
+ {Func1,Args1} =
+ case Function of
+ true -> {fun exc/2,[Func0,Args0]};
+ false -> {Func0,Args0}
+ end,
+
+ {Func,Args} =
+ case Apply of
+ true -> {{erlang,apply},[Func1,Args1]};
+ false -> {Func1,Args1}
+ end,
+
+ R1 = exc_slave(ExcOpts, Func, Args),
+ Stack2 = [{?MODULE,exc_top,3,[]},{?MODULE,slave,2,[]}],
+ Stack3 = [{?MODULE,exc,2,[]}|Stack2],
+ Rs =
+ case x_exc_top(ExcOpts, Func, Args) of % Emulation
+ {crash,{Reason,Stack}}=R when is_list(Stack) ->
+ [R,
+ {crash,{Reason,Stack++Stack2}},
+ {crash,{Reason,Stack++Stack3}}];
+ R ->
+ [R]
+ end,
+ exception_validate(R1, Rs),
+ case R1 of
+ {crash,Crash} ->
+ expect({trace_ts,exit,Crash});
+ _ when not Meta ->
+ expect({rtt,{?MODULE,slave,2}});
+ _ ->
+ ok
+ end,
+ expect({nm}).
exception_validate(R0, Rs0) ->
R = clean_location(R0),
@@ -915,16 +847,16 @@ exception_validate(R0, Rs0) ->
exception_validate_1(R1, [R2|Rs]) ->
case [R1|R2] of
- [R|R] ->
- ok;
- [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}|
- {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] ->
- same({crash,{badarg,[{lists,reverse,
- [lists:reverse(L1b, L1a),[]],[]}|T]}},
- {crash,{badarg,[{lists,reverse,
- [lists:reverse(L2b, L2a),[]],[]}|T]}});
- _ when is_list(Rs), Rs =/= [] ->
- exception_validate(R1, Rs)
+ [R|R] ->
+ ok;
+ [{crash,{badarg,[{lists,reverse,[L1a,L1b],_}|T]}}|
+ {crash,{badarg,[{lists,reverse,[L2a,L2b],_}|T]}}] ->
+ same({crash,{badarg,[{lists,reverse,
+ [lists:reverse(L1b, L1a),[]],[]}|T]}},
+ {crash,{badarg,[{lists,reverse,
+ [lists:reverse(L2b, L2a),[]],[]}|T]}});
+ _ when is_list(Rs), Rs =/= [] ->
+ exception_validate(R1, Rs)
end.
clean_location({crash,{Reason,Stk0}}) ->
@@ -942,20 +874,20 @@ concurrency(_Config) ->
%% if an aligned word-sized write is not atomic.
Ps0 = [spawn_monitor(fun() -> infinite_loop() end) ||
- _ <- lists:seq(1, 2*N)],
+ _ <- lists:seq(1, 2*N)],
OnAndOff = fun() -> concurrency_on_and_off() end,
Ps1 = [spawn_monitor(OnAndOff)|Ps0],
- ?t:sleep(1000),
+ timer:sleep(1000),
%% Now spawn off N more processes that turn on off and off
%% a local trace pattern.
Ps = [spawn_monitor(OnAndOff) || _ <- lists:seq(1, N)] ++ Ps1,
- ?t:sleep(1000),
+ timer:sleep(1000),
%% Clean up.
[exit(Pid, kill) || {Pid,_} <- Ps],
[receive
- {'DOWN',Ref,process,Pid,killed} -> ok
+ {'DOWN',Ref,process,Pid,killed} -> ok
end || {Pid,Ref} <- Ps],
erlang:trace_pattern({?MODULE,infinite_loop,0}, false, [local]),
ok.
@@ -999,16 +931,16 @@ local_tail(Val) ->
exc_top(ExcOpts, Func, Args) ->
case ExcOpts#exc_opts.nocatch of
- false ->
- try exc_jump(Func, Args) of
- Value ->
- {value,Value}
- catch
- Class:Reason ->
- {Class,Reason}
- end;
- true ->
- {value,exc_jump(Func, Args)}
+ false ->
+ try exc_jump(Func, Args) of
+ Value ->
+ {value,Value}
+ catch
+ Class:Reason ->
+ {Class,Reason}
+ end;
+ true ->
+ {value,exc_jump(Func, Args)}
end.
%% x_* functions emulate the non-x_* ones.
@@ -1017,42 +949,42 @@ exc_top(ExcOpts, Func, Args) ->
%% The only possible place for exception
%% is below exc/2.
x_exc_top(ExcOpts, Func, Args) ->
- ?line Rtt = not ExcOpts#exc_opts.meta,
- ?line expect({ctt,{?MODULE,exc_top},[ExcOpts,Func,Args]}),
- ?line case x_exc_jump(ExcOpts, Func, Args) of
- Result when not ExcOpts#exc_opts.nocatch ->
- ?line expect([Rtt,{rtt,{?MODULE,exc_top,3}},
- ?LINE,{rft,{?MODULE,exc_top,3},Result}]),
- ?line Result;
- {value,_}=Result ->
-
- ?line expect([Rtt,{rtt,{?MODULE,exc_top,3}},
- ?LINE,{rft,{?MODULE,exc_top,3},Result}]),
- ?line Result;
- {exit,Reason}=CR ->
- ?line expect({eft,{?MODULE,exc_top,3},CR}),
- ?line {crash,Reason};
- {error,Reason}=CR ->
- ?line expect({eft,{?MODULE,exc_top,3},CR}),
- ?line {crash,{Reason,x_exc_stacktrace()}};
- CR ->
- ?line expect({eft,{?MODULE,exc_top,3},CR}),
- ?line {crash,CR}
- end.
+ Rtt = not ExcOpts#exc_opts.meta,
+ expect({ctt,{?MODULE,exc_top},[ExcOpts,Func,Args]}),
+ case x_exc_jump(ExcOpts, Func, Args) of
+ Result when not ExcOpts#exc_opts.nocatch ->
+ expect([Rtt,{rtt,{?MODULE,exc_top,3}},
+ ?LINE,{rft,{?MODULE,exc_top,3},Result}]),
+ Result;
+ {value,_}=Result ->
+
+ expect([Rtt,{rtt,{?MODULE,exc_top,3}},
+ ?LINE,{rft,{?MODULE,exc_top,3},Result}]),
+ Result;
+ {exit,Reason}=CR ->
+ expect({eft,{?MODULE,exc_top,3},CR}),
+ {crash,Reason};
+ {error,Reason}=CR ->
+ expect({eft,{?MODULE,exc_top,3},CR}),
+ {crash,{Reason,x_exc_stacktrace()}};
+ CR ->
+ expect({eft,{?MODULE,exc_top,3},CR}),
+ {crash,CR}
+ end.
exc_jump(Func, Args) ->
exc(Func, Args, jump).
x_exc_jump(ExcOpts, Func, Args) ->
- ?line expect({ctt,{?MODULE,exc_jump},[Func,Args]}),
- ?line case x_exc(ExcOpts, Func, Args, jump) of
- {value,Value}=Result ->
- ?line expect({rft,{?MODULE,exc_jump,2},Value}),
- ?line Result;
- CR ->
- ?line expect({eft,{?MODULE,exc_jump,2},CR}),
- ?line CR
- end.
+ expect({ctt,{?MODULE,exc_jump},[Func,Args]}),
+ case x_exc(ExcOpts, Func, Args, jump) of
+ {value,Value}=Result ->
+ expect({rft,{?MODULE,exc_jump,2},Value}),
+ Result;
+ CR ->
+ expect({eft,{?MODULE,exc_jump,2},CR}),
+ CR
+ end.
exc(Func, Args, jump) ->
exc(Func, Args, do);
@@ -1060,25 +992,25 @@ exc(Func, Args, do) ->
exc(Func, Args).
x_exc(ExcOpts, Func, Args, jump) ->
- ?line expect({ctt,{?MODULE,exc},[Func,Args,jump]}),
- ?line case x_exc(ExcOpts, Func, Args, do) of
- {value,Value}=Result ->
- ?line expect({rft,{?MODULE,exc,3},Value}),
- ?line Result;
- CR ->
- ?line expect({eft,{?MODULE,exc,3},CR}),
- ?line CR
- end;
+ expect({ctt,{?MODULE,exc},[Func,Args,jump]}),
+ case x_exc(ExcOpts, Func, Args, do) of
+ {value,Value}=Result ->
+ expect({rft,{?MODULE,exc,3},Value}),
+ Result;
+ CR ->
+ expect({eft,{?MODULE,exc,3},CR}),
+ CR
+ end;
x_exc(ExcOpts, Func, Args, do) ->
- ?line expect({ctt,{?MODULE,exc},[Func,Args,do]}),
- ?line case x_exc(ExcOpts, Func, Args) of
- {value,Value}=Result ->
- ?line expect({rft,{?MODULE,exc,3},Value}),
- ?line Result;
- CR ->
- ?line expect({eft,{?MODULE,exc,3},CR}),
- ?line CR
- end.
+ expect({ctt,{?MODULE,exc},[Func,Args,do]}),
+ case x_exc(ExcOpts, Func, Args) of
+ {value,Value}=Result ->
+ expect({rft,{?MODULE,exc,3},Value}),
+ Result;
+ CR ->
+ expect({eft,{?MODULE,exc,3},CR}),
+ CR
+ end.
exc({erlang,apply}, [{M,F},A]) ->
erlang:apply(M, F, id(A));
@@ -1108,114 +1040,114 @@ exc(Func, [A,B]) when is_function(Func, 2) ->
Func(A, id(B)).
x_exc(ExcOpts, {erlang,apply}=Func0, [{_,_}=Func,Args]=Args0) ->
- ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}),
- ?line x_exc_body(ExcOpts, Func, Args, true);
+ expect({ctt,{?MODULE,exc},[Func0,Args0]}),
+ x_exc_body(ExcOpts, Func, Args, true);
x_exc(ExcOpts, {erlang,apply}=Func0, [Func,Args]=Args0)
when is_function(Func, 2)->
- ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}),
- ?line x_exc_func(ExcOpts, Func, Args, Args);
+ expect({ctt,{?MODULE,exc},[Func0,Args0]}),
+ x_exc_func(ExcOpts, Func, Args, Args);
x_exc(ExcOpts, {_,_}=Func, Args) ->
- ?line expect({ctt,{?MODULE,exc},[Func,Args]}),
- ?line x_exc_body(ExcOpts, Func, Args, false);
+ expect({ctt,{?MODULE,exc},[Func,Args]}),
+ x_exc_body(ExcOpts, Func, Args, false);
x_exc(ExcOpts, Func0, [_,Args]=Args0)
when is_function(Func0, 2) ->
- ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}),
- ?line x_exc_func(ExcOpts, Func0, Args0, Args).
+ expect({ctt,{?MODULE,exc},[Func0,Args0]}),
+ x_exc_func(ExcOpts, Func0, Args0, Args).
x_exc_func(ExcOpts, Func, [Func1,Args1]=Args, Id) ->
%% Assumes the called fun =:= fun exc/2,
%% will utterly fail otherwise.
- ?line Rtt = not ExcOpts#exc_opts.meta,
- ?line {module,M} = erlang:fun_info(Func, module),
- ?line {name,F} = erlang:fun_info(Func, name),
- ?line expect([{ctt,{?MODULE,id},[Id]},
- ?LINE,{rft,{?MODULE,id,1},Id},
- ?LINE,Rtt,{rtt,{?MODULE,exc,2}},
- ?LINE,{ctt,{M,F},Args}]),
- ?line case x_exc(ExcOpts, Func1, Args1) of
- {value,Value}=Result ->
- ?line expect([{rft,{M,F,2},Value},
- ?LINE,{rft,{?MODULE,exc,2},Value}]),
- ?line Result;
- CR ->
- ?line expect([{eft,{M,F,2},CR},
- ?LINE,{eft,{?MODULE,exc,2},CR}]),
- ?line CR
- end.
+ Rtt = not ExcOpts#exc_opts.meta,
+ {module,M} = erlang:fun_info(Func, module),
+ {name,F} = erlang:fun_info(Func, name),
+ expect([{ctt,{?MODULE,id},[Id]},
+ ?LINE,{rft,{?MODULE,id,1},Id},
+ ?LINE,Rtt,{rtt,{?MODULE,exc,2}},
+ ?LINE,{ctt,{M,F},Args}]),
+ case x_exc(ExcOpts, Func1, Args1) of
+ {value,Value}=Result ->
+ expect([{rft,{M,F,2},Value},
+ ?LINE,{rft,{?MODULE,exc,2},Value}]),
+ Result;
+ CR ->
+ expect([{eft,{M,F,2},CR},
+ ?LINE,{eft,{?MODULE,exc,2},CR}]),
+ CR
+ end.
x_exc_body(ExcOpts, {M,F}=Func, Args, Apply) ->
- ?line Nocatch = ExcOpts#exc_opts.nocatch,
- ?line Rtt = not ExcOpts#exc_opts.meta,
- ?line Id = case Apply of
- true -> Args;
- false -> lists:last(Args)
- end,
- ?line expect([{ctt,{?MODULE,id},[Id]},
- ?LINE,{rft,{?MODULE,id,1},Id},
- ?LINE,Rtt,{rtt,{?MODULE,exc,2}},
- ?LINE,{ctt,{M,F},Args}]),
- ?line Arity = length(Args),
- ?line try exc(Func, Args) of
- Value ->
- ?line x_exc_value(Rtt, M, F, Args, Arity, Value),
- ?line case expect() of
- {rtt,{M,F,Arity}} when Rtt, Apply ->
- %% We may get the above when
- %% applying a BIF.
- ?line expect({rft,{?MODULE,exc,2},Value});
- {rtt,{?MODULE,exc,2}} when Rtt, not Apply ->
- %% We may get the above when
- %% calling a BIF.
- ?line expect({rft,{?MODULE,exc,2},Value});
- {rft,{?MODULE,exc,2},Value} ->
- ?line ok
- end,
- ?line {value,Value}
- catch
- Thrown when Nocatch ->
- ?line CR = {error,{nocatch,Thrown}},
- ?line x_exc_exception(Rtt, M, F, Args, Arity, CR),
- ?line expect({eft,{?MODULE,exc,2},CR}),
- ?line CR;
- Class:Reason ->
- ?line CR = {Class,Reason},
- ?line x_exc_exception(Rtt, M, F, Args, Arity, CR),
- ?line expect({eft,{?MODULE,exc,2},CR}),
- ?line CR
- end.
+ Nocatch = ExcOpts#exc_opts.nocatch,
+ Rtt = not ExcOpts#exc_opts.meta,
+ Id = case Apply of
+ true -> Args;
+ false -> lists:last(Args)
+ end,
+ expect([{ctt,{?MODULE,id},[Id]},
+ ?LINE,{rft,{?MODULE,id,1},Id},
+ ?LINE,Rtt,{rtt,{?MODULE,exc,2}},
+ ?LINE,{ctt,{M,F},Args}]),
+ Arity = length(Args),
+ try exc(Func, Args) of
+ Value ->
+ x_exc_value(Rtt, M, F, Args, Arity, Value),
+ case expect() of
+ {rtt,{M,F,Arity}} when Rtt, Apply ->
+ %% We may get the above when
+ %% applying a BIF.
+ expect({rft,{?MODULE,exc,2},Value});
+ {rtt,{?MODULE,exc,2}} when Rtt, not Apply ->
+ %% We may get the above when
+ %% calling a BIF.
+ expect({rft,{?MODULE,exc,2},Value});
+ {rft,{?MODULE,exc,2},Value} ->
+ ok
+ end,
+ {value,Value}
+ catch
+ Thrown when Nocatch ->
+ CR = {error,{nocatch,Thrown}},
+ x_exc_exception(Rtt, M, F, Args, Arity, CR),
+ expect({eft,{?MODULE,exc,2},CR}),
+ CR;
+ Class:Reason ->
+ CR = {Class,Reason},
+ x_exc_exception(Rtt, M, F, Args, Arity, CR),
+ expect({eft,{?MODULE,exc,2},CR}),
+ CR
+ end.
x_exc_value(Rtt, ?MODULE, lists_reverse, [La,Lb], 2, R) ->
- ?line L = lists:reverse(Lb, La),
- ?line expect([fun ({ctt,{lists,reverse},[L1,L2]}) ->
- ?line same(L, lists:reverse(L2, L1)),
- ?line next;
- (Msg) ->
- ?line same({rft,{lists,reverse,2},R}, Msg),
- ?line same(R, lists:reverse(L, [])),
- ?line done
- end,
- ?LINE,Rtt,{rtt,{?MODULE,lists_reverse,2}},
- ?LINE,{rft,{?MODULE,lists_reverse,2},R}]);
+ L = lists:reverse(Lb, La),
+ expect([fun ({ctt,{lists,reverse},[L1,L2]}) ->
+ same(L, lists:reverse(L2, L1)),
+ next;
+ (Msg) ->
+ same({rft,{lists,reverse,2},R}, Msg),
+ same(R, lists:reverse(L, [])),
+ done
+ end,
+ ?LINE,Rtt,{rtt,{?MODULE,lists_reverse,2}},
+ ?LINE,{rft,{?MODULE,lists_reverse,2},R}]);
x_exc_value(_Rtt, M, F, _, Arity, Value) ->
- ?line expect({rft,{M,F,Arity},Value}).
+ expect({rft,{M,F,Arity},Value}).
x_exc_exception(_Rtt, ?MODULE, lists_reverse, [La,Lb], 2, CR) ->
- ?line L = lists:reverse(Lb, La),
- ?line expect([fun ({ctt,{lists,reverse},[L1,L2]}) ->
- ?line same(L, lists:reverse(L2, L1)),
- ?line next;
- (Msg) ->
- ?line same({eft,{lists,reverse,2},CR}, Msg),
- ?line done
- end,
- ?LINE,{eft,{?MODULE,lists_reverse,2},CR}]);
+ L = lists:reverse(Lb, La),
+ expect([fun ({ctt,{lists,reverse},[L1,L2]}) ->
+ same(L, lists:reverse(L2, L1)),
+ next;
+ (Msg) ->
+ same({eft,{lists,reverse,2},CR}, Msg),
+ done
+ end,
+ ?LINE,{eft,{?MODULE,lists_reverse,2},CR}]);
x_exc_exception(Rtt, ?MODULE, undef, [_], 1, {Class,Reason}=CR) ->
- ?line expect([{ctt,{erlang,Class},[Reason]},
- ?LINE,{eft,{erlang,Class,1},CR},
- ?LINE,Rtt,{rtt,{error_handler,crash,1}},
- ?LINE,{eft,{?MODULE,undef,1},CR}]);
+ expect([{ctt,{erlang,Class},[Reason]},
+ ?LINE,{eft,{erlang,Class,1},CR},
+ ?LINE,Rtt,{rtt,{error_handler,crash,1}},
+ ?LINE,{eft,{?MODULE,undef,1},CR}]);
x_exc_exception(_Rtt, M, F, _, Arity, CR) ->
- ?line expect({eft,{M,F,Arity},CR}).
+ expect({eft,{M,F,Arity},CR}).
x_exc_stacktrace() ->
x_exc_stacktrace(erlang:get_stacktrace()).
@@ -1252,24 +1184,24 @@ lists_reverse(A, B) ->
slave(Dest, Sync) ->
Dest ! Sync,
receive
- {From,Tag,{apply,M,F,A}} when is_pid(From) ->
- ?line ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]),
- ?line Res = apply(M,F,A),
- ?line ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]),
- From ! {Tag,Res},
- slave(From, Tag);
- {From,Tag,{lambda,Fun}} when is_pid(From) ->
- Res = Fun(),
- From ! {Tag,Res},
- slave(From, Tag);
- {From,Tag,{exc_top,Catch,Func,Args}} when is_pid(From) ->
- ?line ?dbgformat("Exc: ~p ~p~p ~n",[Catch,Func,Args]),
- ?line Res = exc_top(Catch, Func, Args),
- ?line ?dbgformat("done Exc: ~p ~p~p ~n",[Catch,Func,Args]),
- From ! {Tag,Res},
- slave(From,Tag);
- die ->
- exit(normal)
+ {From,Tag,{apply,M,F,A}} when is_pid(From) ->
+ ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]),
+ Res = apply(M,F,A),
+ ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]),
+ From ! {Tag,Res},
+ slave(From, Tag);
+ {From,Tag,{lambda,Fun}} when is_pid(From) ->
+ Res = Fun(),
+ From ! {Tag,Res},
+ slave(From, Tag);
+ {From,Tag,{exc_top,Catch,Func,Args}} when is_pid(From) ->
+ ?dbgformat("Exc: ~p ~p~p ~n",[Catch,Func,Args]),
+ Res = exc_top(Catch, Func, Args),
+ ?dbgformat("done Exc: ~p ~p~p ~n",[Catch,Func,Args]),
+ From ! {Tag,Res},
+ slave(From,Tag);
+ die ->
+ exit(normal)
end.
setup(ProcFlags) ->
@@ -1280,30 +1212,30 @@ setup(ProcFlags) ->
Pid = spawn(fun () -> slave(Self, Sync) end),
Mref = erlang:monitor(process, Pid),
receive
- Sync ->
- put(slave, {Pid,Mref}),
- case ProcFlags of
- [] -> ok;
- _ ->
- erlang:trace(Pid, true, ProcFlags)
- end,
- Pid
+ Sync ->
+ put(slave, {Pid,Mref}),
+ case ProcFlags of
+ [] -> ok;
+ _ ->
+ erlang:trace(Pid, true, ProcFlags)
+ end,
+ Pid
end.
shutdown() ->
trace_off(),
{Pid,Mref} = get(slave),
try erlang:is_process_alive(Pid) of
- true ->
- Pid ! die,
- receive
- {'DOWN',Mref,process,Pid,Reason} ->
- Reason
- end;
- _ ->
- not_alive
+ true ->
+ Pid ! die,
+ receive
+ {'DOWN',Mref,process,Pid,Reason} ->
+ Reason
+ end;
+ _ ->
+ not_alive
catch _:_ ->
- undefined
+ undefined
end.
trace_off() ->
@@ -1311,7 +1243,7 @@ trace_off() ->
erlang:trace_pattern({'_','_','_'},false,[local]),
erlang:trace_pattern({'_','_','_'},false,[meta]),
erlang:trace(all, false, [all]).
-
+
apply_slave_async(M,F,A) ->
{Pid,Mref} = get(slave),
@@ -1332,8 +1264,8 @@ lambda_slave(Fun) ->
exc_slave(Opts, Func, Args) ->
try request({exc_top,Opts,Func,Args})
catch
- Reason ->
- {crash,Reason}
+ Reason ->
+ {crash,Reason}
end.
request(Request) ->
@@ -1344,13 +1276,13 @@ request(Request) ->
result(Tag, Mref) ->
receive
- {Tag,Result} ->
- receive
- Tag ->
- Result
- end;
- {'DOWN',Mref,process,_Pid,Reason} ->
- throw(Reason)
+ {Tag,Result} ->
+ receive
+ Tag ->
+ Result
+ end;
+ {'DOWN',Mref,process,_Pid,Reason} ->
+ throw(Reason)
end.
@@ -1363,25 +1295,25 @@ receive_next() ->
receive_next(TO) ->
receive
- M ->
- M
+ M ->
+ M
after TO ->
- ?t:fail(timeout)
+ ct:fail(timeout)
end.
receive_no_next(TO) ->
receive M ->
- ?t:fail({unexpected_message,[M|flush(TO)]})
+ ct:fail({unexpected_message,[M|flush(TO)]})
after TO ->
- ok
+ ok
end.
flush(T) ->
receive
- M ->
- [M|flush(T)]
+ M ->
+ [M|flush(T)]
after T ->
- []
+ []
end.
@@ -1416,19 +1348,19 @@ abbr(Term, _) -> Term.
%%
abbr_tuple(Tuple, N, J) when J =< size(Tuple) ->
if J > N; N =< 0 ->
- ['...'];
+ ['...'];
true ->
- [abbr(element(J, Tuple), N-1)|abbr_tuple(Tuple, J+1, N)]
+ [abbr(element(J, Tuple), N-1)|abbr_tuple(Tuple, J+1, N)]
end;
abbr_tuple(_, _, _) ->
[].
%%
abbr_list(_, 0, R) ->
case io_lib:printable_list(R) of
- true ->
- reverse(R, "...");
- false ->
- reverse(R, '...')
+ true ->
+ reverse(R, "...");
+ false ->
+ reverse(R, '...')
end;
abbr_list([H|T], N, R) ->
M = N-1,
diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl
index 3b105ec6fe..dcc2cc807b 100644
--- a/erts/emulator/test/trace_meta_SUITE.erl
+++ b/erts/emulator/test/trace_meta_SUITE.erl
@@ -46,7 +46,7 @@
-define(config(A,B),config(A,B)).
-export([config/2]).
-else.
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-endif.
-ifdef(debug).
@@ -66,22 +66,21 @@ config(priv_dir,_) ->
".".
-else.
%% When run in test server.
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
+-export([all/0, suite/0,
init_per_testcase/2, end_per_testcase/2, not_run/1]).
-export([basic/1, return/1, on_and_off/1, stack_grow/1,
info/1, tracer/1, combo/1, nosilent/1]).
init_per_testcase(_Case, Config) ->
- Dog=test_server:timetrap(test_server:minutes(5)),
- [{watchdog, Dog}|Config].
+ Config.
end_per_testcase(_Case, Config) ->
shutdown(),
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
ok.
-suite() -> [{ct_hooks,[ts_install_cth]}].
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 5}}].
all() ->
case test_server:is_native(trace_meta_SUITE) of
@@ -91,74 +90,39 @@ case test_server:is_native(trace_meta_SUITE) of
combo, nosilent]
end.
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
-basic(suite) ->
- [];
-basic(doc) ->
- ["Tests basic meta trace"];
+%% Tests basic meta trace
basic(Config) when is_list(Config) ->
basic_test().
-return(suite) ->
- [];
-return(doc) ->
- ["Tests return trace"];
+%% Tests return trace
return(Config) when is_list(Config) ->
return_test().
-on_and_off(suite) ->
- [];
-on_and_off(doc) ->
- ["Tests turning trace parameters on and off"];
+%% Tests turning trace parameters on and off
on_and_off(Config) when is_list(Config) ->
on_and_off_test().
-stack_grow(doc) ->
- ["Tests the stack growth during return traces"];
+%% Tests the stack growth during return traces
stack_grow(Config) when is_list(Config) ->
stack_grow_test().
-info(doc) ->
- ["Tests the trace_info BIF"];
+%% Tests the trace_info BIF
info(Config) when is_list(Config) ->
info_test().
-tracer(suite) ->
- [];
-tracer(doc) ->
- ["Tests stopping and changing tracer process"];
+%% Tests stopping and changing tracer process
tracer(Config) when is_list(Config) ->
tracer_test().
-combo(suite) ->
- [];
-combo(doc) ->
- ["Tests combining local call trace with meta trace"];
+%% Tests combining local call trace with meta trace
combo(Config) when is_list(Config) ->
combo_test().
-nosilent(suite) ->
- [];
-nosilent(doc) ->
- ["Tests that meta trace is not silenced by the silent process flag"];
+%% Tests that meta trace is not silenced by the silent process flag
nosilent(Config) when is_list(Config) ->
nosilent_test().
@@ -546,7 +510,7 @@ combo_test() ->
{?RT(Slave,{?MODULE,receiver,1}),
?RF(Slave,{erlang,phash2,2},0)} ->
ok;
- Error1 -> ?t:fail({unexpected_message, Error1})
+ Error1 -> ct:fail({unexpected_message, Error1})
end,
case {receive_next_bytag(LocalTracer),
receive_next_bytag(LocalTracer)} of
@@ -556,7 +520,7 @@ combo_test() ->
{?RT(Slave,{?MODULE,slave,1}),
?RF(Slave,{?MODULE,receiver,1},Ref)} ->
ok;
- Error2 -> ?t:fail({unexpected_message, Error2})
+ Error2 -> ct:fail({unexpected_message, Error2})
end,
shutdown(),
?NM,
@@ -745,13 +709,13 @@ receive_next(TO) ->
M ->
M
after TO ->
- ?t:fail(timeout)
+ ct:fail(timeout)
end.
receive_no_next(TO) ->
receive
M ->
- ?t:fail({unexpected_message, M})
+ ct:fail({unexpected_message, M})
after
TO ->
ok
diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl
index 1cd50350e3..49757a414d 100644
--- a/erts/emulator/test/trace_nif_SUITE.erl
+++ b/erts/emulator/test/trace_nif_SUITE.erl
@@ -20,10 +20,9 @@
-module(trace_nif_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
+-export([all/0, suite/0]).
-export([trace_nif/1,
trace_nif_timestamp/1,
trace_nif_local/1,
@@ -45,259 +44,230 @@ all() ->
trace_nif_return]
end.
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
not_run(Config) when is_list(Config) ->
{skipped,"Native code"}.
-trace_nif(doc) -> "Test tracing NIFs.";
+%% Test tracing NIFs.
trace_nif(Config) when is_list(Config) ->
load_nif(Config),
-
+
do_trace_nif([]).
-trace_nif_local(doc) -> "Test tracing NIFs with local flag.";
+%% Test tracing NIFs with local flag.
trace_nif_local(Config) when is_list(Config) ->
load_nif(Config),
do_trace_nif([local]).
-trace_nif_meta(doc) -> "Test tracing NIFs with meta flag.";
+%% Test tracing NIFs with meta flag.
trace_nif_meta(Config) when is_list(Config) ->
load_nif(Config),
- ?line Pid=spawn_link(?MODULE, nif_process, []),
- ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], [meta]),
-
- ?line Pid ! {apply_nif, nif, []},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}),
-
- ?line Pid ! {apply_nif, nif, ["Arg1"]},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {?MODULE,nif, ["Arg1"]}}),
-
- ?line Pid ! {call_nif, nif, []},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {?MODULE,nif, []}}),
-
- ?line Pid ! {call_nif, nif, ["Arg1"]},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {?MODULE,nif, ["Arg1"]}}),
+ Pid=spawn_link(?MODULE, nif_process, []),
+ erlang:trace_pattern({?MODULE,nif,'_'}, [], [meta]),
+
+ Pid ! {apply_nif, nif, []},
+ receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}),
+
+ Pid ! {apply_nif, nif, ["Arg1"]},
+ receive_trace_msg_ts({trace_ts,Pid,call,
+ {?MODULE,nif, ["Arg1"]}}),
+
+ Pid ! {call_nif, nif, []},
+ receive_trace_msg_ts({trace_ts,Pid,call,
+ {?MODULE,nif, []}}),
+
+ Pid ! {call_nif, nif, ["Arg1"]},
+ receive_trace_msg_ts({trace_ts,Pid,call,
+ {?MODULE,nif, ["Arg1"]}}),
ok.
do_trace_nif(Flags) ->
- ?line Pid = spawn(?MODULE, nif_process, []),
- ?line 1 = erlang:trace(Pid, true, [call]),
- ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags),
- ?line Pid ! {apply_nif, nif, []},
- ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}),
- ?line Pid ! {apply_nif, nif, ["Arg1"]},
- ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}),
+ Pid = spawn(?MODULE, nif_process, []),
+ 1 = erlang:trace(Pid, true, [call]),
+ erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags),
+ Pid ! {apply_nif, nif, []},
+ receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}),
+ Pid ! {apply_nif, nif, ["Arg1"]},
+ receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}),
+
+ Pid ! {call_nif, nif, []},
+ receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}),
- ?line Pid ! {call_nif, nif, []},
- ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}),
+ Pid ! {call_nif, nif, ["Arg1"]},
+ receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}),
- ?line Pid ! {call_nif, nif, ["Arg1"]},
- ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}),
-
%% Switch off
- ?line 1 = erlang:trace(Pid, false, [call]),
+ 1 = erlang:trace(Pid, false, [call]),
- ?line Pid ! {apply_nif, nif, []},
+ Pid ! {apply_nif, nif, []},
receive_nothing(),
- ?line Pid ! {apply_nif, nif, ["Arg1"]},
+ Pid ! {apply_nif, nif, ["Arg1"]},
receive_nothing(),
- ?line Pid ! {call_nif, nif, []},
+ Pid ! {call_nif, nif, []},
receive_nothing(),
- ?line Pid ! {call_nif, nif, ["Arg1"]},
+ Pid ! {call_nif, nif, ["Arg1"]},
receive_nothing(),
%% Switch on again
- ?line 1 = erlang:trace(Pid, true, [call]),
- ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags),
- ?line Pid ! {apply_nif, nif, []},
- ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}),
- ?line Pid ! {apply_nif, nif, ["Arg1"]},
- ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}),
-
- ?line Pid ! {call_nif, nif, []},
- ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}),
-
- ?line Pid ! {call_nif, nif, ["Arg1"]},
- ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}),
-
- ?line 1 = erlang:trace(Pid, false, [call]),
- ?line erlang:trace_pattern({?MODULE,nif,'_'}, false, Flags),
- ?line exit(Pid, die),
+ 1 = erlang:trace(Pid, true, [call]),
+ erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags),
+ Pid ! {apply_nif, nif, []},
+ receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}),
+ Pid ! {apply_nif, nif, ["Arg1"]},
+ receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}),
+
+ Pid ! {call_nif, nif, []},
+ receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}),
+
+ Pid ! {call_nif, nif, ["Arg1"]},
+ receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}),
+
+ 1 = erlang:trace(Pid, false, [call]),
+ erlang:trace_pattern({?MODULE,nif,'_'}, false, Flags),
+ exit(Pid, die),
ok.
-trace_nif_timestamp(doc) -> "Test tracing NIFs with timestamps.";
+%% Test tracing NIFs with timestamps.
trace_nif_timestamp(Config) when is_list(Config) ->
load_nif(Config),
do_trace_nif_timestamp([]).
-trace_nif_timestamp_local(doc) ->
- "Test tracing NIFs with timestamps and local flag.";
+%% Test tracing NIFs with timestamps and local flag.
trace_nif_timestamp_local(Config) when is_list(Config) ->
load_nif(Config),
do_trace_nif_timestamp([local]).
do_trace_nif_timestamp(Flags) ->
- ?line Pid=spawn(?MODULE, nif_process, []),
- ?line 1 = erlang:trace(Pid, true, [call,timestamp]),
- ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags),
-
- ?line Pid ! {apply_nif, nif, []},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}),
-
- ?line Pid ! {apply_nif, nif, ["Arg1"]},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {?MODULE,nif, ["Arg1"]}}),
-
- ?line Pid ! {call_nif, nif, []},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {?MODULE,nif, []}}),
-
- ?line Pid ! {call_nif, nif, ["Arg1"]},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {?MODULE,nif, ["Arg1"]}}),
-
+ Pid=spawn(?MODULE, nif_process, []),
+ 1 = erlang:trace(Pid, true, [call,timestamp]),
+ erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags),
+
+ Pid ! {apply_nif, nif, []},
+ receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}),
+
+ Pid ! {apply_nif, nif, ["Arg1"]},
+ receive_trace_msg_ts({trace_ts,Pid,call,
+ {?MODULE,nif, ["Arg1"]}}),
+
+ Pid ! {call_nif, nif, []},
+ receive_trace_msg_ts({trace_ts,Pid,call,
+ {?MODULE,nif, []}}),
+
+ Pid ! {call_nif, nif, ["Arg1"]},
+ receive_trace_msg_ts({trace_ts,Pid,call,
+ {?MODULE,nif, ["Arg1"]}}),
+
%% We should be able to turn off the timestamp.
- ?line 1 = erlang:trace(Pid, false, [timestamp]),
-
- ?line Pid ! {call_nif, nif, []},
- ?line receive_trace_msg({trace,Pid,call,
- {?MODULE,nif, []}}),
-
- ?line Pid ! {apply_nif, nif, ["tjoho"]},
- ?line receive_trace_msg({trace,Pid,call,
- {?MODULE,nif, ["tjoho"]}}),
-
- ?line 1 = erlang:trace(Pid, false, [call]),
- ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags),
-
- ?line exit(Pid, die),
+ 1 = erlang:trace(Pid, false, [timestamp]),
+
+ Pid ! {call_nif, nif, []},
+ receive_trace_msg({trace,Pid,call,
+ {?MODULE,nif, []}}),
+
+ Pid ! {apply_nif, nif, ["tjoho"]},
+ receive_trace_msg({trace,Pid,call,
+ {?MODULE,nif, ["tjoho"]}}),
+
+ 1 = erlang:trace(Pid, false, [call]),
+ erlang:trace_pattern({erlang,'_','_'}, false, Flags),
+
+ exit(Pid, die),
ok.
-trace_nif_return(doc) ->
- "Test tracing NIF's with return/return_to trace.";
+%% Test tracing NIF's with return/return_to trace.
trace_nif_return(Config) when is_list(Config) ->
load_nif(Config),
- ?line Pid=spawn(?MODULE, nif_process, []),
- ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]),
- ?line erlang:trace_pattern({?MODULE,nif,'_'}, [{'_',[],[{return_trace}]}],
- [local]),
-
- ?line Pid ! {apply_nif, nif, []},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}),
- ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
- {?MODULE,nif,0}}),
- ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
- {?MODULE, nif_process,0}}),
-
- ?line Pid ! {call_nif, nif, ["Arg1"]},
- ?line receive_trace_msg_ts({trace_ts,Pid,call,
- {?MODULE,nif, ["Arg1"]}}),
- ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
- {?MODULE,nif,1}}),
- ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
- {?MODULE, nif_process,0}}),
+ Pid=spawn(?MODULE, nif_process, []),
+ 1 = erlang:trace(Pid, true, [call,timestamp,return_to]),
+ erlang:trace_pattern({?MODULE,nif,'_'}, [{'_',[],[{return_trace}]}],
+ [local]),
+
+ Pid ! {apply_nif, nif, []},
+ receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}),
+ receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+ {?MODULE,nif,0}}),
+ receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
+ {?MODULE, nif_process,0}}),
+
+ Pid ! {call_nif, nif, ["Arg1"]},
+ receive_trace_msg_ts({trace_ts,Pid,call,
+ {?MODULE,nif, ["Arg1"]}}),
+ receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
+ {?MODULE,nif,1}}),
+ receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
+ {?MODULE, nif_process,0}}),
ok.
receive_trace_msg(Mess) ->
receive
- Mess ->
- ok;
- Other ->
- io:format("Expected: ~p,~nGot: ~p~n", [Mess, Other]),
- ?t:fail()
+ Mess ->
+ ok;
+ Other ->
+ ct:fail("Expected: ~p,~nGot: ~p~n", [Mess, Other])
after 5000 ->
- io:format("Expected: ~p,~nGot: timeout~n", [Mess]),
- ?t:fail()
+ ct:fail("Expected: ~p,~nGot: timeout~n", [Mess])
end.
receive_nothing() ->
- ?line timeout = receive M -> M after 100 -> timeout end.
+ timeout = receive M -> M after 100 -> timeout end.
receive_trace_msg_ts({trace_ts, Pid, call, {M,F,A}}) ->
receive
- {trace_ts, Pid, call, {M, F, A}, _Ts} ->
- ok;
- Other ->
- io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n"
- "Got: ~p~n",
- [Pid, M, F, A, Other]),
- ?t:fail()
+ {trace_ts, Pid, call, {M, F, A}, _Ts} ->
+ ok;
+ Other ->
+ ct:fail("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n"
+ "Got: ~p~n", [Pid, M, F, A, Other])
after 5000 ->
- io:format("Got timeout~n", []),
- ?t:fail()
+ ct:fail("Got timeout~n", [])
end.
receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {M,F,A}}) ->
receive
- {trace_ts, Pid, return_from, {M, F, A}, _Value, _Ts} ->
- ok;
- Other ->
- io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n"
- "Got: ~p~n",
- [Pid, M, F, A, Other]),
- ?t:fail()
+ {trace_ts, Pid, return_from, {M, F, A}, _Value, _Ts} ->
+ ok;
+ Other ->
+ ct:fail("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n"
+ "Got: ~p~n", [Pid, M, F, A, Other])
after 5000 ->
- io:format("Got timeout~n", []),
- ?t:fail()
+ ct:fail("Got timeout~n", [])
end.
receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) ->
receive
- {trace_ts, Pid, return_to, {M, F, A}, _Ts} ->
- ok;
- Other ->
- io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n"
- "Got: ~p~n",
- [Pid, M, F, A, Other]),
- ?t:fail()
+ {trace_ts, Pid, return_to, {M, F, A}, _Ts} ->
+ ok;
+ Other ->
+ ct:fail("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n"
+ "Got: ~p~n", [Pid, M, F, A, Other])
after 5000 ->
- io:format("Got timeout~n", []),
- ?t:fail()
+ ct:fail("Got timeout~n", [])
end.
nif_process() ->
receive
- {apply_nif, Name, Args} ->
- ?line {ok,Args} = apply(?MODULE, Name, Args);
-
- {call_nif, Name, []} ->
- ?line {ok, []} = ?MODULE:Name();
-
- {call_nif, Name, [A1]} ->
- ?line {ok, [A1]} = ?MODULE:Name(A1);
-
- {call_nif, Name, [A1,A2]} ->
- ?line {ok,[A1,A2]} = ?MODULE:Name(A1,A2);
-
- {call_nif, Name, [A1,A2,A3]} ->
- ?line {ok,[A1,A2,A3]} = ?MODULE:Name(A1,A2,A3)
+ {apply_nif, Name, Args} ->
+ {ok,Args} = apply(?MODULE, Name, Args);
+
+ {call_nif, Name, []} ->
+ {ok, []} = ?MODULE:Name();
+
+ {call_nif, Name, [A1]} ->
+ {ok, [A1]} = ?MODULE:Name(A1);
+
+ {call_nif, Name, [A1,A2]} ->
+ {ok,[A1,A2]} = ?MODULE:Name(A1,A2);
+
+ {call_nif, Name, [A1,A2,A3]} ->
+ {ok,[A1,A2,A3]} = ?MODULE:Name(A1,A2,A3)
end,
nif_process().
load_nif(Config) ->
- ?line Path = ?config(data_dir, Config),
-
- ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0).
+ Path = proplists:get_value(data_dir, Config),
+
+ ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0).
nif() ->
@@ -305,4 +275,3 @@ nif() ->
nif(A1) ->
{"Stub1",[A1]}. %exit(["nif/1 stub called",A1]).
-
diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl
index a77710205e..d33f18543a 100644
--- a/erts/emulator/test/trace_port_SUITE.erl
+++ b/erts/emulator/test/trace_port_SUITE.erl
@@ -21,9 +21,7 @@
-module(trace_port_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2,
+-export([all/0, suite/0,
call_trace/1,
return_trace/1,
send/1,
@@ -38,9 +36,13 @@
default_tracer/1,
tracer_port_crash/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-test_cases() ->
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {seconds, 30}}].
+
+all() ->
[call_trace, return_trace, send, receive_trace,
process_events, schedule, fake_schedule,
fake_schedule_after_register,
@@ -48,212 +50,183 @@ test_cases() ->
fake_schedule_after_getting_unlinked, gc,
default_tracer, tracer_port_crash].
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- test_cases().
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:seconds(30)),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Func, Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
-
-call_trace(doc) -> "Test sending call trace messages to a port.";
+%% Test sending call trace messages to a port.
call_trace(Config) when is_list(Config) ->
case test_server:is_native(?MODULE) orelse
- test_server:is_native(lists) of
- true ->
- {skip,"Native code"};
- false ->
- ?line start_tracer(Config),
- Self = self(),
- ?line trace_func({lists,reverse,1}, []),
- ?line trace_pid(Self, true, [call]),
- ?line trace_info(Self, flags),
- ?line trace_info(Self, tracer),
- ?line [b,a] = lists:reverse([a,b]),
- ?line expect({trace,Self,call,{lists,reverse,[[a,b]]}}),
-
- ?line trace_pid(Self, true, [timestamp]),
- ?line trace_info(Self, flags),
- ?line Huge = huge_data(),
- ?line lists:reverse(Huge),
- ?line expect({trace_ts,Self,call,{lists,reverse,[Huge]},ts}),
-
- ?line trace_pid(Self, true, [arity]),
- ?line trace_info(Self, flags),
- ?line [y,x] = lists:reverse([x,y]),
- ?line expect({trace_ts,Self,call,{lists,reverse,1},ts}),
-
- ?line trace_pid(Self, false, [timestamp]),
- ?line trace_info(Self, flags),
- ?line [z,y,x] = lists:reverse([x,y,z]),
- ?line expect({trace,Self,call,{lists,reverse,1}}),
-
- %% OTP-7399. Delayed sub-binary creation optimization.
- ?line trace_pid(Self, false, [arity]),
- ?line trace_info(Self, flags),
- ?line trace_func({?MODULE,bs_sum_c,2}, [], [local]),
- ?line 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0),
- ?line trace_func({?MODULE,bs_sum_c,2}, false, [local]),
- ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>,0]}}),
- ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>,3]}}),
- ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<7:4,11:4>>,8]}}),
- ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<11:4>>,15]}}),
- ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<>>,26]}}),
-
- ?line trace_func({lists,reverse,1}, false),
- ok
+ test_server:is_native(lists) of
+ true ->
+ {skip,"Native code"};
+ false ->
+ start_tracer(Config),
+ Self = self(),
+ trace_func({lists,reverse,1}, []),
+ trace_pid(Self, true, [call]),
+ trace_info(Self, flags),
+ trace_info(Self, tracer),
+ [b,a] = lists:reverse([a,b]),
+ expect({trace,Self,call,{lists,reverse,[[a,b]]}}),
+
+ trace_pid(Self, true, [timestamp]),
+ trace_info(Self, flags),
+ Huge = huge_data(),
+ lists:reverse(Huge),
+ expect({trace_ts,Self,call,{lists,reverse,[Huge]},ts}),
+
+ trace_pid(Self, true, [arity]),
+ trace_info(Self, flags),
+ [y,x] = lists:reverse([x,y]),
+ expect({trace_ts,Self,call,{lists,reverse,1},ts}),
+
+ trace_pid(Self, false, [timestamp]),
+ trace_info(Self, flags),
+ [z,y,x] = lists:reverse([x,y,z]),
+ expect({trace,Self,call,{lists,reverse,1}}),
+
+ %% OTP-7399. Delayed sub-binary creation optimization.
+ trace_pid(Self, false, [arity]),
+ trace_info(Self, flags),
+ trace_func({?MODULE,bs_sum_c,2}, [], [local]),
+ 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0),
+ trace_func({?MODULE,bs_sum_c,2}, false, [local]),
+ expect({trace,Self,call,{?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>,0]}}),
+ expect({trace,Self,call,{?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>,3]}}),
+ expect({trace,Self,call,{?MODULE,bs_sum_c,[<<7:4,11:4>>,8]}}),
+ expect({trace,Self,call,{?MODULE,bs_sum_c,[<<11:4>>,15]}}),
+ expect({trace,Self,call,{?MODULE,bs_sum_c,[<<>>,26]}}),
+
+ trace_func({lists,reverse,1}, false),
+ ok
end.
bs_sum_c(<<H:4,T/bits>>, Acc) -> bs_sum_c(T, H+Acc);
bs_sum_c(<<>>, Acc) -> Acc.
-return_trace(doc) -> "Test the new return trace.";
+%% Test the new return trace.
return_trace(Config) when is_list(Config) ->
case test_server:is_native(?MODULE) orelse
- test_server:is_native(lists) of
- true ->
- {skip,"Native code"};
- false ->
- ?line start_tracer(Config),
- Self = self(),
- MFA = {lists,reverse,1},
-
- %% Plain (no timestamp, small data).
-
- ?line trace_func(MFA, [{['$1'],[],[{return_trace},
- {message,false}]}]),
- ?line trace_pid(Self, true, [call]),
- ?line trace_info(Self, flags),
- ?line trace_info(Self, tracer),
- ?line trace_info(MFA, match_spec),
- ?line {traced,global} = trace_info(MFA, traced),
- ?line [b,a] = lists:reverse([a,b]),
- ?line expect({trace,Self,return_from,MFA,[b,a]}),
-
- %% Timestamp, huge data.
- ?line trace_pid(Self, true, [timestamp]),
- ?line Result = lists:reverse(huge_data()),
- ?line expect({trace_ts,Self,return_from,MFA,Result,ts}),
-
- %% Turn off trace.
- ?line trace_func(MFA, false),
- ?line trace_info(MFA, match_spec),
- ?line {traced,false} = trace_info(MFA, traced),
- ok
+ test_server:is_native(lists) of
+ true ->
+ {skip,"Native code"};
+ false ->
+ start_tracer(Config),
+ Self = self(),
+ MFA = {lists,reverse,1},
+
+ %% Plain (no timestamp, small data).
+
+ trace_func(MFA, [{['$1'],[],[{return_trace},
+ {message,false}]}]),
+ trace_pid(Self, true, [call]),
+ trace_info(Self, flags),
+ trace_info(Self, tracer),
+ trace_info(MFA, match_spec),
+ {traced,global} = trace_info(MFA, traced),
+ [b,a] = lists:reverse([a,b]),
+ expect({trace,Self,return_from,MFA,[b,a]}),
+
+ %% Timestamp, huge data.
+ trace_pid(Self, true, [timestamp]),
+ Result = lists:reverse(huge_data()),
+ expect({trace_ts,Self,return_from,MFA,Result,ts}),
+
+ %% Turn off trace.
+ trace_func(MFA, false),
+ trace_info(MFA, match_spec),
+ {traced,false} = trace_info(MFA, traced),
+ ok
end.
-send(doc) -> "Test sending send trace messages to a port.";
+%% Test sending send trace messages to a port.
send(Config) when is_list(Config) ->
- ?line Tracer = start_tracer(Config),
+ Tracer = start_tracer(Config),
Self = self(),
- ?line Sender = fun_spawn(fun sender/0),
- ?line trac(Sender, true, [send]),
+ Sender = fun_spawn(fun sender/0),
+ trac(Sender, true, [send]),
%% Simple message, no timestamp.
- ?line Bin = list_to_binary(lists:seq(1, 10)),
- ?line Msg = {some_data,Bin},
+ Bin = list_to_binary(lists:seq(1, 10)),
+ Msg = {some_data,Bin},
Sender ! {send_please,self(),Msg},
receive Msg -> ok end,
- ?line expect({trace,Sender,send,Msg,Self}),
+ expect({trace,Sender,send,Msg,Self}),
%% Timestamp.
BiggerMsg = {even_bigger,Msg},
- ?line trac(Sender, true, [send,timestamp]),
+ trac(Sender, true, [send,timestamp]),
Sender ! {send_please,self(),BiggerMsg},
receive BiggerMsg -> ok end,
- ?line expect({trace_ts,Sender,send,BiggerMsg,Self,ts}),
+ expect({trace_ts,Sender,send,BiggerMsg,Self,ts}),
%% Huge message.
- ?line HugeMsg = huge_data(),
+ HugeMsg = huge_data(),
Sender ! {send_please,self(),HugeMsg},
receive HugeMsg -> ok end,
- ?line expect({trace_ts,Sender,send,HugeMsg,Self,ts}),
+ expect({trace_ts,Sender,send,HugeMsg,Self,ts}),
%% Kill trace port and force a trace. The emulator should not crasch.
- ?line unlink(Tracer),
- ?line exit(Tracer, kill),
+ unlink(Tracer),
+ exit(Tracer, kill),
erlang:yield(), % Make sure that port gets killed.
Sender ! {send_please,Self,good_bye},
receive good_bye -> ok end,
ok.
-receive_trace(doc) -> "Test sending receive traces to a port.";
+%% Test sending receive traces to a port.
receive_trace(Config) when is_list(Config) ->
- ?line start_tracer(Config),
- ?line Receiver = fun_spawn(fun receiver/0),
- ?line trac(Receiver, true, ['receive']),
+ start_tracer(Config),
+ Receiver = fun_spawn(fun receiver/0),
+ trac(Receiver, true, ['receive']),
Receiver ! {hello,world},
- ?line expect({trace,Receiver,'receive',{hello,world}}),
+ expect({trace,Receiver,'receive',{hello,world}}),
- ?line trac(Receiver, true, ['receive',timestamp]),
+ trac(Receiver, true, ['receive',timestamp]),
Huge = {hello,huge_data()},
Receiver ! {hello,huge_data()},
- ?line expect({trace_ts,Receiver,'receive',Huge,ts}),
+ expect({trace_ts,Receiver,'receive',Huge,ts}),
ok.
-process_events(doc) -> "Tests a few process events (like getting linked).";
+%% Tests a few process events (like getting linked).
process_events(Config) when is_list(Config) ->
- ?line start_tracer(Config),
+ start_tracer(Config),
Self = self(),
- ?line Receiver = fun_spawn(fun receiver/0),
- ?line trac(Receiver, true, [procs]),
+ Receiver = fun_spawn(fun receiver/0),
+ trac(Receiver, true, [procs]),
unlink(Receiver), %It is already linked.
- ?line expect({trace,Receiver,getting_unlinked,Self}),
+ expect({trace,Receiver,getting_unlinked,Self}),
link(Receiver),
- ?line expect({trace,Receiver,getting_linked,Self}),
- ?line trac(Receiver, true, [procs,timestamp]),
+ expect({trace,Receiver,getting_linked,Self}),
+ trac(Receiver, true, [procs,timestamp]),
unlink(Receiver),
- ?line expect({trace_ts,Receiver,getting_unlinked,Self,ts}),
+ expect({trace_ts,Receiver,getting_unlinked,Self,ts}),
link(Receiver),
- ?line expect({trace_ts,Receiver,getting_linked,Self,ts}),
+ expect({trace_ts,Receiver,getting_linked,Self,ts}),
unlink(Receiver),
- ?line expect({trace_ts,Receiver,getting_unlinked,Self,ts}),
+ expect({trace_ts,Receiver,getting_unlinked,Self,ts}),
Huge = huge_data(),
exit(Receiver, Huge),
- ?line expect({trace_ts,Receiver,exit,Huge,ts}),
+ expect({trace_ts,Receiver,exit,Huge,ts}),
ok.
-schedule(doc) -> "Test sending scheduling events to a port.";
+%% Test sending scheduling events to a port.
schedule(Config) when is_list(Config) ->
- ?line start_tracer(Config),
- ?line Receiver = fun_spawn(fun receiver/0),
- ?line trac(Receiver, true, [running]),
+ start_tracer(Config),
+ Receiver = fun_spawn(fun receiver/0),
+ trac(Receiver, true, [running]),
Receiver ! hi,
expect({trace,Receiver,in,{?MODULE,receiver,0}}),
expect({trace,Receiver,out,{?MODULE,receiver,0}}),
- ?line trac(Receiver, true, [running,timestamp]),
+ trac(Receiver, true, [running,timestamp]),
Receiver ! hi_again,
expect({trace_ts,Receiver,in,{?MODULE,receiver,0},ts}),
@@ -262,252 +235,248 @@ schedule(Config) when is_list(Config) ->
ok.
run_fake_sched_test(Fun, Config) when is_function(Fun), is_list(Config) ->
- ?line case catch erlang:system_info(smp_support) of
- true ->
- ?line {skipped,
- "No need for faked schedule out/in trace messages "
- "when smp support is enabled"};
- _ ->
- ?line Fun(Config)
- end.
-
-fake_schedule(doc) -> "Tests time compensating fake out/in scheduling.";
+ case catch erlang:system_info(smp_support) of
+ true ->
+ {skipped,
+ "No need for faked schedule out/in trace messages "
+ "when smp support is enabled"};
+ _ ->
+ Fun(Config)
+ end.
+
+%% Tests time compensating fake out/in scheduling.
fake_schedule(Config) when is_list(Config) ->
- ?line run_fake_sched_test(fun fake_schedule_test/1, Config).
+ run_fake_sched_test(fun fake_schedule_test/1, Config).
fake_schedule_test(Config) when is_list(Config) ->
- ?line Tracer = start_tracer(Config),
- ?line Port = get(tracer_port),
- ?line General = fun_spawn(fun general/0),
+ Tracer = start_tracer(Config),
+ Port = get(tracer_port),
+ General = fun_spawn(fun general/0),
%%
- ?line trac(General, true, [send, running]),
+ trac(General, true, [send, running]),
%%
%% Test that fake out/in scheduling is not generated unless
%% both 'running' and 'timestamp' is active.
- ?line [] = erlang:port_control(Port, $h, []),
- ?line General ! nop,
- ?line expect({trace, General, in, {?MODULE, general, 0}}),
- ?line expect({trace, General, out, {?MODULE, general, 0}}),
- ?line expect(),
+ [] = erlang:port_control(Port, $h, []),
+ General ! nop,
+ expect({trace, General, in, {?MODULE, general, 0}}),
+ expect({trace, General, out, {?MODULE, general, 0}}),
+ expect(),
%%
- ?line trac(General, false, [running]),
- ?line trac(General, true, [timestamp]),
+ trac(General, false, [running]),
+ trac(General, true, [timestamp]),
%%
- ?line Ref1 = make_ref(),
- ?line Msg1 = {Port, {data, term_to_binary(Ref1)}},
- ?line [] = erlang:port_control(Port, $h, []),
- ?line General ! {send, Tracer, Msg1},
- ?line expect({trace_ts, General, send, Msg1, Tracer, ts}),
- ?line expect(Ref1),
- ?line expect(),
+ Ref1 = make_ref(),
+ Msg1 = {Port, {data, term_to_binary(Ref1)}},
+ [] = erlang:port_control(Port, $h, []),
+ General ! {send, Tracer, Msg1},
+ expect({trace_ts, General, send, Msg1, Tracer, ts}),
+ expect(Ref1),
+ expect(),
%%
- ?line trac(General, true, [running]),
+ trac(General, true, [running]),
%%
%% Test that fake out/in scheduling can be generated by the driver
- ?line Ref2 = make_ref(),
- ?line Msg2 = {Port, {data, term_to_binary(Ref2)}},
- ?line [] = erlang:port_control(Port, $h, []),
- ?line General ! {send, Tracer, Msg2},
- ?line {_,_,_,_,Ts} =
- expect({trace_ts, General, in, {?MODULE, general, 0}, ts}),
- ?line expect({trace_ts, General, out, 0, Ts}),
- ?line expect({trace_ts, General, in, 0, ts}),
- ?line expect({trace_ts, General, send, Msg2, Tracer, ts}),
- ?line expect(Ref2),
- ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}),
- ?line expect(),
+ Ref2 = make_ref(),
+ Msg2 = {Port, {data, term_to_binary(Ref2)}},
+ [] = erlang:port_control(Port, $h, []),
+ General ! {send, Tracer, Msg2},
+ {_,_,_,_,Ts} =
+ expect({trace_ts, General, in, {?MODULE, general, 0}, ts}),
+ expect({trace_ts, General, out, 0, Ts}),
+ expect({trace_ts, General, in, 0, ts}),
+ expect({trace_ts, General, send, Msg2, Tracer, ts}),
+ expect(Ref2),
+ expect({trace_ts, General, out, {?MODULE, general, 0}, ts}),
+ expect(),
%%
%% Test that fake out/in scheduling is not generated after an
%% 'out' scheduling event
- ?line Ref3 = make_ref(),
- ?line Msg3 = {Port, {data, term_to_binary(Ref3)}},
- ?line General ! {apply, {erlang, port_control, [Port, $h, []]}},
- ?line expect({trace_ts, General, in, {?MODULE, general, 0}, ts}),
- ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}),
- ?line General ! {send, Tracer, Msg3},
- ?line expect({trace_ts, General, in, {?MODULE, general, 0}, ts}),
- ?line expect({trace_ts, General, send, Msg3, Tracer, ts}),
- ?line expect(Ref3),
- ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}),
- ?line expect(),
+ Ref3 = make_ref(),
+ Msg3 = {Port, {data, term_to_binary(Ref3)}},
+ General ! {apply, {erlang, port_control, [Port, $h, []]}},
+ expect({trace_ts, General, in, {?MODULE, general, 0}, ts}),
+ expect({trace_ts, General, out, {?MODULE, general, 0}, ts}),
+ General ! {send, Tracer, Msg3},
+ expect({trace_ts, General, in, {?MODULE, general, 0}, ts}),
+ expect({trace_ts, General, send, Msg3, Tracer, ts}),
+ expect(Ref3),
+ expect({trace_ts, General, out, {?MODULE, general, 0}, ts}),
+ expect(),
%%
ok.
-fake_schedule_after_register(doc) ->
- "Tests fake out/in scheduling contents.";
+%% Tests fake out/in scheduling contents.
fake_schedule_after_register(Config) when is_list(Config) ->
- ?line run_fake_sched_test(fun fake_schedule_after_register_test/1, Config).
+ run_fake_sched_test(fun fake_schedule_after_register_test/1, Config).
fake_schedule_after_register_test(Config) when is_list(Config) ->
- ?line start_tracer(Config),
- ?line Port = get(tracer_port),
- ?line G1 = fun_spawn(fun general/0),
- ?line G2 = fun_spawn(fun general/0),
+ start_tracer(Config),
+ Port = get(tracer_port),
+ G1 = fun_spawn(fun general/0),
+ G2 = fun_spawn(fun general/0),
%%
- ?line trac(G1, true, [running, timestamp, procs]),
- ?line trac(G2, true, [running, timestamp]),
+ trac(G1, true, [running, timestamp, procs]),
+ trac(G2, true, [running, timestamp]),
%%
%% Test fake out/in scheduling after certain messages
- ?line erlang:yield(),
- ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}},
- ?line G2 ! {apply, {erlang, register, [fake_schedule_after_register, G1]}},
- ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}),
- ?line {_,_,_,_,Ts} =
- expect({trace_ts, G1, register, fake_schedule_after_register, ts}),
- ?line expect({trace_ts, G2, out, 0, Ts}),
- ?line expect({trace_ts, G2, in, 0, ts}),
- ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}),
- ?line expect(),
+ erlang:yield(),
+ G2 ! {apply, {erlang, port_control, [Port, $h, []]}},
+ G2 ! {apply, {erlang, register, [fake_schedule_after_register, G1]}},
+ expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}),
+ {_,_,_,_,Ts} =
+ expect({trace_ts, G1, register, fake_schedule_after_register, ts}),
+ expect({trace_ts, G2, out, 0, Ts}),
+ expect({trace_ts, G2, in, 0, ts}),
+ expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}),
+ expect(),
%%
ok.
-fake_schedule_after_getting_linked(doc) ->
- "Tests fake out/in scheduling contents.";
+%% Tests fake out/in scheduling contents.
fake_schedule_after_getting_linked(Config) when is_list(Config) ->
- ?line run_fake_sched_test(fun fake_schedule_after_getting_linked_test/1,
- Config).
+ run_fake_sched_test(fun fake_schedule_after_getting_linked_test/1,
+ Config).
fake_schedule_after_getting_linked_test(Config) when is_list(Config) ->
- ?line start_tracer(Config),
- ?line Port = get(tracer_port),
- ?line G1 = fun_spawn(fun general/0),
- ?line G2 = fun_spawn(fun general/0),
+ start_tracer(Config),
+ Port = get(tracer_port),
+ G1 = fun_spawn(fun general/0),
+ G2 = fun_spawn(fun general/0),
%%
- ?line trac(G1, true, [running, timestamp, procs]),
- ?line trac(G2, true, [running, timestamp]),
+ trac(G1, true, [running, timestamp, procs]),
+ trac(G2, true, [running, timestamp]),
%%
%% Test fake out/in scheduling after certain messages
- ?line erlang:yield(),
- ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}},
- ?line G2 ! {apply, {erlang, link, [G1]}},
- ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}),
- ?line {_,_,_,_,Ts} =
- expect({trace_ts, G1, getting_linked, G2, ts}),
- ?line expect({trace_ts, G2, out, 0, Ts}),
- ?line expect({trace_ts, G2, in, 0, ts}),
- ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}),
- ?line expect(),
+ erlang:yield(),
+ G2 ! {apply, {erlang, port_control, [Port, $h, []]}},
+ G2 ! {apply, {erlang, link, [G1]}},
+ expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}),
+ {_,_,_,_,Ts} =
+ expect({trace_ts, G1, getting_linked, G2, ts}),
+ expect({trace_ts, G2, out, 0, Ts}),
+ expect({trace_ts, G2, in, 0, ts}),
+ expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}),
+ expect(),
%%
ok.
-fake_schedule_after_getting_unlinked(doc) ->
- "Tests fake out/in scheduling contents.";
+%% Tests fake out/in scheduling contents.
fake_schedule_after_getting_unlinked(Config) when is_list(Config) ->
- ?line run_fake_sched_test(fun fake_schedule_after_getting_unlinked_test/1,
- Config).
+ run_fake_sched_test(fun fake_schedule_after_getting_unlinked_test/1,
+ Config).
fake_schedule_after_getting_unlinked_test(Config) when is_list(Config) ->
- ?line start_tracer(Config),
- ?line Port = get(tracer_port),
- ?line G1 = fun_spawn(fun general/0),
- ?line G2 = fun_spawn(fun general/0),
+ start_tracer(Config),
+ Port = get(tracer_port),
+ G1 = fun_spawn(fun general/0),
+ G2 = fun_spawn(fun general/0),
%%
- ?line trac(G1, true, [running, procs]),
- ?line trac(G2, true, [running, timestamp]),
+ trac(G1, true, [running, procs]),
+ trac(G2, true, [running, timestamp]),
%%
%% Test fake out/in scheduling after certain messages
- ?line erlang:yield(),
- ?line G2 ! {apply, {erlang, link, [G1]}},
- ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}},
- ?line G2 ! {apply, {erlang, unlink, [G1]}},
- ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}),
- ?line expect({trace, G1, getting_linked, G2}),
- ?line expect({trace, G1, getting_unlinked, G2}),
- ?line expect({trace_ts, G2, out, 0, ts}),
- ?line expect({trace_ts, G2, in, 0, ts}),
- ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}),
- ?line expect(),
+ erlang:yield(),
+ G2 ! {apply, {erlang, link, [G1]}},
+ G2 ! {apply, {erlang, port_control, [Port, $h, []]}},
+ G2 ! {apply, {erlang, unlink, [G1]}},
+ expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}),
+ expect({trace, G1, getting_linked, G2}),
+ expect({trace, G1, getting_unlinked, G2}),
+ expect({trace_ts, G2, out, 0, ts}),
+ expect({trace_ts, G2, in, 0, ts}),
+ expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}),
+ expect(),
%%
ok.
-gc(doc) -> "Test sending garbage collection events to a port.";
+%% Test sending garbage collection events to a port.
gc(Config) when is_list(Config) ->
- ?line start_tracer(Config),
- ?line Garber = fun_spawn(fun garber/0, [{min_heap_size, 5000}]),
- ?line trac(Garber, true, [garbage_collection]),
- ?line trace_info(Garber, flags),
+ start_tracer(Config),
+ Garber = fun_spawn(fun garber/0, [{min_heap_size, 5000}]),
+ trac(Garber, true, [garbage_collection]),
+ trace_info(Garber, flags),
- ?line trace_info(Garber, flags),
+ trace_info(Garber, flags),
Garber ! hi,
expect({trace,Garber,gc_start,info}),
expect({trace,Garber,gc_end,info}),
- ?line trac(Garber, true, [garbage_collection,timestamp]),
+ trac(Garber, true, [garbage_collection,timestamp]),
Garber ! hi,
expect({trace_ts,Garber,gc_start,info,ts}),
expect({trace_ts,Garber,gc_end,info,ts}),
ok.
-default_tracer(doc) ->
- "Test a port as default tracer.";
+%% Test a port as default tracer.
default_tracer(Config) when is_list(Config) ->
- ?line Tracer = start_tracer(Config),
- ?line TracerMonitor = erlang:monitor(process, Tracer),
- ?line Port = get(tracer_port),
+ Tracer = start_tracer(Config),
+ TracerMonitor = erlang:monitor(process, Tracer),
+ Port = get(tracer_port),
%%
- ?line N = erlang:trace(all, true, [send, {tracer, Port}]),
- ?line {flags, [send]} = erlang:trace_info(self(), flags),
- ?line {tracer, Port} = erlang:trace_info(self(), tracer),
- ?line {flags, [send]} = erlang:trace_info(new, flags),
- ?line {tracer, Port} = erlang:trace_info(new, tracer),
- ?line G1 = fun_spawn(fun general/0),
- ?line {flags, [send]} = erlang:trace_info(G1, flags),
- ?line {tracer, Port} = erlang:trace_info(G1, tracer),
- ?line unlink(Tracer),
- ?line exit(Port, done),
- ?line receive
- {'DOWN', TracerMonitor, process, Tracer, TracerExitReason} ->
- ?line done = TracerExitReason
- end,
- ?line {flags, []} = erlang:trace_info(self(), flags),
- ?line {tracer, []} = erlang:trace_info(self(), tracer),
- ?line {flags, []} = erlang:trace_info(new, flags),
- ?line {tracer, []} = erlang:trace_info(new, tracer),
- ?line M = erlang:trace(all, false, [all]),
- ?line {flags, []} = erlang:trace_info(self(), flags),
- ?line {tracer, []} = erlang:trace_info(self(), tracer),
- ?line {flags, []} = erlang:trace_info(G1, flags),
- ?line {tracer, []} = erlang:trace_info(G1, tracer),
- ?line G1 ! {apply,{erlang,exit,[normal]}},
- ?line io:format("~p = ~p.~n", [M, N]),
- ?line M = N,
+ N = erlang:trace(all, true, [send, {tracer, Port}]),
+ {flags, [send]} = erlang:trace_info(self(), flags),
+ {tracer, Port} = erlang:trace_info(self(), tracer),
+ {flags, [send]} = erlang:trace_info(new, flags),
+ {tracer, Port} = erlang:trace_info(new, tracer),
+ G1 = fun_spawn(fun general/0),
+ {flags, [send]} = erlang:trace_info(G1, flags),
+ {tracer, Port} = erlang:trace_info(G1, tracer),
+ unlink(Tracer),
+ exit(Port, done),
+ receive
+ {'DOWN', TracerMonitor, process, Tracer, TracerExitReason} ->
+ done = TracerExitReason
+ end,
+ {flags, []} = erlang:trace_info(self(), flags),
+ {tracer, []} = erlang:trace_info(self(), tracer),
+ {flags, []} = erlang:trace_info(new, flags),
+ {tracer, []} = erlang:trace_info(new, tracer),
+ M = erlang:trace(all, false, [all]),
+ {flags, []} = erlang:trace_info(self(), flags),
+ {tracer, []} = erlang:trace_info(self(), tracer),
+ {flags, []} = erlang:trace_info(G1, flags),
+ {tracer, []} = erlang:trace_info(G1, tracer),
+ G1 ! {apply,{erlang,exit,[normal]}},
+ io:format("~p = ~p.~n", [M, N]),
+ M = N,
ok.
tracer_port_crash(Config) when is_list(Config) ->
case test_server:is_native(?MODULE) orelse
- test_server:is_native(lists) of
- true ->
- {skip,"Native code"};
- false ->
- Tr = start_tracer(Config),
- Port = get(tracer_port),
- Tracee = spawn(fun () ->
- register(trace_port_linker, self()),
- link(Port),
- receive go -> ok end,
- lists:reverse([1,b,c]),
- receive die -> ok end
- end),
- Tr ! {unlink_tracer_port, self()},
- receive {unlinked_tracer_port, Tr} -> ok end,
- port_control(Port, $c, []), %% Make port commands crash tracer port...
- trace_func({lists,reverse,1}, []),
- trace_pid(Tracee, true, [call]),
- trace_info(Tracee, flags),
- trace_info(self(), tracer),
- Tracee ! go,
- receive after 1000 -> ok end,
- case whereis(trace_port_linker) of
- undefined ->
- ok;
- Id ->
-% erts_debug:set_internal_state(available_internal_state, true),
-% erts_debug:set_internal_state(abort, {trace_port_linker, Id})
- ?t:fail({trace_port_linker, Id})
- end,
- undefined = process_info(Tracee),
- ok
+ test_server:is_native(lists) of
+ true ->
+ {skip,"Native code"};
+ false ->
+ Tr = start_tracer(Config),
+ Port = get(tracer_port),
+ Tracee = spawn(fun () ->
+ register(trace_port_linker, self()),
+ link(Port),
+ receive go -> ok end,
+ lists:reverse([1,b,c]),
+ receive die -> ok end
+ end),
+ Tr ! {unlink_tracer_port, self()},
+ receive {unlinked_tracer_port, Tr} -> ok end,
+ port_control(Port, $c, []), %% Make port commands crash tracer port...
+ trace_func({lists,reverse,1}, []),
+ trace_pid(Tracee, true, [call]),
+ trace_info(Tracee, flags),
+ trace_info(self(), tracer),
+ Tracee ! go,
+ receive after 1000 -> ok end,
+ case whereis(trace_port_linker) of
+ undefined ->
+ ok;
+ Id ->
+ % erts_debug:set_internal_state(available_internal_state, true),
+ % erts_debug:set_internal_state(abort, {trace_port_linker, Id})
+ ct:fail({trace_port_linker, Id})
+ end,
+ undefined = process_info(Tracee),
+ ok
end.
%%% Help functions.
@@ -523,106 +492,106 @@ huge_data(N) ->
expect() ->
receive
- Other ->
- ok = io:format("Unexpected; got ~p", [Other]),
- test_server:fail({unexpected, Other})
+ Other ->
+ ok = io:format("Unexpected; got ~p", [Other]),
+ ct:fail({unexpected, Other})
after 200 ->
- ok
+ ok
end.
expect({trace_ts,E1,E2,info,ts}=Message) ->
receive
- {trace_ts,E1,E2,_Info,_Ts}=MessageTs ->
- ok = io:format("Expected and got ~p", [MessageTs]),
- MessageTs;
- Other ->
- io:format("Expected ~p; got ~p", [Message,Other]),
- test_server:fail({unexpected,Other})
+ {trace_ts,E1,E2,_Info,_Ts}=MessageTs ->
+ ok = io:format("Expected and got ~p", [MessageTs]),
+ MessageTs;
+ Other ->
+ io:format("Expected ~p; got ~p", [Message,Other]),
+ ct:fail({unexpected,Other})
after 5000 ->
- io:format("Expected ~p; got nothing", [Message]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [Message]),
+ ct:fail(no_trace_message)
end;
expect({trace,E1,E2,info}=Message) ->
receive
- {trace,E1,E2,_Info}=MessageTs ->
- ok = io:format("Expected and got ~p", [MessageTs]),
- MessageTs;
- Other ->
- io:format("Expected ~p; got ~p", [Message,Other]),
- test_server:fail({unexpected,Other})
+ {trace,E1,E2,_Info}=MessageTs ->
+ ok = io:format("Expected and got ~p", [MessageTs]),
+ MessageTs;
+ Other ->
+ io:format("Expected ~p; got ~p", [Message,Other]),
+ ct:fail({unexpected,Other})
after 5000 ->
- io:format("Expected ~p; got nothing", [Message]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [Message]),
+ ct:fail(no_trace_message)
end;
expect({trace_ts,E1,E2,E3,ts}=Message) ->
receive
- {trace_ts,E1,E2,E3,_Ts}=MessageTs ->
- ok = io:format("Expected and got ~p", [MessageTs]),
- MessageTs;
- Other ->
- io:format("Expected ~p; got ~p", [Message,Other]),
- test_server:fail({unexpected,Other})
+ {trace_ts,E1,E2,E3,_Ts}=MessageTs ->
+ ok = io:format("Expected and got ~p", [MessageTs]),
+ MessageTs;
+ Other ->
+ io:format("Expected ~p; got ~p", [Message,Other]),
+ ct:fail({unexpected,Other})
after 5000 ->
- io:format("Expected ~p; got nothing", [Message]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [Message]),
+ ct:fail(no_trace_message)
end;
expect({trace_ts,E1,E2,E3,E4,ts}=Message) ->
receive
- {trace_ts,E1,E2,E3,E4,_Ts}=MessageTs ->
- ok = io:format("Expected and got ~p", [MessageTs]),
- MessageTs;
- Other ->
- io:format("Expected ~p; got ~p", [Message,Other]),
- test_server:fail({unexpected,Other})
+ {trace_ts,E1,E2,E3,E4,_Ts}=MessageTs ->
+ ok = io:format("Expected and got ~p", [MessageTs]),
+ MessageTs;
+ Other ->
+ io:format("Expected ~p; got ~p", [Message,Other]),
+ ct:fail({unexpected,Other})
after 5000 ->
- io:format("Expected ~p; got nothing", [Message]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [Message]),
+ ct:fail(no_trace_message)
end;
expect(Message) ->
receive
- Message ->
- ok = io:format("Expected and got ~p", [Message]),
- Message;
- Other ->
- io:format("Expected ~p; got ~p", [Message,Other]),
- test_server:fail({unexpected,Other})
+ Message ->
+ ok = io:format("Expected and got ~p", [Message]),
+ Message;
+ Other ->
+ io:format("Expected ~p; got ~p", [Message,Other]),
+ ct:fail({unexpected,Other})
after 5000 ->
- io:format("Expected ~p; got nothing", [Message]),
- test_server:fail(no_trace_message)
+ io:format("Expected ~p; got nothing", [Message]),
+ ct:fail(no_trace_message)
end.
trac(What, On, Flags0) ->
Flags = [{tracer,get(tracer_port)}|Flags0],
get(tracer) ! {apply,self(),{erlang,trace,[What,On,Flags]}},
Res = receive
- {apply_result,Result} -> Result
- end,
+ {apply_result,Result} -> Result
+ end,
ok = io:format("erlang:trace(~p, ~p, ~p) -> ~p",
- [What,On,Flags,Res]),
+ [What,On,Flags,Res]),
Res.
-
+
trace_info(What, Key) ->
get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}},
Res = receive
- {apply_result,Result} -> Result
- end,
+ {apply_result,Result} -> Result
+ end,
ok = io:format("erlang:trace_info(~p, ~p) -> ~p",
- [What,Key,Res]),
+ [What,Key,Res]),
Res.
-
+
trace_func(MFA, MatchProg) ->
get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA,MatchProg]}},
Res = receive
- {apply_result,Result} -> Result
- end,
+ {apply_result,Result} -> Result
+ end,
ok = io:format("erlang:trace_pattern(~p, ~p) -> ~p", [MFA,MatchProg,Res]),
Res.
trace_func(MFA, MatchProg, Flags) ->
get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA,MatchProg,Flags]}},
Res = receive
- {apply_result,Result} -> Result
- end,
+ {apply_result,Result} -> Result
+ end,
ok = io:format("erlang:trace_pattern(~p, ~p) -> ~p", [MFA,MatchProg,Res]),
Res.
@@ -630,29 +599,29 @@ trace_pid(Pid, On, Flags0) ->
Flags = [{tracer,get(tracer_port)}|Flags0],
get(tracer) ! {apply,self(),{erlang,trace,[Pid,On,Flags]}},
Res = receive
- {apply_result,Result} -> Result
- end,
+ {apply_result,Result} -> Result
+ end,
ok = io:format("erlang:trace(~p, ~p, ~p) -> ~p",
- [Pid,On,Flags,Res]),
+ [Pid,On,Flags,Res]),
Res.
start_tracer(Config) ->
- Path = ?config(data_dir, Config),
+ Path = proplists:get_value(data_dir, Config),
ok = load_driver(Path, echo_drv),
Self = self(),
put(tracer, fun_spawn(fun() -> tracer(Self) end)),
receive
- {started,Port} ->
- put(tracer_port, Port)
+ {started,Port} ->
+ put(tracer_port, Port)
end,
get(tracer).
load_driver(Dir, Driver) ->
case erl_ddll:load_driver(Dir, Driver) of
- ok -> ok;
- {error, Error} = Res ->
- io:format("~s\n", [erl_ddll:format_error(Error)]),
- Res
+ ok -> ok;
+ {error, Error} = Res ->
+ io:format("~s\n", [erl_ddll:format_error(Error)]),
+ Res
end.
tracer(RelayTo) ->
@@ -662,18 +631,18 @@ tracer(RelayTo) ->
tracer_loop(RelayTo, Port) ->
receive
- {apply,From,{M,F,A}} ->
- From ! {apply_result,apply(M, F, A)},
- tracer_loop(RelayTo, Port);
- {Port,{data,Msg}} ->
- RelayTo ! binary_to_term(Msg),
- tracer_loop(RelayTo, Port);
- {unlink_tracer_port, From} ->
- unlink(Port),
- From ! {unlinked_tracer_port, self()},
- tracer_loop(RelayTo, Port);
- Other ->
- exit({bad_message,Other})
+ {apply,From,{M,F,A}} ->
+ From ! {apply_result,apply(M, F, A)},
+ tracer_loop(RelayTo, Port);
+ {Port,{data,Msg}} ->
+ RelayTo ! binary_to_term(Msg),
+ tracer_loop(RelayTo, Port);
+ {unlink_tracer_port, From} ->
+ unlink(Port),
+ From ! {unlinked_tracer_port, self()},
+ tracer_loop(RelayTo, Port);
+ Other ->
+ exit({bad_message,Other})
end.
fun_spawn(Fun) ->
@@ -697,43 +666,43 @@ fun_spawn(Fun, Opts) ->
sender() ->
receive
- {send_please, To, What} ->
- To ! What,
- sender()
+ {send_please, To, What} ->
+ To ! What,
+ sender()
end.
%% Just consumes messages from its message queue.
receiver() ->
receive
- _Any -> receiver()
+ _Any -> receiver()
end.
%% Does a garbage collection when it receives a message.
garber() ->
receive
- _Any ->
- lists:seq(1, 100),
- erlang:garbage_collect(),
- garber()
+ _Any ->
+ lists:seq(1, 100),
+ erlang:garbage_collect(),
+ garber()
end.
%% All-purpose process
general() ->
receive
- {apply, {M, F, Args}} ->
- erlang:apply(M, F, Args),
- general();
- {send, Dest, Msg} ->
- Dest ! Msg,
- general();
- {call_f_1, Arg} ->
- f(Arg),
- general();
- nop ->
- general()
+ {apply, {M, F, Args}} ->
+ erlang:apply(M, F, Args),
+ general();
+ {send, Dest, Msg} ->
+ Dest ! Msg,
+ general();
+ {call_f_1, Arg} ->
+ f(Arg),
+ general();
+ nop ->
+ general()
end.
f(Arg) ->
diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl
index f1f077be6b..d59d7d12d3 100644
--- a/erts/emulator/test/tuple_SUITE.erl
+++ b/erts/emulator/test/tuple_SUITE.erl
@@ -26,7 +26,7 @@
t_make_tuple_2/1, t_make_upper_boundry_tuple_2/1, t_make_tuple_3/1,
t_append_element/1, t_append_element_upper_boundry/1,
build_and_match/1, tuple_with_case/1, tuple_in_guard/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%% Tests tuples and the BIFs:
%%
@@ -64,7 +64,7 @@ init_per_suite(Config) ->
[{started_apps, A}|Config].
end_per_suite(Config) ->
- As = ?config(started_apps, Config),
+ As = proplists:get_value(started_apps, Config),
lists:foreach(fun (A) -> application:stop(A) end, As),
Config.
@@ -259,7 +259,7 @@ t_make_tuple(Size, Element) ->
lists:foreach(fun(El) when El =:= Element ->
ok;
(Other) ->
- test_server:fail({got, Other, expected, Element})
+ ct:fail({got, Other, expected, Element})
end, tuple_to_list(Tuple)).
%% Tests the erlang:make_tuple/3 BIF.
@@ -385,14 +385,14 @@ tuple_in_guard(Config) when is_list(Config) ->
Tuple1 == {element(1, Tuple2),element(2, Tuple2)} ->
ok;
true ->
- test_server:fail()
+ ct:fail("failed")
end,
if
Tuple2 == {element(1, Tuple2),element(2, Tuple2),
element(3, Tuple2)} ->
ok;
true ->
- test_server:fail()
+ ct:fail("failed")
end,
ok.
diff --git a/erts/emulator/test/unique_SUITE.erl b/erts/emulator/test/unique_SUITE.erl
index 6fa634b886..e8537e6152 100644
--- a/erts/emulator/test/unique_SUITE.erl
+++ b/erts/emulator/test/unique_SUITE.erl
@@ -20,38 +20,25 @@
-module(unique_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- init_per_testcase/2,end_per_testcase/2]).
+-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]).
-export([unique_monotonic_integer_white_box/1,
unique_integer_white_box/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
%-define(P(V), V).
-define(P(V), print_ret_val(?FILE, ?LINE, V)).
-define(PRINT(V), print_ret_val(?FILE, ?LINE, V)).
-
-init_per_testcase(Case, Config) ->
- ?line Dog=test_server:timetrap(test_server:minutes(2)),
- [{watchdog, Dog}, {testcase, Case}|Config].
-
-end_per_testcase(_, Config) ->
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 4}}].
all() ->
[unique_monotonic_integer_white_box,
unique_integer_white_box].
-groups() ->
- [].
-
init_per_suite(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
Config.
@@ -60,12 +47,6 @@ end_per_suite(_Config) ->
erts_debug:set_internal_state(available_internal_state, false),
ok.
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
%%
%%
%% Unique counter white box test case
@@ -80,15 +61,15 @@ unique_monotonic_integer_white_box(Config) when is_list(Config) ->
%% the system when moving the strict monotonic counter
%% around in a non-strict monotonic way...
Test = spawn(Node,
- fun () ->
- unique_monotonic_integer_white_box_test(TestServer, Success)
- end),
+ fun () ->
+ unique_monotonic_integer_white_box_test(TestServer, Success)
+ end),
Mon = erlang:monitor(process, Test),
receive
- {'DOWN', Mon, process, Test, Error} ->
- ?t:fail(Error);
- Success ->
- ok
+ {'DOWN', Mon, process, Test, Error} ->
+ ct:fail(Error);
+ Success ->
+ ok
end,
erlang:demonitor(Mon, [flush]),
stop_node(Node),
@@ -96,9 +77,9 @@ unique_monotonic_integer_white_box(Config) when is_list(Config) ->
set_unique_monotonic_integer_state(MinCounter, NextValue) ->
true = erts_debug:set_internal_state(unique_monotonic_integer_state,
- NextValue-MinCounter-1).
-
-
+ NextValue-MinCounter-1).
+
+
unique_monotonic_integer_white_box_test(TestServer, Success) ->
erts_debug:set_internal_state(available_internal_state, true),
@@ -130,10 +111,10 @@ unique_monotonic_integer_white_box_test(TestServer, Success) ->
?PRINT({max_counter, MaxCounter}),
case WordSize of
- 4 ->
- MinCounter = MinSint64;
- 8 ->
- MinCounter = MinSmall
+ 4 ->
+ MinCounter = MinSint64;
+ 8 ->
+ MinCounter = MinSmall
end,
StartState = erts_debug:get_internal_state(unique_monotonic_integer_state),
@@ -141,20 +122,20 @@ unique_monotonic_integer_white_box_test(TestServer, Success) ->
%% Verify that we get expected results over all internal limits...
case MinCounter < MinSmall of
- false ->
- 8 = WordSize,
- ok;
- true ->
- 4 = WordSize,
- ?PRINT(over_min_small),
- set_unique_monotonic_integer_state(MinCounter, MinSmall-2),
- true = (?P(erlang:unique_integer([monotonic])) == MinSmall - 2),
- true = (?P(erlang:unique_integer([monotonic])) == MinSmall - 1),
- true = (?P(erlang:unique_integer([monotonic])) == MinSmall),
- true = (?P(erlang:unique_integer([monotonic])) == MinSmall + 1),
- true = (?P(erlang:unique_integer([monotonic])) == MinSmall + 2),
- garbage_collect(),
- ok
+ false ->
+ 8 = WordSize,
+ ok;
+ true ->
+ 4 = WordSize,
+ ?PRINT(over_min_small),
+ set_unique_monotonic_integer_state(MinCounter, MinSmall-2),
+ true = (?P(erlang:unique_integer([monotonic])) == MinSmall - 2),
+ true = (?P(erlang:unique_integer([monotonic])) == MinSmall - 1),
+ true = (?P(erlang:unique_integer([monotonic])) == MinSmall),
+ true = (?P(erlang:unique_integer([monotonic])) == MinSmall + 1),
+ true = (?P(erlang:unique_integer([monotonic])) == MinSmall + 2),
+ garbage_collect(),
+ ok
end,
?PRINT(over_zero), %% Not really an interesting limit, but...
@@ -176,27 +157,27 @@ unique_monotonic_integer_white_box_test(TestServer, Success) ->
garbage_collect(),
case MaxCounter > MaxSint64 of
- false ->
- 4 = WordSize,
- ok;
- true ->
- 8 = WordSize,
- ?PRINT(over_max_sint64),
- set_unique_monotonic_integer_state(MinCounter, MaxSint64-2),
- true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 - 2),
- true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 - 1),
- true = (?P(erlang:unique_integer([monotonic])) == MaxSint64),
- true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 + 1),
- true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 + 2),
- garbage_collect()
+ false ->
+ 4 = WordSize,
+ ok;
+ true ->
+ 8 = WordSize,
+ ?PRINT(over_max_sint64),
+ set_unique_monotonic_integer_state(MinCounter, MaxSint64-2),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 - 2),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 - 1),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSint64),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 + 1),
+ true = (?P(erlang:unique_integer([monotonic])) == MaxSint64 + 2),
+ garbage_collect()
end,
?PRINT(over_max_min_counter),
set_unique_monotonic_integer_state(MinCounter, if MaxCounter == MaxSint64 ->
- MaxCounter-2;
- true ->
- MinCounter-3
- end),
+ MaxCounter-2;
+ true ->
+ MinCounter-3
+ end),
true = (?P(erlang:unique_integer([monotonic])) == MaxCounter - 2),
true = (?P(erlang:unique_integer([monotonic])) == MaxCounter - 1),
true = (?P(erlang:unique_integer([monotonic])) == MaxCounter),
@@ -208,7 +189,7 @@ unique_monotonic_integer_white_box_test(TestServer, Success) ->
%% Restore initial state and hope we didn't mess it up for the
%% system...
true = erts_debug:set_internal_state(unique_monotonic_integer_state,
- StartState),
+ StartState),
TestServer ! Success.
@@ -219,16 +200,16 @@ unique_monotonic_integer_white_box_test(TestServer, Success) ->
%%
-record(uniqint_info, {min_int,
- max_int,
- max_small,
- schedulers,
- sched_bits}).
+ max_int,
+ max_small,
+ schedulers,
+ sched_bits}).
unique_integer_white_box(Config) when is_list(Config) ->
UinqintInfo = init_uniqint_info(),
#uniqint_info{min_int = MinInt,
- max_int = MaxInt,
- max_small = MaxSmall} = UinqintInfo,
+ max_int = MaxInt,
+ max_small = MaxSmall} = UinqintInfo,
io:format("****************************************************~n", []),
io:format("*** Around MIN_UNIQ_INT ~p ***~n", [MinInt]),
io:format("****************************************************~n", []),
@@ -258,7 +239,7 @@ unique_integer_white_box(Config) when is_list(Config) ->
io:format("****************************************************~n", []),
check_unique_integer_around(MaxInt, UinqintInfo),
ok.
-
+
%%% Internal unique_integer_white_box/1 test case
@@ -267,10 +248,21 @@ calc_sched_bits(NoScheds, Shift) when NoScheds < 1 bsl Shift ->
calc_sched_bits(NoScheds, Shift) ->
calc_sched_bits(NoScheds, Shift+1).
+schedulers() ->
+ S = erlang:system_info(schedulers),
+ try
+ DCPUS = erlang:system_info(dirty_cpu_schedulers),
+ DIOS = erlang:system_info(dirty_io_schedulers),
+ S+DCPUS+DIOS
+ catch
+ _ : _ ->
+ S
+ end.
+
init_uniqint_info() ->
SmallBits = erlang:system_info({wordsize, internal})*8-4,
io:format("SmallBits=~p~n", [SmallBits]),
- Schedulers = erlang:system_info(schedulers),
+ Schedulers = schedulers(),
io:format("Schedulers=~p~n", [Schedulers]),
MinSmall = -1*(1 bsl (SmallBits-1)),
io:format("MinSmall=~p~n", [MinSmall]),
@@ -281,33 +273,33 @@ init_uniqint_info() ->
MaxInt = ((((1 bsl 64) - 1) bsl SchedBits) bor Schedulers) + MinSmall,
io:format("MaxInt=~p~n", [MaxInt]),
#uniqint_info{min_int = MinSmall,
- max_int = MaxInt,
- max_small = MaxSmall,
- schedulers = Schedulers,
- sched_bits = SchedBits}.
+ max_int = MaxInt,
+ max_small = MaxSmall,
+ schedulers = Schedulers,
+ sched_bits = SchedBits}.
valid_uniqint(Int, #uniqint_info{min_int = MinInt} = UinqintInfo) when Int < MinInt ->
valid_uniqint(MinInt, UinqintInfo);
valid_uniqint(Int, #uniqint_info{min_int = MinInt,
- sched_bits = SchedBits,
- schedulers = Scheds}) ->
+ sched_bits = SchedBits,
+ schedulers = Scheds}) ->
Int1 = Int - MinInt,
{Inc, ThreadNo} = case Int1 band ((1 bsl SchedBits) - 1) of
- TN when TN > Scheds ->
- {1, Scheds};
- TN ->
- {0, TN}
- end,
+ TN when TN > Scheds ->
+ {1, Scheds};
+ TN ->
+ {0, TN}
+ end,
Counter = ((Int1 bsr SchedBits) + Inc) rem (1 bsl 64),
((Counter bsl SchedBits) bor ThreadNo) + MinInt.
smaller_valid_uniqint(Int, UinqintInfo) ->
Cand = Int-1,
case valid_uniqint(Cand, UinqintInfo) of
- RI when RI < Int ->
- RI;
- _ ->
- smaller_valid_uniqint(Cand, UinqintInfo)
+ RI when RI < Int ->
+ RI;
+ _ ->
+ smaller_valid_uniqint(Cand, UinqintInfo)
end.
int32_to_bigendian_list(Int) ->
@@ -318,7 +310,7 @@ int32_to_bigendian_list(Int) ->
Int band 16#ff].
mk_uniqint(Int, #uniqint_info {min_int = MinInt,
- sched_bits = SchedBits} = _UinqintInfo) ->
+ sched_bits = SchedBits} = _UinqintInfo) ->
Int1 = Int - MinInt,
ThrId = Int1 band ((1 bsl SchedBits) - 1),
Value = (Int1 bsr SchedBits) band ((1 bsl 64) - 1),
@@ -334,36 +326,36 @@ check_uniqint(Int, UinqintInfo) ->
UniqInt = mk_uniqint(Int, UinqintInfo),
io:format("UniqInt=~p ", [UniqInt]),
case UniqInt =:= Int of
- true ->
- io:format("OK~n~n", []);
- false ->
- io:format("result UniqInt=~p FAILED~n", [UniqInt]),
- exit(badres)
+ true ->
+ io:format("OK~n~n", []);
+ false ->
+ io:format("result Int=~p FAILED~n", [Int]),
+ exit(badres)
end.
check_unique_integer_around(Int, #uniqint_info{min_int = MinInt,
- max_int = MaxInt} = UinqintInfo) ->
+ max_int = MaxInt} = UinqintInfo) ->
{Start, End} = case {Int =< MinInt+100, Int >= MaxInt-100} of
- {true, false} ->
- {MinInt, MinInt+100};
- {false, false} ->
- {smaller_valid_uniqint(Int-100, UinqintInfo),
- valid_uniqint(Int+100, UinqintInfo)};
- {false, true} ->
- {MaxInt-100, MaxInt}
- end,
+ {true, false} ->
+ {MinInt, MinInt+100};
+ {false, false} ->
+ {smaller_valid_uniqint(Int-100, UinqintInfo),
+ valid_uniqint(Int+100, UinqintInfo)};
+ {false, true} ->
+ {MaxInt-100, MaxInt}
+ end,
lists:foldl(fun (I, OldRefInt) ->
- RefInt = valid_uniqint(I, UinqintInfo),
- case OldRefInt =:= RefInt of
- true ->
- ok;
- false ->
- check_uniqint(RefInt, UinqintInfo)
- end,
- RefInt
- end,
- none,
- lists:seq(Start, End)).
+ RefInt = valid_uniqint(I, UinqintInfo),
+ case OldRefInt =:= RefInt of
+ true ->
+ ok;
+ false ->
+ check_uniqint(RefInt, UinqintInfo)
+ end,
+ RefInt
+ end,
+ none,
+ lists:seq(Start, End)).
%% helpers
@@ -375,17 +367,17 @@ print_ret_val(File, Line, Value) ->
start_node(Config) ->
start_node(Config, []).
start_node(Config, Opts) when is_list(Config), is_list(Opts) ->
- ?line Pa = filename:dirname(code:which(?MODULE)),
- ?line A = erlang:monotonic_time(1) + erlang:time_offset(1),
- ?line B = erlang:unique_integer([positive]),
- ?line Name = list_to_atom(atom_to_list(?MODULE)
- ++ "-"
- ++ atom_to_list(?config(testcase, Config))
- ++ "-"
- ++ integer_to_list(A)
- ++ "-"
- ++ integer_to_list(B)),
- ?line ?t:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
+ Pa = filename:dirname(code:which(?MODULE)),
+ A = erlang:monotonic_time(1) + erlang:time_offset(1),
+ B = erlang:unique_integer([positive]),
+ Name = list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(proplists:get_value(testcase, Config))
+ ++ "-"
+ ++ integer_to_list(A)
+ ++ "-"
+ ++ integer_to_list(B)),
+ test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
stop_node(Node) ->
- ?t:stop_node(Node).
+ test_server:stop_node(Node).
diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl
index f4d9030255..93a03e8f91 100644
--- a/erts/emulator/test/z_SUITE.erl
+++ b/erts/emulator/test/z_SUITE.erl
@@ -30,148 +30,117 @@
%-define(line_trace, 1).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-%-compile(export_all).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, init_per_testcase/2,
- end_per_testcase/2]).
+-export([all/0, suite/0]).
-export([schedulers_alive/1, node_container_refc_check/1,
long_timers/1, pollset_size/1,
check_io_debug/1, get_check_io_info/0]).
--define(DEFAULT_TIMEOUT, ?t:minutes(5)).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap, {minutes, 5}}].
all() ->
[schedulers_alive, node_container_refc_check,
long_timers, pollset_size, check_io_debug].
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-init_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?t:timetrap(?DEFAULT_TIMEOUT),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) when is_list(Config) ->
- Dog = ?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
- ok.
-
%%%
%%% The test cases -------------------------------------------------------------
%%%
-schedulers_alive(doc) -> ["Tests that all schedulers are actually used"];
-schedulers_alive(suite) -> [];
+%% Tests that all schedulers are actually used
schedulers_alive(Config) when is_list(Config) ->
- ?line Master = self(),
- ?line NoSchedulersOnline = erlang:system_flag(
- schedulers_online,
- erlang:system_info(schedulers)),
- ?line NoSchedulers = erlang:system_info(schedulers),
+ Master = self(),
+ NoSchedulersOnline = erlang:system_flag(
+ schedulers_online,
+ erlang:system_info(schedulers)),
+ NoSchedulers = erlang:system_info(schedulers),
UsedScheds =
- try
- ?line ?t:format("Number of schedulers configured: ~p~n", [NoSchedulers]),
- ?line case erlang:system_info(multi_scheduling) of
- blocked ->
- ?line ?t:fail(multi_scheduling_blocked);
- disabled ->
- ?line ok;
- enabled ->
- ?t:format("Testing blocking process exit~n"),
- BF = fun () ->
- blocked = erlang:system_flag(multi_scheduling,
- block),
- Master ! {self(), blocking},
- receive after infinity -> ok end
- end,
- ?line Blocker = spawn_link(BF),
- ?line Mon = erlang:monitor(process, Blocker),
- ?line receive {Blocker, blocking} -> ok end,
- ?line [Blocker]
- = erlang:system_info(multi_scheduling_blockers),
- ?line unlink(Blocker),
- ?line exit(Blocker, kill),
- ?line receive {'DOWN', Mon, _, _, _} -> ok end,
- ?line enabled = erlang:system_info(multi_scheduling),
- ?line [] = erlang:system_info(multi_scheduling_blockers),
- ?line ok
- end,
- ?t:format("Testing blocked~n"),
- ?line erlang:system_flag(multi_scheduling, block),
- ?line case erlang:system_info(multi_scheduling) of
- enabled ->
- ?line ?t:fail(multi_scheduling_enabled);
- blocked ->
- ?line [Master] = erlang:system_info(multi_scheduling_blockers);
- disabled -> ?line ok
- end,
- ?line Ps = lists:map(
- fun (_) ->
- spawn_link(fun () ->
- run_on_schedulers(none,
- [],
- Master)
- end)
- end,
- lists:seq(1,NoSchedulers)),
- ?line receive after 1000 -> ok end,
- ?line {_, 1} = verify_all_schedulers_used({[],0}, 1),
- ?line lists:foreach(fun (P) ->
- unlink(P),
- exit(P, bang)
- end,
- Ps),
- ?line case erlang:system_flag(multi_scheduling, unblock) of
- blocked -> ?line ?t:fail(multi_scheduling_blocked);
- disabled -> ?line ok;
- enabled -> ?line ok
- end,
- erts_debug:set_internal_state(available_internal_state, true),
- %% node_and_dist_references will use emulator interal thread blocking...
- erts_debug:get_internal_state(node_and_dist_references),
- erts_debug:set_internal_state(available_internal_state, false),
- ?t:format("Testing not blocked~n"),
- ?line Ps2 = lists:map(
- fun (_) ->
- spawn_link(fun () ->
- run_on_schedulers(none,
- [],
- Master)
- end)
- end,
- lists:seq(1,NoSchedulers)),
- ?line receive after 1000 -> ok end,
- ?line {_, NoSIDs} = verify_all_schedulers_used({[],0},NoSchedulers),
- ?line lists:foreach(fun (P) ->
- unlink(P),
- exit(P, bang)
- end,
- Ps2),
- NoSIDs
- after
- NoSchedulers = erlang:system_flag(schedulers_online,
- NoSchedulersOnline),
- NoSchedulersOnline = erlang:system_info(schedulers_online)
- end,
- ?line {comment, "Number of schedulers " ++ integer_to_list(UsedScheds)}.
+ try
+ io:format("Number of schedulers configured: ~p~n", [NoSchedulers]),
+ case erlang:system_info(multi_scheduling) of
+ blocked ->
+ ct:fail(multi_scheduling_blocked);
+ disabled ->
+ ok;
+ enabled ->
+ io:format("Testing blocking process exit~n"),
+ BF = fun () ->
+ blocked = erlang:system_flag(multi_scheduling,
+ block),
+ Master ! {self(), blocking},
+ receive after infinity -> ok end
+ end,
+ Blocker = spawn_link(BF),
+ Mon = erlang:monitor(process, Blocker),
+ receive {Blocker, blocking} -> ok end,
+ [Blocker]
+ = erlang:system_info(multi_scheduling_blockers),
+ unlink(Blocker),
+ exit(Blocker, kill),
+ receive {'DOWN', Mon, _, _, _} -> ok end,
+ enabled = erlang:system_info(multi_scheduling),
+ [] = erlang:system_info(multi_scheduling_blockers),
+ ok
+ end,
+ io:format("Testing blocked~n"),
+ erlang:system_flag(multi_scheduling, block),
+ case erlang:system_info(multi_scheduling) of
+ enabled ->
+ ct:fail(multi_scheduling_enabled);
+ blocked ->
+ [Master] = erlang:system_info(multi_scheduling_blockers);
+ disabled -> ok
+ end,
+ Ps = lists:map(
+ fun (_) ->
+ spawn_link(fun () ->
+ run_on_schedulers(none,
+ [],
+ Master)
+ end)
+ end,
+ lists:seq(1,NoSchedulers)),
+ receive after 1000 -> ok end,
+ {_, 1} = verify_all_schedulers_used({[],0}, 1),
+ lists:foreach(fun (P) ->
+ unlink(P),
+ exit(P, bang)
+ end, Ps),
+ case erlang:system_flag(multi_scheduling, unblock) of
+ blocked -> ct:fail(multi_scheduling_blocked);
+ disabled -> ok;
+ enabled -> ok
+ end,
+ erts_debug:set_internal_state(available_internal_state, true),
+ %% node_and_dist_references will use emulator interal thread blocking...
+ erts_debug:get_internal_state(node_and_dist_references),
+ erts_debug:set_internal_state(available_internal_state, false),
+ io:format("Testing not blocked~n"),
+ Ps2 = lists:map(
+ fun (_) ->
+ spawn_link(fun () ->
+ run_on_schedulers(none,
+ [],
+ Master)
+ end)
+ end,
+ lists:seq(1,NoSchedulers)),
+ receive after 1000 -> ok end,
+ {_, NoSIDs} = verify_all_schedulers_used({[],0},NoSchedulers),
+ lists:foreach(fun (P) ->
+ unlink(P),
+ exit(P, bang)
+ end, Ps2),
+ NoSIDs
+ after
+ NoSchedulers = erlang:system_flag(schedulers_online,
+ NoSchedulersOnline),
+ NoSchedulersOnline = erlang:system_info(schedulers_online)
+ end,
+ {comment, "Number of schedulers " ++ integer_to_list(UsedScheds)}.
run_on_schedulers(LastSID, SIDs, ReportTo) ->
@@ -198,65 +167,56 @@ wait_on_used_scheduler({SIDs, SIDsLen} = State) ->
true ->
wait_on_used_scheduler(State);
false ->
- ?t:format("Scheduler ~p used~n", [SID]),
+ io:format("Scheduler ~p used~n", [SID]),
{[SID|SIDs], SIDsLen+1}
end
end.
verify_all_schedulers_used({UsedSIDs, UsedSIDsLen} = State, NoSchedulers) ->
- ?line case NoSchedulers of
+ case NoSchedulers of
UsedSIDsLen ->
- ?line State;
+ State;
NoSchdlrs when NoSchdlrs < UsedSIDsLen ->
- ?line ?t:fail({more_schedulers_used_than_exist,
+ ct:fail({more_schedulers_used_than_exist,
{existing_schedulers, NoSchdlrs},
{used_schedulers, UsedSIDsLen},
{used_scheduler_ids, UsedSIDs}});
_ ->
- ?line NewState = wait_on_used_scheduler(State),
- ?line verify_all_schedulers_used(NewState, NoSchedulers)
+ NewState = wait_on_used_scheduler(State),
+ verify_all_schedulers_used(NewState, NoSchedulers)
end.
-node_container_refc_check(doc) -> [];
-node_container_refc_check(suite) -> [];
node_container_refc_check(Config) when is_list(Config) ->
- ?line node_container_SUITE:node_container_refc_check(node()),
- ?line ok.
+ node_container_SUITE:node_container_refc_check(node()),
+ ok.
-long_timers(doc) ->
- [];
-long_timers(suite) ->
- [];
long_timers(Config) when is_list(Config) ->
- ?line ok = long_timers_test:check_result().
+ ok = long_timers_test:check_result().
-pollset_size(doc) ->
- [];
-pollset_size(suite) ->
- [];
pollset_size(Config) when is_list(Config) ->
- ?line Name = pollset_size_testcase_initial_state_holder,
- ?line Mon = erlang:monitor(process, Name),
- ?line (catch Name ! {get_initial_check_io_result, self()}),
- ?line InitChkIo = receive
+ Name = pollset_size_testcase_initial_state_holder,
+ Mon = erlang:monitor(process, Name),
+ (catch Name ! {get_initial_check_io_result, self()}),
+ InitChkIo = receive
{initial_check_io_result, ICIO} ->
- ?line erlang:demonitor(Mon, [flush]),
- ?line ICIO;
+ erlang:demonitor(Mon, [flush]),
+ ICIO;
{'DOWN', Mon, _, _, Reason} ->
- ?line ?t:fail({non_existing, Name, Reason})
+ ct:fail({non_existing, Name, Reason})
end,
- ?line FinChkIo = get_check_io_info(),
- ?line io:format("Initial: ~p~nFinal: ~p~n", [InitChkIo, FinChkIo]),
- ?line InitPollsetSize = lists:keysearch(total_poll_set_size, 1, InitChkIo),
- ?line FinPollsetSize = lists:keysearch(total_poll_set_size, 1, FinChkIo),
- ?line case InitPollsetSize =:= FinPollsetSize of
+ FinChkIo = get_check_io_info(),
+ io:format("Initial: ~p~nFinal: ~p~n", [InitChkIo, FinChkIo]),
+ InitPollsetSize = lists:keysearch(total_poll_set_size, 1, InitChkIo),
+ FinPollsetSize = lists:keysearch(total_poll_set_size, 1, FinChkIo),
+ HasGethost = case has_gethost() of true -> 1; _ -> 0 end,
+ case InitPollsetSize =:= FinPollsetSize of
true ->
case InitPollsetSize of
{value, {total_poll_set_size, Size}} ->
- ?line {comment,
+ {comment,
"Pollset size: " ++ integer_to_list(Size)};
_ ->
- ?line {skipped,
+ {skipped,
"Pollset size information not available"}
end;
false ->
@@ -265,40 +225,59 @@ pollset_size(Config) when is_list(Config) ->
%% that is ok as long as there are at least 2
%% descriptors (dist listen socket and
%% epmd socket) in the pollset.
- ?line {value, {total_poll_set_size, InitSize}}
+ {value, {total_poll_set_size, InitSize}}
= InitPollsetSize,
- ?line {value, {total_poll_set_size, FinSize}}
+ {value, {total_poll_set_size, FinSize}}
= FinPollsetSize,
- ?line true = FinSize < InitSize,
- ?line true = 2 =< FinSize,
- ?line {comment,
+ true = FinSize < (InitSize + HasGethost),
+ true = 2 =< FinSize,
+ {comment,
"Start pollset size: "
++ integer_to_list(InitSize)
++ " End pollset size: "
++ integer_to_list(FinSize)}
end.
-check_io_debug(doc) ->
- [];
-check_io_debug(suite) ->
- [];
check_io_debug(Config) when is_list(Config) ->
- ?line case lists:keysearch(name, 1, erlang:system_info(check_io)) of
- {value, {name, erts_poll}} -> ?line check_io_debug_test();
- _ -> ?line {skipped, "Not implemented in this emulator"}
+ case lists:keysearch(name, 1, erlang:system_info(check_io)) of
+ {value, {name, erts_poll}} -> check_io_debug_test();
+ _ -> {skipped, "Not implemented in this emulator"}
end.
check_io_debug_test() ->
- ?line erlang:display(get_check_io_info()),
- ?line erts_debug:set_internal_state(available_internal_state, true),
- ?line {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs}
+ erlang:display(get_check_io_info()),
+ erts_debug:set_internal_state(available_internal_state, true),
+ {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} = CheckIoDebug
= erts_debug:get_internal_state(check_io_debug),
- ?line erts_debug:set_internal_state(available_internal_state, false),
- ?line 0 = NoErrorFds,
- ?line NoUsedFds = NoDrvSelStructs,
- ?line 0 = NoDrvEvStructs,
- ?line ok.
+ erts_debug:set_internal_state(available_internal_state, false),
+ HasGetHost = has_gethost(),
+ ct:log("check_io_debug: ~p~n"
+ "HasGetHost: ~p",[CheckIoDebug, HasGetHost]),
+ 0 = NoErrorFds,
+ if
+ NoUsedFds == NoDrvSelStructs ->
+ ok;
+ HasGetHost andalso (NoUsedFds == (NoDrvSelStructs - 1)) ->
+ %% If the inet_gethost port is alive, we may have
+ %% one extra used fd that is not selected on.
+ %% This happens when the initial setup of the
+ %% port returns an EAGAIN
+ ok
+ end,
+ 0 = NoDrvEvStructs,
+ ok.
+has_gethost() ->
+ has_gethost(erlang:ports()).
+has_gethost([P|T]) ->
+ case erlang:port_info(P, name) of
+ {name,"inet_gethost"++_} ->
+ true;
+ _ ->
+ has_gethost(T)
+ end;
+has_gethost([]) ->
+ false.
%%
@@ -332,6 +311,3 @@ get_check_io_info() ->
receive after 100 -> ok end,
get_check_io_info()
end.
-
-
-
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index 9a8c3585e6..f805e7cc64 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -48,12 +48,17 @@ $pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize
'(3*BEAM_LOOSE_SHIFT)'];
$pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD];
-$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK'];
+$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD];
$pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize
'BEAM_LOOSE_MASK',
'BEAM_LOOSE_MASK',
$WHOLE_WORD];
+# Mapping from packagable arguments to number of packed arguments per
+# word. Initialized after the wordsize is known.
+
+my @args_per_word;
+
# There are two types of instructions: generic and specific.
# The generic instructions are those generated by the Beam compiler.
# Corresponding to each generic instruction, there is generally a
@@ -176,11 +181,12 @@ sub define_type_bit {
}
# Composed types.
- define_type_bit('d', $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'});
+ define_type_bit('d', $type_bit{'x'} | $type_bit{'y'});
define_type_bit('c', $type_bit{'i'} | $type_bit{'a'} |
$type_bit{'n'} | $type_bit{'q'});
define_type_bit('s', $type_bit{'d'} | $type_bit{'i'} |
- $type_bit{'a'} | $type_bit{'n'});
+ $type_bit{'a'} | $type_bit{'n'} |
+ $type_bit{'q'});
define_type_bit('j', $type_bit{'f'} | $type_bit{'p'});
# Aliases (for matching purposes).
@@ -236,6 +242,20 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) {
}
#
+# Initialize number of arguments per packed word.
+#
+
+$args_per_word[2] = 2;
+$args_per_word[3] = 3;
+$args_per_word[4] = 2;
+$args_per_word[5] = 3;
+$args_per_word[6] = 3;
+
+if ($wordsize == 64) {
+ $args_per_word[4] = 4;
+}
+
+#
# Parse the input files.
#
@@ -527,12 +547,16 @@ sub emulator_output {
my(@bits) = (0) x ($max_spec_operands/2);
my($i);
+ my $involves_r = 0;
for ($i = 0; $i < $max_spec_operands && defined $args[$i]; $i++) {
my $t = $args[$i];
- if (defined $type_bit{$t}) {
- my $shift = $max_genop_types * ($i % 2);
- $bits[int($i/2)] |= $type_bit{$t} << $shift;
+ my $bits = $type_bit{$t};
+ if ($t eq 'r') {
+ $bits |= $type_bit{'x'};
+ $involves_r |= 1 << $i;
}
+ my $shift = $max_genop_types * ($i % 2);
+ $bits[int($i/2)] |= $bits << $shift;
}
printf "/* %3d */ ", $spec_opnum;
@@ -544,7 +568,7 @@ sub emulator_output {
$sep = ",";
}
$init .= "}";
- &init_item($print_name, $init, $size, $pack, $sign, 0);
+ init_item($print_name, $init, $involves_r, $size, $pack, $sign, 0);
$op_to_name[$spec_opnum] = $instr;
$spec_opnum++;
}
@@ -601,15 +625,12 @@ sub emulator_output {
print "#define MAX_GENERIC_OPCODE ", $num_file_opcodes-1, "\n";
print "#define NUM_GENERIC_OPS ", scalar(@gen_opname), "\n";
print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n";
+ print "#define SCRATCH_X_REG 1023\n";
print "\n";
print "#ifdef ARCH_64\n";
print "# define BEAM_WIDE_MASK 0xFFFFUL\n";
- print "# define BEAM_LOOSE_MASK 0x1FFFUL\n";
- print "#if HALFWORD_HEAP\n";
- print "# define BEAM_TIGHT_MASK 0x1FFCUL\n";
- print "#else\n";
- print "# define BEAM_TIGHT_MASK 0x1FF8UL\n";
- print "#endif\n";
+ print "# define BEAM_LOOSE_MASK 0xFFFFUL\n";
+ print "# define BEAM_TIGHT_MASK 0xFFFFUL\n";
print "# define BEAM_WIDE_SHIFT 32\n";
print "# define BEAM_LOOSE_SHIFT 16\n";
print "# define BEAM_TIGHT_SHIFT 16\n";
@@ -734,7 +755,7 @@ sub init_item {
print "${sep}NULL";
} elsif (/^\{/) {
print "$sep$_";
- } elsif (/^-?\d/) {
+ } elsif (/^-?\d+$/) {
print "$sep$_";
} else {
print "$sep\"$_\"";
@@ -896,6 +917,7 @@ sub basic_generator {
my($var_decls) = '';
my($gen_dest_arg) = 'StoreSimpleDest';
my($i);
+ my($no_prefetch) = 0;
# The following argument types should be included as macro arguments.
my(%incl_arg) = ('c' => 1,
@@ -994,6 +1016,7 @@ sub basic_generator {
#
$flags =~ /-fail_action/ and do {
+ $no_prefetch = 1;
if (!defined $fail_type) {
my($i);
for ($i = 0; $i < @f_types; $i++) {
@@ -1040,6 +1063,12 @@ sub basic_generator {
"I += $size + 1;",
"goto $goto;",
"}");
+ } elsif ($no_prefetch) {
+ $code = join("\n",
+ "{ $var_decls",
+ $macro_code,
+ "Next($size);",
+ "}", "");
} else {
$code = join("\n",
"{ $var_decls",
@@ -1061,6 +1090,7 @@ sub do_pack {
my($packable_args) = 0;
my @is_packable; # Packability (boolean) for each argument.
my $wide_packing = 0;
+ my(@orig_args) = @args;
#
# Count the number of packable arguments. If we encounter any 's' or 'd'
@@ -1081,6 +1111,18 @@ sub do_pack {
}
} elsif ($arg =~ /^[sd]/) {
return ('', '', @args);
+ } elsif ($arg =~ /^[scq]/ and $packable_args > 0) {
+ # When packing, this operand will be picked up from the
+ # code array, put onto the packing stack, and later put
+ # back into a different location in the code. The problem
+ # is that if this operand is a literal, the original
+ # location in the code would have been remembered in a
+ # literal patch. For packing to work, we would have to
+ # adjust the position in the literal patch. For the
+ # moment, adding additional instructions to the packing
+ # engine to handle this does not seem worth it, so we will
+ # just turn off packing.
+ return ('', '', @args);
} else {
push @is_packable, 0;
}
@@ -1090,7 +1132,6 @@ sub do_pack {
# Get out of here if too few or too many arguments.
#
return ('', '', @args) if $packable_args < 2;
- &error("too many packable arguments") if $packable_args > 4;
my($size) = 0;
my($pack_prefix) = '';
@@ -1098,14 +1139,8 @@ sub do_pack {
# beginning).
my($up) = ''; # Pack commands (storing back while
# moving forward).
- my $args_per_word;
- if ($packable_args < 4 or $wordsize == 64) {
- $args_per_word = $packable_args;
- } else {
- # 4 packable argument, 32 bit wordsize. Need 2 words.
- $args_per_word = 2;
- }
+ my $args_per_word = $args_per_word[$packable_args];
my @shift;
my @mask;
my @instr;
@@ -1299,6 +1334,8 @@ sub tr_parse_op {
foreach (split('', $type)) {
&error("bad type in $op")
unless defined $type_bit{$_} or $type eq '*';
+ $_ eq 'r' and
+ error("$op: 'r' is not allowed in transformations")
}
}
@@ -1332,7 +1369,10 @@ sub tr_parse_op {
}
# Get an optional value. (In destination.)
+ $type_val = $type eq 'x' ? 1023 : 0;
if (/^=(.*)/) {
+ error("value not allowed in source: $op")
+ if $src;
$type_val = $1;
$_ = '';
}
@@ -1351,11 +1391,6 @@ sub tr_parse_op {
if $var && $type;
}
- # Test that source has no values.
- if ($src) {
- error("value not allowed in source: $op")
- if $type_val;
- }
($var,$type,$type_val,$cond,$cond_val);
}
diff --git a/erts/emulator/valgrind/suppress.halfword b/erts/emulator/valgrind/suppress.halfword
deleted file mode 100644
index 8fe448d897..0000000000
--- a/erts/emulator/valgrind/suppress.halfword
+++ /dev/null
@@ -1,56 +0,0 @@
-# Extra suppressions specific for the halfword emulator.
-
-# --- Suppress all offheap binaries ---
-# Valgrinds leak check does not recognize pointers that are stored
-# at unaligned addresses. In halfword emulator we store 64-bit pointers
-# to offheap data on 32-bit aligned heaps.
-# We solve this by suppressing allocation of all offheap structures
-# that are not referenced by other tables (ie binaries).
-
-{
-Halfword erts_bin_nrml_alloc
-Memcheck:Leak
-...
-fun:erts_bin_nrml_alloc
-...
-}
-
-{
-Halfword erts_bin_realloc
-Memcheck:Leak
-...
-fun:erts_bin_realloc
-...
-}
-
-{
-Halfword erts_bin_realloc_fnf
-Memcheck:Leak
-...
-fun:erts_bin_realloc_fnf
-...
-}
-
-{
-Halfword erts_bin_drv_alloc
-Memcheck:Leak
-...
-fun:erts_bin_drv_alloc
-...
-}
-
-{
-Halfword erts_bin_drv_alloc_fnf
-Memcheck:Leak
-...
-fun:erts_bin_drv_alloc_fnf
-...
-}
-
-{
-Halfword erts_create_magic_binary
-Memcheck:Leak
-...
-fun:erts_create_magic_binary
-...
-}
diff --git a/erts/emulator/valgrind/suppress.patched.3.6.0 b/erts/emulator/valgrind/suppress.patched.3.6.0
index 16cecf2dba..fcde4a0123 100644
--- a/erts/emulator/valgrind/suppress.patched.3.6.0
+++ b/erts/emulator/valgrind/suppress.patched.3.6.0
@@ -368,7 +368,7 @@ Memcheck:Addr4
...
fun:erts_print_scheduler_info
...
-fun:erl_exit
+fun:erts_exit
fun:broken_halt_test
fun:erts_debug_set_internal_state_2
fun:process_main
diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard
index a1f3f82364..bb07c92fc1 100644
--- a/erts/emulator/valgrind/suppress.standard
+++ b/erts/emulator/valgrind/suppress.standard
@@ -336,7 +336,7 @@ Memcheck:Addr4
...
fun:erts_print_scheduler_info
...
-fun:erl_exit
+fun:erts_exit
fun:broken_halt_test
fun:erts_debug_set_internal_state_2
fun:process_main
diff --git a/erts/epmd/src/Makefile.in b/erts/epmd/src/Makefile.in
index b6e3ba7762..1266be44cb 100644
--- a/erts/epmd/src/Makefile.in
+++ b/erts/epmd/src/Makefile.in
@@ -19,10 +19,6 @@
#
include $(ERL_TOP)/make/target.mk
-ifeq ($(findstring ose,$(TARGET)),ose)
-include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk
-endif
-
ifeq ($(TYPE),debug)
PURIFY =
TYPEMARKER = .debug
@@ -32,21 +28,13 @@ else
ifeq ($(TYPE),purify)
PURIFY = purify
TYPEMARKER =
-ifeq ($(findstring ose,$(TARGET)),ose)
- TYPE_FLAGS = -DPURIFY
-else
- TYPE_FLAGS = -O2 -DPURIFY
-endif
+TYPE_FLAGS = -O2 -DPURIFY
else
override TYPE = opt
PURIFY =
TYPEMARKER =
-ifeq ($(findstring ose,$(TARGET)),ose)
- TYPE_FLAGS =
-else
- TYPE_FLAGS = -O2
-endif
+TYPE_FLAGS = -O2
endif
endif
@@ -68,13 +56,9 @@ else
ifeq ($(findstring vxworks,$(TARGET)),vxworks)
ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@
-else
ERTS_INTERNAL_LIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ -lm
endif
endif
-endif
ERTS_LIB = $(ERL_TOP)/erts/lib_src/obj/$(TARGET)/$(TYPE)/MADE
@@ -82,11 +66,7 @@ CC = @CC@
WFLAGS = @WFLAGS@
CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) $(WFLAGS) $(ERTS_INCL)
LD = @LD@
-ifeq ($(findstring ose,$(TARGET)),ose)
-LIBS = $(ERTS_INTERNAL_LIBS) @LIBS@
-else
LIBS = @LIBS@ @SYSTEMD_DAEMON_LIBS@ $(ERTS_INTERNAL_LIBS)
-endif
LDFLAGS = @LDFLAGS@
@@ -135,25 +115,12 @@ clean:
rm -f *.o
rm -f *~ core
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(OBJDIR)/ose_confd.o: $(OSE_CONFD)
- $(V_CC) $(CFLAGS) -o $@ -c $<
-$(OBJDIR)/crt0_lm.o: $(CRT0_LM)
- $(V_CC) $(CFLAGS) -o $@ -c $<
-OSE_LM_OBJS += $(OBJDIR)/ose_confd.o $(OBJDIR)/crt0_lm.o
-endif
-
#
# Objects & executables
#
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(BINDIR)/$(EPMD): $(EPMD_OBJS) $(ERTS_LIB) $(OSE_LM_OBJS)
- $(call build-ose-load-module, $@, $(EPMD_OBJS) $(OSE_LM_OBJS), $(LIBS), $(EPMD_LMCONF))
-else
$(BINDIR)/$(EPMD): $(EPMD_OBJS) $(ERTS_LIB)
$(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) -o $@ $(EPMD_OBJS) $(LIBS)
-endif
$(OBJDIR)/%.o: %.c epmd.h epmd_int.h
$(V_CC) $(CFLAGS) $(EPMD_FLAGS) -o $@ -c $<
diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c
index 132bda725c..324ae6ac40 100644
--- a/erts/epmd/src/epmd.c
+++ b/erts/epmd/src/epmd.c
@@ -29,7 +29,7 @@
#ifdef HAVE_STDLIB_H
# include <stdlib.h>
#endif
-
+#include <time.h>
/* forward declarations */
static void usage(EpmdVars *);
@@ -343,7 +343,7 @@ static void run_daemon(EpmdVars *g)
for (fd = 0; fd < g->max_conn ; fd++) /* close all files ... */
close(fd);
/* Syslog on linux will try to write to whatever if we dont
- inform it of that the log is closed. */
+ inform it that the log is closed. */
closelog();
/* These shouldn't be needed but for safety... */
@@ -397,7 +397,7 @@ static void run_daemon(EpmdVars *g)
}
#endif
-#if defined(VXWORKS) || defined(__OSE__)
+#if defined(VXWORKS)
static void run_daemon(EpmdVars *g)
{
run(g);
diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c
index a8fe865d9a..6fc05e153e 100644
--- a/erts/epmd/src/epmd_cli.c
+++ b/erts/epmd/src/epmd_cli.c
@@ -136,19 +136,33 @@ void epmd_call(EpmdVars *g,int what)
static int conn_to_epmd(EpmdVars *g)
{
struct EPMD_SOCKADDR_IN address;
+ size_t salen = 0;
int connect_sock;
-
- connect_sock = socket(FAMILY, SOCK_STREAM, 0);
- if (connect_sock<0)
- goto error;
+ unsigned short sport = g->port;
+
+#if defined(EPMD6)
+ SET_ADDR6(address, in6addr_loopback, sport);
+ salen = sizeof(struct sockaddr_in6);
+
+ connect_sock = socket(AF_INET6, SOCK_STREAM, 0);
+ if (connect_sock>=0) {
+
+ if (connect(connect_sock, (struct sockaddr*)&address, salen) == 0)
+ return connect_sock;
- { /* store port number in unsigned short */
- unsigned short sport = g->port;
- SET_ADDR(address, EPMD_ADDR_LOOPBACK, sport);
+ close(connect_sock);
}
+#endif
+ SET_ADDR(address, htonl(INADDR_LOOPBACK), sport);
+ salen = sizeof(struct sockaddr_in);
- if (connect(connect_sock, (struct sockaddr*)&address, sizeof address) < 0)
+ connect_sock = socket(AF_INET, SOCK_STREAM, 0);
+ if (connect_sock<0)
goto error;
+
+ if (connect(connect_sock, (struct sockaddr*)&address, salen) < 0)
+ goto error;
+
return connect_sock;
error:
diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h
index 26100afc93..e127eff097 100644
--- a/erts/epmd/src/epmd_int.h
+++ b/erts/epmd/src/epmd_int.h
@@ -37,13 +37,6 @@
#define DONT_USE_MAIN
#endif
-#ifdef __OSE__
-# define NO_DAEMON
-# define NO_SYSLOG
-# define NO_SYSCONF
-# define NO_FCNTL
-#endif
-
/* ************************************************************************ */
/* Standard includes */
@@ -55,6 +48,7 @@
# ifndef WINDOWS_H_INCLUDES_WINSOCK2_H
# include <winsock2.h>
# endif
+# include <ws2tcpip.h>
# include <windows.h>
# include <process.h>
#endif
@@ -100,12 +94,7 @@
#endif /* ! WIN32 */
#include <ctype.h>
-
-#if !defined(__OSE__)
-# include <signal.h>
-#endif
-
-
+#include <signal.h>
#include <errno.h>
#ifdef HAVE_SYSLOG_H
@@ -122,14 +111,14 @@
#include <stdarg.h>
-#ifdef __OSE__
-# include "sys/select.h"
-#endif
-
#ifdef HAVE_SYSTEMD_DAEMON
# include <systemd/sd-daemon.h>
#endif /* HAVE_SYSTEMD_DAEMON */
+#if defined(HAVE_IN6) && defined(AF_INET6) && defined(HAVE_INET_PTON)
+# define EPMD6
+#endif
+
/* ************************************************************************ */
/* Replace some functions by others by making the function name a macro */
@@ -183,33 +172,53 @@
/* ************************************************************************ */
/* Macros that let us use IPv6 */
-#if defined(HAVE_IN6) && defined(AF_INET6) && defined(EPMD6)
+#if HAVE_IN6
+# if ! defined(HAVE_IN6ADDR_ANY) || ! HAVE_IN6ADDR_ANY
+# if HAVE_DECL_IN6ADDR_ANY_INIT
+static const struct in6_addr in6addr_any = { { IN6ADDR_ANY_INIT } };
+# else
+static const struct in6_addr in6addr_any =
+ { { { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 } } };
+# endif /* HAVE_IN6ADDR_ANY_INIT */
+# endif /* ! HAVE_DECL_IN6ADDR_ANY */
+
+# if ! defined(HAVE_IN6ADDR_LOOPBACK) || ! HAVE_IN6ADDR_LOOPBACK
+# if HAVE_DECL_IN6ADDR_LOOPBACK_INIT
+static const struct in6_addr in6addr_loopback =
+ { { IN6ADDR_LOOPBACK_INIT } };
+# else
+static const struct in6_addr in6addr_loopback =
+ { { { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 } } };
+# endif /* HAVE_IN6ADDR_LOOPBACK_INIT */
+# endif /* ! HAVE_DECL_IN6ADDR_LOOPBACK */
+#endif /* HAVE_IN6 */
+
+#define IS_ADDR_LOOPBACK(addr) ((addr).s_addr == htonl(INADDR_LOOPBACK))
-#define EPMD_SOCKADDR_IN sockaddr_in6
-#define EPMD_IN_ADDR in6_addr
-#define EPMD_S_ADDR s6_addr
-#define EPMD_ADDR_LOOPBACK in6addr_loopback.s6_addr
-#define EPMD_ADDR_ANY in6addr_any.s6_addr
+#if defined(EPMD6)
+
+#define EPMD_SOCKADDR_IN sockaddr_storage
#define FAMILY AF_INET6
-#define SET_ADDR(dst, addr, port) do { \
- memset((char*)&(dst), 0, sizeof(dst)); \
- memcpy((char*)&(dst).sin6_addr.s6_addr, (char*)&(addr), 16); \
- (dst).sin6_family = AF_INET6; \
- (dst).sin6_flowinfo = 0; \
- (dst).sin6_port = htons(port); \
+#define SET_ADDR6(dst, addr, port) do { \
+ struct sockaddr_in6 *sa = (struct sockaddr_in6 *)&(dst); \
+ memset(sa, 0, sizeof(dst)); \
+ sa->sin6_family = AF_INET6; \
+ sa->sin6_addr = (addr); \
+ sa->sin6_port = htons(port); \
} while(0)
-#define IS_ADDR_LOOPBACK(addr) \
- (memcmp((addr).s6_addr, in6addr_loopback.s6_addr, 16) == 0)
+#define SET_ADDR(dst, addr, port) do { \
+ struct sockaddr_in *sa = (struct sockaddr_in *)&(dst); \
+ memset(sa, 0, sizeof(dst)); \
+ sa->sin_family = AF_INET; \
+ sa->sin_addr.s_addr = (addr); \
+ sa->sin_port = htons(port); \
+ } while(0)
#else /* Not IP v6 */
#define EPMD_SOCKADDR_IN sockaddr_in
-#define EPMD_IN_ADDR in_addr
-#define EPMD_S_ADDR s_addr
-#define EPMD_ADDR_LOOPBACK htonl(INADDR_LOOPBACK)
-#define EPMD_ADDR_ANY htonl(INADDR_ANY)
#define FAMILY AF_INET
#define SET_ADDR(dst, addr, port) do { \
@@ -219,8 +228,6 @@
(dst).sin_port = htons(port); \
} while(0)
-#define IS_ADDR_LOOPBACK(addr) ((addr).s_addr == htonl(INADDR_LOOPBACK))
-
#endif /* Not IP v6 */
/* ************************************************************************ */
diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c
index 8c8d7304f2..75a33f28cb 100644
--- a/erts/epmd/src/epmd_srv.c
+++ b/erts/epmd/src/epmd_srv.c
@@ -30,11 +30,6 @@
# define INADDR_NONE 0xffffffff
#endif
-#if defined(__OSE__)
-# include "sys/ioctl.h"
-# define sleep(x) delay(x*1000)
-#endif
-
/*
*
* This server is a local name server for Erlang nodes. Erlang nodes can
@@ -76,6 +71,7 @@ static time_t current_time(EpmdVars*);
static Connection *conn_init(EpmdVars*);
static int conn_open(EpmdVars*,int);
+static int conn_local_peer_check(EpmdVars*, int);
static int conn_close_fd(EpmdVars*,int);
static void node_init(EpmdVars*);
@@ -206,10 +202,11 @@ void run(EpmdVars *g)
{
struct EPMD_SOCKADDR_IN iserv_addr[MAX_LISTEN_SOCKETS];
int listensock[MAX_LISTEN_SOCKETS];
- int num_sockets;
+ int num_sockets = 0;
int i;
int opt;
unsigned short sport = g->port;
+ int bound = 0;
node_init(g);
g->conn = conn_init(g);
@@ -252,70 +249,88 @@ void run(EpmdVars *g)
if (g->addresses != NULL && /* String contains non-separator characters if: */
g->addresses[strspn(g->addresses," ,")] != '\000')
{
- char *tmp;
- char *token;
- int loopback_ok = 0;
+ char *tmp = NULL;
+ char *token = NULL;
+
+ /* Always listen on the loopback. */
+ SET_ADDR(iserv_addr[num_sockets],htonl(INADDR_LOOPBACK),sport);
+ num_sockets++;
+#if defined(EPMD6)
+ SET_ADDR6(iserv_addr[num_sockets],in6addr_loopback,sport);
+ num_sockets++;
+#endif
- if ((tmp = (char *)malloc(strlen(g->addresses) + 1)) == NULL)
+ if ((tmp = strdup(g->addresses)) == NULL)
{
dbg_perror(g,"cannot allocate memory");
epmd_cleanup_exit(g,1);
}
- strcpy(tmp,g->addresses);
- for(token = strtok(tmp,", "), num_sockets = 0;
+ for(token = strtok(tmp,", ");
token != NULL;
- token = strtok(NULL,", "), num_sockets++)
+ token = strtok(NULL,", "))
{
- struct EPMD_IN_ADDR addr;
-#ifdef HAVE_INET_PTON
- int ret;
+ struct in_addr addr;
+#if defined(EPMD6)
+ struct in6_addr addr6;
+ struct sockaddr_storage *sa = &iserv_addr[num_sockets];
- if ((ret = inet_pton(FAMILY,token,&addr)) == -1)
+ if (inet_pton(AF_INET6,token,&addr6) == 1)
{
- dbg_perror(g,"cannot convert IP address to network format");
- epmd_cleanup_exit(g,1);
+ SET_ADDR6(iserv_addr[num_sockets],addr6,sport);
+ }
+ else if (inet_pton(AF_INET,token,&addr) == 1)
+ {
+ SET_ADDR(iserv_addr[num_sockets],addr.s_addr,sport);
+ }
+ else
+#else
+ if ((addr.s_addr = inet_addr(token)) != INADDR_NONE)
+ {
+ SET_ADDR(iserv_addr[num_sockets],addr.s_addr,sport);
}
- else if (ret == 0)
-#elif !defined(EPMD6)
- if ((addr.EPMD_S_ADDR = inet_addr(token)) == INADDR_NONE)
+ else
#endif
{
dbg_tty_printf(g,0,"cannot parse IP address \"%s\"",token);
epmd_cleanup_exit(g,1);
}
+#if defined(EPMD6)
+ if (sa->ss_family == AF_INET6 && IN6_IS_ADDR_LOOPBACK(&addr6))
+ continue;
+
+ if (sa->ss_family == AF_INET)
+#endif
if (IS_ADDR_LOOPBACK(addr))
- loopback_ok = 1;
+ continue;
+
+ num_sockets++;
- if (num_sockets - loopback_ok == MAX_LISTEN_SOCKETS - 1)
+ if (num_sockets >= MAX_LISTEN_SOCKETS)
{
dbg_tty_printf(g,0,"cannot listen on more than %d IP addresses",
MAX_LISTEN_SOCKETS);
epmd_cleanup_exit(g,1);
}
-
- SET_ADDR(iserv_addr[num_sockets],addr.EPMD_S_ADDR,sport);
}
free(tmp);
-
- if (!loopback_ok)
- {
- SET_ADDR(iserv_addr[num_sockets],EPMD_ADDR_LOOPBACK,sport);
- num_sockets++;
- }
}
else
{
- SET_ADDR(iserv_addr[0],EPMD_ADDR_ANY,sport);
- num_sockets = 1;
+ SET_ADDR(iserv_addr[num_sockets],htonl(INADDR_ANY),sport);
+ num_sockets++;
+#if defined(EPMD6)
+ SET_ADDR6(iserv_addr[num_sockets],in6addr_any,sport);
+ num_sockets++;
+#endif
}
#ifdef HAVE_SYSTEMD_DAEMON
}
#endif /* HAVE_SYSTEMD_DAEMON */
-#if !defined(__WIN32__) && !defined(__OSE__)
+#if !defined(__WIN32__)
/* We ignore the SIGPIPE signal that is raised when we call write
twice on a socket closed by the other end. */
signal(SIGPIPE, SIG_IGN);
@@ -340,13 +355,39 @@ void run(EpmdVars *g)
#endif /* HAVE_SYSTEMD_DAEMON */
for (i = 0; i < num_sockets; i++)
{
- if ((listensock[i] = socket(FAMILY,SOCK_STREAM,0)) < 0)
+ struct sockaddr *sa = (struct sockaddr *)&iserv_addr[i];
+#if defined(EPMD6)
+ size_t salen = (sa->sa_family == AF_INET6 ?
+ sizeof(struct sockaddr_in6) :
+ sizeof(struct sockaddr_in));
+#else
+ size_t salen = sizeof(struct sockaddr_in);
+#endif
+
+ if ((listensock[i] = socket(sa->sa_family,SOCK_STREAM,0)) < 0)
+ {
+ switch (errno) {
+ case EAFNOSUPPORT:
+ case EPROTONOSUPPORT:
+ continue;
+ default:
+ dbg_perror(g,"error opening stream socket");
+ epmd_cleanup_exit(g,1);
+ }
+ }
+ g->listenfd[bound++] = listensock[i];
+
+#if HAVE_DECL_IPV6_V6ONLY
+ opt = 1;
+ if (sa->sa_family == AF_INET6 &&
+ setsockopt(listensock[i],IPPROTO_IPV6,IPV6_V6ONLY,&opt,
+ sizeof(opt)) <0)
{
- dbg_perror(g,"error opening stream socket");
+ dbg_perror(g,"can't set IPv6 only socket option");
epmd_cleanup_exit(g,1);
}
- g->listenfd[i] = listensock[i];
-
+#endif
+
/*
* Note that we must not enable the SO_REUSEADDR on Windows,
* because addresses will be reused even if they are still in use.
@@ -378,8 +419,7 @@ void run(EpmdVars *g)
dbg_perror(g,"failed to set non-blocking mode of listening socket %d",
listensock[i]);
- if (bind(listensock[i], (struct sockaddr*) &iserv_addr[i],
- sizeof(iserv_addr[i])) < 0)
+ if (bind(listensock[i], (struct sockaddr*) &iserv_addr[i], salen) < 0)
{
if (errno == EADDRINUSE)
{
@@ -400,6 +440,11 @@ void run(EpmdVars *g)
}
select_fd_set(g, listensock[i]);
}
+ if (bound == 0) {
+ dbg_perror(g,"unable to bind any address");
+ epmd_cleanup_exit(g,1);
+ }
+ num_sockets = bound;
#ifdef HAVE_SYSTEMD_DAEMON
}
sd_notifyf(0, "READY=1\n"
@@ -444,8 +489,8 @@ void run(EpmdVars *g)
}
for (i = 0; i < num_sockets; i++)
- if (FD_ISSET(listensock[i],&read_mask)) {
- if (do_accept(g, listensock[i]) && g->active_conn < g->max_conn) {
+ if (FD_ISSET(g->listenfd[i],&read_mask)) {
+ if (do_accept(g, g->listenfd[i]) && g->active_conn < g->max_conn) {
/*
* The accept() succeeded, and we have at least one file
* descriptor still free, which means that another accept()
@@ -700,11 +745,9 @@ static void do_request(g, fd, s, buf, bsize)
put_int16(node->creation, wbuf+2);
}
- if (g->delay_write) /* Test of busy server */
- sleep(g->delay_write);
-
if (reply(g, fd, wbuf, 4) != 4)
{
+ node_unreg(g, name);
dbg_tty_printf(g,1,"** failed to send ALIVE2_RESP for \"%s\"",
name);
return;
@@ -1007,15 +1050,6 @@ static int conn_open(EpmdVars *g,int fd)
for (i = 0; i < g->max_conn; i++) {
if (g->conn[i].open == EPMD_FALSE) {
- struct sockaddr_in si;
- struct sockaddr_in di;
-#ifdef HAVE_SOCKLEN_T
- socklen_t st;
-#else
- int st;
-#endif
- st = sizeof(si);
-
g->active_conn++;
s = &g->conn[i];
@@ -1026,20 +1060,7 @@ static int conn_open(EpmdVars *g,int fd)
s->open = EPMD_TRUE;
s->keep = EPMD_FALSE;
- /* Determine if connection is from localhost */
- if (getpeername(s->fd,(struct sockaddr*) &si,&st) ||
- st < sizeof(si)) {
- /* Failure to get peername is regarded as non local host */
- s->local_peer = EPMD_FALSE;
- } else {
- /* Only 127.x.x.x and connections from the host's IP address
- allowed, no false positives */
- s->local_peer =
- (((((unsigned) ntohl(si.sin_addr.s_addr)) & 0xFF000000U) ==
- 0x7F000000U) ||
- (getsockname(s->fd,(struct sockaddr*) &di,&st) ?
- EPMD_FALSE : si.sin_addr.s_addr == di.sin_addr.s_addr));
- }
+ s->local_peer = conn_local_peer_check(g, s->fd);
dbg_tty_printf(g,2,(s->local_peer) ? "Local peer connected" :
"Non-local peer connected");
@@ -1047,7 +1068,7 @@ static int conn_open(EpmdVars *g,int fd)
s->got = 0;
s->mod_time = current_time(g); /* Note activity */
- s->buf = (char *)malloc(INBUF_SIZE);
+ s->buf = malloc(INBUF_SIZE);
if (s->buf == NULL) {
dbg_printf(g,0,"epmd: Insufficient memory");
@@ -1065,6 +1086,60 @@ static int conn_open(EpmdVars *g,int fd)
return EPMD_FALSE;
}
+static int conn_local_peer_check(EpmdVars *g, int fd)
+{
+ struct EPMD_SOCKADDR_IN si;
+ struct EPMD_SOCKADDR_IN di;
+
+ struct sockaddr_in *si4 = (struct sockaddr_in *)&si;
+ struct sockaddr_in *di4 = (struct sockaddr_in *)&di;
+
+#if defined(EPMD6)
+ struct sockaddr_in6 *si6 = (struct sockaddr_in6 *)&si;
+ struct sockaddr_in6 *di6 = (struct sockaddr_in6 *)&di;
+#endif
+
+#ifdef HAVE_SOCKLEN_T
+ socklen_t st;
+#else
+ int st;
+#endif
+
+ st = sizeof(si);
+
+ /* Determine if connection is from localhost */
+ if (getpeername(fd,(struct sockaddr*) &si,&st) ||
+ st > sizeof(si)) {
+ /* Failure to get peername is regarded as non local host */
+ return EPMD_FALSE;
+ }
+
+ /* Only 127.x.x.x and connections from the host's IP address
+ allowed, no false positives */
+#if defined(EPMD6)
+ if (si.ss_family == AF_INET6 && IN6_IS_ADDR_LOOPBACK(&(si6->sin6_addr)))
+ return EPMD_TRUE;
+
+ if (si.ss_family == AF_INET)
+#endif
+ if ((((unsigned) ntohl(si4->sin_addr.s_addr)) & 0xFF000000U) ==
+ 0x7F000000U)
+ return EPMD_TRUE;
+
+ if (getsockname(fd,(struct sockaddr*) &di,&st))
+ return EPMD_FALSE;
+
+#if defined(EPMD6)
+ if (si.ss_family == AF_INET6)
+ return IN6_ARE_ADDR_EQUAL( &(si6->sin6_addr), &(di6->sin6_addr));
+ if (si.ss_family == AF_INET)
+#endif
+ return si4->sin_addr.s_addr == di4->sin_addr.s_addr;
+#if defined(EPMD6)
+ return EPMD_FALSE;
+#endif
+}
+
static int conn_close_fd(EpmdVars *g,int fd)
{
int i;
diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl
index e8bbfdbb18..44d3c5a880 100644
--- a/erts/epmd/test/epmd_SUITE.erl
+++ b/erts/epmd/test/epmd_SUITE.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(epmd_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -43,6 +43,7 @@
-export(
[
register_name/1,
+ register_name_ipv6/1,
register_names_1/1,
register_names_2/1,
register_duplicate_name/1,
@@ -76,7 +77,9 @@
buffer_overrun_2/1,
no_nonlocal_register/1,
no_nonlocal_kill/1,
- no_live_killing/1
+ no_live_killing/1,
+
+ socket_reset_before_alive2_reply_is_written/1
]).
@@ -111,7 +114,8 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [register_name, register_names_1, register_names_2,
+ [register_name, register_name_ipv6,
+ register_names_1, register_names_2,
register_duplicate_name, unicode_name, long_unicode_name,
get_port_nr, slow_get_port_nr,
unregister_others_name_1, unregister_others_name_2,
@@ -123,7 +127,8 @@ all() ->
returns_valid_populated_extra_with_nulls,
names_stdout,
{group, buffer_overrun}, no_nonlocal_register,
- no_nonlocal_kill, no_live_killing].
+ no_nonlocal_kill, no_live_killing,
+ socket_reset_before_alive2_reply_is_written].
groups() ->
[{buffer_overrun, [],
@@ -169,6 +174,24 @@ register_name(Config) when is_list(Config) ->
?line ok = close(Sock), % Unregister
ok.
+register_name_ipv6(doc) ->
+ ["Register a name over IPv6"];
+register_name_ipv6(suite) ->
+ [];
+register_name_ipv6(Config) when is_list(Config) ->
+ % Test if the host has an IPv6 loopback address
+ Res = gen_tcp:listen(0, [inet6, {ip, {0,0,0,0,0,0,0,1}}]),
+ case Res of
+ {ok,LSock} ->
+ gen_tcp:close(LSock),
+ ?line ok = epmdrun(),
+ ?line {ok,Sock} = register_node6("foobar6"),
+ ?line ok = close(Sock), % Unregister
+ ok;
+ _Error ->
+ {skip, "Host does not have an IPv6 loopback address"}
+ end.
+
register_names_1(doc) ->
["Register and unregister two nodes"];
register_names_1(suite) ->
@@ -242,13 +265,14 @@ register_node(Name) ->
register_node(Name,Port) ->
register_node_v2(Port,$M,0,5,5,Name,"").
+register_node6(Name) ->
+ register_node_v2({0,0,0,0,0,0,0,1},?DUMMY_PORT,$M,0,5,5,Name,"").
+
register_node_v2(Port, NodeType, Prot, HVsn, LVsn, Name, Extra) ->
- Utf8Name = unicode:characters_to_binary(Name),
- Req = [?EPMD_ALIVE2_REQ, put16(Port), NodeType, Prot,
- put16(HVsn), put16(LVsn),
- put16(size(Utf8Name)), binary_to_list(Utf8Name),
- size16(Extra), Extra],
- case send_req(Req) of
+ register_node_v2("localhost", Port, NodeType, Prot, HVsn, LVsn, Name, Extra).
+register_node_v2(Addr, Port, NodeType, Prot, HVsn, LVsn, Name, Extra) ->
+ Req = alive2_req(Port, NodeType, Prot, HVsn, LVsn, Name, Extra),
+ case send_req(Req, Addr) of
{ok,Sock} ->
case recv(Sock,4) of
{ok, [?EPMD_ALIVE2_RESP,_Res=0,_C0,_C1]} ->
@@ -938,6 +962,42 @@ no_live_killing(Config) when is_list(Config) ->
?line close(Sock3),
ok.
+socket_reset_before_alive2_reply_is_written(doc) ->
+ ["Check for regression - don't make zombie from node which "
+ "sends TCP RST at wrong time"];
+socket_reset_before_alive2_reply_is_written(suite) ->
+ [];
+socket_reset_before_alive2_reply_is_written(Config) when is_list(Config) ->
+ %% - delay_write for easier triggering of race condition
+ %% - relaxed_command_check for gracefull shutdown of epmd even if there
+ %% is stuck node.
+ ?line ok = epmdrun("-delay_write 1 -relaxed_command_check"),
+
+ %% We can't use send_req/1 directly as we want to do inet:setopts/2
+ %% on our socket.
+ ?line {ok, Sock} = connect(),
+
+ %% Issuing close/1 on such socket will result in immediate RST packet.
+ ?line ok = inet:setopts(Sock, [{linger, {true, 0}}]),
+
+ Req = alive2_req(4711, 77, 0, 5, 5, "test", []),
+ ?line ok = send(Sock, [size16(Req), Req]),
+
+ timer:sleep(500), %% Wait for the first 1/2 of delay_write before closing
+ ?line ok = close(Sock),
+
+ timer:sleep(500 + ?SHORT_PAUSE), %% Wait for the other 1/2 of delay_write
+
+ %% Wait another delay_write interval, due to delay doubling in epmd.
+ %% Should be removed when this is issue is fixed there.
+ timer:sleep(1000),
+
+ ?line {ok, SockForNames} = connect_active(),
+
+ %% And there should be no stuck nodes
+ ?line {ok, []} = do_get_names(SockForNames),
+ ?line ok = close(SockForNames),
+ ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Terminate all tests with killing epmd.
@@ -1151,7 +1211,9 @@ send_direct(Sock, Bytes) ->
end.
send_req(Req) ->
- case connect() of
+ send_req(Req, "localhost").
+send_req(Req, Addr) ->
+ case connect(Addr) of
{ok,Sock} ->
case send(Sock, [size16(Req), Req]) of
ok ->
@@ -1200,3 +1262,12 @@ flat_count([_|T], N) ->
flat_count(T, N);
flat_count([], N) -> N.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+alive2_req(Port, NodeType, Prot, HVsn, LVsn, Name, Extra) ->
+ Utf8Name = unicode:characters_to_binary(Name),
+ [?EPMD_ALIVE2_REQ, put16(Port), NodeType, Prot,
+ put16(HVsn), put16(LVsn),
+ put16(size(Utf8Name)), binary_to_list(Utf8Name),
+ size16(Extra), Extra].
diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in
index 8e55fa78c9..05d925f19f 100644
--- a/erts/etc/common/Makefile.in
+++ b/erts/etc/common/Makefile.in
@@ -21,10 +21,6 @@
include $(ERL_TOP)/make/output.mk
include $(ERL_TOP)/make/target.mk
-ifeq ($(findstring ose,$(TARGET)),ose)
-include $(ERL_TOP)/make/$(TARGET)/ose_lm.mk
-endif
-
ERTS_LIB_TYPEMARKER=.$(TYPE)
USING_MINGW=@MIXED_CYGWIN_MINGW@
@@ -85,18 +81,13 @@ EMUOSDIR = $(ERL_TOP)/erts/emulator/@ERLANG_OSTYPE@
SYSDIR = $(ERL_TOP)/erts/emulator/sys/@ERLANG_OSTYPE@
DRVDIR = $(ERL_TOP)/erts/emulator/drivers/@ERLANG_OSTYPE@
UXETC = ../unix
-OSEETC = ../ose
WINETC = ../win32
ifeq ($(TARGET), win32)
ETC = $(WINETC)
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-ETC = $(OSEETC)
-else
ETC = $(UXETC)
endif
-endif
ifeq ($(TARGET), win32)
ERLEXEC = erlexec.dll
@@ -180,25 +171,6 @@ PORT_ENTRY_POINT=erl_port_entry
ENTRY_LDFLAGS=-entry:$(PORT_ENTRY_POINT)
else
-ifeq ($(findstring ose,$(TARGET)),ose)
-ENTRY_LDFLAGS=
-ENTRY_OBJ=
-ERLSRV_OBJECTS=
-MC_OUTPUTS=
-INET_GETHOST =
-INSTALL_EMBEDDED_PROGS = $(BINDIR)/run_erl_lm
-INSTALL_EMBEDDED_DATA =
-INSTALL_TOP = Install
-INSTALL_TOP_BIN =
-INSTALL_MISC =
-INSTALL_SRC =
-ERLEXECDIR = .
-INSTALL_LIBS =
-INSTALL_OBJS =
-INSTALL_INCLUDES =
-TEXTFILES = Install erl.src
-INSTALL_PROGS = $(INSTALL_EMBEDDED_PROGS)
-else # UNIX (!win32 && !ose)
ENTRY_LDFLAGS=
ENTRY_OBJ=
ERLSRV_OBJECTS=
@@ -223,7 +195,6 @@ INSTALL_PROGS = \
$(BINDIR)/$(ERLEXEC) \
$(INSTALL_EMBEDDED_PROGS)
endif
-endif
.PHONY: etc
etc: $(ENTRY_OBJ) $(INSTALL_PROGS) $(INSTALL_LIBS) $(TEXTFILES) $(INSTALL_TOP_BIN)
@@ -269,8 +240,8 @@ endif
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/dyn_erl.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/safe_string.o
- rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl_common.o
- rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl_common.o
+ rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl.o
+ rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/typer.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/ct_run.o
rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/vxcall.o
@@ -423,28 +394,24 @@ $(BINDIR)/inet_gethost@EXEEXT@: $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(ERTS_LIB
$(ld_verbose)$(PURIFY) $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(LIBS) $(ERTS_INTERNAL_LIBS)
# run_erl
-$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(OBJDIR)/run_erl_common.o
- $(V_LD) $(LDFLAGS) -o $@ $^ $(LIBS)
-$(OBJDIR)/run_erl.o: $(ETC)/run_erl.c ../common/run_erl_common.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(ETC)/run_erl.c
-$(OBJDIR)/run_erl_common.o: ../common/run_erl_common.c ../common/run_erl_common.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -o $@ -c $<
+$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o
+ $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(LIBS)
+$(OBJDIR)/run_erl.o: $(ETC)/run_erl.c $(RC_GENERATED)
+ $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/run_erl.c
# to_erl
-$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o $(OBJDIR)/to_erl_common.o
- $(V_LD) $(LDFLAGS) -o $@ $^
-$(OBJDIR)/to_erl.o: $(ETC)/to_erl.c ../common/safe_string.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(ETC)/to_erl.c
-$(OBJDIR)/to_erl_common.o: ../common/to_erl_common.c ../common/to_erl_common.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -o $@ -c $<
+$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o
+ $(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o
+$(OBJDIR)/to_erl.o: $(ETC)/to_erl.c $(RC_GENERATED)
+ $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/to_erl.c
# dyn_erl
$(BINDIR)/dyn_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o
$(V_LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o
$(OBJDIR)/dyn_erl.o: $(UXETC)/dyn_erl.c $(RC_GENERATED)
$(V_CC) $(CFLAGS) -o $@ -c $(UXETC)/dyn_erl.c
-$(OBJDIR)/safe_string.o: ../common/safe_string.c $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -o $@ -c ../common/safe_string.c
+$(OBJDIR)/safe_string.o: $(ETC)/safe_string.c $(RC_GENERATED)
+ $(V_CC) $(CFLAGS) -o $@ -c $(ETC)/safe_string.c
ifneq ($(TARGET),win32)
$(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o $(ERTS_LIB)
@@ -499,30 +466,6 @@ erl.src: $(UXETC)/erl.src.src ../../vsn.mk $(TARGET)/Makefile
-e 's;%VSN%;$(VSN);' \
$(UXETC)/erl.src.src > erl.src
-#---------------------------------------------------------
-# OSE specific targets
-#---------------------------------------------------------
-ifeq ($(findstring ose,$(TARGET)),ose)
-$(OBJDIR)/ose_confd.o: $(OSE_CONFD)
- $(V_CC) $(CFLAGS) -o $@ -c $<
-$(OBJDIR)/crt0_lm.o: $(CRT0_LM)
- $(V_CC) $(CFLAGS) -o $@ -c $<
-OSE_LM_OBJS += $(OBJDIR)/ose_confd.o $(OBJDIR)/crt0_lm.o
-
-$(BINDIR)/run_erl_lm: $(OBJDIR)/run_erl_main.o $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(OBJDIR)/run_erl_common.o $(OBJDIR)/to_erl_common.o $(OSE_LM_OBJS)
- $(call build-ose-load-module, $@, $^, $(LIBS), $(RUN_ERL_LMCONF))
-
-
-$(OBJDIR)/run_erl_main.o: $(OSEETC)/run_erl_main.c $(OSEETC)/run_erl.h ../common/to_erl_common.h $(RC_GENERATED)
- $(V_CC) $(CFLAGS) -I ../common/ -o $@ -c $(OSEETC)/run_erl_main.c
-
-endif
-
-#---------------------------------------------------------
-# End of ose specific targets.
-#---------------------------------------------------------
-
-
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
@@ -537,11 +480,9 @@ endif
$(INSTALL_DIR) "$(RELEASE_PATH)/erts-$(VSN)/bin"
ifneq ($(TARGET), win32)
ifneq ($(findstring vxworks,$(TARGET)), vxworks)
-ifneq ($(findstring ose,$(TARGET)), ose)
$(INSTALL_SCRIPT) erl.src "$(RELEASE_PATH)/erts-$(VSN)/bin"
endif
endif
-endif
ifneq ($(INSTALL_PROGS),)
$(INSTALL_PROGRAM) $(INSTALL_PROGS) "$(RELEASE_PATH)/erts-$(VSN)/bin"
endif
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index cde0b25a2a..54da59e50d 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -65,6 +65,7 @@
static const char plusM_au_allocs[]= {
'u', /* all alloc_util allocators */
'B', /* binary_alloc */
+ 'I', /* literal_alloc */
'D', /* std_alloc */
'E', /* ets_alloc */
'F', /* fix_alloc */
@@ -73,6 +74,7 @@ static const char plusM_au_allocs[]= {
'R', /* driver_alloc */
'S', /* sl_alloc */
'T', /* temp_alloc */
+ 'Z', /* test_alloc */
'\0'
};
@@ -120,6 +122,7 @@ static char *plusM_other_switches[] = {
"Ym",
"Ytp",
"Ytt",
+ "Iscs",
NULL
};
@@ -155,6 +158,12 @@ static char *plusr_val_switches[] = {
NULL
};
+/* +x arguments with values */
+static char *plusx_val_switches[] = {
+ "mqd",
+ NULL
+};
+
/* +z arguments with values */
static char *plusz_val_switches[] = {
"dbbl",
@@ -718,7 +727,7 @@ int main(int argc, char **argv)
* on itself here. We'll avoid doing that.
*/
if (strcmp(argv[i], "-make") == 0) {
- add_args("-noshell", "-noinput", "-s", "make", "all", NULL);
+ add_args("-noshell", "-noinput", "-s", "make", "all_or_nothing", NULL);
add_Eargs("-B");
haltAfterwards = 1;
i = argc; /* Skip rest of command line */
@@ -975,6 +984,20 @@ int main(int argc, char **argv)
add_Eargs(argv[i+1]);
i++;
break;
+ case 'x':
+ if (!is_one_of_strings(&argv[i][2], plusx_val_switches)) {
+ goto the_default;
+ } else {
+ if (i+1 >= argc
+ || argv[i+1][0] == '-'
+ || argv[i+1][0] == '+')
+ usage(argv[i]);
+ argv[i][0] = '-';
+ add_Eargs(argv[i]);
+ add_Eargs(argv[i+1]);
+ i++;
+ }
+ break;
case 'z':
if (!is_one_of_strings(&argv[i][2], plusz_val_switches)) {
goto the_default;
@@ -1175,7 +1198,7 @@ usage_aux(void)
"[+S NO_SCHEDULERS:NO_SCHEDULERS_ONLINE] "
"[+SP PERCENTAGE_SCHEDULERS:PERCENTAGE_SCHEDULERS_ONLINE] "
"[+T LEVEL] [+V] [+v] "
- "[+W<i|w|e>] [+z MISC_OPTION] [args ...]\n");
+ "[+W<i|w|e>] [+x DEFAULT_PROC_FLAGS] [+z MISC_OPTION] [args ...]\n");
exit(1);
}
diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c
index 01ef840b5d..1a826221fb 100644
--- a/erts/etc/common/heart.c
+++ b/erts/etc/common/heart.c
@@ -472,10 +472,6 @@ message_loop(erlin_fd, erlout_fd)
switch (mp->op) {
case HEART_BEAT:
timestamp(&last_received);
-#ifdef USE_WATCHDOG
- /* reset the hardware watchdog timer */
- wd_reset();
-#endif
break;
case SHUT_DOWN:
return R_SHUT_DOWN;
@@ -718,14 +714,12 @@ do_terminate(int erlin_fd, int reason) {
print_error("Would reboot. Terminating.");
else {
kill_old_erlang();
- /* suppress gcc warning with 'if' */
ret = system(command);
print_error("Executed \"%s\" -> %d. Terminating.",command, ret);
}
free_env_val(command);
} else {
kill_old_erlang();
- /* suppress gcc warning with 'if' */
ret = system((char*)&cmd[0]);
print_error("Executed \"%s\" -> %d. Terminating.",cmd, ret);
}
diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c
deleted file mode 100644
index c03d5e3ae2..0000000000
--- a/erts/etc/common/run_erl_common.c
+++ /dev/null
@@ -1,696 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2014. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include <dirent.h>
-#include <errno.h>
-#include <fcntl.h>
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <sys/stat.h>
-#include <sys/types.h>
-#include <time.h>
-#include <unistd.h>
-
-#ifdef __ANDROID__
-# include <termios.h>
-#endif
-
-#ifdef HAVE_SYSLOG_H
-# include <syslog.h>
-#endif
-
-#ifdef HAVE_SYS_IOCTL_H
-# include <sys/ioctl.h>
-#endif
-
-#ifdef __OSE__
-# include "ramlog.h"
-#endif
-
-#include "run_erl_common.h"
-#include "safe_string.h"
-
-#define DEFAULT_LOG_GENERATIONS 5
-#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */
-#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */
-#define DEFAULT_LOG_MAXSIZE 100000
-#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */
-#define LOG_STUBNAME "erlang.log."
-#define LOG_PERM 0664
-#define DEFAULT_LOG_ACTIVITY_MINUTES 5
-#define DEFAULT_LOG_ALIVE_MINUTES 15
-#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y"
-#define ALIVE_BUFFSIZ 1024
-
-#define STATUSFILENAME "/run_erl.log"
-
-#define PIPE_STUBNAME "erlang.pipe"
-#define PIPE_STUBLEN strlen(PIPE_STUBNAME)
-#define PERM (S_IWUSR | S_IRUSR | S_IWOTH | S_IROTH | S_IWGRP | S_IRGRP)
-
-/* OSE has defined O_SYNC but it is not recognized by open */
-#if !defined(O_SYNC) || defined(__OSE__)
-#undef O_SYNC
-#define O_SYNC 0
-#define USE_FSYNC 1
-#endif
-
-/* Global variable definitions
- * We need this complex way of handling global variables because of how
- * OSE works here. We want to make it possible to run the shell command
- * run_erl multiple times with different global variables without them
- * effecting eachother.
- */
-
-#define STATUSFILE (RE_DATA->statusfile)
-#define LOG_DIR (RE_DATA->log_dir)
-#define STDSTATUS (RE_DATA->stdstatus)
-#define LOG_GENERATIONS (RE_DATA->log_generations)
-#define LOG_MAXSIZE (RE_DATA->log_maxsize)
-#define LOG_ACTIVITY_MINUTES (RE_DATA->log_activity_minutes)
-#define LOG_ALIVE_IN_GMT (RE_DATA->log_alive_in_gmt)
-#define LOG_ALIVE_FORMAT (RE_DATA->log_alive_format)
-#define RUN_DAEMON (RE_DATA->run_daemon)
-#define LOG_ALIVE_MINUTES (RE_DATA->log_alive_minutes)
-#define LOG_NUM (RE_DATA->log_num)
-#define LFD (RE_DATA->lfd)
-#define PROTOCOL_VER (RE_DATA->protocol_ver)
-
-struct run_erl_ {
- /* constant config data */
- char statusfile[FILENAME_BUFSIZ];
- char log_dir[FILENAME_BUFSIZ];
- FILE *stdstatus;
- int log_generations;
- int log_maxsize;
- int log_activity_minutes;
- int log_alive_in_gmt;
- char log_alive_format[ALIVE_BUFFSIZ+1];
- int run_daemon;
- int log_alive_minutes;
- /* Current log number and log fd */
- int log_num;
- int lfd;
- unsigned protocol_ver;
-};
-
-typedef struct run_erl_ run_erl;
-
-#ifdef __OSE__
-static OSPPDKEY run_erl_pp_key;
-#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key))
-#else
-static run_erl re;
-#define RE_DATA (&re)
-#endif
-
-/* prototypes */
-
-static int next_log(int log_num);
-static int prev_log(int log_num);
-static int find_next_log_num(void);
-static int open_log(int log_num, int flags);
-
-/*
- * getenv_int:
- */
-static char *getenv_int(const char *name) {
-#ifdef __OSE__
- return get_env(get_bid(current_process()),name);
-#else
- return getenv(name);
-#endif
-}
-
-/*
- * next_log:
- * Returns the index number that follows the given index number.
- * (Wrapping after log_generations)
- */
-static int next_log(int log_num) {
- return log_num>=LOG_GENERATIONS?1:log_num+1;
-}
-
-/*
- * prev_log:
- * Returns the index number that precedes the given index number.
- * (Wrapping after log_generations)
- */
-static int prev_log(int log_num) {
- return log_num<=1?LOG_GENERATIONS:log_num-1;
-}
-
-/*
- * find_next_log_num()
- * Searches through the log directory to check which logs that already
- * exist. It finds the "hole" in the sequence, and returns the index
- * number for the last log in the log sequence. If there is no hole, index
- * 1 is returned.
- */
-static int find_next_log_num(void) {
- int i, next_gen, log_gen;
- DIR *dirp;
- struct dirent *direntp;
- int log_exists[LOG_MAX_GENERATIONS+1];
- int stub_len = strlen(LOG_STUBNAME);
-
- /* Initialize exiting log table */
-
- for(i=LOG_GENERATIONS; i>=0; i--)
- log_exists[i] = 0;
- dirp = opendir(LOG_DIR);
- if(!dirp) {
- ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", LOG_DIR);
- exit(1);
- }
-
- /* Check the directory for existing logs */
-
- while((direntp=readdir(dirp)) != NULL) {
- if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) {
- int num = atoi(direntp->d_name+stub_len);
- if(num < 1 || num > LOG_GENERATIONS)
- continue;
- log_exists[num] = 1;
- }
- }
- closedir(dirp);
-
- /* Find out the next available log file number */
-
- next_gen = 0;
- for(i=LOG_GENERATIONS; i>=0; i--) {
- if(log_exists[i])
- if(next_gen)
- break;
- else
- ;
- else
- next_gen = i;
- }
-
- /* Find out the current log file number */
-
- if(next_gen)
- log_gen = prev_log(next_gen);
- else
- log_gen = 1;
-
- return log_gen;
-} /* find_next_log_num() */
-
-static int open_log(int log_num, int flags)
-{
- char buf[FILENAME_MAX];
- time_t now;
- struct tm *tmptr;
- char log_buffer[ALIVE_BUFFSIZ+1];
-
- /* Remove the next log (to keep a "hole" in the log sequence) */
- sn_printf(buf, sizeof(buf), "%s/%s%d",
- LOG_DIR, LOG_STUBNAME, next_log(log_num));
- unlink(buf);
-
- /* Create or continue on the current log file */
- sn_printf(buf, sizeof(buf), "%s/%s%d", LOG_DIR, LOG_STUBNAME, log_num);
-
- LFD = sf_open(buf, flags, LOG_PERM);
-
- if(LFD <0){
- ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf);
- exit(1);
- }
-
- /* Write a LOGGING STARTED and time stamp into the log file */
- time(&now);
- if (LOG_ALIVE_IN_GMT) {
- tmptr = gmtime(&now);
- } else {
- tmptr = localtime(&now);
- }
- if (!strftime(log_buffer, ALIVE_BUFFSIZ, LOG_ALIVE_FORMAT,
- tmptr)) {
- strn_cpy(log_buffer, sizeof(log_buffer),
- "(could not format time in 256 positions "
- "with current format string.)");
- }
- log_buffer[ALIVE_BUFFSIZ] = '\0';
-
- sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n",
- log_buffer);
- if (erts_run_erl_write_all(LFD, buf, strlen(buf)) < 0)
- erts_run_erl_log_status("Error in writing to log.\n");
-
-#if USE_FSYNC
- fsync(LFD);
-#endif
-
- return LFD;
-}
-
-/* Instead of making sure basename exists, we do our own */
-char *simple_basename(char *path)
-{
- char *ptr;
- for (ptr = path; *ptr != '\0'; ++ptr) {
- if (*ptr == '/') {
- path = ptr + 1;
- }
- }
- return path;
-}
-
-ssize_t sf_read(int fd, void *buffer, size_t len) {
- ssize_t n = 0;
-
- do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR);
-
- return n;
-}
-
-ssize_t sf_write(int fd, const void *buffer, size_t len) {
- ssize_t n = 0;
-
- do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR);
-
- return n;
-}
-
-int sf_open(const char *path, int type, mode_t mode) {
- int fd = 0;
-
- do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR);
-
- return fd;
-}
-
-int sf_close(int fd) {
- int res = 0;
-
- do { res = close(fd); } while(res < 0 && errno == EINTR);
-
- return res;
-}
-
-/* Call write() until entire buffer has been written or error.
- * Return len or -1.
- */
-int erts_run_erl_write_all(int fd, const char* buf, int len)
-{
- int left = len;
- int written;
- for (;;) {
- do {
- written = write(fd,buf,left);
- } while (written < 0 && errno == EINTR);
- if (written == left) {
- return len;
- }
- if (written < 0) {
- return -1;
- }
- left -= written;
- buf += written;
- }
- return written;
-}
-
-/* erts_run_erl_log_status()
- * Prints the arguments to a status file
- * Works like printf (see vfrpintf)
- */
-void erts_run_erl_log_status(const char *format,...)
-{
- va_list args;
- time_t now;
-
- if (STDSTATUS == NULL)
- STDSTATUS = fopen(STATUSFILE, "w");
- if (STDSTATUS == NULL)
- return;
- now = time(NULL);
- fprintf(STDSTATUS, "run_erl [%d] %s",
-#ifdef __OSE__
- (int)current_process(),
-#else
- (int)getpid(),
-#endif
- ctime(&now));
- va_start(args, format);
- vfprintf(STDSTATUS, format, args);
- va_end(args);
- fflush(STDSTATUS);
- return;
-}
-
-/* Fetch the current log alive minutes */
-int erts_run_erl_log_alive_minutes() {
- return LOG_ALIVE_MINUTES;
-}
-
-/* error_logf()
- * Prints the arguments to stderr or syslog
- * Works like printf (see vfprintf)
- */
-void erts_run_erl_log_error(int priority, int line, const char *format, ...)
-{
- va_list args;
- va_start(args, format);
-
-#ifdef HAVE_SYSLOG_H
- if (RUN_DAEMON) {
- vsyslog(priority,format,args);
- }
- else
-#endif
-#ifdef __OSE__
- if (RUN_DAEMON) {
- char *buff = malloc(sizeof(char)*1024);
- vsnprintf(buff,1024,format, args);
- ramlog_printf(buff);
- }
- else
-#endif
- {
- time_t now = time(NULL);
- fprintf(stderr, "run_erl:%d [%d] %s", line,
-#ifdef __OSE__
- (int)current_process(),
-#else
- (int)getpid(),
-#endif
- ctime(&now));
- vfprintf(stderr, format, args);
- }
- va_end(args);
-}
-
-/* erts_run_erl_log_write()
- * Writes a message to lfd. If the current log file is full,
- * a new log file is opened.
- */
-int erts_run_erl_log_write(char* buf, size_t len)
-{
- int size;
- ssize_t res;
- /* Decide if new logfile needed, and open if so */
-
- size = lseek(LFD,0,SEEK_END);
- if(size+len > LOG_MAXSIZE) {
- int res;
- do {
- res = close(LFD);
- } while (res < 0 && errno == EINTR);
- LOG_NUM = next_log(LOG_NUM);
- LFD = open_log(LOG_NUM, O_RDWR|O_CREAT|O_TRUNC|O_SYNC);
- }
-
- /* Write to log file */
-
- if ((res = erts_run_erl_write_all(LFD, buf, len)) < 0) {
- erts_run_erl_log_status("Error in writing to log.\n");
- }
-
-#if USE_FSYNC
- fsync(LFD);
-#endif
- return res;
-}
-
-int erts_run_erl_log_activity(int timeout,time_t now,time_t last_activity) {
- char log_alive_buffer[ALIVE_BUFFSIZ+1];
- char buf[BUFSIZ];
-
- if (timeout || now - last_activity > LOG_ACTIVITY_MINUTES*60) {
- /* Either a time out: 15 minutes without action, */
- /* or something is coming in right now, but it's a long time */
- /* since last time, so let's write a time stamp this message */
- struct tm *tmptr;
- if (LOG_ALIVE_IN_GMT) {
- tmptr = gmtime(&now);
- } else {
- tmptr = localtime(&now);
- }
- if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, LOG_ALIVE_FORMAT,
- tmptr)) {
- strn_cpy(log_alive_buffer, sizeof(log_alive_buffer),
- "(could not format time in 256 positions "
- "with current format string.)");
- }
- log_alive_buffer[ALIVE_BUFFSIZ] = '\0';
-
- sn_printf(buf, sizeof(buf), "\n===== %s%s\n",
- timeout?"ALIVE ":"", log_alive_buffer);
- return erts_run_erl_log_write(buf, strlen(buf));
- }
- return 0;
-}
-
-int erts_run_erl_log_open() {
-
- LOG_NUM = find_next_log_num();
- LFD = open_log(LOG_NUM, O_RDWR|O_APPEND|O_CREAT|O_SYNC);
- return 0;
-}
-
-int erts_run_erl_log_init(int daemon, char* logdir) {
- char *p;
-
-#ifdef __OSE__
- run_erl **re_pp;
- if (!run_erl_pp_key)
- ose_create_ppdata("run_erl_ppdata",&run_erl_pp_key);
- re_pp = (run_erl **)ose_get_ppdata(run_erl_pp_key);
- *re_pp = malloc(sizeof(run_erl));
-#endif
-
- STDSTATUS = NULL;
- LOG_GENERATIONS = DEFAULT_LOG_GENERATIONS;
- LOG_MAXSIZE = DEFAULT_LOG_MAXSIZE;
- LOG_ACTIVITY_MINUTES = DEFAULT_LOG_ACTIVITY_MINUTES;
- LOG_ALIVE_IN_GMT = 0;
- RUN_DAEMON = 0;
- LOG_ALIVE_MINUTES = DEFAULT_LOG_ALIVE_MINUTES;
- LFD = 0;
- PROTOCOL_VER = RUN_ERL_LO_VER; /* assume lowest to begin with */
-
- /* Get values for LOG file handling from the environment */
- if ((p = getenv_int("RUN_ERL_LOG_ALIVE_MINUTES"))) {
- LOG_ALIVE_MINUTES = atoi(p);
- if (!LOG_ALIVE_MINUTES) {
- ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 "
- "(current value is %s)",p);
- }
- LOG_ACTIVITY_MINUTES = LOG_ALIVE_MINUTES / 3;
- if (!LOG_ACTIVITY_MINUTES) {
- ++LOG_ACTIVITY_MINUTES;
- }
- }
- if ((p = getenv_int(
- "RUN_ERL_LOG_ACTIVITY_MINUTES"))) {
- LOG_ACTIVITY_MINUTES = atoi(p);
- if (!LOG_ACTIVITY_MINUTES) {
- ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 "
- "(current value is %s)",p);
- }
- }
- if ((p = getenv_int("RUN_ERL_LOG_ALIVE_FORMAT"))) {
- if (strlen(p) > ALIVE_BUFFSIZ) {
- ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of "
- "%d characters", ALIVE_BUFFSIZ);
- }
- strn_cpy(LOG_ALIVE_FORMAT, sizeof(LOG_ALIVE_FORMAT), p);
- } else {
- strn_cpy(LOG_ALIVE_FORMAT, sizeof(LOG_ALIVE_FORMAT),
- DEFAULT_LOG_ALIVE_FORMAT);
- }
- if ((p = getenv_int("RUN_ERL_LOG_ALIVE_IN_UTC"))
- && strcmp(p,"0")) {
- ++LOG_ALIVE_IN_GMT;
- }
- if ((p = getenv_int("RUN_ERL_LOG_GENERATIONS"))) {
- LOG_GENERATIONS = atoi(p);
- if (LOG_GENERATIONS < LOG_MIN_GENERATIONS)
- ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d",
- LOG_MIN_GENERATIONS);
- if (LOG_GENERATIONS > LOG_MAX_GENERATIONS)
- ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d",
- LOG_MAX_GENERATIONS);
- }
-
- if ((p = getenv_int("RUN_ERL_LOG_MAXSIZE"))) {
- LOG_MAXSIZE = atoi(p);
- if (LOG_MAXSIZE < LOG_MIN_MAXSIZE)
- ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE);
- }
-
- RUN_DAEMON = daemon;
-
- strn_cpy(LOG_DIR, sizeof(LOG_DIR), logdir);
- strn_cpy(STATUSFILE, sizeof(STATUSFILE), LOG_DIR);
- strn_cat(STATUSFILE, sizeof(STATUSFILE), STATUSFILENAME);
-
- return 0;
-}
-
-/* create_fifo()
- * Creates a new fifo with the given name and permission.
- */
-static int create_fifo(char *name, int perm)
-{
- if ((mkfifo(name, perm) < 0) && (errno != EEXIST))
- return -1;
- return 0;
-}
-
-/*
- * w- and r_pipename have to be pre-allocated of atleast FILENAME_MAX size
- */
-int erts_run_erl_open_fifo(char *pipename,char *w_pipename,char *r_pipename) {
- int calculated_pipename = 0;
- int highest_pipe_num = 0;
- int fd;
-
- /*
- * Create FIFOs and open them
- */
-
- if(*pipename && pipename[strlen(pipename)-1] == '/') {
- /* The user wishes us to find a unique pipe name in the specified */
- /* directory */
- DIR *dirp;
- struct dirent *direntp;
-
- calculated_pipename = 1;
- dirp = opendir(pipename);
- if(!dirp) {
- ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename);
- return 1;
- }
-
- /* Check the directory for existing pipes */
-
- while((direntp=readdir(dirp)) != NULL) {
- if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) {
- int num = atoi(direntp->d_name+PIPE_STUBLEN+1);
- if(num > highest_pipe_num)
- highest_pipe_num = num;
- }
- }
- closedir(dirp);
- strn_catf(pipename, BUFSIZ, "%s.%d",
- PIPE_STUBNAME, highest_pipe_num+1);
- } /* if */
-
- for(;;) {
- /* write FIFO - is read FIFO for `to_erl' program */
- strn_cpy(w_pipename, BUFSIZ, pipename);
- strn_cat(w_pipename, BUFSIZ, ".r");
- if (create_fifo(w_pipename, PERM) < 0) {
- ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.",
- w_pipename);
- return 1;
- }
-
- /* read FIFO - is write FIFO for `to_erl' program */
- strn_cpy(r_pipename, BUFSIZ, pipename);
- strn_cat(r_pipename, BUFSIZ, ".w");
-
- /* Check that nobody is running run_erl already */
- if ((fd = sf_open(r_pipename, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) {
- /* Open as client succeeded -- run_erl is already running! */
- sf_close(fd);
- if (calculated_pipename) {
- ++highest_pipe_num;
- strn_catf(pipename, BUFSIZ, "%s.%d",
- PIPE_STUBNAME, highest_pipe_num+1);
- continue;
- }
- ERROR1(LOG_ERR, "Erlang already running on pipe %s.\n", pipename);
- unlink(w_pipename);
- return 1;
- }
- if (create_fifo(r_pipename, PERM) < 0) {
- unlink(w_pipename);
- ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.",
- r_pipename);
- return 1;
- }
- break;
- }
- return 0;
-}
-
-/* Extract any control sequences that are ment only for run_erl
- * and should not be forwarded to the pty.
- */
-int erts_run_erl_extract_ctrl_seq(char* buf, int len, int mfd)
-{
- static const char prefix[] = "\033_";
- static const char suffix[] = "\033\\";
- char* bufend = buf + len;
- char* start = buf;
- char* command;
- char* end;
-
- for (;;) {
- start = find_str(start, bufend-start, prefix);
- if (!start) break;
-
- command = start + strlen(prefix);
- end = find_str(command, bufend-command, suffix);
- if (end) {
- unsigned col, row;
- if (sscanf(command,"version=%u", &PROTOCOL_VER)==1) {
- /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/
- }
- else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) {
-#ifdef TIOCSWINSZ
- struct winsize ws;
- ws.ws_col = col;
- ws.ws_row = row;
- if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) {
- ERRNO_ERR0(LOG_ERR,"Failed to set window size");
- }
-#endif
- }
- else {
- ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n",
- (int)(end-command), command);
- }
-
- /* Remove ctrl sequence from buf */
- end += strlen(suffix);
- memmove(start, end, bufend-end);
- bufend -= end - start;
- }
- else {
- ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n",
- (int)(bufend-start), start);
- break;
- }
- }
- return bufend - buf;
-}
diff --git a/erts/etc/common/run_erl_common.h b/erts/etc/common/run_erl_common.h
deleted file mode 100644
index cecf7521f9..0000000000
--- a/erts/etc/common/run_erl_common.h
+++ /dev/null
@@ -1,97 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Functions that are common to both OSE and unix implementations of run_erl
- */
-#ifndef ERL_RUN_ERL_LOG_H
-#define ERL_RUN_ERL_LOG_H
-
-#include <stdio.h>
-#include <time.h>
-#include <unistd.h>
-
-#include "run_erl_vsn.h"
-
-/* Log handling */
-int erts_run_erl_log_init(int run_daemon, char* logdir);
-int erts_run_erl_log_open(void);
-int erts_run_erl_log_close(void);
-int erts_run_erl_log_write(char *buff, size_t len);
-int erts_run_erl_log_activity(int timeout, time_t now, time_t last_activity);
-
-void erts_run_erl_log_status(const char *format,...);
-void erts_run_erl_log_error(int priority, int line, const char *format,...);
-
-int erts_run_erl_open_fifo(char *pipename,char *w_pipename,char *r_pipename);
-int erts_run_erl_log_alive_minutes(void);
-int erts_run_erl_extract_ctrl_seq(char* buf, int len, int mfd);
-
-/* File operations */
-ssize_t sf_read(int fd, void *buffer, size_t len);
-ssize_t sf_write(int fd, const void *buffer, size_t len);
-int sf_open(const char *path, int type, mode_t mode);
-int sf_close(int fd);
-int erts_run_erl_write_all(int fd, const char* buf, int len);
-char *simple_basename(char *path);
-
-#ifndef LOG_ERR
-#ifdef __OSE__
-#define LOG_ERR 0
-#else
-#define LOG_ERR NULL
-#endif
-#endif
-
-#define ERROR0(Prio,Format) erts_run_erl_log_error(Prio,__LINE__,Format"\n")
-#define ERROR1(Prio,Format,A1) erts_run_erl_log_error(Prio,__LINE__,Format"\n",A1)
-#define ERROR2(Prio,Format,A1,A2) erts_run_erl_log_error(Prio,__LINE__,Format"\n",A1,A2)
-
-#ifdef HAVE_STRERROR
-# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno)
-#else
-# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno
-#endif
-#define ERRNO_ERR0(Prio,Format) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format))
-#define ERRNO_ERR1(Prio,Format,A1) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format),A1)
-#define ERRNO_ERR2(Prio,Format,A1,A2) erts_run_erl_log_error(Prio,__LINE__,ADD_ERRNO(Format),A1,A2)
-
-#define RUN_ERL_USAGE \
- "%s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"" \
- "\n\nDESCRIPTION:\n" \
- "You may also set the environment variables RUN_ERL_LOG_GENERATIONS\n" \
- "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n" \
- "size of the log file when to switch to the next log file\n"
-
-#ifndef FILENAME_MAX
-#define FILENAME_MAX 250
-#endif
-
-#define FILENAME_BUFSIZ FILENAME_MAX
-
-#ifdef O_NONBLOCK
-# define DONT_BLOCK_PLEASE O_NONBLOCK
-#else
-# define DONT_BLOCK_PLEASE O_NDELAY
-# ifndef EAGAIN
-# define EAGAIN -3898734
-# endif
-#endif
-
-#endif
diff --git a/erts/etc/common/to_erl_common.c b/erts/etc/common/to_erl_common.c
deleted file mode 100644
index 8aa94ccfa4..0000000000
--- a/erts/etc/common/to_erl_common.c
+++ /dev/null
@@ -1,717 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Module: to_erl.c
- *
- * This module implements a process that opens two specified FIFOs, one
- * for reading and one for writing; reads from its stdin, and writes what
- * it has read to the write FIF0; reads from the read FIFO, and writes to
- * its stdout.
- *
- ________ _________
- | |--<-- pipe.r (fifo1) --<--| |
- | to_erl | | run_erl | (parent)
- |________|-->-- pipe.w (fifo2) -->--|_________|
- ^ master pty
- |
- | slave pty
- ____V____
- | |
- | "erl" | (child)
- |_________|
- */
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <sys/time.h>
-#include <sys/types.h>
-#include <fcntl.h>
-#include <unistd.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <dirent.h>
-#include <errno.h>
-
-#ifdef __OSE__
-#include <aio.h>
-#include "ose.h"
-#include "efs.h"
-#include "ose_spi/fm.sig"
-#else /* __UNIX__ */
-#include <termios.h>
-#include <signal.h>
-#endif
-
-#ifdef HAVE_SYS_IOCTL_H
-# include <sys/ioctl.h>
-#endif
-
-#include "to_erl_common.h"
-#include "run_erl_vsn.h"
-#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */
-
-#if defined(O_NONBLOCK)
-# define DONT_BLOCK_PLEASE O_NONBLOCK
-#else
-# define DONT_BLOCK_PLEASE O_NDELAY
-# if !defined(EAGAIN)
-# define EAGAIN -3898734
-# endif
-#endif
-
-#ifdef HAVE_STRERROR
-# define STRERROR(x) strerror(x)
-#else
-# define STRERROR(x) ""
-#endif
-
-#define noDEBUG
-
-#ifdef __OSE__
-#define PIPE_DIR "/pipe/"
-#else
-#define PIPE_DIR "/tmp/"
-#endif
-#define PIPE_STUBNAME "erlang.pipe"
-#define PIPE_STUBLEN strlen(PIPE_STUBNAME)
-
-#ifdef DEBUG
-#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); }
-#else
-#define STATUS(s)
-#endif
-
-#ifndef FILENAME_MAX
-#define FILENAME_MAX 250
-#endif
-
-static int tty_eof = 0;
-static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */
-
-static int write_all(int fd, const char* buf, int len);
-static int version_handshake(char* buf, int len, int wfd);
-
-
-#ifdef __OSE__
-
-#define SET_AIO(REQ,FD,SIZE,BUFF) \
- /* Make sure to clean data structure of previous request */ \
- memset(&(REQ),0,sizeof(REQ)); \
- (REQ).aio_fildes = FD; \
- (REQ).aio_offset = FM_POSITION_CURRENT; \
- (REQ).aio_nbytes = SIZE; \
- (REQ).aio_buf = BUFF; \
- (REQ).aio_sigevent.sigev_notify = SIGEV_NONE
-
-#define READ_AIO(REQ,FD,SIZE,BUFF) \
- SET_AIO(REQ,FD,SIZE,BUFF); \
- if (aio_read(&(REQ)) != 0) \
- fprintf(stderr,"aio_read of child_read_req(%d) failed" \
- "with error %d\n",FD,errno)
-
-union SIGNAL {
- SIGSELECT signo;
- struct FmReadPtr fm_read_ptr;
-};
-
-#else /* __UNIX__ */
-static int recv_sig = 0;
-static struct termios tty_smode, tty_rmode;
-static int window_size_seq(char* buf, size_t bufsz);
-#ifdef DEBUG
-static void show_terminal_settings(struct termios *);
-#endif
-
-static void handle_ctrlc(int sig)
-{
- /* Reinstall the handler, and signal break flag */
- signal(SIGINT,handle_ctrlc);
- recv_sig = SIGINT;
-}
-
-static void handle_sigwinch(int sig)
-{
- recv_sig = SIGWINCH;
-}
-#endif
-
-static void usage(char *pname)
-{
- fprintf(stderr, "Usage: ");
- fprintf(stderr,TO_ERL_USAGE,pname);
-}
-
-int to_erl(int argc, char **argv)
-{
- char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX];
- int i, len, wfd, rfd;
- char pipename[FILENAME_MAX];
- int pipeIx = 1;
- int force_lock = 0;
- int got_some = 0;
-
-#ifdef __OSE__
- struct aiocb stdin_read_req, pipe_read_req;
- FmHandle stdin_fh, pipe_fh;
- char *stdin_buf, *pipe_buf;
- char *buf;
- union SIGNAL *sig;
-#else /* __UNIX__ */
- char buf[BUFSIZ];
- fd_set readfds;
-#endif
-
- if (argc >= 2 && argv[1][0]=='-') {
- switch (argv[1][1]) {
- case 'h':
- usage(argv[0]);
- exit(1);
- case 'F':
- force_lock = 1;
- break;
- default:
- fprintf(stderr,"Invalid option '%s'\n",argv[1]);
- exit(1);
- }
- pipeIx = 2;
- }
-
-#ifdef DEBUG
- fprintf(stderr, "%s: pid is : %d\n", argv[0],(int)
-#ifdef __OSE__
- current_process()
-#else /* __UNIX__ */
- getpid()
-#endif
- );
-#endif
-
- strn_cpy(pipename, sizeof(pipename),
- (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR));
-
- if(*pipename && pipename[strlen(pipename)-1] == '/') {
- /* The user wishes us to find a pipe name in the specified */
- /* directory */
- int highest_pipe_num = 0;
- DIR *dirp;
- struct dirent *direntp;
-
- dirp = opendir(pipename);
- if(!dirp) {
- fprintf(stderr, "Can't access pipe directory %s: %s\n", pipename, strerror(errno));
- exit(1);
- }
-
- /* Check the directory for existing pipes */
-
- while((direntp=readdir(dirp)) != NULL) {
- if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) {
- int num = atoi(direntp->d_name+PIPE_STUBLEN+1);
- if(num > highest_pipe_num)
- highest_pipe_num = num;
- }
- }
- closedir(dirp);
- strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"),
- PIPE_STUBNAME, highest_pipe_num);
- } /* if */
-
- /* read FIFO */
- sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename);
- /* write FIFO */
- sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename);
-
-#ifndef __OSE__
- /* Check that nobody is running to_erl on this pipe already */
- if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) {
- /* Open as server succeeded -- to_erl is already running! */
- close(wfd);
- fprintf(stderr, "Another to_erl process already attached to pipe "
- "%s.\n", pipename);
- if (force_lock) {
- fprintf(stderr, "But we proceed anyway by force (-F).\n");
- }
- else {
- exit(1);
- }
- }
-#endif
-
- if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
-#ifdef DEBUG
- fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1);
-#endif
- fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno));
- exit(1);
- }
-#ifdef DEBUG
- fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1);
-#endif
-
- if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
-#ifdef DEBUG
- fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2);
-#endif
- fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno));
- close(rfd);
- exit(1);
- }
-#ifdef DEBUG
- fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2);
-#endif
-
-#ifndef __OSE__
- fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename);
-#else
- fprintf(stderr, "Attaching to %s (^C to exit)\n\n", pipename);
-#endif
-
-#ifndef __OSE__
- /* Set break handler to our handler */
- signal(SIGINT,handle_ctrlc);
-
- /*
- * Save the current state of the terminal, and set raw mode.
- */
- if (tcgetattr(0, &tty_rmode) , 0) {
- fprintf(stderr, "Cannot get terminals current mode\n");
- exit(-1);
- }
- tty_smode = tty_rmode;
- tty_eof = '\004'; /* Ctrl+D to exit */
-#ifdef DEBUG
- show_terminal_settings(&tty_rmode);
-#endif
- tty_smode.c_iflag =
- 1*BRKINT |/*Signal interrupt on break.*/
- 1*IGNPAR |/*Ignore characters with parity errors.*/
- 1*ISTRIP |/*Strip character.*/
- 0;
-
-#if 0
-0*IGNBRK |/*Ignore break condition.*/
-0*PARMRK |/*Mark parity errors.*/
-0*INPCK |/*Enable input parity check.*/
-0*INLCR |/*Map NL to CR on input.*/
-0*IGNCR |/*Ignore CR.*/
-0*ICRNL |/*Map CR to NL on input.*/
-0*IUCLC |/*Map upper-case to lower-case on input.*/
-0*IXON |/*Enable start/stop output control.*/
-0*IXANY |/*Enable any character to restart output.*/
-0*IXOFF |/*Enable start/stop input control.*/
-0*IMAXBEL|/*Echo BEL on input line too long.*/
-#endif
-
- tty_smode.c_oflag =
- 1*OPOST |/*Post-process output.*/
- 1*ONLCR |/*Map NL to CR-NL on output.*/
-#ifdef XTABS
- 1*XTABS |/*Expand tabs to spaces. (Linux)*/
-#endif
-#ifdef OXTABS
- 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/
-#endif
-#ifdef NL0
- 1*NL0 |/*Select newline delays*/
-#endif
-#ifdef CR0
- 1*CR0 |/*Select carriage-return delays*/
-#endif
-#ifdef TAB0
- 1*TAB0 |/*Select horizontal tab delays*/
-#endif
-#ifdef BS0
- 1*BS0 |/*Select backspace delays*/
-#endif
-#ifdef VT0
- 1*VT0 |/*Select vertical tab delays*/
-#endif
-#ifdef FF0
- 1*FF0 |/*Select form feed delays*/
-#endif
- 0;
-
-#if 0
-0*OLCUC |/*Map lower case to upper on output.*/
-0*OCRNL |/*Map CR to NL on output.*/
-0*ONOCR |/*No CR output at column 0.*/
-0*ONLRET |/*NL performs CR function.*/
-0*OFILL |/*Use fill characters for delay.*/
-0*OFDEL |/*Fill is DEL, else NULL.*/
-0*NL1 |
-0*CR1 |
-0*CR2 |
-0*CR3 |
-0*TAB1 |
-0*TAB2 |
-0*TAB3 |/*Expand tabs to spaces.*/
-0*BS1 |
-0*VT1 |
-0*FF1 |
-#endif
-
- /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */
- /* advisable if this is a *real* terminal, such as the console. In fact */
- /* this may hang the entire machine, deep, deep down (signalling break */
- /* or toggling the abort switch doesn't help) */
-
- tty_smode.c_lflag =
- 0;
-
-#if 0
-0*ISIG |/*Enable signals.*/
-0*ICANON |/*Canonical input (erase and kill processing).*/
-0*XCASE |/*Canonical upper/lower presentation.*/
-0*ECHO |/*Enable echo.*/
-0*ECHOE |/*Echo erase character as BS-SP-BS.*/
-0*ECHOK |/*Echo NL after kill character.*/
-0*ECHONL |/*Echo NL.*/
-0*NOFLSH |/*Disable flush after interrupt or quit.*/
-0*TOSTOP |/*Send SIGTTOU for background output.*/
-0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/
-0*ECHOPRT|/*Echo erase character as character erased.*/
-0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/
-0*FLUSHO |/*Output is being flushed.*/
-0*PENDIN |/*Retype pending input at next read or input character.*/
-0*IEXTEN |/*Enable extended (implementation-defined) functions.*/
-#endif
-
- tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */
- tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */
- tty_smode.c_cc[VINTR] =3;
-
- tcsetattr(0, TCSADRAIN, &tty_smode);
-
-#ifdef DEBUG
- show_terminal_settings(&tty_smode);
-#endif
-
-#endif /* !__OSE__ */
- /*
- * "Write a ^L to the FIFO which causes the other end to redisplay
- * the input line."
- * This does not seem to work as was intended in old comment above.
- * However, this control character is now (R12B-3) used by run_erl
- * to trigger the version handshaking between to_erl and run_erl
- * at the start of every new to_erl-session.
- */
-
- if (write(wfd, "\014", 1) < 0) {
- fprintf(stderr, "Error in writing ^L to FIFO.\n");
- }
-
-#ifdef __OSE__
- /* we have a tiny stack so we malloc the buffers */
- stdin_buf = malloc(sizeof(char) * BUFSIZ);
- pipe_buf = malloc(sizeof(char) * BUFSIZ);
-
- efs_examine_fd(rfd,FLIB_FD_HANDLE,&pipe_fh);
- efs_examine_fd(0,FLIB_FD_HANDLE,&stdin_fh);
- READ_AIO(stdin_read_req,0,BUFSIZ,stdin_buf);
- READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_buf);
-#endif
-
- /*
- * read and write
- */
- while (1) {
-#ifndef __OSE__
- FD_ZERO(&readfds);
- FD_SET(0, &readfds);
- FD_SET(rfd, &readfds);
- if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) {
- if (recv_sig) {
- FD_ZERO(&readfds);
- }
- else {
- fprintf(stderr, "Error in select.\n");
- break;
- }
- }
- len = 0;
-
- /*
- * Read from terminal and write to FIFO
- */
- if (recv_sig) {
- switch (recv_sig) {
- case SIGINT:
- fprintf(stderr, "[Break]\n\r");
- buf[0] = '\003';
- len = 1;
- break;
- case SIGWINCH:
- len = window_size_seq(buf,sizeof(buf));
- break;
- default:
- fprintf(stderr,"Unexpected signal: %u\n",recv_sig);
- }
- recv_sig = 0;
- }
- else
-#else /* __OSE__ */
- SIGSELECT sigsel[] = {0};
- sig = receive(sigsel);
- len = 0;
-#endif
-#ifndef __OSE__
- if (FD_ISSET(0,&readfds)) {
- len = read(0, buf, sizeof(buf));
-#else /* __OSE__ */
- if (sig->signo == FM_READ_PTR_REPLY &&
- sig->fm_read_ptr.handle == stdin_fh) {
- len = sig->fm_read_ptr.status == EFS_SUCCESS ? sig->fm_read_ptr.actual : -1;
- buf = sig->fm_read_ptr.buffer;
-#endif
- if (len <= 0) {
- close(rfd);
- close(wfd);
- if (len < 0) {
- fprintf(stderr, "Error in reading from stdin.\n");
- } else {
- fprintf(stderr, "[EOF]\n\r");
- }
- break;
- }
- /* check if there is an eof character in input */
- for (i = 0; i < len-1 && buf[i] != tty_eof; i++);
- if (buf[i] == tty_eof) {
- fprintf(stderr, "[Quit]\n\r");
- break;
- }
- }
-
- if (len) {
-#ifdef DEBUG
- if(write(1, buf, len));
-#endif
- if (write_all(wfd, buf, len) != len) {
- fprintf(stderr, "Error in writing to FIFO.\n");
- close(rfd);
- close(wfd);
- break;
- }
- STATUS("\" OK\r\n");
-#ifdef __OSE__
- aio_dispatch(sig);
- READ_AIO(stdin_read_req, 0, BUFSIZ, stdin_buf);
-#endif
- }
-
- /*
- * Read from FIFO, write to terminal.
- */
-#ifndef __OSE__
- if (FD_ISSET(rfd, &readfds)) {
- STATUS("FIFO read: ");
- len = read(rfd, buf, BUFSIZ);
-#else /* __OSE__ */
- if (sig->signo == FM_READ_PTR_REPLY &&
- sig->fm_read_ptr.handle == pipe_fh) {
- len = sig->fm_read_ptr.status == EFS_SUCCESS ? sig->fm_read_ptr.actual : -1;
- buf = sig->fm_read_ptr.buffer;
-#endif
- if (len < 0 && errno == EAGAIN) {
- /*
- * No data this time, but the writing end of the FIFO is still open.
- * Do nothing.
- */
- ;
- } else if (len <= 0) {
- /*
- * Either an error or end of file. In either case, break out
- * of the loop.
- */
- close(rfd);
- close(wfd);
- if (len < 0) {
- fprintf(stderr, "Error in reading from FIFO.\n");
- } else
- fprintf(stderr, "[End]\n\r");
- break;
- } else {
- if (!got_some) {
- if ((len=version_handshake(buf,len,wfd)) < 0) {
- close(rfd);
- close(wfd);
- break;
- }
-#ifndef __OSE__
- if (protocol_ver >= 1) {
- /* Tell run_erl size of terminal window */
- signal(SIGWINCH, handle_sigwinch);
- raise(SIGWINCH);
- }
-#endif
- got_some = 1;
- }
-
- /*
- * We successfully read at least one character. Write what we got.
- */
- STATUS("Terminal write: \"");
- if (write_all(1, buf, len) != len) {
- fprintf(stderr, "Error in writing to terminal.\n");
- close(rfd);
- close(wfd);
- break;
- }
- STATUS("\" OK\r\n");
-#ifdef __OSE__
- aio_dispatch(sig);
- READ_AIO(pipe_read_req, rfd, BUFSIZ, pipe_buf);
-#endif
- }
- }
- }
-
-#ifndef __OSE__
- /*
- * Reset terminal characterstics
- * XXX
- */
- tcsetattr(0, TCSADRAIN, &tty_rmode);
-#endif
- return 0;
-}
-
-/* Call write() until entire buffer has been written or error.
- * Return len or -1.
- */
-static int write_all(int fd, const char* buf, int len)
-{
- int left = len;
- int written;
- while (left) {
- written = write(fd,buf,left);
- if (written < 0) {
- return -1;
- }
- left -= written;
- buf += written;
- }
- return len;
-}
-
-#ifndef __OSE__
-static int window_size_seq(char* buf, size_t bufsz)
-{
-#ifdef TIOCGWINSZ
- struct winsize ws;
- static const char prefix[] = "\033_";
- static const char suffix[] = "\033\\";
- /* This Esc sequence is called "Application Program Command"
- and seems suitable to use for our own customized stuff. */
-
- if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) {
- int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s",
- prefix, ws.ws_col, ws.ws_row, suffix);
- return len;
- }
-#endif /* TIOCGWINSZ */
- return 0;
-}
-#endif /* !__OSE__ */
-
-/* to_erl run_erl
- * | |
- * |---------- '\014' -------->| (session start)
- * | |
- * |<---- "[run_erl v1-0]" ----| (version interval)
- * | |
- * |--- Esc_"version=1"Esc\ -->| (common version)
- * | |
- */
-static int version_handshake(char* buf, int len, int wfd)
-{
- unsigned re_high=0, re_low;
- char *end = find_str(buf,len,"]\n");
-
- if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) {
- char wbuf[30];
- int wlen;
-
- if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) {
- fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n",
- RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low);
- return -1;
- }
- /* Choose highest common version */
- protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER;
-
- wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\",
- protocol_ver);
- if (write_all(wfd, wbuf, wlen) < 0) {
- fprintf(stderr,"Failed to send version handshake\n");
- return -1;
- }
- end += 2;
- len -= (end-buf);
- memmove(buf,end,len);
-
- }
- else { /* we assume old run_erl without version handshake */
- protocol_ver = 0;
- }
-
- if (re_high != RUN_ERL_HI_VER) {
- fprintf(stderr,"run_erl has different version, "
- "using common protocol level %u\n", protocol_ver);
- }
-
- return len;
-}
-
-
-#if defined(DEBUG) && !defined(__OSE__)
-#define S(x) ((x) > 0 ? 1 : 0)
-
-static void show_terminal_settings(struct termios *t)
-{
- fprintf(stderr,"c_iflag:\n");
- fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT));
- fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL));
- fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK));
- fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR));
- fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR));
- fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR));
- fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK));
- fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP));
- fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF));
- fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON));
- fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK));
- fprintf(stderr,"\n");
- fprintf(stderr,"c_oflag:\n");
- fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST));
- fprintf(stderr,"\n");
- fprintf(stderr,"c_cflag:\n");
- fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL));
- fprintf(stderr,"\n");
- fprintf(stderr,"c_local:\n");
- fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO));
- fprintf(stderr,"\n");
- fprintf(stderr,"c_cc:\n");
- fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]);
-}
-#endif /* DEBUG && !__OSE__ */
diff --git a/erts/etc/common/to_erl_common.h b/erts/etc/common/to_erl_common.h
deleted file mode 100644
index a139da418f..0000000000
--- a/erts/etc/common/to_erl_common.h
+++ /dev/null
@@ -1,29 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-#ifndef ERL_TO_ERL_H
-#define ERL_TO_ERL_H
-
-#define TO_ERL_USAGE "to_erl [-h|-F] %s\n" \
- "\t-h\tThis help text.\n" \
- "\t-f\tForce connection even though pipe is locked by other to_erl process."
-
-int to_erl(int argc, char **argv);
-
-#endif
diff --git a/erts/etc/ose/etc.lmconf b/erts/etc/ose/etc.lmconf
deleted file mode 100644
index b402b325b1..0000000000
--- a/erts/etc/ose/etc.lmconf
+++ /dev/null
@@ -1,20 +0,0 @@
-OSE_LM_STACK_SIZES=256,512,1024,2048,4096,8192,16384,65536
-OSE_LM_SIGNAL_SIZES=31,63,127,255,1023,4095,16383,65535
-OSE_LM_POOL_SIZE=0x200000
-OSE_LM_MAIN_NAME=main
-OSE_LM_MAIN_STACK_SIZE=0xF000
-OSE_LM_MAIN_PRIORITY=20
-## Has to be of a type that allows MAM
-OSE_LM_PROGRAM_TYPE=APP_RAM
-OSE_LM_DATA_INIT=YES
-OSE_LM_BSS_INIT=YES
-OSE_LM_EXEC_MODEL=SHARED
-HEAP_MAX_SIZE=1000000000
-HEAP_SMALL_BUF_INIT_SIZE=64000000
-HEAP_LARGE_BUF_THRESHOLD=16000000
-HEAP_LOCK_TYPE=2
-
-# Setting the environment variable EFS_RESOLVE_TMO on the block to 0.
-# This will eliminiate delays when trying to open files on not mounted
-# volumes.
-EFS_RESOLVE_TMO=0
diff --git a/erts/etc/ose/run_erl.c b/erts/etc/ose/run_erl.c
deleted file mode 100644
index 6775525297..0000000000
--- a/erts/etc/ose/run_erl.c
+++ /dev/null
@@ -1,664 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Module: run_erl.c
- *
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-/* System includes */
-#include <aio.h>
-#include <errno.h>
-#include <dirent.h>
-#include <stdlib.h>
-#include <string.h>
-#include <stdio.h>
-#include <sys/stat.h>
-#include <unistd.h>
-
-/* OSE includes */
-#include "ose.h"
-#include "ose_spi/ose_spi.h"
-#include "efs.h"
-#include "pm.h"
-#include "ose_spi/fm.sig"
-
-/* erts includes */
-#include "run_erl.h"
-#include "run_erl_common.h"
-#include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */
-
-typedef struct RunErlSetup_ {
- SIGSELECT signo;
- int run_daemon;
- char *logdir;
- char *command;
- char *pipename;
- char *blockname;
-} RunErlSetup;
-
-typedef struct ProgramState_ {
- /* child process */
- int ifd, ofd;
- OSDOMAIN domain;
- PROCESS progpid, mainbid;
- struct PmProgramInfo *info;
- /* to_erl */
- char w_pipe[FILENAME_BUFSIZ],
- r_pipe[FILENAME_BUFSIZ];
-} ProgramState;
-
-union SIGNAL {
- SIGSELECT signo;
- RunErlSetup setup;
- struct FmReadPtr fm_read_ptr;
- struct FmWritePtr fm_write_ptr;
-};
-
-static OSBOOLEAN hunt_in_block(char *block_name,
- char *process_name,
- PROCESS *pid);
-static int create_child_process(char *command_string, char *blockname,
- ProgramState *state);
-
-
-static OSBOOLEAN hunt_in_block(char *block_name,
- char *process_name,
- PROCESS *pid) {
- struct OS_pid_list *list;
- PROCESS block_id = OSE_ILLEGAL_PROCESS;
- int i;
- char *name;
-
- *pid = OSE_ILLEGAL_PROCESS;
-
- list = get_bid_list(0);
-
- if (!list)
- return 0;
-
- for (i = 0; i < list->count; i++) {
-
- if (list->list[i] == get_bid(current_process()))
- continue;
-
- name = (char*)get_pid_info(list->list[i], OSE_PI_NAME);
- if (name) {
- if (strcmp(name,block_name) == 0) {
- block_id = list->list[i];
- free_buf((union SIGNAL**)&name);
- break;
- }
- free_buf((union SIGNAL**)&name);
- }
- }
-
- free_buf((union SIGNAL**)&list);
-
- if (block_id == OSE_ILLEGAL_PROCESS)
- return 0;
-
- list = get_pid_list(block_id);
-
- if (!list)
- return 0;
-
- for (i = 0; i < list->count; i++) {
- name = (char*)get_pid_info(list->list[i], OSE_PI_NAME);
- if (name) {
- if (strcmp(name,process_name) == 0) {
- *pid = list->list[i];
- free_buf((union SIGNAL**)&name);
- break;
- }
- free_buf((union SIGNAL**)&name);
- }
- }
-
- free_buf((union SIGNAL**)&list);
-
- if (*pid == OSE_ILLEGAL_PROCESS)
- return 0;
-
- return 1;
-
-}
-
-
-static int create_child_process(char *command_string, char *blockname,
- ProgramState *state) {
- char *command = command_string;
- char *argv;
- int i = 0;
- int ret_status;
- PmStatus pm_status;
- int tmp_io[2];
- int fd_arr[3];
- int ifd[2], ofd[2];
- char *handle;
- struct PmLoadModuleInfoReply *mod_info;
-
- /* Parse out cmd and argv from the command string */
- while (1) {
- if (command[i] == ' ' || command[i] == '\0') {
- if (command[i] == '\0')
- argv = NULL;
- else {
- command[i] = '\0';
- argv = command_string + i + 1;
- }
- break;
- }
- i++;
- }
-
- if (blockname)
- handle = blockname;
- else
- handle = simple_basename(command);
-
- if (ose_pm_load_module_info(handle,&mod_info) == PM_SUCCESS) {
- /* Already installed */
- free_buf((union SIGNAL**)&mod_info);
- } else if ((pm_status = ose_pm_install_load_module(0,"ELF",command,handle,0,0,NULL))
- != PM_SUCCESS) {
- ERROR1(LOG_ERR,"ose_pm_install_load_module failed - pmstatus: 0x%08x\n",
- pm_status);
- return 0;
- }
-
- state->domain = PM_NEW_DOMAIN;
-
- pm_status = ose_pm_create_program(&state->domain, handle, 0, 0 , NULL,
- &state->progpid, &state->mainbid);
-
- if (pm_status != PM_SUCCESS) {
- if (pm_status == PM_EINSTALL_HANDLE_IN_USE)
- ERROR1(LOG_ERR,"ose_pm_create_program failed - "
- "install handle \"%s\" is in use. You can specify another "
- "install handle by using the -block option to run_erl.\n",handle);
- else
- ERROR1(LOG_ERR,"ose_pm_create_program failed - pmstatus: 0x%08x\n",
- pm_status);
- return 0;
- }
-
- pm_status = ose_pm_program_info(state->progpid, &state->info);
- /* FIXME don't forget to free this ((union SIGNAL **)&info) */
- if (pm_status != PM_SUCCESS) {
- ERROR1(LOG_ERR,"ose_pm_program_info failed - pmstatus: 0x%08x\n",
- pm_status);
- return 0;
- }
-
- /* We only clone stdin+stdout, what about stderr? */
-
- /* create pipes */
- if (pipe(ifd) < 0) {
- if (errno == ENOENT)
- ERRNO_ERR0(LOG_ERR,"The /pipe file system is not available\n");
- else
- ERRNO_ERR0(LOG_ERR,"pipe ifd failed\n");
- return 0;
- }
-
- if (pipe(ofd) < 0) {
- ERRNO_ERR0(LOG_ERR,"pipe ofd failed\n");
- return 0;
- }
-
- /* FIXME Lock? */
-
- /* backup our stdin stdout */
- if ((tmp_io[0] = dup(0)) < 0) {
- ERRNO_ERR0(LOG_ERR,"dup 0 failed\n");
- return 0;
- }
-
- if ((tmp_io[1] = dup(1)) < 0) {
- ERRNO_ERR0(LOG_ERR,"dup 1 failed\n");
- return 0;
- }
-
- /* set new pipe to fd 0,1 */
- if (dup2(ifd[1], 1) < 0) {
- ERRNO_ERR0(LOG_ERR,"dup2 1 failed\n");
- return 0;
- }
-
- if (dup2(ofd[0], 0) < 0) {
- ERRNO_ERR0(LOG_ERR,"dup2 0 failed\n");
- return 0;
- }
-
- /* clone array to newly created */
- fd_arr[0] = 2; /* Number of fd's */
- fd_arr[1] = 0;
- fd_arr[2] = 1;
-
- if ((ret_status = efs_clone_array(state->info->main_process, fd_arr))
- != EFS_SUCCESS) {
- ERROR1(LOG_ERR,"efs_close_array filed, errcode: %d\n", ret_status);
- return 0;
- }
-
- if (dup2(tmp_io[1], 1) < 0) {
- ERRNO_ERR0(LOG_ERR,"restoring dup2 1 failed\n");
- return 0;
- }
-
- if (dup2(tmp_io[0], 0) < 0) {
- ERRNO_ERR0(LOG_ERR,"restoring dup2 1 failed\n");
- return 0;
- }
-
- /* close loose-ends */
- sf_close(tmp_io[0]);
- sf_close(tmp_io[1]);
- sf_close(ifd[1]);
- sf_close(ofd[0]);
- state->ifd = ifd[0];
- state->ofd = ofd[1];
-
- if (argv && set_env(state->progpid, "ARGV", argv)) {
- ERRNO_ERR0(LOG_ERR,"something went wrong with set_env\n");
- }
-
- /*
- * Start the program.
- */
- pm_status = ose_pm_start_program(state->progpid);
- if (pm_status != PM_SUCCESS) {
- ERROR1(LOG_ERR,"ose_pm_install_load_module failed - pmstatus: 0x%08x\n",
- pm_status);
- return 0;
- }
-
- return 1;
-}
-
-#define SET_AIO(REQ,FD,SIZE,BUFF) \
- /* Make sure to clean data structure of previous request */ \
- memset(&(REQ),0,sizeof(REQ)); \
- (REQ).aio_fildes = FD; \
- (REQ).aio_offset = FM_POSITION_CURRENT; \
- (REQ).aio_nbytes = SIZE; \
- (REQ).aio_buf = BUFF; \
- (REQ).aio_sigevent.sigev_notify = SIGEV_NONE
-
-#define READ_AIO(REQ,FD,SIZE,BUFF) do { \
- SET_AIO(REQ,FD,SIZE,BUFF); \
- if (aio_read(&(REQ)) != 0) \
- ERRNO_ERR1(LOG_ERR,"aio_read of child_read_req(%d) failed\n",FD); \
- } while (0)
-
-#define WRITE_AIO(FD,SIZE,BUFF) do { \
- struct aiocb *write_req = malloc(sizeof(struct aiocb)); \
- char *write_buff = malloc(sizeof(char)*SIZE); \
- memcpy(write_buff,BUFF,SIZE); \
- SET_AIO(*write_req,FD,SIZE,write_buff); \
- if (aio_write(write_req) != 0) \
- ERRNO_ERR1(LOG_ERR,"aio_write of write_req(%d) failed\n",FD); \
- } while(0)
-
-int pass_on(ProgramState *state);
-int pass_on(ProgramState *s) {
- SIGSELECT sigsel[] = {0,FM_READ_PTR_REPLY};
- union SIGNAL *sig;
- char child_read_buff[BUFSIZ], pipe_read_buff[BUFSIZ];
- struct aiocb child_read_req, pipe_read_req;
- int rfd, wfd = 0;
- FmHandle rfh, child_rfh;
- int outstanding_writes = 0, got_some = 0, child_done = 0;
-
- if ((rfd = sf_open(s->r_pipe, O_RDONLY, 0)) < 0) {
- ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.\n", s->r_pipe);
- rfd = 0;
- return 1;
- }
-
- attach(NULL,s->progpid);
-
- /* Open the log file */
- erts_run_erl_log_open();
-
- efs_examine_fd(rfd,FLIB_FD_HANDLE,&rfh);
- efs_examine_fd(s->ifd,FLIB_FD_HANDLE,&child_rfh);
-
- READ_AIO(child_read_req,s->ifd,BUFSIZ,child_read_buff);
- READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff);
-
- while (1) {
- time_t now,last_activity;
-
- time(&last_activity);
- sig = receive_w_tmo(erts_run_erl_log_alive_minutes()*60000,sigsel);
-
- time(&now);
-
- if (sig) {
- erts_run_erl_log_activity(0,now,last_activity);
- } else {
- /* timeout */
- erts_run_erl_log_activity(1,now,last_activity);
- continue;
- }
-
- switch (sig->signo) {
- case OS_ATTACH_SIG: {
- if (rfd) { sf_close(rfd); rfd = 0; }
- free_buf(&sig);
- child_done = 1;
- /* Make sure to to let all outstanding write request finish */
- if (outstanding_writes)
- break;
- if (wfd) sf_close(wfd);
- return 0;
- }
- case FM_WRITE_PTR_REPLY: {
- if (sig->fm_write_ptr.status == EFS_SUCCESS) {
- if (sig->fm_write_ptr.actual < sig->fm_write_ptr.requested) {
- WRITE_AIO(wfd, sig->fm_write_ptr.requested-sig->fm_write_ptr.actual,
- sig->fm_write_ptr.buffer+sig->fm_write_ptr.actual);
- }
- } else {
- /* Assume to_erl has terminated. */
- sf_close(wfd);
- wfd = 0;
- }
- free((char*)sig->fm_write_ptr.buffer);
- aio_dispatch(sig);
- if ((--outstanding_writes == 0) && child_done) {
- if (wfd) sf_close(wfd);
- return 0;
- }
- break;
- }
- case FM_READ_PTR_REPLY: {
- /* Child fd */
- if (sig->fm_read_ptr.handle == child_rfh) {
-
- /* Child terminated */
- if (sig->fm_read_ptr.status != EFS_SUCCESS ||
- sig->fm_read_ptr.actual == 0) {
-
- if (rfd) { sf_close(rfd); rfd = 0; }
-
- if (sig->fm_read_ptr.status != EFS_SUCCESS) {
- ERROR0(LOG_ERR,"Erlang closed the connection.");
- aio_dispatch(sig);
- return 1;
- }
-
- /* child closed connection gracefully */
- aio_dispatch(sig);
- if (outstanding_writes) {
- child_done = 1;
- break;
- }
-
- if (wfd) sf_close(wfd);
-
- return 0;
- } else {
- erts_run_erl_log_write(sig->fm_read_ptr.buffer,
- sig->fm_read_ptr.actual);
- if (wfd) {
- WRITE_AIO(wfd, sig->fm_read_ptr.actual, sig->fm_read_ptr.buffer);
- outstanding_writes++;
- }
- aio_dispatch(sig);
- READ_AIO(child_read_req, s->ifd,BUFSIZ, child_read_buff);
- }
- /* pipe fd */
- } else if (sig->fm_read_ptr.handle == rfh) {
- if (sig->fm_read_ptr.status != EFS_SUCCESS) {
- if(rfd) sf_close(rfd);
- if(wfd) sf_close(wfd);
- aio_dispatch(sig);
- ERRNO_ERR0(LOG_ERR,"Error in reading from FIFO.");
- return 1;
- }
- if (sig->fm_read_ptr.actual == 0) {
- /* to_erl closed its end of the pipe */
- aio_dispatch(sig);
- sf_close(rfd);
- rfd = sf_open(s->r_pipe,O_RDONLY|DONT_BLOCK_PLEASE, 0);
- if (rfd < 0) {
- ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.",
- s->r_pipe);
- rfd = 0;
- } else {
- READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff);
- }
- got_some = 0; /* reset for next session */
- } else {
- int len = sig->fm_read_ptr.actual;
- char *buffer = sig->fm_read_ptr.buffer;
- if (!wfd) {
- /* Try to open the write pipe to to_erl. Now that we got some data
- * from to_erl, to_erl should already be reading this pipe - open
- * should succeed. But in case of error, we just ignore it.
- */
- if ((wfd = sf_open(s->w_pipe, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
- erts_run_erl_log_status("Client expected on FIFO %s, "
- "but can't open (len=%d)\n",
- s->w_pipe, sig->fm_read_ptr.actual);
- sf_close(rfd);
- rfd = sf_open(s->r_pipe, O_RDONLY|DONT_BLOCK_PLEASE, 0);
- if (rfd < 0) {
- ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.",
- s->r_pipe);
- return 1;
- }
- wfd = 0;
- } else {
-#ifdef DEBUG
- erts_run_erl_log_status("run_erl: %s opened for writing\n",
- s->w_pipe);
-#endif
- }
- }
-
- if (!got_some && wfd && buffer[0] == '\014') {
- char wbuf[30];
- int wlen = sn_printf(wbuf,sizeof(wbuf),"[run_erl v%u-%u]\n",
- RUN_ERL_HI_VER, RUN_ERL_LO_VER);
- /* For some reason this, the first write aio seems to
- not get an FM_WRITE_PTR_REPLY, so we do not do:
- outstanding_writes++;
- */
- WRITE_AIO(wfd, wlen, wbuf);
- }
- got_some = 1;
-
- /* Write the message */
-#ifdef DEBUG
- erts_run_erl_log_status("Pty master write; ");
-#endif
- len = erts_run_erl_extract_ctrl_seq(buffer,len, s->ofd);
-
- if (len > 0) {
- int wlen = erts_run_erl_write_all(s->ofd, buffer, len);
- if (wlen != len) {
- aio_dispatch(sig);
- ERRNO_ERR0(LOG_ERR,"Error in writing to terminal.");
- if(rfd) sf_close(rfd);
- if(wfd) sf_close(wfd);
- return 1;
- }
- }
-#ifdef DEBUG
- erts_run_erl_log_status("OK\n");
-#endif
- aio_dispatch(sig);
- READ_AIO(pipe_read_req,rfd,BUFSIZ,pipe_read_buff);
- }
- }
- break;
- }
- default: {
- free_buf(&sig);
- break;
- }
- }
- }
-}
-
-OS_PROCESS(run_erl_process) {
- char *logdir, *command, *blockname;
- SIGSELECT sigsel[] = {1,ERTS_SIGNAL_RUN_ERL_SETUP};
- union SIGNAL *sig = receive(sigsel);
- ProgramState state;
- char pipename[FILENAME_BUFSIZ];
-
- state.info = NULL;
-
- logdir = strdup(sig->setup.logdir);
- command = strdup(sig->setup.command);
- strn_cpy(pipename,sizeof(pipename),sig->setup.pipename);
-
- if (sig->setup.blockname)
- blockname = strdup(sig->setup.blockname);
- else
- blockname = NULL;
-
- erts_run_erl_log_init(sig->setup.run_daemon, logdir);
-
- free_buf(&sig);
-
- if (erts_run_erl_open_fifo(pipename,state.w_pipe,state.r_pipe))
- kill_proc(current_process());
-
- if (create_child_process(command,blockname,&state))
- pass_on(&state);
-
- free(logdir);
- free(command);
- if (blockname)
- free(blockname);
-
- if (state.info)
- free_buf(((union SIGNAL**)&state.info));
-
- sf_close(state.ifd);
- sf_close(state.ofd);
-
- unlink(state.w_pipe);
- unlink(state.r_pipe);
-
- kill_proc(current_process());
-}
-
-int run_erl(int argc,char **argv) {
- char *pipename, *logdir, *command, *blockname = NULL;
- int pipename_len, logdir_len, command_len, blockname_len = 0;
- int i = 1, run_daemon = 0;
- PROCESS pid;
- SIGSELECT sigsel[] = {0};
- union SIGNAL *sig;
-
- if(argc < 4) {
- fprintf(stderr,RUN_ERL_USAGE,"run_erl");
- return 1;
- }
-
- while (1) {
- if (argv[i][0] != '-')
- break;
- if (!strcmp(argv[i],"-daemon")) {
- run_daemon = 1;
- i++;
- continue;
- }
- if (!strcmp(argv[i],"-block")) {
- blockname = argv[i+1];
- blockname_len = strlen(argv[i+1]) + 1;
- i+=2;
- continue;
- }
- fprintf(stderr,RUN_ERL_USAGE,"run_erl");
- return 1;
- }
-
- pipename = argv[i++];
- logdir = argv[i++];
- command = argv[i++];
-
- /* + 1 to include NULL at end */
- logdir_len = strlen(logdir) + 1;
- command_len = strlen(command) + 1;
- pipename_len = strlen(pipename) + 1;
-
- if (run_daemon) {
- /* We request that the run_erl_process should be started from the
- main process so that it does not die when the shell command
- returns */
- PROCESS main_pid;
- hunt_in_block("run_erl","main",&main_pid);
- sig = alloc(sizeof(*sig),ERTS_SIGNAL_RUN_ERL_DAEMON);
- send(&sig,main_pid);
- sig = receive(sigsel);
- pid = sender(&sig);
- free_buf(&sig);
- } else {
- pid = create_process(OS_BG_PROC,"run_erl_process",
- run_erl_process, 0x800,
- 0, 0, 0, NULL, 0, 0);
- }
-
- sig = alloc(sizeof(RunErlSetup)+
- logdir_len+command_len+pipename_len+blockname_len,
- ERTS_SIGNAL_RUN_ERL_SETUP);
- sig->setup.run_daemon = run_daemon;
- sig->setup.logdir = ((char*)sig)+sizeof(RunErlSetup);
- sig->setup.command = ((char*)sig)+sizeof(RunErlSetup)+logdir_len;
- sig->setup.pipename = ((char*)sig)+sizeof(RunErlSetup)+logdir_len+command_len;
- if (blockname)
- sig->setup.blockname = ((char*)sig)+sizeof(RunErlSetup)+
- logdir_len+command_len+pipename_len;
- else
- sig->setup.blockname = NULL;
-
- strcpy(sig->setup.logdir,logdir);
- strcpy(sig->setup.command,command);
- strcpy(sig->setup.pipename,pipename);
- if (blockname) strcpy(sig->setup.blockname,blockname);
-
- send(&sig,pid);
-
- if (run_daemon) {
- /* We are a daemon, error msgs will be sent to ramlog */
- start(pid);
- return 1;
- }
-
- /* We are not daemon, error msgs will be sent to stderr and we block here */
- efs_clone(pid);
- start(pid);
-
- attach(NULL,pid);
- sig = receive(sigsel);
-
- return 1;
-}
diff --git a/erts/etc/ose/run_erl.h b/erts/etc/ose/run_erl.h
deleted file mode 100644
index bdc8b6c355..0000000000
--- a/erts/etc/ose/run_erl.h
+++ /dev/null
@@ -1,30 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-#ifndef ERL_RUN_ERL_H
-#define ERL_RUN_ERL_H
-
-#include "ose.h"
-
-#include "erts.sig"
-
-int run_erl(int argc, char **argv);
-OS_PROCESS(run_erl_process);
-
-#endif
diff --git a/erts/etc/ose/run_erl_main.c b/erts/etc/ose/run_erl_main.c
deleted file mode 100644
index 8895c773a1..0000000000
--- a/erts/etc/ose/run_erl_main.c
+++ /dev/null
@@ -1,80 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2013. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-/*
- * Module: run_erl_main.c
- *
- * Container for load module that installs both run_erl and to_erl command.
- */
-
-#ifdef HAVE_CONFIG_H
-# include "config.h"
-#endif
-
-#include <stdio.h>
-
-#include "ose.h"
-#include "shell.h"
-
-#include "run_erl_common.h"
-#include "run_erl.h"
-#include "to_erl_common.h"
-
-union SIGNAL {
- SIGSELECT signo;
-};
-
-int main(int argc, char **argv)
-{
-
- char run_erl_usage[320],
- to_erl_usage[120];
-
- (void)stdin;(void)stdout;(void)stderr;
-
- sprintf(run_erl_usage,RUN_ERL_USAGE,"run_erl [-daemon] [-block blockname]");
- sprintf(to_erl_usage,TO_ERL_USAGE,"pipename");
-
- shell_add_cmd_attrs(
- "run_erl",run_erl_usage,
- "Redirect Erlang input and output streams",
- run_erl,DEFAULT_PROC_TYPE,DEFAULT_PRIORITY,DEFAULT_STACK_SIZE);
-
- shell_add_cmd_attrs(
- "to_erl",to_erl_usage,
- "Attach to redirected Erlang input and output streams",
- to_erl,DEFAULT_PROC_TYPE,DEFAULT_PRIORITY,DEFAULT_STACK_SIZE);
-
- while (1) {
- static const SIGSELECT sigsel[] = {0};
- union SIGNAL *sig = receive(sigsel);
-
- if (sig->signo == ERTS_SIGNAL_RUN_ERL_DAEMON) {
- PROCESS pid = create_process(OS_BG_PROC,"run_erl_daemon",
- run_erl_process, 0x800,
- 0, 0, 0, NULL, 0, 0);
- send_w_s(&sig,pid,sender(&sig));
- } else {
- printf("Got unexpected signal!");
- free_buf(&sig);
- }
- }
-
- return 1;
-}
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index 19d67de92f..7b554e71f2 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -774,7 +774,7 @@ define etp-pid-1
#
set $etp_pid_1 = (Eterm)($arg0)
if ($etp_pid_1 & 0xF) == 0x3
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff)
else
@@ -834,7 +834,7 @@ define etp-port-1
#
set $etp_port_1 = (Eterm)($arg0)
if ($etp_port_1 & 0xF) == 0x7
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_port_data = (unsigned) ((((Uint64) $etp_port_1) >> 36) & 0x0fffffff)
else
@@ -1577,7 +1577,7 @@ define etp-term-dump-pid
#
set $etp_pid_1 = (Eterm)($arg0)
if ($etp_pid_1 & 0xF) == 0x3
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_pid_data = (unsigned) ((((Uint64) $etp_pid_1) >> 36) & 0x0fffffff)
else
@@ -1622,7 +1622,7 @@ end
define etp-pid2pix-1
# Args: Eterm
#
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff)
else
@@ -1965,7 +1965,7 @@ end
define etp-port-id2pix-1
# Args: Eterm
#
- if (etp_arch_bits == 64 && etp_halfword == 0)
+ if (etp_arch_bits == 64)
if (etp_big_endian)
set $etp_pix = (int) (((Uint64) $arg0) & 0x0fffffff)
elser
@@ -2493,12 +2493,6 @@ define etp-system-info
printf "Little\n"
end
printf "Word size: %d-bit\n", etp_arch_bits
- printf "Halfword: "
- if (etp_halfword)
- printf "yes\n"
- else
- printf "no\n"
- end
printf "HiPE support: "
if (etp_hipe)
printf "yes\n"
diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c
index c8414030ca..22302d539a 100644
--- a/erts/etc/unix/run_erl.c
+++ b/erts/etc/unix/run_erl.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2015. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -41,13 +41,16 @@
#ifdef HAVE_CONFIG_H
# include "config.h"
#endif
-
#ifdef HAVE_WORKING_POSIX_OPENPT
-#ifndef _XOPEN_SOURCE
-#define _XOPEN_SOURCE 600
-#endif
+# ifndef _XOPEN_SOURCE
+ /* On OS X, we must leave _XOPEN_SOURCE undefined in order for
+ * the prototype of vsyslog() to be included.
+ */
+# ifndef __APPLE__
+# define _XOPEN_SOURCE 600
+# endif
+# endif
#endif
-
#include <sys/types.h>
#include <sys/wait.h>
#include <sys/stat.h>
@@ -65,6 +68,11 @@
#include <dirent.h>
#include <termios.h>
#include <time.h>
+
+#ifdef __ANDROID__
+# include <termios.h>
+#endif
+
#ifdef HAVE_SYSLOG_H
# include <syslog.h>
#endif
@@ -84,25 +92,81 @@
# include <stropts.h>
#endif
-#include "run_erl_common.h"
+#include "run_erl.h"
#include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */
+#ifdef O_NONBLOCK
+# define DONT_BLOCK_PLEASE O_NONBLOCK
+#else
+# define DONT_BLOCK_PLEASE O_NDELAY
+# ifndef EAGAIN
+# define EAGAIN -3898734
+# endif
+#endif
+
+#define noDEBUG
+
+#define DEFAULT_LOG_GENERATIONS 5
+#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */
+#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */
+#define DEFAULT_LOG_MAXSIZE 100000
+#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */
+#define LOG_STUBNAME "erlang.log."
+#define LOG_PERM 0664
+#define DEFAULT_LOG_ACTIVITY_MINUTES 5
+#define DEFAULT_LOG_ALIVE_MINUTES 15
+#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y"
+#define ALIVE_BUFFSIZ 256
+
+#define PERM 0600
+#define STATUSFILENAME "/run_erl.log"
+#define PIPE_STUBNAME "erlang.pipe"
+#define PIPE_STUBLEN strlen(PIPE_STUBNAME)
+
+#ifndef FILENAME_MAX
+#define FILENAME_MAX 250
+#endif
+
+#ifndef O_SYNC
+#define O_SYNC 0
+#define USE_FSYNC 1
+#endif
+
#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#define FILENAME_BUFSIZ FILENAME_MAX
+
/* prototypes */
static void usage(char *);
+static int create_fifo(char *name, int perm);
static int open_pty_master(char **name, int *sfd);
static int open_pty_slave(char *name);
static void pass_on(pid_t);
static void exec_shell(char **);
+static void status(const char *format,...);
+static void error_logf(int priority, int line, const char *format,...);
static void catch_sigchild(int);
+static int next_log(int log_num);
+static int prev_log(int log_num);
+static int find_next_log_num(void);
+static int open_log(int log_num, int flags);
+static void write_to_log(int* lfd, int* log_num, char* buf, int len);
static void daemon_init(void);
+static char *simple_basename(char *path);
static void init_outbuf(void);
static int outbuf_size(void);
static void clear_outbuf(void);
static char* outbuf_first(void);
static void outbuf_delete(int bytes);
static void outbuf_append(const char* bytes, int n);
+static int write_all(int fd, const char* buf, int len);
+static int extract_ctrl_seq(char* buf, int len);
+static void set_window_size(unsigned col, unsigned row);
+
+static ssize_t sf_write(int fd, const void *buffer, size_t len);
+static ssize_t sf_read(int fd, void *buffer, size_t len);
+static int sf_open(const char *path, int flags, mode_t mode);
+static int sf_close(int fd);
#ifdef DEBUG
static void show_terminal_settings(struct termios *t);
@@ -110,11 +174,20 @@ static void show_terminal_settings(struct termios *t);
/* static data */
static char fifo1[FILENAME_BUFSIZ], fifo2[FILENAME_BUFSIZ];
+static char statusfile[FILENAME_BUFSIZ];
+static char log_dir[FILENAME_BUFSIZ];
static char pipename[FILENAME_BUFSIZ];
static FILE *stdstatus = NULL;
+static int log_generations = DEFAULT_LOG_GENERATIONS;
+static int log_maxsize = DEFAULT_LOG_MAXSIZE;
+static int log_alive_minutes = DEFAULT_LOG_ALIVE_MINUTES;
+static int log_activity_minutes = DEFAULT_LOG_ACTIVITY_MINUTES;
+static int log_alive_in_gmt = 0;
+static char log_alive_format[ALIVE_BUFFSIZ+1];
static int run_daemon = 0;
static char *program_name;
static int mfd; /* master pty fd */
+static unsigned protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */
/*
* Output buffer.
@@ -145,13 +218,29 @@ static char* outbuf_in;
LOG_PID|LOG_CONS|LOG_NOWAIT,LOG_USER)
#endif
+#define ERROR0(Prio,Format) error_logf(Prio,__LINE__,Format"\n")
+#define ERROR1(Prio,Format,A1) error_logf(Prio,__LINE__,Format"\n",A1)
+#define ERROR2(Prio,Format,A1,A2) error_logf(Prio,__LINE__,Format"\n",A1,A2)
+
+#ifdef HAVE_STRERROR
+# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno)
+#else
+# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno
+#endif
+#define ERRNO_ERR0(Prio,Format) error_logf(Prio,__LINE__,ADD_ERRNO(Format))
+#define ERRNO_ERR1(Prio,Format,A1) error_logf(Prio,__LINE__,ADD_ERRNO(Format),A1)
+
+
int main(int argc, char **argv)
{
int childpid;
int sfd = -1;
- char *ptyslave=NULL;
+ int fd;
+ char *p, *ptyslave=NULL;
int i = 1;
int off_argv;
+ int calculated_pipename = 0;
+ int highest_pipe_num = 0;
program_name = argv[0];
@@ -169,16 +258,122 @@ int main(int argc, char **argv)
off_argv = i;
strn_cpy(pipename, sizeof(pipename), argv[i++]);
-
- erts_run_erl_log_init(run_daemon,argv[i]);
+ strn_cpy(log_dir, sizeof(log_dir), argv[i]);
+ strn_cpy(statusfile, sizeof(statusfile), log_dir);
+ strn_cat(statusfile, sizeof(statusfile), STATUSFILENAME);
#ifdef DEBUG
- erts_run_erl_log_status("%s: pid is : %d\n", argv[0], getpid());
+ status("%s: pid is : %d\n", argv[0], getpid());
#endif
- /* Open read and write fifo */
- if (erts_run_erl_open_fifo(pipename,fifo1,fifo2))
- exit(1);
+ /* Get values for LOG file handling from the environment */
+ if ((p = getenv("RUN_ERL_LOG_ALIVE_MINUTES"))) {
+ log_alive_minutes = atoi(p);
+ if (!log_alive_minutes) {
+ ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 "
+ "(current value is %s)",p);
+ }
+ log_activity_minutes = log_alive_minutes / 3;
+ if (!log_activity_minutes) {
+ ++log_activity_minutes;
+ }
+ }
+ if ((p = getenv("RUN_ERL_LOG_ACTIVITY_MINUTES"))) {
+ log_activity_minutes = atoi(p);
+ if (!log_activity_minutes) {
+ ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 "
+ "(current value is %s)",p);
+ }
+ }
+ if ((p = getenv("RUN_ERL_LOG_ALIVE_FORMAT"))) {
+ if (strlen(p) > ALIVE_BUFFSIZ) {
+ ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of "
+ "%d characters", ALIVE_BUFFSIZ);
+ }
+ strn_cpy(log_alive_format, sizeof(log_alive_format), p);
+ } else {
+ strn_cpy(log_alive_format, sizeof(log_alive_format), DEFAULT_LOG_ALIVE_FORMAT);
+ }
+ if ((p = getenv("RUN_ERL_LOG_ALIVE_IN_UTC")) && strcmp(p,"0")) {
+ ++log_alive_in_gmt;
+ }
+ if ((p = getenv("RUN_ERL_LOG_GENERATIONS"))) {
+ log_generations = atoi(p);
+ if (log_generations < LOG_MIN_GENERATIONS)
+ ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d", LOG_MIN_GENERATIONS);
+ if (log_generations > LOG_MAX_GENERATIONS)
+ ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d", LOG_MAX_GENERATIONS);
+ }
+
+ if ((p = getenv("RUN_ERL_LOG_MAXSIZE"))) {
+ log_maxsize = atoi(p);
+ if (log_maxsize < LOG_MIN_MAXSIZE)
+ ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE);
+ }
+
+ /*
+ * Create FIFOs and open them
+ */
+
+ if(*pipename && pipename[strlen(pipename)-1] == '/') {
+ /* The user wishes us to find a unique pipe name in the specified */
+ /* directory */
+ DIR *dirp;
+ struct dirent *direntp;
+
+ calculated_pipename = 1;
+ dirp = opendir(pipename);
+ if(!dirp) {
+ ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename);
+ exit(1);
+ }
+
+ /* Check the directory for existing pipes */
+
+ while((direntp=readdir(dirp)) != NULL) {
+ if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) {
+ int num = atoi(direntp->d_name+PIPE_STUBLEN+1);
+ if(num > highest_pipe_num)
+ highest_pipe_num = num;
+ }
+ }
+ closedir(dirp);
+ strn_catf(pipename, sizeof(pipename), "%s.%d",
+ PIPE_STUBNAME, highest_pipe_num+1);
+ } /* if */
+
+ for(;;) {
+ /* write FIFO - is read FIFO for `to_erl' program */
+ strn_cpy(fifo1, sizeof(fifo1), pipename);
+ strn_cat(fifo1, sizeof(fifo1), ".r");
+ if (create_fifo(fifo1, PERM) < 0) {
+ ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.", fifo1);
+ exit(1);
+ }
+
+ /* read FIFO - is write FIFO for `to_erl' program */
+ strn_cpy(fifo2, sizeof(fifo2), pipename);
+ strn_cat(fifo2, sizeof(fifo2), ".w");
+
+ /* Check that nobody is running run_erl already */
+ if ((fd = sf_open(fifo2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) {
+ /* Open as client succeeded -- run_erl is already running! */
+ sf_close(fd);
+ if (calculated_pipename) {
+ ++highest_pipe_num;
+ strn_catf(pipename, sizeof(pipename), "%s.%d",
+ PIPE_STUBNAME, highest_pipe_num+1);
+ continue;
+ }
+ fprintf(stderr, "Erlang already running on pipe %s.\n", pipename);
+ exit(1);
+ }
+ if (create_fifo(fifo2, PERM) < 0) {
+ ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.", fifo2);
+ exit(1);
+ }
+ break;
+ }
/*
* Open master pseudo-terminal
@@ -250,7 +445,7 @@ int main(int argc, char **argv)
sf_close(2);
if (dup(sfd) != 0 || dup(sfd) != 1 || dup(sfd) != 2) {
- erts_run_erl_log_status("Cannot dup\n");
+ status("Cannot dup\n");
}
sf_close(sfd);
exec_shell(argv+off_argv); /* exec_shell expects argv[2] to be */
@@ -293,7 +488,9 @@ static void pass_on(pid_t childpid)
struct timeval timeout;
time_t last_activity;
char buf[BUFSIZ];
- int rfd, wfd=0;
+ char log_alive_buffer[ALIVE_BUFFSIZ+1];
+ int lognum;
+ int rfd, wfd=0, lfd=0;
int maxfd;
int ready;
int got_some = 0; /* from to_erl */
@@ -308,12 +505,13 @@ static void pass_on(pid_t childpid)
}
#ifdef DEBUG
- erts_run_erl_log_status("run_erl: %s opened for reading\n", fifo2);
+ status("run_erl: %s opened for reading\n", fifo2);
#endif
/* Open the log file */
- erts_run_erl_log_open();
+ lognum = find_next_log_num();
+ lfd = open_log(lognum, O_RDWR|O_APPEND|O_CREAT|O_SYNC);
/* Enter the work loop */
@@ -332,8 +530,7 @@ static void pass_on(pid_t childpid)
writefds_ptr = &writefds;
}
time(&last_activity);
- /* don't assume old BSD bug */
- timeout.tv_sec = erts_run_erl_log_alive_minutes()*60;
+ timeout.tv_sec = log_alive_minutes*60; /* don't assume old BSD bug */
timeout.tv_usec = 0;
ready = select(maxfd + 1, &readfds, writefds_ptr, NULL, &timeout);
if (ready < 0) {
@@ -363,7 +560,28 @@ static void pass_on(pid_t childpid)
/* Check how long time we've been inactive */
time(&now);
- erts_run_erl_log_activity(!ready,now,last_activity);
+ if(!ready || now - last_activity > log_activity_minutes*60) {
+ /* Either a time out: 15 minutes without action, */
+ /* or something is coming in right now, but it's a long time */
+ /* since last time, so let's write a time stamp this message */
+ struct tm *tmptr;
+ if (log_alive_in_gmt) {
+ tmptr = gmtime(&now);
+ } else {
+ tmptr = localtime(&now);
+ }
+ if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, log_alive_format,
+ tmptr)) {
+ strn_cpy(log_alive_buffer, sizeof(log_alive_buffer),
+ "(could not format time in 256 positions "
+ "with current format string.)");
+ }
+ log_alive_buffer[ALIVE_BUFFSIZ] = '\0';
+
+ sn_printf(buf, sizeof(buf), "\n===== %s%s\n",
+ ready?"":"ALIVE ", log_alive_buffer);
+ write_to_log(&lfd, &lognum, buf, strlen(buf));
+ }
}
/*
@@ -398,7 +616,7 @@ static void pass_on(pid_t childpid)
*/
if (FD_ISSET(mfd, &readfds)) {
#ifdef DEBUG
- erts_run_erl_log_status("Pty master read; ");
+ status("Pty master read; ");
#endif
if ((len = sf_read(mfd, buf, BUFSIZ)) <= 0) {
sf_close(rfd);
@@ -416,7 +634,7 @@ static void pass_on(pid_t childpid)
exit(0);
}
- erts_run_erl_log_write(buf, len);
+ write_to_log(&lfd, &lognum, buf, len);
/*
* Save in the output queue.
@@ -432,7 +650,7 @@ static void pass_on(pid_t childpid)
*/
if (FD_ISSET(rfd, &readfds)) {
#ifdef DEBUG
- erts_run_erl_log_status("FIFO read; ");
+ status("FIFO read; ");
#endif
if ((len = sf_read(rfd, buf, BUFSIZ)) < 0) {
sf_close(rfd);
@@ -461,7 +679,7 @@ static void pass_on(pid_t childpid)
* should succeed. But in case of error, we just ignore it.
*/
if ((wfd = sf_open(fifo1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
- erts_run_erl_log_status("Client expected on FIFO %s, but can't open (len=%d)\n",
+ status("Client expected on FIFO %s, but can't open (len=%d)\n",
fifo1, len);
sf_close(rfd);
rfd = sf_open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0);
@@ -473,7 +691,7 @@ static void pass_on(pid_t childpid)
}
else {
#ifdef DEBUG
- erts_run_erl_log_status("run_erl: %s opened for writing\n", fifo1);
+ status("run_erl: %s opened for writing\n", fifo1);
#endif
}
}
@@ -489,15 +707,14 @@ static void pass_on(pid_t childpid)
/* Write the message */
#ifdef DEBUG
- erts_run_erl_log_status("Pty master write; ");
+ status("Pty master write; ");
#endif
- len = erts_run_erl_extract_ctrl_seq(buf, len, mfd);
+ len = extract_ctrl_seq(buf, len);
if(len==1 && buf[0] == '\003') {
kill(childpid,SIGINT);
- }
- else if (len>0 && erts_run_erl_write_all(mfd, buf, len) != len)
- {
+ }
+ else if (len>0 && write_all(mfd, buf, len) != len) {
ERRNO_ERR0(LOG_ERR,"Error in writing to terminal.");
sf_close(rfd);
if(wfd) sf_close(wfd);
@@ -506,7 +723,7 @@ static void pass_on(pid_t childpid)
}
}
#ifdef DEBUG
- erts_run_erl_log_status("OK\n");
+ status("OK\n");
#endif
}
}
@@ -516,6 +733,173 @@ static void catch_sigchild(int sig)
{
}
+/*
+ * next_log:
+ * Returns the index number that follows the given index number.
+ * (Wrapping after log_generations)
+ */
+static int next_log(int log_num) {
+ return log_num>=log_generations?1:log_num+1;
+}
+
+/*
+ * prev_log:
+ * Returns the index number that precedes the given index number.
+ * (Wrapping after log_generations)
+ */
+static int prev_log(int log_num) {
+ return log_num<=1?log_generations:log_num-1;
+}
+
+/*
+ * find_next_log_num()
+ * Searches through the log directory to check which logs that already
+ * exist. It finds the "hole" in the sequence, and returns the index
+ * number for the last log in the log sequence. If there is no hole, index
+ * 1 is returned.
+ */
+static int find_next_log_num(void) {
+ int i, next_gen, log_gen;
+ DIR *dirp;
+ struct dirent *direntp;
+ int log_exists[LOG_MAX_GENERATIONS+1];
+ int stub_len = strlen(LOG_STUBNAME);
+
+ /* Initialize exiting log table */
+
+ for(i=log_generations; i>=0; i--)
+ log_exists[i] = 0;
+ dirp = opendir(log_dir);
+ if(!dirp) {
+ ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", log_dir);
+ exit(1);
+ }
+
+ /* Check the directory for existing logs */
+
+ while((direntp=readdir(dirp)) != NULL) {
+ if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) {
+ int num = atoi(direntp->d_name+stub_len);
+ if(num < 1 || num > log_generations)
+ continue;
+ log_exists[num] = 1;
+ }
+ }
+ closedir(dirp);
+
+ /* Find out the next available log file number */
+
+ next_gen = 0;
+ for(i=log_generations; i>=0; i--) {
+ if(log_exists[i])
+ if(next_gen)
+ break;
+ else
+ ;
+ else
+ next_gen = i;
+ }
+
+ /* Find out the current log file number */
+
+ if(next_gen)
+ log_gen = prev_log(next_gen);
+ else
+ log_gen = 1;
+
+ return log_gen;
+} /* find_next_log_num() */
+
+/* open_log()
+ * Opens a log file (with given index) for writing. Writing may be
+ * at the end or a trucnating write, according to flags.
+ * A LOGGING STARTED and time stamp message is inserted into the log file
+ */
+static int open_log(int log_num, int flags)
+{
+ char buf[FILENAME_MAX];
+ time_t now;
+ struct tm *tmptr;
+ char log_buffer[ALIVE_BUFFSIZ+1];
+ int lfd;
+
+ /* Remove the next log (to keep a "hole" in the log sequence) */
+ sn_printf(buf, sizeof(buf), "%s/%s%d",
+ log_dir, LOG_STUBNAME, next_log(log_num));
+ unlink(buf);
+
+ /* Create or continue on the current log file */
+ sn_printf(buf, sizeof(buf), "%s/%s%d", log_dir, LOG_STUBNAME, log_num);
+ if((lfd = sf_open(buf, flags, LOG_PERM))<0){
+ ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf);
+ exit(1);
+ }
+
+ /* Write a LOGGING STARTED and time stamp into the log file */
+ time(&now);
+ if (log_alive_in_gmt) {
+ tmptr = gmtime(&now);
+ } else {
+ tmptr = localtime(&now);
+ }
+ if (!strftime(log_buffer, ALIVE_BUFFSIZ, log_alive_format,
+ tmptr)) {
+ strn_cpy(log_buffer, sizeof(log_buffer),
+ "(could not format time in 256 positions "
+ "with current format string.)");
+ }
+ log_buffer[ALIVE_BUFFSIZ] = '\0';
+
+ sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n",
+ log_buffer);
+ if (write_all(lfd, buf, strlen(buf)) < 0)
+ status("Error in writing to log.\n");
+
+#if USE_FSYNC
+ fsync(lfd);
+#endif
+
+ return lfd;
+}
+
+/* write_to_log()
+ * Writes a message to a log file. If the current log file is full,
+ * a new log file is opened.
+ */
+static void write_to_log(int* lfd, int* log_num, char* buf, int len)
+{
+ int size;
+
+ /* Decide if new logfile needed, and open if so */
+
+ size = lseek(*lfd,0,SEEK_END);
+ if(size+len > log_maxsize) {
+ sf_close(*lfd);
+ *log_num = next_log(*log_num);
+ *lfd = open_log(*log_num, O_RDWR|O_CREAT|O_TRUNC|O_SYNC);
+ }
+
+ /* Write to log file */
+
+ if (write_all(*lfd, buf, len) < 0) {
+ status("Error in writing to log.\n");
+ }
+
+#if USE_FSYNC
+ fsync(*lfd);
+#endif
+}
+
+/* create_fifo()
+ * Creates a new fifo with the given name and permission.
+ */
+static int create_fifo(char *name, int perm)
+{
+ if ((mkfifo(name, perm) < 0) && (errno != EEXIST))
+ return -1;
+ return 0;
+}
+
/* open_pty_master()
* Find a master device, open and return fd and slave device name.
@@ -712,9 +1096,9 @@ static void exec_shell(char **argv)
else
argv[0] = sh;
argv[1] = "-c";
- erts_run_erl_log_status("Args before exec of shell:\n");
+ status("Args before exec of shell:\n");
for (vp = argv, i = 0; *vp; vp++, i++)
- erts_run_erl_log_status("argv[%d] = %s\n", i, *vp);
+ status("argv[%d] = %s\n", i, *vp);
if (stdstatus) {
fclose(stdstatus);
}
@@ -725,6 +1109,26 @@ static void exec_shell(char **argv)
ERRNO_ERR0(LOG_ERR,"Could not execv");
}
+/* status()
+ * Prints the arguments to a status file
+ * Works like printf (see vfrpintf)
+ */
+static void status(const char *format,...)
+{
+ va_list args;
+ time_t now;
+
+ if (stdstatus == NULL)
+ stdstatus = fopen(statusfile, "w");
+ if (stdstatus == NULL)
+ return;
+ now = time(NULL);
+ fprintf(stdstatus, "run_erl [%d] %s", (int)getpid(), ctime(&now));
+ va_start(args, format);
+ vfprintf(stdstatus, format, args);
+ va_end(args);
+ fflush(stdstatus);
+}
static void daemon_init(void)
/* As R Stevens wants it, to a certain extent anyway... */
@@ -764,10 +1168,47 @@ static void daemon_init(void)
run_daemon = 1;
}
+/* error_logf()
+ * Prints the arguments to stderr or syslog
+ * Works like printf (see vfprintf)
+ */
+static void error_logf(int priority, int line, const char *format, ...)
+{
+ va_list args;
+ va_start(args, format);
+
+#ifdef HAVE_SYSLOG_H
+ if (run_daemon) {
+ vsyslog(priority,format,args);
+ }
+ else
+#endif
+ {
+ time_t now = time(NULL);
+ fprintf(stderr, "run_erl:%d [%d] %s", line, (int)getpid(), ctime(&now));
+ vfprintf(stderr, format, args);
+ }
+ va_end(args);
+}
+
static void usage(char *pname)
{
- fprintf(stderr, "Usage: ");
- fprintf(stderr, RUN_ERL_USAGE, pname);
+ fprintf(stderr, "Usage: %s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"\n", pname);
+ fprintf(stderr, "\nYou may also set the environment variables RUN_ERL_LOG_GENERATIONS\n");
+ fprintf(stderr, "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n");
+ fprintf(stderr, "size of the log file when to switch to the next log file\n");
+}
+
+/* Instead of making sure basename exists, we do our own */
+static char *simple_basename(char *path)
+{
+ char *ptr;
+ for (ptr = path; *ptr != '\0'; ++ptr) {
+ if (*ptr == '/') {
+ path = ptr + 1;
+ }
+ }
+ return path;
}
static void init_outbuf(void)
@@ -838,6 +1279,114 @@ static void outbuf_append(const char* buf, int n)
outbuf_in += n;
}
+/* Call write() until entire buffer has been written or error.
+ * Return len or -1.
+ */
+static int write_all(int fd, const char* buf, int len)
+{
+ int left = len;
+ int written;
+ for (;;) {
+ written = sf_write(fd,buf,left);
+ if (written == left) {
+ return len;
+ }
+ if (written < 0) {
+ return -1;
+ }
+ left -= written;
+ buf += written;
+ }
+}
+
+static ssize_t sf_read(int fd, void *buffer, size_t len) {
+ ssize_t n = 0;
+
+ do { n = read(fd, buffer, len); } while (n < 0 && errno == EINTR);
+
+ return n;
+}
+
+static ssize_t sf_write(int fd, const void *buffer, size_t len) {
+ ssize_t n = 0;
+
+ do { n = write(fd, buffer, len); } while (n < 0 && errno == EINTR);
+
+ return n;
+}
+
+static int sf_open(const char *path, int type, mode_t mode) {
+ int fd = 0;
+
+ do { fd = open(path, type, mode); } while(fd < 0 && errno == EINTR);
+
+ return fd;
+}
+static int sf_close(int fd) {
+ int res = 0;
+
+ do { res = close(fd); } while(fd < 0 && errno == EINTR);
+
+ return res;
+}
+/* Extract any control sequences that are ment only for run_erl
+ * and should not be forwarded to the pty.
+ */
+static int extract_ctrl_seq(char* buf, int len)
+{
+ static const char prefix[] = "\033_";
+ static const char suffix[] = "\033\\";
+ char* bufend = buf + len;
+ char* start = buf;
+ char* command;
+ char* end;
+
+ for (;;) {
+ start = find_str(start, bufend-start, prefix);
+ if (!start) break;
+
+ command = start + strlen(prefix);
+ end = find_str(command, bufend-command, suffix);
+ if (end) {
+ unsigned col, row;
+ if (sscanf(command,"version=%u", &protocol_ver)==1) {
+ /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/
+ }
+ else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) {
+ set_window_size(col,row);
+ }
+ else {
+ ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n",
+ (int)(end-command), command);
+ }
+
+ /* Remove ctrl sequence from buf */
+ end += strlen(suffix);
+ memmove(start, end, bufend-end);
+ bufend -= end - start;
+ }
+ else {
+ ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n",
+ (int)(bufend-start), start);
+ break;
+ }
+ }
+ return bufend - buf;
+}
+
+static void set_window_size(unsigned col, unsigned row)
+{
+#ifdef TIOCSWINSZ
+ struct winsize ws;
+ ws.ws_col = col;
+ ws.ws_row = row;
+ if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) {
+ ERRNO_ERR0(LOG_ERR,"Failed to set window size");
+ }
+#endif
+}
+
+
#ifdef DEBUG
#define S(x) ((x) > 0 ? 1 : 0)
diff --git a/erts/etc/common/run_erl_vsn.h b/erts/etc/unix/run_erl.h
index 2c3e67e81c..cc70a98e52 100644
--- a/erts/etc/common/run_erl_vsn.h
+++ b/erts/etc/unix/run_erl.h
@@ -1,8 +1,8 @@
/*
* %CopyrightBegin%
- *
+ *
* Copyright Ericsson AB 2008-2009. All Rights Reserved.
- *
+ *
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
@@ -14,7 +14,7 @@
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
- *
+ *
* %CopyrightEnd%
*/
@@ -28,3 +28,4 @@
* 0: Older, without version handshake
* 1: R12B-3, version handshake + window size ctrl
*/
+
diff --git a/erts/etc/common/safe_string.c b/erts/etc/unix/safe_string.c
index cdcdbf16f0..a5c11d41d8 100644
--- a/erts/etc/common/safe_string.c
+++ b/erts/etc/unix/safe_string.c
@@ -1,8 +1,8 @@
/*
* %CopyrightBegin%
- *
+ *
* Copyright Ericsson AB 2008-2009. All Rights Reserved.
- *
+ *
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
@@ -14,12 +14,12 @@
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
- *
+ *
* %CopyrightEnd%
*/
-/*
+/*
* Module: safe_string.c
- *
+ *
* This is a bunch of generic string operation
* that are safe regarding buffer overflow.
*
@@ -121,3 +121,4 @@ void* memmove(void *dest, const void *src, size_t n)
return dest;
}
#endif /* HAVE_MEMMOVE */
+
diff --git a/erts/etc/common/safe_string.h b/erts/etc/unix/safe_string.h
index f9d2b2023a..5a471f10de 100644
--- a/erts/etc/common/safe_string.h
+++ b/erts/etc/unix/safe_string.h
@@ -1,8 +1,8 @@
/*
* %CopyrightBegin%
- *
+ *
* Copyright Ericsson AB 2008-2009. All Rights Reserved.
- *
+ *
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
@@ -14,12 +14,12 @@
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
- *
+ *
* %CopyrightEnd%
*/
-/*
+/*
* Module: safe_string.h
- *
+ *
* This is an interface to a bunch of generic string operation
* that are safe regarding buffer overflow.
*
@@ -63,3 +63,4 @@ char* find_str(const char* haystack, int size, const char* needle);
#ifndef HAVE_MEMMOVE
void* memmove(void *dest, const void *src, size_t n);
#endif
+
diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c
index 82d3218964..0bd469727c 100644
--- a/erts/etc/unix/to_erl.c
+++ b/erts/etc/unix/to_erl.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2015. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -17,9 +17,592 @@
*
* %CopyrightEnd%
*/
+/*
+ * Module: to_erl.c
+ *
+ * This module implements a process that opens two specified FIFOs, one
+ * for reading and one for writing; reads from its stdin, and writes what
+ * it has read to the write FIF0; reads from the read FIFO, and writes to
+ * its stdout.
+ *
+ ________ _________
+ | |--<-- pipe.r (fifo1) --<--| |
+ | to_erl | | run_erl | (parent)
+ |________|-->-- pipe.w (fifo2) -->--|_________|
+ ^ master pty
+ |
+ | slave pty
+ ____V____
+ | |
+ | "erl" | (child)
+ |_________|
+ */
+#ifdef HAVE_CONFIG_H
+# include "config.h"
+#endif
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <sys/types.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <termios.h>
+#include <dirent.h>
+#include <signal.h>
+#include <errno.h>
+#ifdef HAVE_SYS_IOCTL_H
+# include <sys/ioctl.h>
+#endif
+
+#include "run_erl.h"
+#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */
+
+#if defined(O_NONBLOCK)
+# define DONT_BLOCK_PLEASE O_NONBLOCK
+#else
+# define DONT_BLOCK_PLEASE O_NDELAY
+# if !defined(EAGAIN)
+# define EAGAIN -3898734
+# endif
+#endif
+
+#ifdef HAVE_STRERROR
+# define STRERROR(x) strerror(x)
+#else
+# define STRERROR(x) ""
+#endif
+
+#define noDEBUG
+
+#define PIPE_DIR "/tmp/"
+#define PIPE_STUBNAME "erlang.pipe"
+#define PIPE_STUBLEN strlen(PIPE_STUBNAME)
+
+#ifdef DEBUG
+#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); }
+#else
+#define STATUS(s)
+#endif
+
+#ifndef FILENAME_MAX
+#define FILENAME_MAX 250
+#endif
+
+static struct termios tty_smode, tty_rmode;
+static int tty_eof = 0;
+static int recv_sig = 0;
+static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */
+
+static int write_all(int fd, const char* buf, int len);
+static int window_size_seq(char* buf, size_t bufsz);
+static int version_handshake(char* buf, int len, int wfd);
+#ifdef DEBUG
+static void show_terminal_settings(struct termios *);
+#endif
+
+static void handle_ctrlc(int sig)
+{
+ /* Reinstall the handler, and signal break flag */
+ signal(SIGINT,handle_ctrlc);
+ recv_sig = SIGINT;
+}
+
+static void handle_sigwinch(int sig)
+{
+ recv_sig = SIGWINCH;
+}
+
+static void usage(char *pname)
+{
+ fprintf(stderr, "Usage: %s [-h|-F] [pipe_name|pipe_dir/]\n", pname);
+ fprintf(stderr, "\t-h\tThis help text.\n");
+ fprintf(stderr, "\t-F\tForce connection even though pipe is locked by other to_erl process.\n");
+}
+
+int main(int argc, char **argv)
+{
+ char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX];
+ int i, len, wfd, rfd;
+ fd_set readfds;
+ char buf[BUFSIZ];
+ char pipename[FILENAME_MAX];
+ int pipeIx = 1;
+ int force_lock = 0;
+ int got_some = 0;
+
+ if (argc >= 2 && argv[1][0]=='-') {
+ switch (argv[1][1]) {
+ case 'h':
+ usage(argv[0]);
+ exit(1);
+ case 'F':
+ force_lock = 1;
+ break;
+ default:
+ fprintf(stderr,"Invalid option '%s'\n",argv[1]);
+ exit(1);
+ }
+ pipeIx = 2;
+ }
+
+#ifdef DEBUG
+ fprintf(stderr, "%s: pid is : %d\n", argv[0], (int)getpid());
+#endif
+
+ strn_cpy(pipename, sizeof(pipename),
+ (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR));
+
+ if(*pipename && pipename[strlen(pipename)-1] == '/') {
+ /* The user wishes us to find a pipe name in the specified */
+ /* directory */
+ int highest_pipe_num = 0;
+ DIR *dirp;
+ struct dirent *direntp;
+
+ dirp = opendir(pipename);
+ if(!dirp) {
+ fprintf(stderr, "Can't access pipe directory %s: %s\n", pipename, strerror(errno));
+ exit(1);
+ }
+
+ /* Check the directory for existing pipes */
+
+ while((direntp=readdir(dirp)) != NULL) {
+ if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) {
+ int num = atoi(direntp->d_name+PIPE_STUBLEN+1);
+ if(num > highest_pipe_num)
+ highest_pipe_num = num;
+ }
+ }
+ closedir(dirp);
+ strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"),
+ PIPE_STUBNAME, highest_pipe_num);
+ } /* if */
+
+ /* read FIFO */
+ sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename);
+ /* write FIFO */
+ sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename);
+
+ /* Check that nobody is running to_erl on this pipe already */
+ if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) {
+ /* Open as server succeeded -- to_erl is already running! */
+ close(wfd);
+ fprintf(stderr, "Another to_erl process already attached to pipe "
+ "%s.\n", pipename);
+ if (force_lock) {
+ fprintf(stderr, "But we proceed anyway by force (-F).\n");
+ }
+ else {
+ exit(1);
+ }
+ }
+
+ if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
+#ifdef DEBUG
+ fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1);
+#endif
+ fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno));
+ exit(1);
+ }
+#ifdef DEBUG
+ fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1);
+#endif
+
+ if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) {
+#ifdef DEBUG
+ fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2);
+#endif
+ fprintf(stderr, "No running Erlang on pipe %s: %s\n", pipename, strerror(errno));
+ close(rfd);
+ exit(1);
+ }
+#ifdef DEBUG
+ fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2);
+#endif
+
+ fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename);
+
+ /* Set break handler to our handler */
+ signal(SIGINT,handle_ctrlc);
+
+ /*
+ * Save the current state of the terminal, and set raw mode.
+ */
+ if (tcgetattr(0, &tty_rmode) , 0) {
+ fprintf(stderr, "Cannot get terminals current mode\n");
+ exit(-1);
+ }
+ tty_smode = tty_rmode;
+ tty_eof = '\004'; /* Ctrl+D to exit */
+#ifdef DEBUG
+ show_terminal_settings(&tty_rmode);
+#endif
+ tty_smode.c_iflag =
+ 1*BRKINT |/*Signal interrupt on break.*/
+ 1*IGNPAR |/*Ignore characters with parity errors.*/
+ 1*ISTRIP |/*Strip character.*/
+ 0;
+
+#if 0
+0*IGNBRK |/*Ignore break condition.*/
+0*PARMRK |/*Mark parity errors.*/
+0*INPCK |/*Enable input parity check.*/
+0*INLCR |/*Map NL to CR on input.*/
+0*IGNCR |/*Ignore CR.*/
+0*ICRNL |/*Map CR to NL on input.*/
+0*IUCLC |/*Map upper-case to lower-case on input.*/
+0*IXON |/*Enable start/stop output control.*/
+0*IXANY |/*Enable any character to restart output.*/
+0*IXOFF |/*Enable start/stop input control.*/
+0*IMAXBEL|/*Echo BEL on input line too long.*/
+#endif
+
+ tty_smode.c_oflag =
+ 1*OPOST |/*Post-process output.*/
+ 1*ONLCR |/*Map NL to CR-NL on output.*/
+#ifdef XTABS
+ 1*XTABS |/*Expand tabs to spaces. (Linux)*/
+#endif
+#ifdef OXTABS
+ 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/
+#endif
+#ifdef NL0
+ 1*NL0 |/*Select newline delays*/
+#endif
+#ifdef CR0
+ 1*CR0 |/*Select carriage-return delays*/
+#endif
+#ifdef TAB0
+ 1*TAB0 |/*Select horizontal tab delays*/
+#endif
+#ifdef BS0
+ 1*BS0 |/*Select backspace delays*/
+#endif
+#ifdef VT0
+ 1*VT0 |/*Select vertical tab delays*/
+#endif
+#ifdef FF0
+ 1*FF0 |/*Select form feed delays*/
+#endif
+ 0;
+
+#if 0
+0*OLCUC |/*Map lower case to upper on output.*/
+0*OCRNL |/*Map CR to NL on output.*/
+0*ONOCR |/*No CR output at column 0.*/
+0*ONLRET |/*NL performs CR function.*/
+0*OFILL |/*Use fill characters for delay.*/
+0*OFDEL |/*Fill is DEL, else NULL.*/
+0*NL1 |
+0*CR1 |
+0*CR2 |
+0*CR3 |
+0*TAB1 |
+0*TAB2 |
+0*TAB3 |/*Expand tabs to spaces.*/
+0*BS1 |
+0*VT1 |
+0*FF1 |
+#endif
+
+ /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */
+ /* advisable if this is a *real* terminal, such as the console. In fact */
+ /* this may hang the entire machine, deep, deep down (signalling break */
+ /* or toggling the abort switch doesn't help) */
+
+ tty_smode.c_lflag =
+ 0;
+
+#if 0
+0*ISIG |/*Enable signals.*/
+0*ICANON |/*Canonical input (erase and kill processing).*/
+0*XCASE |/*Canonical upper/lower presentation.*/
+0*ECHO |/*Enable echo.*/
+0*ECHOE |/*Echo erase character as BS-SP-BS.*/
+0*ECHOK |/*Echo NL after kill character.*/
+0*ECHONL |/*Echo NL.*/
+0*NOFLSH |/*Disable flush after interrupt or quit.*/
+0*TOSTOP |/*Send SIGTTOU for background output.*/
+0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/
+0*ECHOPRT|/*Echo erase character as character erased.*/
+0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/
+0*FLUSHO |/*Output is being flushed.*/
+0*PENDIN |/*Retype pending input at next read or input character.*/
+0*IEXTEN |/*Enable extended (implementation-defined) functions.*/
+#endif
+
+ tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */
+ tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */
+ tty_smode.c_cc[VINTR] =3;
+
+ tcsetattr(0, TCSADRAIN, &tty_smode);
+
+#ifdef DEBUG
+ show_terminal_settings(&tty_smode);
+#endif
+ /*
+ * "Write a ^L to the FIFO which causes the other end to redisplay
+ * the input line."
+ * This does not seem to work as was intended in old comment above.
+ * However, this control character is now (R12B-3) used by run_erl
+ * to trigger the version handshaking between to_erl and run_erl
+ * at the start of every new to_erl-session.
+ */
+
+ if (write(wfd, "\014", 1) < 0) {
+ fprintf(stderr, "Error in writing ^L to FIFO.\n");
+ }
+
+ /*
+ * read and write
+ */
+ while (1) {
+ FD_ZERO(&readfds);
+ FD_SET(0, &readfds);
+ FD_SET(rfd, &readfds);
+ if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) {
+ if (recv_sig) {
+ FD_ZERO(&readfds);
+ }
+ else {
+ fprintf(stderr, "Error in select.\n");
+ break;
+ }
+ }
+ len = 0;
+
+ /*
+ * Read from terminal and write to FIFO
+ */
+ if (recv_sig) {
+ switch (recv_sig) {
+ case SIGINT:
+ fprintf(stderr, "[Break]\n\r");
+ buf[0] = '\003';
+ len = 1;
+ break;
+ case SIGWINCH:
+ len = window_size_seq(buf,sizeof(buf));
+ break;
+ default:
+ fprintf(stderr,"Unexpected signal: %u\n",recv_sig);
+ }
+ recv_sig = 0;
+ }
+ else if (FD_ISSET(0, &readfds)) {
+ len = read(0, buf, sizeof(buf));
+ if (len <= 0) {
+ close(rfd);
+ close(wfd);
+ if (len < 0) {
+ fprintf(stderr, "Error in reading from stdin.\n");
+ } else {
+ fprintf(stderr, "[EOF]\n\r");
+ }
+ break;
+ }
+ /* check if there is an eof character in input */
+ for (i = 0; i < len && buf[i] != tty_eof; i++);
+ if (buf[i] == tty_eof) {
+ fprintf(stderr, "[Quit]\n\r");
+ break;
+ }
+ }
+
+ if (len) {
+#ifdef DEBUG
+ if(write(1, buf, len));
+#endif
+ if (write_all(wfd, buf, len) != len) {
+ fprintf(stderr, "Error in writing to FIFO.\n");
+ close(rfd);
+ close(wfd);
+ break;
+ }
+ STATUS("\" OK\r\n");
+ }
+
+ /*
+ * Read from FIFO, write to terminal.
+ */
+ if (FD_ISSET(rfd, &readfds)) {
+ STATUS("FIFO read: ");
+ len = read(rfd, buf, BUFSIZ);
+ if (len < 0 && errno == EAGAIN) {
+ /*
+ * No data this time, but the writing end of the FIFO is still open.
+ * Do nothing.
+ */
+ ;
+ } else if (len <= 0) {
+ /*
+ * Either an error or end of file. In either case, break out
+ * of the loop.
+ */
+ close(rfd);
+ close(wfd);
+ if (len < 0) {
+ fprintf(stderr, "Error in reading from FIFO.\n");
+ } else
+ fprintf(stderr, "[End]\n\r");
+ break;
+ } else {
+ if (!got_some) {
+ if ((len=version_handshake(buf,len,wfd)) < 0) {
+ close(rfd);
+ close(wfd);
+ break;
+ }
+ if (protocol_ver >= 1) {
+ /* Tell run_erl size of terminal window */
+ signal(SIGWINCH, handle_sigwinch);
+ raise(SIGWINCH);
+ }
+ got_some = 1;
+ }
+
+ /*
+ * We successfully read at least one character. Write what we got.
+ */
+ STATUS("Terminal write: \"");
+ if (write_all(1, buf, len) != len) {
+ fprintf(stderr, "Error in writing to terminal.\n");
+ close(rfd);
+ close(wfd);
+ break;
+ }
+ STATUS("\" OK\r\n");
+ }
+ }
+ }
+
+ /*
+ * Reset terminal characterstics
+ * XXX
+ */
+ tcsetattr(0, TCSADRAIN, &tty_rmode);
+ return 0;
+}
+
+/* Call write() until entire buffer has been written or error.
+ * Return len or -1.
+ */
+static int write_all(int fd, const char* buf, int len)
+{
+ int left = len;
+ int written;
+ while (left) {
+ written = write(fd,buf,left);
+ if (written < 0) {
+ return -1;
+ }
+ left -= written;
+ buf += written;
+ }
+ return len;
+}
+
+static int window_size_seq(char* buf, size_t bufsz)
+{
+#ifdef TIOCGWINSZ
+ struct winsize ws;
+ static const char prefix[] = "\033_";
+ static const char suffix[] = "\033\\";
+ /* This Esc sequence is called "Application Program Command"
+ and seems suitable to use for our own customized stuff. */
+
+ if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) {
+ int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s",
+ prefix, ws.ws_col, ws.ws_row, suffix);
+ return len;
+ }
+#endif /* TIOCGWINSZ */
+ return 0;
+}
+
+/* to_erl run_erl
+ * | |
+ * |---------- '\014' -------->| (session start)
+ * | |
+ * |<---- "[run_erl v1-0]" ----| (version interval)
+ * | |
+ * |--- Esc_"version=1"Esc\ -->| (common version)
+ * | |
+ */
+static int version_handshake(char* buf, int len, int wfd)
+{
+ unsigned re_high=0, re_low;
+ char *end = find_str(buf,len,"]\n");
+
+ if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) {
+ char wbuf[30];
+ int wlen;
+
+ if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) {
+ fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n",
+ RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low);
+ return -1;
+ }
+ /* Choose highest common version */
+ protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER;
+
+ wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\",
+ protocol_ver);
+ if (write_all(wfd, wbuf, wlen) < 0) {
+ fprintf(stderr,"Failed to send version handshake\n");
+ return -1;
+ }
+ end += 2;
+ len -= (end-buf);
+ memmove(buf,end,len);
+
+ }
+ else { /* we assume old run_erl without version handshake */
+ protocol_ver = 0;
+ }
+
+ if (re_high != RUN_ERL_HI_VER) {
+ fprintf(stderr,"run_erl has different version, "
+ "using common protocol level %u\n", protocol_ver);
+ }
+
+ return len;
+}
+
-#include "to_erl_common.h"
+#ifdef DEBUG
+#define S(x) ((x) > 0 ? 1 : 0)
-int main(int argc,char **argv) {
- return to_erl(argc,argv);
+static void show_terminal_settings(struct termios *t)
+{
+ fprintf(stderr,"c_iflag:\n");
+ fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT));
+ fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL));
+ fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK));
+ fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR));
+ fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR));
+ fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR));
+ fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK));
+ fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP));
+ fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF));
+ fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON));
+ fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK));
+ fprintf(stderr,"\n");
+ fprintf(stderr,"c_oflag:\n");
+ fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST));
+ fprintf(stderr,"\n");
+ fprintf(stderr,"c_cflag:\n");
+ fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL));
+ fprintf(stderr,"\n");
+ fprintf(stderr,"c_local:\n");
+ fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO));
+ fprintf(stderr,"\n");
+ fprintf(stderr,"c_cc:\n");
+ fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]);
}
+#endif
diff --git a/erts/etc/win32/cygwin_tools/vc/cc.sh b/erts/etc/win32/cygwin_tools/vc/cc.sh
index 48a579d5f0..651b6e098d 100755
--- a/erts/etc/win32/cygwin_tools/vc/cc.sh
+++ b/erts/etc/win32/cygwin_tools/vc/cc.sh
@@ -267,7 +267,7 @@ for x in $SOURCES; do
echo
echo
after_sed=`date '+%s'`
- echo Made dependencises for $x':' `expr $after_sed '-' $start_time` 's' >&2
+ echo Made dependencies for $x':' `expr $after_sed '-' $start_time` 's' >&2
fi
else
cat $MSG_FILE
diff --git a/erts/etc/win32/msys_tools/vc/cc.sh b/erts/etc/win32/msys_tools/vc/cc.sh
index ac89aac34e..72005862ed 100644
--- a/erts/etc/win32/msys_tools/vc/cc.sh
+++ b/erts/etc/win32/msys_tools/vc/cc.sh
@@ -268,7 +268,7 @@ for x in $SOURCES; do
echo
echo
after_sed=`date '+%s'`
- echo Made dependencises for $x':' `expr $after_sed '-' $start_time` 's' >&2
+ echo Made dependencies for $x':' `expr $after_sed '-' $start_time` 's' >&2
fi
else
cat $MSG_FILE
diff --git a/erts/include/erl_int_sizes_config.h.in b/erts/include/erl_int_sizes_config.h.in
index b18f5ebc00..88c74cdeff 100644
--- a/erts/include/erl_int_sizes_config.h.in
+++ b/erts/include/erl_int_sizes_config.h.in
@@ -35,6 +35,3 @@
/* The size of a pointer. */
#undef SIZEOF_VOID_P
-
-/* Define if building a halfword-heap 64bit emulator (needed for NIF's) */
-#undef HALFWORD_HEAP_EMULATOR
diff --git a/erts/include/internal/erl_printf_format.h b/erts/include/internal/erl_printf_format.h
index efd926be99..953022017a 100644
--- a/erts/include/internal/erl_printf_format.h
+++ b/erts/include/internal/erl_printf_format.h
@@ -44,7 +44,6 @@ typedef long long ErlPfSWord;
#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint'
#endif
-
typedef int (*fmtfn_t)(void*, char*, size_t);
extern int erts_printf_format(fmtfn_t, void*, char*, va_list);
@@ -57,17 +56,9 @@ extern int erts_printf_uword(fmtfn_t, void*, char, int, int, ErlPfUWord);
extern int erts_printf_sword(fmtfn_t, void*, char, int, int, ErlPfSWord);
extern int erts_printf_double(fmtfn_t, void *, char, int, int, double);
-#ifdef HALFWORD_HEAP_EMULATOR
-# if SIZEOF_INT != 4
-# error Unsupported integer size for HALFWORD_HEAP_EMULATOR
-# endif
-typedef unsigned int ErlPfEterm;
-#else
typedef ErlPfUWord ErlPfEterm;
-#endif
-
-extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*);
+extern int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long);
#endif /* ERL_PRINTF_FORMAT_H__ */
diff --git a/erts/include/internal/ethr_internal.h b/erts/include/internal/ethr_internal.h
index d4ded6ff05..693b34df61 100644
--- a/erts/include/internal/ethr_internal.h
+++ b/erts/include/internal/ethr_internal.h
@@ -92,7 +92,6 @@ void ethr_run_exit_handlers__(void);
void ethr_ts_event_destructor__(void *vtsep);
#if defined(ETHR_X86_RUNTIME_CONF__)
-int ethr_x86_have_cpuid__(void);
void ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx);
#endif
diff --git a/erts/include/internal/ethr_mutex.h b/erts/include/internal/ethr_mutex.h
index f76c4262ca..b402a139f5 100644
--- a/erts/include/internal/ethr_mutex.h
+++ b/erts/include/internal/ethr_mutex.h
@@ -98,7 +98,7 @@ void LeaveCriticalSection(CRITICAL_SECTION *);
#if 0
# define ETHR_MTX_Q_LOCK_SPINLOCK__
# define ETHR_MTX_QLOCK_TYPE__ ethr_spinlock_t
-#elif defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)
+#elif defined(ETHR_PTHREADS)
# define ETHR_MTX_Q_LOCK_PTHREAD_MUTEX__
# define ETHR_MTX_QLOCK_TYPE__ pthread_mutex_t
#elif defined(ETHR_WIN32_THREADS)
@@ -211,7 +211,7 @@ struct ethr_cond_ {
#endif
};
-#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
typedef struct ethr_mutex_ ethr_mutex;
struct ethr_mutex_ {
@@ -355,7 +355,7 @@ void ethr_rwmutex_rwunlock(ethr_rwmutex *);
#ifdef ETHR_MTX_HARD_DEBUG
#define ETHR_MTX_HARD_ASSERT(A) \
- ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, __func__,#A)))
+ ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, __func__, #A)))
#else
#define ETHR_MTX_HARD_ASSERT(A) ((void) 1)
#endif
@@ -634,7 +634,7 @@ ETHR_INLINE_MTX_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx)
#endif /* ETHR_TRY_INLINE_FUNCS */
-#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_MUTEX_IMPL__)
diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h
index f9c203e97c..e5c5cdfa33 100644
--- a/erts/include/internal/ethread.h
+++ b/erts/include/internal/ethread.h
@@ -54,7 +54,8 @@
#endif
#if defined(ETHR_DEBUG) || !defined(ETHR_INLINE) || ETHR_XCHK \
- || (defined(__GNUC__) && defined(ERTS_MIXED_CYGWIN_VC))
+ || (defined(__GNUC__) && defined(ERTS_MIXED_CYGWIN_VC)) \
+ || (defined(__GNUC__) && defined(ERTS_MIXED_MSYS_VC))
# undef ETHR_INLINE
# define ETHR_INLINE
# undef ETHR_FORCE_INLINE
@@ -193,28 +194,6 @@ typedef DWORD ethr_tsd_key;
#define ETHR_YIELD() (Sleep(0), 0)
-#elif defined(ETHR_OSE_THREADS)
-
-#include "ose.h"
-#undef NIL
-
-#if defined(ETHR_HAVE_PTHREAD_H)
-#include <pthread.h>
-#endif
-
-typedef struct {
- PROCESS id;
- unsigned int tsd_key_index;
- void *res;
-} ethr_tid;
-
-typedef OSPPDKEY ethr_tsd_key;
-
-#undef ETHR_HAVE_ETHR_SIG_FUNCS
-
-/* Out own RW mutexes are probably faster, but use OSEs mutexes */
-#define ETHR_USE_OWN_RWMTX_IMPL__
-
#else /* No supported thread lib found */
#ifdef ETHR_NO_SUPP_THR_LIB_NOT_FATAL
@@ -295,14 +274,40 @@ ETHR_PROTO_NORETURN__ ethr_fatal_error__(const char *file,
|| (defined(_MSC_VER) && (defined(_M_IX86) || defined(_M_AMD64))))
# define ETHR_X86_RUNTIME_CONF__
-# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \
- (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg != 0, 1))
-# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \
- (__builtin_expect(ethr_runtime__.conf.have_dw_cmpxchg == 0, 0))
-# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \
- (__builtin_expect(ethr_runtime__.conf.have_sse2 != 0, 1))
-# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \
- (__builtin_expect(ethr_runtime__.conf.have_sse2 == 0, 0))
+# define ETHR_X86_RUNTIME_CONF_HAVE_META(feature) \
+ (__builtin_expect(ethr_runtime__.conf.have_##feature != 0, 1))
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_META(feature) \
+ (__builtin_expect(ethr_runtime__.conf.have_##feature == 0, 0))
+
+# define ETHR_X86_RUNTIME_CONF_HAVE_DW_CMPXCHG__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(dw_cmpxchg)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_DW_CMPXCHG__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(dw_cmpxchg)
+# define ETHR_X86_RUNTIME_CONF_HAVE_SSE2__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(sse2)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_SSE2__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(sse2)
+# define ETHR_X86_RUNTIME_CONF_HAVE_RDTSCP__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(rdtscp)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_RDTSCP__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(rdtscp)
+# define ETHR_X86_RUNTIME_CONF_HAVE_CONSTANT_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(constant_tsc)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_CONSTANT_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc)
+# define ETHR_X86_RUNTIME_CONF_HAVE_TSC_RELIABLE__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(tsc_reliable)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_TSC_RELIABLE_TSC__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(tsc_reliable)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NONSTOP_TSC_S3__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_META(nonstop_tsc_s3)
+# define ETHR_X86_RUNTIME_CONF_HAVE_NO_NONSTOP_TSC_S3__ \
+ ETHR_X86_RUNTIME_CONF_HAVE_NO_META(nonstop_tsc_s3)
+
#endif
#if (defined(__GNUC__) \
@@ -321,6 +326,11 @@ typedef struct {
#if defined(ETHR_X86_RUNTIME_CONF__)
int have_dw_cmpxchg;
int have_sse2;
+ int have_rdtscp;
+ int have_constant_tsc;
+ int have_tsc_reliable;
+ int have_nonstop_tsc;
+ int have_nonstop_tsc_s3;
#endif
#if defined(ETHR_PPC_RUNTIME_CONF__)
int have_lwsync;
@@ -382,19 +392,7 @@ extern ethr_runtime_t ethr_runtime__;
#include "ethr_atomics.h" /* The atomics API */
-#if defined (ETHR_OSE_THREADS)
-static ETHR_INLINE void
-ose_yield(void)
-{
- if (get_ptype(current_process()) == OS_PRI_PROC) {
- set_pri(get_pri(current_process()));
- } else {
- delay(1);
- }
-}
-#endif
-
-#if defined(__GNUC__) && !defined(ETHR_OSE_THREADS)
+#if defined(__GNUC__)
# ifndef ETHR_SPIN_BODY
# if defined(__i386__) || defined(__x86_64__)
# define ETHR_SPIN_BODY __asm__ __volatile__("rep;nop" : : : "memory")
@@ -410,20 +408,9 @@ ose_yield(void)
# ifndef ETHR_SPIN_BODY
# define ETHR_SPIN_BODY do {YieldProcessor();ETHR_COMPILER_BARRIER;} while(0)
# endif
-#elif defined(ETHR_OSE_THREADS)
-# ifndef ETHR_SPIN_BODY
-# define ETHR_SPIN_BODY ose_yield()
-# else
-# error "OSE should use ose_yield()"
-# endif
#endif
-#ifndef ETHR_OSE_THREADS
#define ETHR_YIELD_AFTER_BUSY_LOOPS 50
-#else
-#define ETHR_YIELD_AFTER_BUSY_LOOPS 0
-#endif
-
#ifndef ETHR_SPIN_BODY
# define ETHR_SPIN_BODY ETHR_COMPILER_BARRIER
@@ -446,18 +433,13 @@ ose_yield(void)
# else
# define ETHR_YIELD() (pthread_yield(), 0)
# endif
-# elif defined(ETHR_OSE_THREADS)
-# define ETHR_YIELD() (ose_yield(), 0)
# else
# define ETHR_YIELD() (ethr_compiler_barrier(), 0)
# endif
#endif
-#if defined(VALGRIND) || defined(ETHR_OSE_THREADS)
-/* mutex as fallback for spinlock for VALGRIND and OSE.
- OSE cannot use spinlocks as processes working on the
- same execution unit have a tendency to deadlock.
- */
+#if defined(VALGRIND)
+/* mutex as fallback for spinlock for VALGRIND. */
# undef ETHR_HAVE_NATIVE_SPINLOCKS
# undef ETHR_HAVE_NATIVE_RWSPINLOCKS
#else
@@ -504,16 +486,9 @@ typedef struct {
int detached; /* boolean (default false) */
int suggested_stack_size; /* kilo words (default sys dependent) */
char *name; /* max 14 char long (default no-name) */
-#ifdef ETHR_OSE_THREADS
- U32 coreNo;
-#endif
} ethr_thr_opts;
-#if defined(ETHR_OSE_THREADS)
-#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL, 0}
-#else
#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1, NULL}
-#endif
#if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_AUX_IMPL__)
# define ETHR_NEED_SPINLOCK_PROTOTYPES__
@@ -627,8 +602,6 @@ typedef struct ethr_ts_event_ ethr_ts_event; /* Needed by ethr_mutex.h */
# include "win/ethr_event.h"
#elif defined(ETHR_PTHREADS)
# include "pthread/ethr_event.h"
-#elif defined(ETHR_OSE_THREADS)
-# include "ose/ethr_event.h"
#endif
int ethr_set_main_thr_status(int, int);
@@ -718,37 +691,6 @@ ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep)
#endif
-#elif defined (ETHR_OSE_THREADS)
-
-#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHREAD_IMPL__)
-
-extern ethr_tsd_key ethr_ts_event_key__;
-
-static ETHR_INLINE ethr_ts_event *
-ETHR_INLINE_FUNC_NAME_(ethr_get_ts_event)(void)
-{
- ethr_ts_event *tsep = *(ethr_ts_event**)ose_get_ppdata(ethr_ts_event_key__);
- if (!tsep) {
- int res = ethr_get_tmp_ts_event__(&tsep);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- ETHR_ASSERT(tsep);
- }
- return tsep;
-}
-
-static ETHR_INLINE void
-ETHR_INLINE_FUNC_NAME_(ethr_leave_ts_event)(ethr_ts_event *tsep)
-{
- if (tsep->iflgs & ETHR_TS_EV_TMP) {
- int res = ethr_free_ts_event__(tsep);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
-}
-
-#endif
-
#endif
#include "ethr_mutex.h" /* Need atomic declarations and tse */
diff --git a/erts/include/internal/ethread_header_config.h.in b/erts/include/internal/ethread_header_config.h.in
index 9cabd0591a..f4b08cfced 100644
--- a/erts/include/internal/ethread_header_config.h.in
+++ b/erts/include/internal/ethread_header_config.h.in
@@ -166,6 +166,10 @@
/* Define if you use a gcc that supports the double word cmpxchg instruction */
#undef ETHR_GCC_HAVE_DW_CMPXCHG_ASM_SUPPORT
+/* Define if gcc wont let you clobber ebx with cmpxchg8b and position
+ independent code */
+#undef ETHR_CMPXCHG8B_PIC_NO_CLOBBER_EBX
+
/* Define if you get a register shortage with cmpxchg8b and position independent code */
#undef ETHR_CMPXCHG8B_REGISTER_SHORTAGE
diff --git a/erts/include/internal/i386/ethr_dw_atomic.h b/erts/include/internal/i386/ethr_dw_atomic.h
index e8c4119ef0..5444a6345c 100644
--- a/erts/include/internal/i386/ethr_dw_atomic.h
+++ b/erts/include/internal/i386/ethr_dw_atomic.h
@@ -115,13 +115,19 @@ ethr_native_dw_atomic_addr(ethr_native_dw_atomic_t *var)
return (ethr_sint_t *) ETHR_DW_NATMC_MEM__(var);
}
-#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__
+#if defined(ETHR_CMPXCHG8B_PIC_NO_CLOBBER_EBX) && defined(__PIC__) && __PIC__
+#if ETHR_SIZEOF_PTR != 4
+# error unexpected pic issue
+#endif
/*
* When position independent code is used in 32-bit mode, the EBX register
- * is used for storage of global offset table address, and we may not
- * use it as input or output in an asm. We need to save and restore the
- * EBX register explicitly (for some reason gcc doesn't provide this
- * service to us).
+ * is used for storage of global offset table address. When compiling with
+ * an old gcc (< vsn 5) we may not use it as input or output in an inline
+ * asm. We then need to save and restore the EBX register explicitly (for
+ * some reason old gcc compilers didn't provide this service to us).
+ * ETHR_CMPXCHG8B_PIC_NO_CLOBBER_EBX will be defined if we need to
+ * explicitly manage EBX ourselves.
+ *
*/
# define ETHR_NO_CLOBBER_EBX__ 1
#else
@@ -151,36 +157,53 @@ ethr_native_dw_atomic_cmpxchg_mb(ethr_native_dw_atomic_t *var,
ETHR_DW_DBG_ALIGNED__(p);
+#if ETHR_NO_CLOBBER_EBX__ && ETHR_CMPXCHG8B_REGISTER_SHORTAGE
+ /*
+ * gcc wont let us use ebx as input and we
+ * get a register shortage
+ */
+
__asm__ __volatile__(
-#if ETHR_NO_CLOBBER_EBX__
"pushl %%ebx\n\t"
-# if ETHR_CMPXCHG8B_REGISTER_SHORTAGE
"movl (%7), %%ebx\n\t"
"movl 4(%7), %%ecx\n\t"
-# else
- "movl %8, %%ebx\n\t"
-# endif
-#endif
- "lock; cmpxchg" ETHR_DW_CMPXCHG_SFX__ " %0\n\t"
+ "lock; cmpxchg8b %0\n\t"
"setz %3\n\t"
-#if ETHR_NO_CLOBBER_EBX__
"popl %%ebx\n\t"
-#endif
: "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=c"(xchgd)
- : "m"(*p), "1"(xchg[1]), "2"(xchg[0]),
-#if ETHR_NO_CLOBBER_EBX__
-# if ETHR_CMPXCHG8B_REGISTER_SHORTAGE
- "3"(new)
-# else
- "3"(new[1]),
- "r"(new[0])
-# endif
+ : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "r"(new)
+ : "cc", "memory");
+
+#elif ETHR_NO_CLOBBER_EBX__
+ /*
+ * gcc wont let us use ebx as input
+ */
+
+ __asm__ __volatile__(
+ "pushl %%ebx\n\t"
+ "movl %8, %%ebx\n\t"
+ "lock; cmpxchg8b %0\n\t"
+ "setz %3\n\t"
+ "popl %%ebx\n\t"
+ : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=q"(xchgd)
+ : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "c"(new[1]), "r"(new[0])
+ : "cc", "memory");
+
#else
- "3"(new[1]),
- "b"(new[0])
-#endif
+ /*
+ * gcc lets us place values in the registers where
+ * we want them
+ */
+
+ __asm__ __volatile__(
+ "lock; cmpxchg" ETHR_DW_CMPXCHG_SFX__ " %0\n\t"
+ "setz %3\n\t"
+ : "=m"(*p), "=d"(xchg[1]), "=a"(xchg[0]), "=q"(xchgd)
+ : "m"(*p), "1"(xchg[1]), "2"(xchg[0]), "c"(new[1]), "b"(new[0])
: "cc", "memory");
+#endif
+
return (int) xchgd;
}
diff --git a/erts/include/internal/ose/ethr_event.h b/erts/include/internal/ose/ethr_event.h
deleted file mode 100644
index c18f30aa4a..0000000000
--- a/erts/include/internal/ose/ethr_event.h
+++ /dev/null
@@ -1,114 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2009-2011. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Author: Rickard Green
- */
-
-//#define USE_PTHREAD_API
-
-#define ETHR_EVENT_OFF_WAITER__ -1L
-#define ETHR_EVENT_OFF__ 1L
-#define ETHR_EVENT_ON__ 0L
-
-#ifdef USE_PTHREAD_API
-
-typedef struct {
- ethr_atomic32_t state;
- pthread_mutex_t mtx;
- pthread_cond_t cnd;
-} ethr_event;
-
-#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__)
-
-static void ETHR_INLINE
-ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e)
-{
- ethr_sint32_t val;
- val = ethr_atomic32_xchg_mb(&e->state, ETHR_EVENT_ON__);
- if (val == ETHR_EVENT_OFF_WAITER__) {
- int res = pthread_mutex_lock(&e->mtx);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- res = pthread_cond_signal(&e->cnd);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- res = pthread_mutex_unlock(&e->mtx);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
-}
-
-static void ETHR_INLINE
-ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e)
-{
- ethr_atomic32_set(&e->state, ETHR_EVENT_OFF__);
- ETHR_MEMORY_BARRIER;
-}
-
-#endif
-
-#else
-
-typedef struct {
- ethr_atomic32_t state;
- PROCESS proc;
-} ethr_event;
-
-#if defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__)
-
-static void ETHR_INLINE
-ETHR_INLINE_FUNC_NAME_(ethr_event_set)(ethr_event *e)
-{
- ethr_sint32_t val = ethr_atomic32_xchg_mb(&e->state, ETHR_EVENT_ON__);
- if (val == ETHR_EVENT_OFF_WAITER__) {
-#ifdef DEBUG
- OSFSEMVAL fsem_val = get_fsem(e->proc);
-
- /* There is a race in this assert.
- This is because the state is set before the wait call in wait__.
- We hope that a delay of 10 ms is enough */
- if (fsem_val == 0)
- delay(10);
- ETHR_ASSERT(get_fsem(e->proc) == -1);
-#endif
- signal_fsem(e->proc);
- }
-}
-
-static void ETHR_INLINE
-ETHR_INLINE_FUNC_NAME_(ethr_event_reset)(ethr_event *e)
-{
- ethr_atomic32_set(&e->state, ETHR_EVENT_OFF__);
- ETHR_MEMORY_BARRIER;
-}
-
-#endif
-
-#endif
-
-int ethr_event_init(ethr_event *e);
-int ethr_event_destroy(ethr_event *e);
-int ethr_event_wait(ethr_event *e);
-int ethr_event_swait(ethr_event *e, int spincount);
-#if !defined(ETHR_TRY_INLINE_FUNCS) || defined(ETHR_EVENT_IMPL__)
-void ethr_event_set(ethr_event *e);
-void ethr_event_reset(ethr_event *e);
-#endif
diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c
index 1262c50718..053217304b 100644
--- a/erts/lib_src/common/erl_misc_utils.c
+++ b/erts/lib_src/common/erl_misc_utils.c
@@ -160,8 +160,6 @@ erts_milli_sleep(long ms)
if (ms > 0) {
#ifdef __WIN32__
Sleep((DWORD) ms);
-#elif defined(__OSE__)
- delay(ms);
#else
struct timeval tv;
tv.tv_sec = ms / 1000;
@@ -320,10 +318,6 @@ erts_cpu_info_update(erts_cpu_info_t *cpuinfo)
online = 0;
#endif
}
-#elif defined(__OSE__)
- online = ose_num_cpus();
- configured = ose_num_cpus();
- available = ose_num_cpus();
#endif
if (online > configured)
diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c
index 307680505c..e7d5d4413e 100644
--- a/erts/lib_src/common/erl_printf_format.c
+++ b/erts/lib_src/common/erl_printf_format.c
@@ -78,15 +78,7 @@
#endif
#ifndef ERTS_SIZEOF_ETERM
-# ifdef HALFWORD_HEAP_EMULATOR
-# if SIZEOF_VOID_P == 8
-# define ERTS_SIZEOF_ETERM 4
-# else
-# error "HALFWORD_HEAP_EMULATOR only allowed on 64-bit architecture"
-# endif
-# else
-# define ERTS_SIZEOF_ETERM SIZEOF_VOID_P
-# endif
+#define ERTS_SIZEOF_ETERM SIZEOF_VOID_P
#endif
#if defined(__GNUC__)
@@ -102,7 +94,7 @@
#endif
#define FMTC_d 0x0000
-#define FMTC_R 0x0001
+/*empty 0x0001 was RELATIVE */
#define FMTC_o 0x0002
#define FMTC_u 0x0003
#define FMTC_x 0x0004
@@ -166,7 +158,7 @@ static char heX[] = "0123456789ABCDEF";
#define SIGN(X) ((X) > 0 ? 1 : ((X) < 0 ? -1 : 0))
#define USIGN(X) ((X) == 0 ? 0 : 1)
-int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long, ErlPfEterm*) = NULL;
+int (*erts_printf_eterm_func)(fmtfn_t, void*, ErlPfEterm, long) = NULL;
static int
noop_fn(void *vfp, char* buf, size_t len)
@@ -645,7 +637,6 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap)
case 'p': ptr++; fmt |= FMTC_p; break;
case 'n': ptr++; fmt |= FMTC_n; break;
case 'T': ptr++; fmt |= FMTC_T; break;
- case 'R': ptr++; fmt |= FMTC_R; break;
case '%':
FMT(fn,arg,ptr,1,count);
ptr++;
@@ -820,11 +811,9 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap)
default: *va_arg(ap,int*) = count; break;
}
break;
- case FMTC_T: /* Eterm */
- case FMTC_R: { /* Eterm, Eterm* base (base ignored if !HALFWORD_HEAP) */
+ case FMTC_T: { /* Eterm */
long prec;
ErlPfEterm eterm;
- ErlPfEterm* eterm_base;
if (!erts_printf_eterm_func)
return -EINVAL;
@@ -835,16 +824,14 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap)
else
prec = (long) precision;
eterm = va_arg(ap, ErlPfEterm);
- eterm_base = ((fmt & FMTC_MASK) == FMTC_R) ?
- va_arg(ap, ErlPfEterm*) : NULL;
if (width > 0 && !(fmt & FMTF_adj)) {
- res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec, eterm_base);
+ res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec);
if (res < 0)
return res;
if (width > res)
BLANKS(fn, arg, width - res, count);
}
- res = (*erts_printf_eterm_func)(fn, arg, eterm, prec, eterm_base);
+ res = (*erts_printf_eterm_func)(fn, arg, eterm, prec);
if (res < 0)
return res;
count += res;
diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c
index 0cbb1b2fb8..3e7aad16c7 100644
--- a/erts/lib_src/common/ethr_aux.c
+++ b/erts/lib_src/common/ethr_aux.c
@@ -139,6 +139,38 @@ x86_init(void)
#endif
/* bit 26 of edx is set if we have sse2 */
ethr_runtime__.conf.have_sse2 = (edx & (1 << 26));
+
+ /* check if we have extended feature set */
+ eax = 0x80000000;
+ ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx);
+
+ if (eax < 0x80000001)
+ return;
+
+ if (eax >= 0x80000007) {
+ /* Advanced Power Management Information */
+ eax = 0x80000007;
+ ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx);
+
+ /* I got the values below from:
+ http://lxr.free-electrons.com/source/arch/x86/include/asm/cpufeature.h
+ They can be gotten from the intel/amd manual as well.
+ */
+
+ ethr_runtime__.conf.have_constant_tsc = (edx & (1 << 8));
+ ethr_runtime__.conf.have_tsc_reliable = (edx & (1 << 23));
+ ethr_runtime__.conf.have_nonstop_tsc = (edx & (1 << 24));
+ ethr_runtime__.conf.have_nonstop_tsc_s3 = (edx & (1 << 30));
+
+ }
+
+ /* Extended Processor Info and Feature Bits */
+ eax = 0x80000001;
+ ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx);
+
+ /* bit 27 of edx is set if we have rdtscp */
+ ethr_runtime__.conf.have_rdtscp = (edx & (1 << 27));
+
}
#endif /* ETHR_X86_RUNTIME_CONF__ */
@@ -207,18 +239,7 @@ ethr_init_common__(ethr_init_data *id)
ethr_min_stack_size__ = ETHR_B2KW(ethr_min_stack_size__);
-#ifdef __OSE__
- /* For supervisor processes, OSE adds a number of bytes to the requested stack. With this
- * addition, the resulting size must not exceed the largest available stack size. The number
- * of bytes that will be added is configured in the monolith and can therefore not be
- * specified here. We simply assume that it is less than 0x1000. The available stack sizes
- * are configured in the .lmconf file and the largest one is usually 65536 bytes.
- * Consequently, the requested stack size is limited to 0xF000.
- */
- ethr_max_stack_size__ = 0xF000;
-#else
ethr_max_stack_size__ = 32*1024*1024;
-#endif
#if SIZEOF_VOID_P == 8
ethr_max_stack_size__ *= 2;
#endif
@@ -664,10 +685,6 @@ ETHR_IMPL_NORETURN__ ethr_fatal_error__(const char *file,
int ethr_assert_failed(const char *file, int line, const char *func, char *a)
{
fprintf(stderr, "%s:%d: %s(): Assertion failed: %s\n", file, line, func, a);
-#ifdef __OSE__
- ramlog_printf("%d: %s:%d: %s(): Assertion failed: %s\n",
- current_process(),file, line, func, a);
-#endif
ethr_abort__();
return 0;
}
diff --git a/erts/lib_src/common/ethr_mutex.c b/erts/lib_src/common/ethr_mutex.c
index 72aa34ec1c..a596e6c31c 100644
--- a/erts/lib_src/common/ethr_mutex.c
+++ b/erts/lib_src/common/ethr_mutex.c
@@ -1250,7 +1250,7 @@ ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx)
return 0;
}
-#elif (defined(ETHR_PTHREADS) || defined(ETHR_OSE_THREADS)) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
+#elif defined(ETHR_PTHREADS) && !defined(ETHR_DBG_WIN_MTX_WITH_PTHREADS)
/* -- pthread mutex and condition variables -------------------------------- */
int
diff --git a/erts/lib_src/ose/ethr_event.c b/erts/lib_src/ose/ethr_event.c
deleted file mode 100644
index 24ea191c4b..0000000000
--- a/erts/lib_src/ose/ethr_event.c
+++ /dev/null
@@ -1,220 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2009-2010. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Author: Rickard Green
- */
-
-#define ETHR_INLINE_FUNC_NAME_(X) X ## __
-#define ETHR_EVENT_IMPL__
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#include "ethread.h"
-
-#ifdef USE_PTHREAD_API
-
-int
-ethr_event_init(ethr_event *e)
-{
- int res;
- ethr_atomic32_init(&e->state, ETHR_EVENT_OFF__);
- res = pthread_mutex_init(&e->mtx, NULL);
- if (res != 0)
- return res;
- res = pthread_cond_init(&e->cnd, NULL);
- if (res != 0) {
- pthread_mutex_destroy(&e->mtx);
- return res;
- }
- return 0;
-}
-
-int
-ethr_event_destroy(ethr_event *e)
-{
- int res;
- res = pthread_mutex_destroy(&e->mtx);
- if (res != 0)
- return res;
- res = pthread_cond_destroy(&e->cnd);
- if (res != 0)
- return res;
- return 0;
-}
-
-static ETHR_INLINE int
-wait__(ethr_event *e, int spincount)
-{
- int sc = spincount;
- ethr_sint32_t val;
- int res, ulres;
- int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
-
- if (spincount < 0)
- ETHR_FATAL_ERROR__(EINVAL);
-
- while (1) {
- val = ethr_atomic32_read(&e->state);
- if (val == ETHR_EVENT_ON__)
- return 0;
- if (sc == 0)
- break;
- sc--;
- ETHR_SPIN_BODY;
- if (--until_yield == 0) {
- until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
- res = ETHR_YIELD();
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
- }
-
- if (val != ETHR_EVENT_OFF_WAITER__) {
- val = ethr_atomic32_cmpxchg(&e->state,
- ETHR_EVENT_OFF_WAITER__,
- ETHR_EVENT_OFF__);
- if (val == ETHR_EVENT_ON__)
- return 0;
- ETHR_ASSERT(val == ETHR_EVENT_OFF__);
- }
-
- ETHR_ASSERT(val == ETHR_EVENT_OFF_WAITER__
- || val == ETHR_EVENT_OFF__);
-
- res = pthread_mutex_lock(&e->mtx);
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
-
- while (1) {
-
- val = ethr_atomic32_read(&e->state);
- if (val == ETHR_EVENT_ON__)
- break;
-
- res = pthread_cond_wait(&e->cnd, &e->mtx);
- if (res == EINTR)
- break;
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
-
- ulres = pthread_mutex_unlock(&e->mtx);
- if (ulres != 0)
- ETHR_FATAL_ERROR__(ulres);
-
- return res; /* 0 || EINTR */
-}
-
-#else
-/* --- OSE implementation of events ---------------------------- */
-
-#ifdef DEBUG
-union SIGNAL {
- SIGSELECT signo;
-};
-#endif
-
-int
-ethr_event_init(ethr_event *e)
-{
- ethr_atomic32_init(&e->state, ETHR_EVENT_OFF__);
- e->proc = current_process();
- return 0;
-}
-
-int
-ethr_event_destroy(ethr_event *e)
-{
- return 0;
-}
-
-static ETHR_INLINE int
-wait__(ethr_event *e, int spincount)
-{
- int sc = spincount;
- int res;
- int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
-
- if (spincount < 0)
- ETHR_FATAL_ERROR__(EINVAL);
-
- ETHR_ASSERT(e->proc == current_process());
- ETHR_ASSERT(get_fsem(current_process()) == 0);
-
- while (1) {
- ethr_sint32_t val;
- while (1) {
- val = ethr_atomic32_read(&e->state);
- if (val == ETHR_EVENT_ON__)
- return 0;
- if (sc == 0)
- break;
- sc--;
- ETHR_SPIN_BODY;
- if (--until_yield == 0) {
- until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
- res = ETHR_YIELD();
- if (res != 0)
- ETHR_FATAL_ERROR__(res);
- }
- }
- if (val != ETHR_EVENT_OFF_WAITER__) {
- val = ethr_atomic32_cmpxchg(&e->state,
- ETHR_EVENT_OFF_WAITER__,
- ETHR_EVENT_OFF__);
- if (val == ETHR_EVENT_ON__)
- return 0;
- ETHR_ASSERT(val == ETHR_EVENT_OFF__);
- }
-
- wait_fsem(1);
-
- ETHR_ASSERT(get_fsem(current_process()) == 0);
- }
-}
-
-#endif
-
-void
-ethr_event_reset(ethr_event *e)
-{
- ethr_event_reset__(e);
-}
-
-void
-ethr_event_set(ethr_event *e)
-{
- ethr_event_set__(e);
-}
-
-int
-ethr_event_wait(ethr_event *e)
-{
- return wait__(e, 0);
-}
-
-int
-ethr_event_swait(ethr_event *e, int spincount)
-{
- return wait__(e, spincount);
-}
diff --git a/erts/lib_src/ose/ethread.c b/erts/lib_src/ose/ethread.c
deleted file mode 100644
index dc16acdd08..0000000000
--- a/erts/lib_src/ose/ethread.c
+++ /dev/null
@@ -1,833 +0,0 @@
-/*
- * %CopyrightBegin%
- *
- * Copyright Ericsson AB 2010-2011. All Rights Reserved.
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * %CopyrightEnd%
- */
-
-/*
- * Description: OSE implementation of the ethread library
- * Author: Lukas Larsson
- */
-
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#include "stdio.h"
-#ifdef ETHR_TIME_WITH_SYS_TIME
-# include "time.h"
-# include "sys/time.h"
-#else
-# ifdef ETHR_HAVE_SYS_TIME_H
-# include "sys/time.h"
-# else
-# include "time.h"
-# endif
-#endif
-#include "sys/types.h"
-#include "unistd.h"
-
-#include "limits.h"
-
-#define ETHR_INLINE_FUNC_NAME_(X) X ## __
-#define ETHREAD_IMPL__
-
-#include "ethread.h"
-#include "ethr_internal.h"
-
-#include "erl_printf.h"
-#include "efs.h"
-#include "ose.h"
-
-#include "ose_spi.h"
-
-#include "string.h"
-#include "ctype.h"
-#include "stdlib.h"
-
-#ifndef ETHR_HAVE_ETHREAD_DEFINES
-#error Missing configure defines
-#endif
-
-#define ETHR_INVALID_TID_ID -1
-
-#define DEFAULT_PRIO_NAME "ERTS_ETHR_DEFAULT_PRIO"
-
-/* Set the define to 1 to get some logging */
-#if 0
-#include "ramlog.h"
-#define LOG(output) ramlog_printf output
-#else
-#define LOG(output)
-#endif
-
-static ethr_tid main_thr_tid;
-static const char* own_tid_key = "ethread_own_tid";
-ethr_tsd_key ethr_ts_event_key__;
-
-#define ETHREADWRAPDATASIG 1
-
-/* Init data sent to thr_wrapper() */
-typedef struct {
- SIGSELECT sig_no;
- ethr_ts_event *tse;
- ethr_tid *tid;
- ethr_sint32_t result;
- void *(*thr_func)(void *);
- void *arg;
- void *prep_func_res;
- const char *name;
-} ethr_thr_wrap_data__;
-
-union SIGNAL {
- SIGSELECT sig_no;
- ethr_thr_wrap_data__ data;
-};
-
-#define ETHR_GET_OWN_TID__ ((ethr_tid *) get_envp(current_process(),\
- own_tid_key))
-
-/*
- * --------------------------------------------------------------------------
- * Static functions
- * --------------------------------------------------------------------------
- */
-
-/* Will retrive the instrinsic name by removing the 'prefix' and the
- * suffix from 'name'.
- * The 'prefix' is given as an inparameter. If NULL or an empty string no
- * prefix will be removed.
- * If 'strip_suffix' is 1 suffixes in the form of '_123' will be removed.
- * Will return a pointer to a newly allocated buffer containing the intrinsic
- * name in uppercase characters.
- * The caller must remember to free this buffer when no lnger needed.
- */
-static char *
-ethr_intrinsic_name(const char *name, const char *prefix, int strip_suffix)
-{
- const char *start = name;
- const char *end = name + strlen(name);
- char *intrinsic_name = NULL;
- int i;
-
- if (name == NULL) {
- LOG(("ERTS - ethr_intrinsic_namNo input name.\n"));
- return NULL;
- }
-
- /* take care of the prefix */
- if ((prefix != NULL) && (*prefix != '\0')) {
- const char *found = strstr(name, prefix);
-
- if (found == name) {
- /* found the prefix at the beginning */
- start += strlen(prefix);
- }
- }
-
- /* take care of the suffix */
- if (strip_suffix) {
- const char *suffix_start = strrchr(start, '_');
-
- if (suffix_start != NULL) {
- const char *ch;
- int only_numbers = 1;
-
- for (ch = suffix_start + 1; *ch != '\0'; ch++) {
- if (strchr("0123456789", *ch) == NULL) {
- only_numbers = 0;
- break;
- }
- }
-
- if (only_numbers) {
- end = suffix_start;
- }
- }
- }
-
- intrinsic_name = malloc(end - start + 1);
- for (i = 0; (start + i) < end; i++) {
- intrinsic_name[i] = toupper(start[i]);
- }
- intrinsic_name[i] = '\0';
-
- return intrinsic_name;
-}
-
-static char *
-ethr_get_amended_env(const char *name, const char *prefix, const char *suffix)
-{
- unsigned len;
- char *env_name = NULL;
- char *env_value = NULL;
-
- if (name == NULL) {
- return NULL;
- }
-
- len = strlen(name);
-
- if (prefix != NULL) {
- len += strlen(prefix);
- }
-
- if (suffix != NULL) {
- len += strlen(suffix);
- }
-
- env_name = malloc(len + 1);
- sprintf(env_name, "%s%s%s", (prefix != NULL) ? prefix : "",
- name,
- (suffix != NULL) ? suffix : "");
- env_value = get_env(get_bid(current_process()), env_name);
-
- if (env_value == NULL) {
- LOG(("ERTS - ethr_get_amended_env(): %s environment variable not present\n", env_name));
- } else {
- LOG(("ERTS - ethr_get_amended_env(): Found %s environment variable: %s.\n", env_name, env_value));
- }
- free(env_name);
-
- return env_value;
-}
-
-/* Reads the environment variable derived from 'name' and interprets it as as an
- * OSE priority. If successfull it will update 'out_prio'.
- * Returns: 0 if successfull
- * -1 orherwise.
- */
-static int
-ethr_get_prio(const char *name, OSPRIORITY *out_prio)
-{
- int rc = -1;
- char *intrinsic_name = NULL;
- char *prio_env = NULL;
- long prio;
- char *endptr = NULL;
-
- LOG(("ERTS - ethr_get_prio(): name: %s.\n", name));
-
- intrinsic_name = ethr_intrinsic_name(name, NULL, 1);
- LOG(("ERTS - ethr_get_prio(): Intrinsic name: %s.\n", intrinsic_name));
-
- prio_env = ethr_get_amended_env(intrinsic_name, "ERTS_", "_PRIO");
- if (prio_env == NULL) {
- goto fini;
- }
-
- prio = efs_str_to_long(prio_env, (const char **)&endptr);
- if (endptr != NULL) {
- LOG(("ERTS - ethr_get_prio(): Environment varible for '%s' includes "
- "non-numerical characters: '%s'.\n", intrinsic_name, prio_env));
- goto fini;
- }
-
- if ((prio < 0) || (prio > 32)) {
- LOG(("ERTS - ethr_get_prio(): prio for '%s' (%d) is out of bounds (0-32).\n",
- intrinsic_name, prio));
- goto fini;
- }
-
- /* Success */
- *out_prio = (OSPRIORITY)prio;
- rc = 0;
-
-fini:
- if (intrinsic_name != NULL) {
- free(intrinsic_name);
- }
- if (prio_env != NULL) {
- free_buf((union SIGNAL **) &prio_env);
- }
-
- return rc;
-}
-
-static PROCESS blockId(void) {
- static PROCESS bid = (PROCESS)0;
-
- /* For now we only use the same block. */
- /* if (bid == 0) {
- bid = create_block("Erlang-VM", 0, 0, 0, 0);
- }
- return bid; */
- return 0;
-}
-
-static void thr_exit_cleanup(ethr_tid *tid, void *res)
-{
-
- ETHR_ASSERT(tid == ETHR_GET_OWN_TID__);
-
- tid->res = res;
-
- ethr_run_exit_handlers__();
- ethr_ts_event_destructor__((void *) ethr_get_tse__());
-}
-
-//static OS_PROCESS(thr_wrapper);
-static OS_PROCESS(thr_wrapper)
-{
- ethr_tid my_tid;
- ethr_sint32_t result;
- void *res;
- void *(*thr_func)(void *);
- void *arg;
- ethr_ts_event *tsep = NULL;
-
-#ifdef DEBUG
- {
- PROCESS pid = current_process();
-
- const char *execMode;
-
- PROCESS bid = get_bid(pid);
-
- /* In the call below, 16 is a secret number provided by frbr that makes
- * the function return current domain. */
- OSADDRESS domain = get_pid_info(current_process(), 16);
-
-#ifdef HAVE_OSE_SPI_H
- execMode = get_pid_info(pid, OSE_PI_SUPERVISOR)
- ? "Supervisor"
- : "User";
-#else
- execMode = "unknown";
-#endif
-
- fprintf(stderr,"[0x%x] New process. Bid:0x%x, domain:%d, exec mode:%s\n",
- current_process(), bid, domain, execMode);
- }
-#endif
-
- {
- SIGSELECT sigsel[] = {1,ETHREADWRAPDATASIG};
- union SIGNAL *init_msg = receive(sigsel);
-
- thr_func = init_msg->data.thr_func;
- arg = init_msg->data.arg;
-
- result = (ethr_sint32_t) ethr_make_ts_event__(&tsep);
-
- if (result == 0) {
- tsep->iflgs |= ETHR_TS_EV_ETHREAD;
- my_tid = *init_msg->data.tid;
- set_envp(current_process(), own_tid_key, (OSADDRESS)&my_tid);
- if (ethr_thr_child_func__)
- ethr_thr_child_func__(init_msg->data.prep_func_res);
- }
-
- init_msg->data.result = result;
-
- send(&init_msg,sender(&init_msg));
- }
-
- /* pthread mutex api says we have to do this */
- signal_fsem(current_process());
- ETHR_ASSERT(get_fsem(current_process()) == 0);
-
- res = result == 0 ? (*thr_func)(arg) : NULL;
-
- ethr_thr_exit(&res);
-}
-
-/* internal exports */
-
-int ethr_set_tse__(ethr_ts_event *tsep)
-{
- return ethr_tsd_set(ethr_ts_event_key__,(void *) tsep);
-}
-
-ethr_ts_event *ethr_get_tse__(void)
-{
- return (ethr_ts_event *) ethr_tsd_get(ethr_ts_event_key__);
-}
-
-#if defined(ETHR_PPC_RUNTIME_CONF__)
-
-static int
-ppc_init__(void)
-{
- int pid;
-
-
- ethr_runtime__.conf.have_lwsync = 0;
-
- return 0;
-}
-
-#endif
-
-#if defined(ETHR_X86_RUNTIME_CONF__)
-
-void
-ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx)
-{
-#if ETHR_SIZEOF_PTR == 4
- int have_cpuid;
- /*
- * If it is possible to toggle eflags bit 21,
- * we have the cpuid instruction.
- */
- __asm__ ("pushf\n\t"
- "popl %%eax\n\t"
- "movl %%eax, %%ecx\n\t"
- "xorl $0x200000, %%eax\n\t"
- "pushl %%eax\n\t"
- "popf\n\t"
- "pushf\n\t"
- "popl %%eax\n\t"
- "movl $0x0, %0\n\t"
- "xorl %%ecx, %%eax\n\t"
- "jz no_cpuid\n\t"
- "movl $0x1, %0\n\t"
- "no_cpuid:\n\t"
- : "=r"(have_cpuid)
- :
- : "%eax", "%ecx", "cc");
- if (!have_cpuid) {
- *eax = *ebx = *ecx = *edx = 0;
- return;
- }
-#endif
-#if ETHR_SIZEOF_PTR == 4 && defined(__PIC__) && __PIC__
- /*
- * When position independet code is used in 32-bit mode, the B register
- * is used for storage of global offset table address, and we may not
- * use it as input or output in an asm. We need to save and restore the
- * B register explicitly (for some reason gcc doesn't provide this
- * service to us).
- */
- __asm__ ("pushl %%ebx\n\t"
- "cpuid\n\t"
- "movl %%ebx, %1\n\t"
- "popl %%ebx\n\t"
- : "=a"(*eax), "=r"(*ebx), "=c"(*ecx), "=d"(*edx)
- : "0"(*eax)
- : "cc");
-#else
- __asm__ ("cpuid\n\t"
- : "=a"(*eax), "=b"(*ebx), "=c"(*ecx), "=d"(*edx)
- : "0"(*eax)
- : "cc");
-#endif
-}
-
-#endif /* ETHR_X86_RUNTIME_CONF__ */
-
-/*
- * --------------------------------------------------------------------------
- * Exported functions
- * --------------------------------------------------------------------------
- */
-
-int
-ethr_init(ethr_init_data *id)
-{
- int res;
-
- if (!ethr_not_inited__)
- return EINVAL;
-
-
-#if defined(ETHR_PPC_RUNTIME_CONF__)
- res = ppc_init__();
- if (res != 0)
- goto error;
-#endif
-
- res = ethr_init_common__(id);
- if (res != 0)
- goto error;
-
- main_thr_tid.id = current_process();
- main_thr_tid.tsd_key_index = 0;
-
- set_envp(current_process(),own_tid_key,(OSADDRESS)&main_thr_tid);
- signal_fsem(current_process());
-
-
- ETHR_ASSERT(&main_thr_tid == ETHR_GET_OWN_TID__);
-
- ethr_not_inited__ = 0;
-
- ethr_tsd_key_create(&ethr_ts_event_key__,"ethread_tse");
-
- return 0;
- error:
- ethr_not_inited__ = 1;
- return res;
-
-}
-
-int
-ethr_late_init(ethr_late_init_data *id)
-{
- int res = ethr_late_init_common__(id);
- if (res != 0)
- return res;
- ethr_not_completely_inited__ = 0;
- return res;
-}
-
-int
-ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg,
- ethr_thr_opts *opts)
-{
- int res;
- int use_stack_size = (opts && opts->suggested_stack_size >= 0
- ? opts->suggested_stack_size
- : 0x200 /* Use system default */);
- OSPRIORITY use_prio;
- char *use_name;
- char default_thr_name[20];
- static int no_of_thr = 0;
- cpuid_t use_core;
-
- union SIGNAL *init_msg;
- SIGSELECT sigsel[] = {1,ETHREADWRAPDATASIG};
- void *prep_func_res;
-
-
- if (opts != NULL) {
- LOG(("ERTS - ethr_thr_create(): opts supplied: name: %s, coreNo: %u.\n",
- opts->name, opts->coreNo));
- use_name = opts->name;
- use_core = opts->coreNo;
- if (0 != ethr_get_prio(use_name, &use_prio)) {
- if (0 != ethr_get_prio("DEFAULT", &use_prio)) {
- use_prio = get_pri(current_process());
- LOG(("ERTS - ethr_thr_create(): Using current process' prio: %d.\n", use_prio));
- } else {
- LOG(("ERTS - ethr_thr_create(): Using default prio: %d.\n", use_prio));
- }
- } else {
- LOG(("ERTS - ethr_thr_create(): Using configured prio: %d.\n", use_prio));
- }
- } else {
- LOG(("ERTS - ethr_thr_create(): opts not supplied. Using defaults.\n"));
- no_of_thr++;
- sprintf(default_thr_name, "ethread_%d", no_of_thr);
- use_name = default_thr_name;
- use_core = ose_cpu_id();
-
- if (0 != ethr_get_prio("DEFAULT", &use_prio)) {
- use_prio = get_pri(current_process());
- LOG(("ERTS - ethr_thr_create(): Using current process' prio: %d.\n", use_prio));
- }
- }
-
-#ifdef ETHR_MODIFIED_DEFAULT_STACK_SIZE
- if (use_stack_size < 0)
- use_stack_size = ETHR_MODIFIED_DEFAULT_STACK_SIZE;
-#endif
-
-#if ETHR_XCHK
- if (ethr_not_completely_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
- if (!tid || !func) {
- ETHR_ASSERT(0);
- return EINVAL;
- }
-#endif
-
- if (use_stack_size >= 0) {
- size_t suggested_stack_size = (size_t) use_stack_size;
- size_t stack_size;
-#ifdef ETHR_DEBUG
- suggested_stack_size /= 2; /* Make sure we got margin */
-#endif
-#ifdef ETHR_STACK_GUARD_SIZE
- /* The guard is at least on some platforms included in the stack size
- passed when creating threads */
- suggested_stack_size += ETHR_B2KW(ETHR_STACK_GUARD_SIZE);
-#endif
-
- if (suggested_stack_size < ethr_min_stack_size__)
- stack_size = ETHR_KW2B(ethr_min_stack_size__);
- else if (suggested_stack_size > ethr_max_stack_size__)
- stack_size = ETHR_KW2B(ethr_max_stack_size__);
- else
- stack_size = ETHR_PAGE_ALIGN(ETHR_KW2B(suggested_stack_size));
- use_stack_size = stack_size;
- }
-
- init_msg = alloc(sizeof(ethr_thr_wrap_data__), ETHREADWRAPDATASIG);
-
- /* Call prepare func if it exist */
- if (ethr_thr_prepare_func__)
- init_msg->data.prep_func_res = ethr_thr_prepare_func__();
- else
- init_msg->data.prep_func_res = NULL;
-
- LOG(("ERTS - ethr_thr_create(): Process [0x%x] is creating '%s', coreNo = %u, prio:%u\n",
- current_process(), use_name, use_core, use_prio));
-
- tid->id = create_process(OS_PRI_PROC, use_name, thr_wrapper,
- use_stack_size, use_prio, 0,
- get_bid(current_process()), NULL, 0, 0);
- if (ose_bind_process(tid->id, use_core)) {
- LOG(("ERTS - ethr_thr_create(): Bound pid 0x%x (%s) to core no %u.\n",
- tid->id, use_name, use_core));
- } else {
- LOG(("ERTS - ethr_thr_create(): Failed binding pid 0x%x (%s) to core no %u.\n",
- tid->id, use_name, use_core));
- }
-
- /*FIXME!!! Normally this shouldn't be used in shared mode. Still there is
- * a problem with stdin fd in fd_ processes which should be further
- * investigated */
- efs_clone(tid->id);
-
- tid->tsd_key_index = 0;
- tid->res = NULL;
-
- init_msg->data.tse = ethr_get_ts_event();
- init_msg->data.thr_func = func;
- init_msg->data.arg = arg;
- init_msg->data.tid = tid;
- init_msg->data.name = opts->name;
-
- send(&init_msg, tid->id);
-
- start(tid->id);
- init_msg = receive(sigsel);
-
- res = init_msg->data.result;
- prep_func_res = init_msg->data.prep_func_res;
-
- free_buf(&init_msg);
- /* Cleanup... */
-
- if (ethr_thr_parent_func__)
- ethr_thr_parent_func__(prep_func_res);
-
- LOG(("ERTS - ethr_thr_create(): Exiting.\n"));
- return res;
-}
-
-int
-ethr_thr_join(ethr_tid tid, void **res)
-{
- SIGSELECT sigsel[] = {1,OS_ATTACH_SIG};
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
-#endif
-
- if (tid.id == ETHR_INVALID_TID_ID)
- return EINVAL;
-
- attach(NULL,tid.id);
- receive(sigsel);
-
- if (res)
- *res = tid.res;
-
- return 0;
-}
-
-int
-ethr_thr_detach(ethr_tid tid)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
-#endif
- return 0;
-}
-
-void
-ethr_thr_exit(void *res)
-{
- ethr_tid *tid;
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return;
- }
-#endif
- tid = ETHR_GET_OWN_TID__;
- if (!tid) {
- ETHR_ASSERT(0);
- kill_proc(current_process());
- }
- thr_exit_cleanup(tid, res);
- /* Harakiri possible? */
- kill_proc(current_process());
-}
-
-ethr_tid
-ethr_self(void)
-{
- ethr_tid *tid;
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ethr_tid dummy_tid = {ETHR_INVALID_TID_ID, 0, NULL};
- ETHR_ASSERT(0);
- return dummy_tid;
- }
-#endif
- tid = ETHR_GET_OWN_TID__;
- if (!tid) {
- ethr_tid dummy_tid = {ETHR_INVALID_TID_ID, 0, NULL};
- return dummy_tid;
- }
- return *tid;
-}
-
-int
-ethr_equal_tids(ethr_tid tid1, ethr_tid tid2)
-{
- return tid1.id == tid2.id && tid1.id != ETHR_INVALID_TID_ID;
-}
-
-
-/*
- * Thread specific events
- */
-
-ethr_ts_event *
-ethr_get_ts_event(void)
-{
- return ethr_get_ts_event__();
-}
-
-void
-ethr_leave_ts_event(ethr_ts_event *tsep)
-{
- ethr_leave_ts_event__(tsep);
-}
-
-/*
- * Thread specific data
- */
-
-int
-ethr_tsd_key_create(ethr_tsd_key *keyp, char *keyname)
-{
-
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
- if (!keyp) {
- ETHR_ASSERT(0);
- return EINVAL;
- }
-#endif
-
- ose_create_ppdata(keyname,keyp);
-
- return 0;
-}
-
-int
-ethr_tsd_key_delete(ethr_tsd_key key)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
-#endif
- /* Not possible to delete ppdata */
-
- return 0;
-}
-
-int
-ethr_tsd_set(ethr_tsd_key key, void *value)
-{
- void **ppdp;
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
-#endif
- ppdp = (void **)ose_get_ppdata(key);
- *ppdp = value;
- return 0;
-}
-
-void *
-ethr_tsd_get(ethr_tsd_key key)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return NULL;
- }
-#endif
- return *(void**)ose_get_ppdata(key);
-}
-
-/*
- * Signal functions
- */
-
-#if ETHR_HAVE_ETHR_SIG_FUNCS
-
-int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
- if (!set && !oset) {
- ETHR_ASSERT(0);
- return EINVAL;
- }
-#endif
- return pthread_sigmask(how, set, oset);
-}
-
-int ethr_sigwait(const sigset_t *set, int *sig)
-{
-#if ETHR_XCHK
- if (ethr_not_inited__) {
- ETHR_ASSERT(0);
- return EACCES;
- }
- if (!set || !sig) {
- ETHR_ASSERT(0);
- return EINVAL;
- }
-#endif
- if (sigwait(set, sig) < 0)
- return errno;
- return 0;
-}
-
-#endif /* #if ETHR_HAVE_ETHR_SIG_FUNCS */
-
-ETHR_IMPL_NORETURN__
-ethr_abort__(void)
-{
- abort();
-}
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index df12c6f8e0..6d777fa811 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 863a5e61ef..2ea2de4c70 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam
new file mode 100644
index 0000000000..4188e5fd9b
--- /dev/null
+++ b/erts/preloaded/ebin/erts_code_purger.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index dc8c711e1a..88da34b192 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index 851513b2e9..9d2dd38f3a 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam
index 33c112f4de..3cd2515ba8 100644
--- a/erts/preloaded/ebin/otp_ring0.beam
+++ b/erts/preloaded/ebin/otp_ring0.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam
index ebca6e7eea..9a208d1545 100644
--- a/erts/preloaded/ebin/prim_eval.beam
+++ b/erts/preloaded/ebin/prim_eval.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index e8817d183e..426e764127 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam
index 8b87d1ae26..d68d18ecba 100644
--- a/erts/preloaded/ebin/prim_inet.beam
+++ b/erts/preloaded/ebin/prim_inet.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam
index 969239be98..01b3b1feb8 100644
--- a/erts/preloaded/ebin/prim_zip.beam
+++ b/erts/preloaded/ebin/prim_zip.beam
Binary files differ
diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam
index 281f668f8c..7252d866bb 100644
--- a/erts/preloaded/ebin/zlib.beam
+++ b/erts/preloaded/ebin/zlib.beam
Binary files differ
diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile
index 52034a0881..31383dda83 100644
--- a/erts/preloaded/src/Makefile
+++ b/erts/preloaded/src/Makefile
@@ -41,6 +41,7 @@ PRE_LOADED_ERL_MODULES = \
zlib \
prim_zip \
otp_ring0 \
+ erts_code_purger \
erlang \
erts_internal
diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index 9f6cba33bd..cbcced5512 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -42,7 +42,7 @@
-include("inet_boot.hrl").
%% Public
--export([start/3, set_path/1, get_path/0, get_file/1, get_files/2,
+-export([start/0, set_path/1, get_path/0, get_file/1,
list_dir/1, read_file_info/1, read_link_info/1, get_cwd/0, get_cwd/1]).
%% Used by erl_boot_server
@@ -50,30 +50,31 @@
prim_read_file_info/3, prim_get_cwd/2]).
%% Used by escript and code
--export([set_primary_archive/4, release_archives/0]).
+-export([set_primary_archive/4]).
+
+%% Used by test suites
+-export([purge_archive_cache/0]).
+
+%% Used by init and the code server.
+-export([get_modules/3]).
-include_lib("kernel/include/file.hrl").
-type host() :: atom().
-record(prim_state, {debug :: boolean(),
- cache,
primary_archive}).
-type prim_state() :: #prim_state{}.
-record(state,
{loader :: 'efile' | 'inet',
hosts = [] :: [host()], % hosts list (to boot from)
- id, % not used any more?
data :: 'noport' | port(), % data port etc
- timeout :: timeout(), % idle timeout
- %% Number of timeouts before archives are released
- n_timeouts :: non_neg_integer(),
- multi_get = false :: boolean(),
+ timeout :: timeout(), % idle timeout
prim_state :: prim_state()}). % state for efile code loader
--define(IDLE_TIMEOUT, 60000). %% tear inet connection after 1 minutes
--define(N_TIMEOUTS, 6). %% release efile archive after 6 minutes
+-define(EFILE_IDLE_TIMEOUT, (6*60*1000)). %purge archives
+-define(INET_IDLE_TIMEOUT, (60*1000)). %tear down connection timeout
%% Defines for inet as prim_loader
-define(INET_FAMILY, inet).
@@ -103,26 +104,13 @@ debug(#prim_state{debug = Deb}, Term) ->
%%% Interface Functions.
%%% --------------------------------------------------------
--spec start(Id, Loader, Hosts) ->
+-spec start() ->
{'ok', Pid} | {'error', What} when
- Id :: term(),
- Loader :: atom() | string(),
- Hosts :: Host | [Host],
- Host :: host(),
Pid :: pid(),
What :: term().
-start(Id, Pgm, Hosts) when is_atom(Hosts) ->
- start(Id, Pgm, [Hosts]);
-start(Id, Pgm0, Hosts) ->
- Pgm = if
- is_atom(Pgm0) ->
- atom_to_list(Pgm0);
- true ->
- Pgm0
- end,
+start() ->
Self = self(),
- Pid = spawn_link(fun() -> start_it(Pgm, Id, Self, Hosts) end),
- register(erl_prim_loader, Pid),
+ Pid = spawn_link(fun() -> start_it(Self) end),
receive
{Pid,ok} ->
{ok,Pid};
@@ -130,26 +118,39 @@ start(Id, Pgm0, Hosts) ->
{error,Reason}
end.
-%% Hosts must be a list of form ['1.2.3.4' ...]
-start_it("inet", Id, Pid, Hosts) ->
+start_it(Parent) ->
process_flag(trap_exit, true),
- ?dbg(inet, {Id,Pid,Hosts}),
+ register(erl_prim_loader, self()),
+ Loader = case init:get_argument(loader) of
+ {ok,[[Loader0]]} ->
+ Loader0;
+ error ->
+ "efile"
+ end,
+ case Loader of
+ "efile" -> start_efile(Parent);
+ "inet" -> start_inet(Parent)
+ end.
+
+%% Hosts must be a list of form ['1.2.3.4' ...]
+start_inet(Parent) ->
+ Hosts = case init:get_argument(hosts) of
+ {ok,[Hosts0]} -> Hosts0;
+ _ -> []
+ end,
AL = ipv4_list(Hosts),
?dbg(addresses, AL),
{ok,Tcp} = find_master(AL),
- init_ack(Pid),
+ init_ack(Parent),
PS = prim_init(),
State = #state {loader = inet,
hosts = AL,
- id = Id,
data = Tcp,
- timeout = ?IDLE_TIMEOUT,
- n_timeouts = ?N_TIMEOUTS,
+ timeout = ?INET_IDLE_TIMEOUT,
prim_state = PS},
- loop(State, Pid, []);
+ loop(State, Parent, []).
-start_it("efile", Id, Pid, _Hosts) ->
- process_flag(trap_exit, true),
+start_efile(Parent) ->
{ok, Port} = prim_file:start(),
%% Check that we started in a valid directory.
case prim_file:get_cwd(Port) of
@@ -160,20 +161,14 @@ start_it("efile", Id, Pid, _Hosts) ->
erlang:display(Report),
exit({error, invalid_current_directory});
_ ->
- init_ack(Pid)
+ init_ack(Parent)
end,
- MultiGet = case erlang:system_info(thread_pool_size) of
- 0 -> false;
- _ -> true
- end,
PS = prim_init(),
State = #state {loader = efile,
- id = Id,
data = Port,
- timeout = infinity,
- multi_get = MultiGet,
+ timeout = ?EFILE_IDLE_TIMEOUT,
prim_state = PS},
- loop(State, Pid, []).
+ loop(State, Parent, []).
init_ack(Pid) ->
Pid ! {self(),ok},
@@ -198,20 +193,6 @@ get_file(File) when is_atom(File) ->
get_file(File) ->
check_file_result(get_file, File, request({get_file,File})).
--spec get_files([{atom(), string()}],
- fun((atom(),binary(),string()) -> 'ok' | {'error', atom()})) ->
- 'ok' | {'error', atom()}.
-get_files(ModFiles, Fun) ->
- case request({get_files,{ModFiles,Fun}}) of
- E = {error,_M} ->
- E;
- {error,Reason,M} ->
- check_file_result(get_files, M, {error,Reason}),
- {error,M};
- ok ->
- ok
- end.
-
-spec list_dir(Dir) -> {'ok', Filenames} | 'error' when
Dir :: string(),
Filenames :: [Filename :: string()].
@@ -250,10 +231,23 @@ set_primary_archive(File, ArchiveBin, FileInfo, ParserFun)
when is_list(File), is_binary(ArchiveBin), is_record(FileInfo, file_info) ->
request({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}).
--spec release_archives() -> 'ok' | {'error', _}.
+%% NOTE: Does not close the primary archive. Only closes all
+%% open zip files kept in the cache. Should be called before an archive
+%% file is to be removed (for example in the test suites).
-release_archives() ->
- request(release_archives).
+-spec purge_archive_cache() -> 'ok' | {'error', _}.
+purge_archive_cache() ->
+ request(purge_archive_cache).
+
+
+-spec get_modules([module()],
+ fun((atom(), string(), binary()) ->
+ {'ok',any()} | {'error',any()}),
+ [string()]) ->
+ {'ok',{[any()],[any()]}}.
+
+get_modules(Modules, Fun, Path) ->
+ request({get_modules,{Modules,Fun,Path}}).
request(Req) ->
Loader = whereis(erl_prim_loader),
@@ -310,76 +304,61 @@ check_file_result(_, _, Other) ->
%%% The main loop.
%%% --------------------------------------------------------
-loop(State, Parent, Paths) ->
+loop(St0, Parent, Paths) ->
receive
+ {Pid,{set_path,NewPaths}} when is_pid(Pid) ->
+ Pid ! {self(),ok},
+ loop(St0, Parent, to_strs(NewPaths));
{Pid,Req} when is_pid(Pid) ->
- %% erlang:display(Req),
- {Resp,State2,Paths2} =
- case Req of
- {set_path,NewPaths} ->
- {ok,State,to_strs(NewPaths)};
- {get_path,_} ->
- {{ok,Paths},State,Paths};
- {get_file,File} ->
- {Res,State1} = handle_get_file(State, Paths, File),
- {Res,State1,Paths};
- {get_files,{ModFiles,Fun}} ->
- {Res,State1} = handle_get_files(State, ModFiles, Paths, Fun),
- {Res,State1,Paths};
- {list_dir,Dir} ->
- {Res,State1} = handle_list_dir(State, Dir),
- {Res,State1,Paths};
- {read_file_info,File} ->
- {Res,State1} = handle_read_file_info(State, File),
- {Res,State1,Paths};
- {read_link_info,File} ->
- {Res,State1} = handle_read_link_info(State, File),
- {Res,State1,Paths};
- {get_cwd,[]} ->
- {Res,State1} = handle_get_cwd(State, []),
- {Res,State1,Paths};
- {get_cwd,[_]=Args} ->
- {Res,State1} = handle_get_cwd(State, Args),
- {Res,State1,Paths};
- {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} ->
- {Res,State1} =
- handle_set_primary_archive(State, File,
- ArchiveBin, FileInfo,
- ParserFun),
- {Res,State1,Paths};
- release_archives ->
- {Res,State1} = handle_release_archives(State),
- {Res,State1,Paths};
- _Other ->
- {ignore,State,Paths}
- end,
- if Resp =:= ignore -> ok;
- true -> Pid ! {self(),Resp}, ok
- end,
- if
- is_record(State2, state) ->
- loop(State2, Parent, Paths2);
- true ->
- exit({bad_state, Req, State2})
+ case handle_request(Req, Paths, St0) of
+ ignore ->
+ ok;
+ {Resp,#state{}=St1} ->
+ Pid ! {self(),Resp},
+ loop(St1, Parent, Paths);
+ {_,State2,_} ->
+ exit({bad_state,Req,State2})
end;
{'EXIT',Parent,W} ->
- _State1 = handle_stop(State),
+ _ = handle_stop(St0),
exit(W);
{'EXIT',P,W} ->
- State1 = handle_exit(State, P, W),
- loop(State1, Parent, Paths);
+ St1 = handle_exit(St0, P, W),
+ loop(St1, Parent, Paths);
_Message ->
- loop(State, Parent, Paths)
- after State#state.timeout ->
- State1 = handle_timeout(State, Parent),
- loop(State1, Parent, Paths)
+ loop(St0, Parent, Paths)
+ after St0#state.timeout ->
+ St1 = handle_timeout(St0, Parent),
+ loop(St1, Parent, Paths)
+ end.
+
+handle_request(Req, Paths, St0) ->
+ case Req of
+ {get_path,_} ->
+ {{ok,Paths},St0};
+ {get_file,File} ->
+ handle_get_file(St0, Paths, File);
+ {get_modules,{Modules,Fun,ModPaths}} ->
+ handle_get_modules(St0, Modules, Fun, ModPaths);
+ {list_dir,Dir} ->
+ handle_list_dir(St0, Dir);
+ {read_file_info,File} ->
+ handle_read_file_info(St0, File);
+ {read_link_info,File} ->
+ handle_read_link_info(St0, File);
+ {get_cwd,[]} ->
+ handle_get_cwd(St0, []);
+ {get_cwd,[_]=Args} ->
+ handle_get_cwd(St0, Args);
+ {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} ->
+ handle_set_primary_archive(St0, File, ArchiveBin,
+ FileInfo, ParserFun);
+ purge_archive_cache ->
+ handle_purge_archive_cache(St0);
+ _ ->
+ ignore
end.
-handle_get_files(State = #state{multi_get = true}, ModFiles, Paths, Fun) ->
- ?SAFE2(efile_multi_get_file_from_port(State, ModFiles, Paths, Fun), State);
-handle_get_files(State, _ModFiles, _Paths, _Fun) -> % no multi get
- {{error,no_multi_get},State}.
-
handle_get_file(State = #state{loader = efile}, Paths, File) ->
?SAFE2(efile_get_file_from_port(State, File, Paths), State);
handle_get_file(State = #state{loader = inet}, Paths, File) ->
@@ -388,8 +367,9 @@ handle_get_file(State = #state{loader = inet}, Paths, File) ->
handle_set_primary_archive(State= #state{loader = efile}, File, ArchiveBin, FileInfo, ParserFun) ->
?SAFE2(efile_set_primary_archive(State, File, ArchiveBin, FileInfo, ParserFun), State).
-handle_release_archives(State= #state{loader = efile}) ->
- ?SAFE2(efile_release_archives(State), State).
+handle_purge_archive_cache(#state{loader = efile}=State) ->
+ prim_purge_cache(),
+ {ok,State}.
handle_list_dir(State = #state{loader = efile}, Dir) ->
?SAFE2(efile_list_dir(State, Dir), State);
@@ -430,53 +410,6 @@ handle_timeout(State = #state{loader = inet}, Parent) ->
%%% Functions which handle efile as prim_loader (default).
%%% --------------------------------------------------------
-%%% Reading many files in parallel is an optimization.
-%%% See also comment in init.erl.
-
-%% -> {ok,State} | {{error,Module},State} | {{error,Reason,Module},State}
-efile_multi_get_file_from_port(State, ModFiles, Paths, Fun) ->
- Ref = make_ref(),
- %% More than 200 processes is no gain.
- Max = erlang:min(200, erlang:system_info(thread_pool_size)),
- efile_multi_get_file_from_port2(ModFiles, 0, Max, State, Paths, Fun, Ref, ok).
-
-efile_multi_get_file_from_port2([MF | MFs], Out, Max, State, Paths, Fun, Ref, Ret) when Out < Max ->
- Self = self(),
- _Pid = spawn(fun() -> efile_par_get_file(Ref, State, MF, Paths, Self, Fun) end),
- efile_multi_get_file_from_port2(MFs, Out+1, Max, State, Paths, Fun, Ref, Ret);
-efile_multi_get_file_from_port2(MFs, Out, Max, _State, Paths, Fun, Ref, Ret) when Out > 0 ->
- receive
- {Ref, ok, State1} ->
- efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Ret);
- {Ref, {error,_Mod} = Error, State1} ->
- efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Error);
- {Ref, MF, {error,emfile,State1}} ->
- %% Max can take negative values. Out cannot.
- efile_multi_get_file_from_port2([MF | MFs], Out-1, Max-1, State1, Paths, Fun, Ref, Ret);
- {Ref, {M,_F}, {error,Error,State1}} ->
- efile_multi_get_file_from_port2(MFs, Out-1, 0, State1, Paths, Fun, Ref, {error,Error,M})
- end;
-efile_multi_get_file_from_port2(_MFs, 0, _Max, State, _Paths, _Fun, _Ref, Ret) ->
- {Ret,State}.
-
-efile_par_get_file(Ref, State, {Mod,File} = MF, Paths, Pid, Fun) ->
- %% One port for each file read in "parallel":
- case prim_file:start() of
- {ok, Port} ->
- Port0 = State#state.data,
- State1 = State#state{data = Port},
- R = case efile_get_file_from_port(State1, File, Paths) of
- {{error,Reason},State2} ->
- {Ref,MF,{error,Reason,State2}};
- {{ok,BinFile,Full},State2} ->
- %% Fun(...) -> ok | {error,Mod}
- {Ref,Fun(Mod, BinFile, Full),State2#state{data=Port0}}
- end,
- prim_file:close(Port),
- Pid ! R;
- {error, Error} ->
- Pid ! {Ref,MF,{error,Error,State}}
- end.
%% -> {{ok,BinFile,File},State} | {{error,Reason},State}
efile_get_file_from_port(State, File, Paths) ->
@@ -521,10 +454,6 @@ efile_set_primary_archive(#state{prim_state = PS} = State, File,
FileInfo, ParserFun),
{Res,State#state{prim_state = PS2}}.
-efile_release_archives(#state{prim_state = PS} = State) ->
- {Res, PS2} = prim_release_archives(PS),
- {Res,State#state{prim_state = PS2}}.
-
efile_list_dir(#state{prim_state = PS} = State, Dir) ->
{Res, PS2} = prim_list_dir(PS, Dir),
{Res, State#state{prim_state = PS2}}.
@@ -546,15 +475,128 @@ efile_exit_port(State, Port, Reason) when State#state.data =:= Port ->
efile_exit_port(State, _Port, _Reason) ->
State.
-efile_timeout_handler(#state{n_timeouts = N} = State, _Parent) ->
- if
- N =< 0 ->
- {_Res, State2} = efile_release_archives(State),
- State2#state{n_timeouts = ?N_TIMEOUTS};
- true ->
- State#state{n_timeouts = N - 1}
+efile_timeout_handler(State, _Parent) ->
+ prim_purge_cache(),
+ State.
+
+%%% --------------------------------------------------------
+%%% Read and process severals modules in parallel.
+%%% --------------------------------------------------------
+
+handle_get_modules(#state{loader=efile}=St, Ms, Process, Paths) ->
+ Primary = (St#state.prim_state)#prim_state.primary_archive,
+ Res = case efile_any_archives(Paths, Primary) of
+ false ->
+ efile_get_mods_par(Ms, Process, Paths);
+ true ->
+ Get = fun efile_get_file_from_port/3,
+ gm_get_mods(St, Get, Ms, Process, Paths)
+ end,
+ {Res,St};
+handle_get_modules(#state{loader=inet}=St, Ms, Process, Paths) ->
+ Get = fun inet_get_file_from_port/3,
+ {gm_get_mods(St, Get, Ms, Process, Paths),St}.
+
+efile_get_mods_par(Ms, Process, Paths) ->
+ Self = self(),
+ Ref = make_ref(),
+ GmSpawn = fun() ->
+ efile_gm_spawn({Self,Ref}, Ms, Process, Paths)
+ end,
+ _ = spawn_link(GmSpawn),
+ N = length(Ms),
+ efile_gm_recv(N, Ref, [], []).
+
+efile_any_archives([H|T], Primary) ->
+ case name_split(Primary, H) of
+ {file,_} -> efile_any_archives(T, Primary);
+ {archive,_,_} -> true
+ end;
+efile_any_archives([], _) ->
+ false.
+
+efile_gm_recv(0, _Ref, Succ, Fail) ->
+ {ok,{Succ,Fail}};
+efile_gm_recv(N, Ref, Succ, Fail) ->
+ receive
+ {Ref,Mod,{ok,Res}} ->
+ efile_gm_recv(N-1, Ref, [{Mod,Res}|Succ], Fail);
+ {Ref,Mod,{error,Res}} ->
+ efile_gm_recv(N-1, Ref, Succ, [{Mod,Res}|Fail])
end.
+efile_gm_spawn(ParentRef, Ms, Process, Paths) ->
+ efile_gm_spawn_1(0, Ms, ParentRef, Process, Paths).
+
+efile_gm_spawn_1(N, Ms, ParentRef, Process, Paths) when N >= 32 ->
+ receive
+ {'DOWN',_,process,_,_} ->
+ efile_gm_spawn_1(N-1, Ms, ParentRef, Process, Paths)
+ end;
+efile_gm_spawn_1(N, [M|Ms], ParentRef, Process, Paths) ->
+ Get = fun() -> efile_gm_get(Paths, M, ParentRef, Process) end,
+ _ = spawn_monitor(Get),
+ efile_gm_spawn_1(N+1, Ms, ParentRef, Process, Paths);
+efile_gm_spawn_1(_, [], _, _, _) ->
+ ok.
+
+efile_gm_get(Paths, Mod, ParentRef, Process) ->
+ File = atom_to_list(Mod) ++ init:objfile_extension(),
+ efile_gm_get_1(Paths, File, Mod, ParentRef, Process).
+
+efile_gm_get_1([P|Ps], File0, Mod, {Parent,Ref}=PR, Process) ->
+ File = join(P, File0),
+ Res = try prim_file:read_file(File) of
+ {ok,Bin} ->
+ gm_process(Mod, File, Bin, Process);
+ {error,enoent} ->
+ efile_gm_get_1(Ps, File0, Mod, PR, Process);
+ Error ->
+ check_file_result(get_modules, File, Error),
+ Error
+ catch
+ _:Reason ->
+ {error,{crash,Reason}}
+ end,
+ Parent ! {Ref,Mod,Res};
+efile_gm_get_1([], _, Mod, {Parent,Ref}, _Process) ->
+ Parent ! {Ref,Mod,{error,enoent}}.
+
+gm_get_mods(St, Get, Ms, Process, Paths) ->
+ gm_get_mods(St, Get, Ms, Process, Paths, [], []).
+
+gm_get_mods(St, Get, [M|Ms], Process, Paths, Succ, Fail) ->
+ File = atom_to_list(M) ++ init:objfile_extension(),
+ case gm_arch_get(St, Get, M, File, Paths, Process) of
+ {ok,Res} ->
+ gm_get_mods(St, Get, Ms, Process, Paths,
+ [{M,Res}|Succ], Fail);
+ {error,Res} ->
+ gm_get_mods(St, Get, Ms, Process, Paths,
+ Succ, [{M,Res}|Fail])
+ end;
+gm_get_mods(_St, _Get, [], _, _, Succ, Fail) ->
+ {ok,{Succ,Fail}}.
+
+gm_arch_get(St, Get, Mod, File, Paths, Process) ->
+ case Get(St, File, Paths) of
+ {{error,_}=E,_} ->
+ E;
+ {{ok,Bin,Full},_} ->
+ gm_process(Mod, Full, Bin, Process)
+ end.
+
+gm_process(Mod, File, Bin, Process) ->
+ try Process(Mod, File, Bin) of
+ {ok,_}=Res -> Res;
+ {error,_}=Res -> Res;
+ Other -> {error,{bad_return,Other}}
+ catch
+ _:Error ->
+ {error,{crash,Error}}
+ end.
+
+
%%% --------------------------------------------------------
%%% Functions which handle inet prim_loader
%%% --------------------------------------------------------
@@ -694,7 +736,7 @@ inet_get_file_from_port1(_File, [], State) ->
inet_send_and_rcv(Msg, Tag, State) when State#state.data =:= noport ->
{ok,Tcp} = find_master(State#state.hosts), %% reconnect
inet_send_and_rcv(Msg, Tag, State#state{data = Tcp,
- timeout = ?IDLE_TIMEOUT});
+ timeout = ?INET_IDLE_TIMEOUT});
inet_send_and_rcv(Msg, Tag, #state{data = Tcp, timeout = Timeout} = State) ->
prim_inet:send(Tcp, term_to_binary(Msg)),
receive
@@ -819,32 +861,19 @@ prim_init() ->
end,
cache_new(#prim_state{debug = Deb}).
-prim_release_archives(PS) ->
- debug(PS, release_archives),
- {Res, PS2} = prim_do_release_archives(PS, get(), []),
- debug(PS2, {return, Res}),
- {Res, PS2}.
-
-prim_do_release_archives(PS, [{ArchiveFile, DictVal} | KeyVals], Acc) ->
- Res =
- case DictVal of
- {primary, _PrimZip, _FI, _ParserFun} ->
- ok; % Keep primary archive
- {Cache, _FI} ->
- debug(PS, {release, cache, ArchiveFile}),
- erase(ArchiveFile),
- clear_cache(ArchiveFile, Cache)
- end,
- case Res of
- ok ->
- prim_do_release_archives(PS, KeyVals, Acc);
- {error, Reason} ->
- prim_do_release_archives(PS, KeyVals, [{ArchiveFile, Reason} | Acc])
- end;
-prim_do_release_archives(PS, [], []) ->
- {ok, PS#prim_state{primary_archive = undefined}};
-prim_do_release_archives(PS, [], Errors) ->
- {{error, Errors}, PS#prim_state{primary_archive = undefined}}.
+prim_purge_cache() ->
+ do_prim_purge_cache(get()).
+
+do_prim_purge_cache([{Key,Val}|T]) ->
+ case Val of
+ {Cache,_FI} ->
+ catch clear_cache(Key, Cache);
+ _ ->
+ ok
+ end,
+ do_prim_purge_cache(T);
+do_prim_purge_cache([]) ->
+ ok.
prim_set_primary_archive(PS, undefined, undefined, undefined, _ParserFun) ->
debug(PS, {set_primary_archive, clean}),
@@ -1287,70 +1316,62 @@ path_join([Path],Acc) ->
path_join([Path|Paths],Acc) ->
path_join(Paths,"/" ++ reverse(Path) ++ Acc).
-name_split(ArchiveFile, File0) ->
- File = absname(File0),
- do_name_split(ArchiveFile, File).
-
-do_name_split(undefined, File) ->
+name_split(undefined, File) ->
%% Ignore primary archive
- case string_split(File, init:archive_extension(), []) of
+ RevExt = reverse(init:archive_extension()),
+ case archive_split(File, RevExt, []) of
no_split ->
- %% Plain file
{file, File};
- {split, _RevArchiveBase, RevArchiveFile, []} ->
- %% Top dir in archive
- ArchiveFile = reverse(RevArchiveFile),
- {archive, ArchiveFile, []};
- {split, _RevArchiveBase, RevArchiveFile, [$/ | FileInArchive]} ->
- %% File in archive
- ArchiveFile = reverse(RevArchiveFile),
- {archive, ArchiveFile, FileInArchive};
- {split, _RevArchiveBase, _RevArchiveFile, _FileInArchive} ->
- %% False match. Assume plain file
- {file, File}
+ Archive ->
+ Archive
end;
-do_name_split(ArchiveFile, File) ->
+name_split(ArchiveFile, File0) ->
%% Look first in primary archive
- case string_match(real_path(File), ArchiveFile, []) of
+ File = absname(File0),
+ case string_match(real_path(File), ArchiveFile) of
no_match ->
%% Archive or plain file
- do_name_split(undefined, File);
- {match, _RevPrimArchiveFile, FileInArchive} ->
+ name_split(undefined, File);
+ {match, FileInArchive} ->
%% Primary archive
{archive, ArchiveFile, FileInArchive}
end.
-string_match([Char | File], [Char | Archive], RevTop) ->
- string_match(File, Archive, [Char | RevTop]);
-string_match([] = File, [], RevTop) ->
- {match, RevTop, File};
-string_match([$/ | File], [], RevTop) ->
- {match, RevTop, File};
-string_match(_File, _Archive, _RevTop) ->
+string_match([Char | File], [Char | Archive]) ->
+ string_match(File, Archive);
+string_match([] = File, []) ->
+ {match, File};
+string_match([$/ | File], []) ->
+ {match, File};
+string_match(_File, _Archive) ->
no_match.
-string_split([Char | File], [Char | Ext] = FullExt, RevTop) ->
- RevTop2 = [Char | RevTop],
- string_split2(File, Ext, RevTop, RevTop2, File, FullExt, RevTop2);
-string_split([Char | File], Ext, RevTop) ->
- string_split(File, Ext, [Char | RevTop]);
-string_split([], _Ext, _RevTop) ->
- no_split.
-
-string_split2([Char | File], [Char | Ext], RevBase, RevTop, SaveFile, SaveExt, SaveTop) ->
- string_split2(File, Ext, RevBase, [Char | RevTop], SaveFile, SaveExt, SaveTop);
-string_split2(File, [], RevBase, RevTop, _SaveFile, _SaveExt, _SaveTop) ->
- {split, RevBase, RevTop, File};
-string_split2(_, _Ext, _RevBase, _RevTop, SaveFile, SaveExt, SaveTop) ->
- string_split(SaveFile, SaveExt, SaveTop).
+archive_split("/"++File, RevExt, Acc) ->
+ case is_prefix(RevExt, Acc) of
+ false ->
+ archive_split(File, RevExt, [$/|Acc]);
+ true ->
+ ArchiveFile = absname(reverse(Acc)),
+ {archive, ArchiveFile, File}
+ end;
+archive_split([H|T], RevExt, Acc) ->
+ archive_split(T, RevExt, [H|Acc]);
+archive_split([], RevExt, Acc) ->
+ case is_prefix(RevExt, Acc) of
+ false ->
+ no_split;
+ true ->
+ ArchiveFile = absname(reverse(Acc)),
+ {archive, ArchiveFile, []}
+ end.
+
+is_prefix([H|T1], [H|T2]) -> is_prefix(T1, T2);
+is_prefix([_|_], _) -> false;
+is_prefix([], _ ) -> true.
%% Parse list of ipv4 addresses
ipv4_list([H | T]) ->
- IPV = if is_atom(H) -> ipv4_address(atom_to_list(H));
- is_list(H) -> ipv4_address(H);
- true -> {error,einal}
- end,
- case IPV of
+ case ipv4_address(H) of
{ok,IP} -> [IP | ipv4_list(T)];
_ -> ipv4_list(T)
end;
@@ -1415,8 +1436,6 @@ absname_vr([Drive, $\: | NameRest], _) ->
%% Assumes normalized name
pathtype(Name) when is_list(Name) ->
case erlang:system_info(os_type) of
- {ose, _} ->
- unix_pathtype(Name);
{unix, _} ->
unix_pathtype(Name);
{win32, _} ->
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 7280b43502..dfbd116d6e 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -71,7 +71,8 @@
| 'milli_seconds'
| 'micro_seconds'
| 'nano_seconds'
- | 'native'.
+ | 'native'
+ | 'perf_counter'.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Native code BIF stubs and their types
@@ -104,7 +105,9 @@
-export([garbage_collect/0, garbage_collect/1, garbage_collect/2]).
-export([garbage_collect_message_area/0, get/0, get/1, get_keys/0, get_keys/1]).
-export([get_module_info/1, get_stacktrace/0, group_leader/0]).
--export([group_leader/2, halt/0, halt/1, halt/2, hash/2, hibernate/3]).
+-export([group_leader/2]).
+-export([halt/0, halt/1, halt/2, hash/2,
+ has_prepared_code_on_load/1, hibernate/3]).
-export([insert_element/3]).
-export([integer_to_binary/1, integer_to_list/1]).
-export([iolist_size/1, iolist_to_binary/1]).
@@ -185,6 +188,8 @@
'receive' |
'print' |
'timestamp' |
+ 'monotonic_timestamp' |
+ 'strict_monotonic_timestamp' |
'label' |
'serial'.
@@ -198,7 +203,10 @@
'exclusive' |
'runnable_ports' |
'runnable_procs' |
- 'scheduler'.
+ 'scheduler' |
+ 'timestamp' |
+ 'monotonic_timestamp' |
+ 'strict_monotonic_timestamp'.
-type system_monitor_option() ::
'busy_port' |
@@ -230,6 +238,8 @@
garbage_collection |
timestamp |
cpu_timestamp |
+ monotonic_timestamp |
+ strict_monotonic_timestamp |
arity |
set_on_spawn |
set_on_first_spawn |
@@ -258,6 +268,8 @@
running |
garbage_collection |
timestamp |
+ monotonic_timestamp |
+ strict_monotonic_timestamp |
arity.
-type trace_info_return() ::
@@ -460,7 +472,7 @@ check_old_code(_Module) ->
CheckResult :: boolean().
check_process_code(Pid, Module) ->
try
- erlang:check_process_code(Pid, Module, [{allow_gc, true}])
+ erts_internal:check_process_code(Pid, Module, [{allow_gc, true}])
catch
error:Error -> erlang:error(Error, [Pid, Module])
end.
@@ -475,51 +487,11 @@ check_process_code(Pid, Module) ->
CheckResult :: boolean() | aborted.
check_process_code(Pid, Module, OptionList) ->
try
- {Async, AllowGC} = get_cpc_opts(OptionList, sync, true),
- case Async of
- {async, ReqId} ->
- {priority, Prio} = erlang:process_info(erlang:self(),
- priority),
- erts_internal:request_system_task(Pid,
- Prio,
- {check_process_code,
- ReqId,
- Module,
- AllowGC}),
- async;
- sync ->
- case Pid == erlang:self() of
- true ->
- erts_internal:check_process_code(Module,
- [{allow_gc, AllowGC}]);
- false ->
- {priority, Prio} = erlang:process_info(erlang:self(),
- priority),
- ReqId = erlang:make_ref(),
- erts_internal:request_system_task(Pid,
- Prio,
- {check_process_code,
- ReqId,
- Module,
- AllowGC}),
- receive
- {check_process_code, ReqId, CheckResult} ->
- CheckResult
- end
- end
- end
+ erts_internal:check_process_code(Pid, Module, OptionList)
catch
error:Error -> erlang:error(Error, [Pid, Module, OptionList])
end.
-% gets async and allow_gc opts and verify valid option list
-get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, AllowGC) ->
- get_cpc_opts(Options, AsyncTuple, AllowGC);
-get_cpc_opts([{allow_gc, AllowGC} | Options], Async, _OldAllowGC) ->
- get_cpc_opts(Options, Async, AllowGC);
-get_cpc_opts([], Async, AllowGC) ->
- {Async, AllowGC}.
-
%% crc32/1
-spec erlang:crc32(Data) -> non_neg_integer() when
Data :: iodata().
@@ -1027,6 +999,12 @@ halt(_Status, _Options) ->
hash(_Term, _Range) ->
erlang:nif_error(undefined).
+%% has_prepared_code_on_load/1
+-spec erlang:has_prepared_code_on_load(PreparedCode) -> boolean() when
+ PreparedCode :: binary().
+has_prepared_code_on_load(_PreparedCode) ->
+ erlang:nif_error(undefined).
+
%% hibernate/3
-spec erlang:hibernate(Module, Function, Args) -> no_return() when
Module :: module(),
@@ -1378,6 +1356,7 @@ convert_time_unit(Time, FromUnit, ToUnit) ->
try
FU = case FromUnit of
native -> erts_internal:time_unit();
+ perf_counter -> erts_internal:perf_counter_unit();
nano_seconds -> 1000*1000*1000;
micro_seconds -> 1000*1000;
milli_seconds -> 1000;
@@ -1386,6 +1365,7 @@ convert_time_unit(Time, FromUnit, ToUnit) ->
end,
TU = case ToUnit of
native -> erts_internal:time_unit();
+ perf_counter -> erts_internal:perf_counter_unit();
nano_seconds -> 1000*1000*1000;
micro_seconds -> 1000*1000;
milli_seconds -> 1000;
@@ -1464,8 +1444,16 @@ processes() ->
%% purge_module/1
-spec purge_module(Module) -> true when
Module :: atom().
-purge_module(_Module) ->
- erlang:nif_error(undefined).
+purge_module(Module) when erlang:is_atom(Module) ->
+ case erts_code_purger:purge(Module) of
+ {false, _} ->
+ erlang:error(badarg, [Module]);
+ {true, _} ->
+ true
+ end;
+purge_module(Arg) ->
+ erlang:error(badarg, [Arg]).
+
%% put/2
-spec put(Key, Val) -> term() when
@@ -2027,12 +2015,21 @@ nodes(_Arg) ->
| eof
| {parallelism, Boolean :: boolean()}
| hide.
-open_port(_PortName,_PortSettings) ->
- erlang:nif_error(undefined).
+open_port(PortName, PortSettings) ->
+ case case erts_internal:open_port(PortName, PortSettings) of
+ Ref when erlang:is_reference(Ref) -> receive {Ref, Res} -> Res end;
+ Res -> Res
+ end of
+ Port when erlang:is_port(Port) -> Port;
+ Error -> erlang:error(Error, [PortName, PortSettings])
+ end.
-type priority_level() ::
low | normal | high | max.
+-type message_queue_data() ::
+ off_heap | on_heap | mixed.
+
-spec process_flag(trap_exit, Boolean) -> OldBoolean when
Boolean :: boolean(),
OldBoolean :: boolean();
@@ -2045,6 +2042,9 @@ open_port(_PortName,_PortSettings) ->
(min_bin_vheap_size, MinBinVHeapSize) -> OldMinBinVHeapSize when
MinBinVHeapSize :: non_neg_integer(),
OldMinBinVHeapSize :: non_neg_integer();
+ (message_queue_data, MQD) -> OldMQD when
+ MQD :: message_queue_data(),
+ OldMQD :: message_queue_data();
(priority, Level) -> OldLevel when
Level :: priority_level(),
OldLevel :: priority_level();
@@ -2071,6 +2071,7 @@ process_flag(_Flag, _Value) ->
dictionary |
error_handler |
garbage_collection |
+ garbage_collection_info |
group_leader |
heap_size |
initial_call |
@@ -2083,6 +2084,7 @@ process_flag(_Flag, _Value) ->
min_bin_vheap_size |
monitored_by |
monitors |
+ message_queue_data |
priority |
reductions |
registered_name |
@@ -2110,6 +2112,7 @@ process_flag(_Flag, _Value) ->
{dictionary, Dictionary :: [{Key :: term(), Value :: term()}]} |
{error_handler, Module :: module()} |
{garbage_collection, GCInfo :: [{atom(),non_neg_integer()}]} |
+ {garbage_collection_info, GCInfo :: [{atom(),non_neg_integer()}]} |
{group_leader, GroupLeader :: pid()} |
{heap_size, Size :: non_neg_integer()} |
{initial_call, mfa()} |
@@ -2124,6 +2127,7 @@ process_flag(_Flag, _Value) ->
{monitors,
Monitors :: [{process, Pid :: pid() |
{RegName :: atom(), Node :: node()}}]} |
+ {message_queue_data, MQD :: message_queue_data()} |
{priority, Level :: priority_level()} |
{reductions, Number :: non_neg_integer()} |
{registered_name, Atom :: atom()} |
@@ -2178,6 +2182,8 @@ send(_Dest,_Msg,_Options) ->
('receive') -> {'receive', boolean()};
(print) -> {print, boolean()};
(timestamp) -> {timestamp, boolean()};
+ (monotonic_timestamp) -> {timestamp, boolean()};
+ (strict_monotonic_timestamp) -> {strict_monotonic_timestamp, boolean()};
(label) -> [] | {label, non_neg_integer()};
(serial) -> [] | {serial, {non_neg_integer(), non_neg_integer()}}.
seq_trace_info(_What) ->
@@ -2205,7 +2211,9 @@ setelement(_Index, _Tuple1, _Value) ->
spawn_opt(_Tuple) ->
erlang:nif_error(undefined).
--spec statistics(context_switches) -> {ContextSwitches,0} when
+-spec statistics(active_tasks) -> [ActiveTasks] when
+ ActiveTasks :: non_neg_integer();
+ (context_switches) -> {ContextSwitches,0} when
ContextSwitches :: non_neg_integer();
(exact_reductions) -> {Total_Exact_Reductions,
Exact_Reductions_Since_Last_Call} when
@@ -2217,11 +2225,23 @@ spawn_opt(_Tuple) ->
(io) -> {{input, Input}, {output, Output}} when
Input :: non_neg_integer(),
Output :: non_neg_integer();
+ (microstate_accounting) -> [MSAcc_Thread] | undefined when
+ MSAcc_Thread :: #{ type => MSAcc_Thread_Type,
+ id => MSAcc_Thread_Id,
+ counters => MSAcc_Counters},
+ MSAcc_Thread_Type :: scheduler | async | aux,
+ MSAcc_Thread_Id :: non_neg_integer(),
+ MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() },
+ MSAcc_Thread_State :: alloc | aux | bif | busy_wait | check_io |
+ emulator | ets | gc | gc_fullsweep | nif |
+ other | port | send | sleep | timers;
(reductions) -> {Total_Reductions,
Reductions_Since_Last_Call} when
Total_Reductions :: non_neg_integer(),
Reductions_Since_Last_Call :: non_neg_integer();
(run_queue) -> non_neg_integer();
+ (run_queue_lengths) -> [RunQueueLenght] when
+ RunQueueLenght :: non_neg_integer();
(runtime) -> {Total_Run_Time, Time_Since_Last_Call} when
Total_Run_Time :: non_neg_integer(),
Time_Since_Last_Call :: non_neg_integer();
@@ -2229,6 +2249,10 @@ spawn_opt(_Tuple) ->
SchedulerId :: pos_integer(),
ActiveTime :: non_neg_integer(),
TotalTime :: non_neg_integer();
+ (total_active_tasks) -> ActiveTasks when
+ ActiveTasks :: non_neg_integer();
+ (total_run_queue_lengths) -> TotalRunQueueLenghts when
+ TotalRunQueueLenghts :: non_neg_integer();
(wall_clock) -> {Total_Wallclock_Time,
Wallclock_Time_Since_Last_Call} when
Total_Wallclock_Time :: non_neg_integer(),
@@ -2265,6 +2289,9 @@ subtract(_,_) ->
(fullsweep_after, Number) -> OldNumber when
Number :: non_neg_integer(),
OldNumber :: non_neg_integer();
+ (microstate_accounting, Action) -> OldState when
+ Action :: true | false | reset,
+ OldState :: true | false;
(min_heap_size, MinHeapSize) -> OldMinHeapSize when
MinHeapSize :: non_neg_integer(),
OldMinHeapSize :: non_neg_integer();
@@ -2273,8 +2300,8 @@ subtract(_,_) ->
MinBinVHeapSize :: non_neg_integer(),
OldMinBinVHeapSize :: non_neg_integer();
(multi_scheduling, BlockState) -> OldBlockState when
- BlockState :: block | unblock,
- OldBlockState :: block | unblock | enabled;
+ BlockState :: block | unblock | block_normal | unblock_normal,
+ OldBlockState :: blocked | disabled | enabled;
(scheduler_bind_type, How) -> OldBindType when
How :: scheduler_bind_type() | default_bind,
OldBindType :: scheduler_bind_type();
@@ -2419,13 +2446,15 @@ tuple_to_list(_Tuple) ->
logical_processors_available |
logical_processors_online) -> unknown | pos_integer();
(machine) -> string();
+ (message_queue_data) -> message_queue_data();
(min_heap_size) -> {min_heap_size, MinHeapSize :: pos_integer()};
(min_bin_vheap_size) -> {min_bin_vheap_size,
MinBinVHeapSize :: pos_integer()};
(modified_timing_level) -> integer() | undefined;
- (multi_scheduling) -> disabled | blocked | enabled;
+ (multi_scheduling) -> disabled | blocked | blocked_normal | enabled;
(multi_scheduling_blockers) -> [Pid :: pid()];
(nif_version) -> string();
+ (normal_multi_scheduling_blockers) -> [Pid :: pid()];
(otp_release) -> string();
(os_monotonic_time_source) -> [{atom(),term()}];
(os_system_time_source) -> [{atom(),term()}];
@@ -2553,14 +2582,19 @@ spawn_monitor(M, F, A) when erlang:is_atom(M),
spawn_monitor(M, F, A) ->
erlang:error(badarg, [M,F,A]).
+
+-type spawn_opt_option() ::
+ link
+ | monitor
+ | {priority, Level :: priority_level()}
+ | {fullsweep_after, Number :: non_neg_integer()}
+ | {min_heap_size, Size :: non_neg_integer()}
+ | {min_bin_vheap_size, VSize :: non_neg_integer()}
+ | {message_queue_data, MQD :: message_queue_data()}.
+
-spec spawn_opt(Fun, Options) -> pid() | {pid(), reference()} when
Fun :: function(),
- Options :: [Option],
- Option :: link | monitor
- | {priority, Level :: priority_level()}
- | {fullsweep_after, Number :: non_neg_integer()}
- | {min_heap_size, Size :: non_neg_integer()}
- | {min_bin_vheap_size, VSize :: non_neg_integer()}.
+ Options :: [spawn_opt_option()].
spawn_opt(F, O) when erlang:is_function(F) ->
spawn_opt(erlang, apply, [F, []], O);
spawn_opt({M,F}=MF, O) when erlang:is_atom(M), erlang:is_atom(F) ->
@@ -2573,12 +2607,7 @@ spawn_opt(F, O) ->
-spec spawn_opt(Node, Fun, Options) -> pid() | {pid(), reference()} when
Node :: node(),
Fun :: function(),
- Options :: [Option],
- Option :: link | monitor
- | {priority, Level :: priority_level()}
- | {fullsweep_after, Number :: non_neg_integer()}
- | {min_heap_size, Size :: non_neg_integer()}
- | {min_bin_vheap_size, VSize :: non_neg_integer()}.
+ Options :: [spawn_opt_option()].
spawn_opt(N, F, O) when N =:= erlang:node() ->
spawn_opt(F, O);
spawn_opt(N, F, O) when erlang:is_function(F) ->
@@ -2665,12 +2694,7 @@ spawn_link(N,M,F,A) ->
Module :: module(),
Function :: atom(),
Args :: [term()],
- Options :: [Option],
- Option :: link | monitor
- | {priority, Level :: priority_level()}
- | {fullsweep_after, Number :: non_neg_integer()}
- | {min_heap_size, Size :: non_neg_integer()}
- | {min_bin_vheap_size, VSize :: non_neg_integer()}.
+ Options :: [spawn_opt_option()].
spawn_opt(M, F, A, Opts) ->
case catch erlang:spawn_opt({M,F,A,Opts}) of
{'EXIT',{Reason,_}} ->
@@ -2685,12 +2709,7 @@ spawn_opt(M, F, A, Opts) ->
Module :: module(),
Function :: atom(),
Args :: [term()],
- Options :: [Option],
- Option :: link | monitor
- | {priority, Level :: priority_level()}
- | {fullsweep_after, Number :: non_neg_integer()}
- | {min_heap_size, Size :: non_neg_integer()}
- | {min_bin_vheap_size, VSize :: non_neg_integer()}.
+ Options :: [spawn_opt_option()].
spawn_opt(N, M, F, A, O) when N =:= erlang:node(),
erlang:is_atom(M), erlang:is_atom(F),
erlang:is_list(A), erlang:is_list(O) ->
diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src
index 8442aaf7e8..e53b6e5bab 100644
--- a/erts/preloaded/src/erts.app.src
+++ b/erts/preloaded/src/erts.app.src
@@ -27,6 +27,7 @@
erts_internal,
init,
otp_ring0,
+ erts_code_purger,
prim_eval,
prim_file,
prim_inet,
diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl
new file mode 100644
index 0000000000..d1e64342e0
--- /dev/null
+++ b/erts/preloaded/src/erts_code_purger.erl
@@ -0,0 +1,299 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erts_code_purger).
+
+%% Purpose : Implement system process erts_code_purger
+%% to handle code module purging.
+
+-export([start/0, purge/1, soft_purge/1]).
+
+-spec start() -> term().
+start() ->
+ register(erts_code_purger, self()),
+ process_flag(trap_exit, true),
+ loop().
+
+loop() ->
+ _ = receive
+ {purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
+ Res = do_purge(Mod),
+ From ! {reply, purge, Res, Ref};
+
+ {soft_purge,Mod,From,Ref} when is_atom(Mod), is_pid(From) ->
+ Res = do_soft_purge(Mod),
+ From ! {reply, soft_purge, Res, Ref};
+
+ _Other -> ignore
+ end,
+ loop().
+
+
+%% purge(Module)
+%% Kill all processes running code from *old* Module, and then purge the
+%% module. Return {WasOld, DidKill}:
+%% {false, false} there was no old module to purge
+%% {true, false} module purged, no process killed
+%% {true, true} module purged, at least one process killed
+
+purge(Mod) when is_atom(Mod) ->
+ Ref = make_ref(),
+ erts_code_purger ! {purge, Mod, self(), Ref},
+ receive
+ {reply, purge, Result, Ref} ->
+ Result
+ end.
+
+
+do_purge(Mod) ->
+ case erts_internal:copy_literals(Mod, true) of
+ false ->
+ {false, false};
+ true ->
+ DidKill = check_proc_code(erlang:processes(), Mod, true),
+ true = erts_internal:copy_literals(Mod, false),
+ WasPurged = erts_internal:purge_module(Mod),
+ {WasPurged, DidKill}
+ end.
+
+%% soft_purge(Module)
+%% Purge old code only if no procs remain that run old code.
+%% Return true in that case, false if procs remain (in this
+%% case old code is not purged)
+
+soft_purge(Mod) ->
+ Ref = make_ref(),
+ erts_code_purger ! {soft_purge, Mod, self(), Ref},
+ receive
+ {reply, soft_purge, Result, Ref} ->
+ Result
+ end.
+
+
+do_soft_purge(Mod) ->
+ case erts_internal:copy_literals(Mod, true) of
+ false ->
+ true;
+ true ->
+ DoPurge = check_proc_code(erlang:processes(), Mod, false),
+ true = erts_internal:copy_literals(Mod, false),
+ case DoPurge of
+ false ->
+ false;
+ true ->
+ erts_internal:purge_module(Mod),
+ true
+ end
+ end.
+
+%%
+%% check_proc_code(Pids, Mod, Hard) - Send asynchronous
+%% requests to all processes to perform a check_process_code
+%% operation. Each process will check their own state and
+%% reply with the result. If 'Hard' equals
+%% - true, processes that refer 'Mod' will be killed. If
+%% any processes were killed true is returned; otherwise,
+%% false.
+%% - false, and any processes refer 'Mod', false will
+%% returned; otherwise, true.
+%%
+%% Requests will be sent to all processes identified by
+%% Pids at once, but without allowing GC to be performed.
+%% Check process code operations that are aborted due to
+%% GC need, will be restarted allowing GC. However, only
+%% ?MAX_CPC_GC_PROCS outstanding operation allowing GC at
+%% a time will be allowed. This in order not to blow up
+%% memory wise.
+%%
+%% We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS
+%% outstanding kills. This both in order to avoid flooding
+%% our message queue with 'DOWN' messages and limiting the
+%% amount of memory used to keep references to all
+%% outstanding kills.
+%%
+
+%% We maybe should allow more than two outstanding
+%% GC requests, but for now we play it safe...
+-define(MAX_CPC_GC_PROCS, 2).
+-define(MAX_CPC_NO_OUTSTANDING_KILLS, 10).
+
+-record(cpc_static, {hard, module, tag}).
+
+-record(cpc_kill, {outstanding = [],
+ no_outstanding = 0,
+ waiting = [],
+ killed = false}).
+
+check_proc_code(Pids, Mod, Hard) ->
+ Tag = erlang:make_ref(),
+ CpcS = #cpc_static{hard = Hard,
+ module = Mod,
+ tag = Tag},
+ check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true).
+
+check_proc_code(#cpc_static{hard = true}, 0, 0, [],
+ #cpc_kill{outstanding = [], waiting = [], killed = Killed},
+ true) ->
+ %% No outstanding requests. We did a hard check, so result is whether or
+ %% not we killed any processes...
+ Killed;
+check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) ->
+ %% No outstanding requests and we did a soft check...
+ Success;
+check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0,
+ [], _KillState, false) ->
+ %% Failed soft check; just cleanup the remaining replies corresponding
+ %% to the requests we've sent...
+ {NoReq1, NoGcReq1} = receive
+ {check_process_code, {Tag, _P, GC}, _Res} ->
+ case GC of
+ false -> {NoReq0-1, NoGcReq0};
+ true -> {NoReq0, NoGcReq0-1}
+ end
+ end,
+ check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false);
+check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0,
+ KillState0, Success) ->
+
+ %% Check if we should request a GC operation
+ {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of
+ GcOpAllowed when GcOpAllowed == false;
+ NeedGC0 == [] ->
+ {NoGcReq0, NeedGC0};
+ _ ->
+ {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)}
+ end,
+
+ %% Wait for a cpc reply or 'DOWN' message
+ {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag,
+ NoReq0,
+ NoGcReq1,
+ KillState0),
+
+ %% Check the result of the reply
+ case Result of
+ aborted ->
+ %% Operation aborted due to the need to GC in order to
+ %% determine if the process is referring the module.
+ %% Schedule the operation for restart allowing GC...
+ check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1,
+ Success);
+ false ->
+ %% Process not referring the module; done with this process...
+ check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1,
+ Success);
+ true ->
+ %% Process referring the module...
+ case CpcS#cpc_static.hard of
+ false ->
+ %% ... and soft check. The whole operation failed so
+ %% no point continuing; clean up and fail...
+ check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1,
+ false);
+ true ->
+ %% ... and hard check; schedule kill of it...
+ check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1,
+ cpc_sched_kill(Pid, KillState1), Success)
+ end;
+ 'DOWN' ->
+ %% Handled 'DOWN' message
+ check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1,
+ KillState1, Success)
+ end.
+
+cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) ->
+ receive
+ {check_process_code, {Tag, Pid, GC}, Res} ->
+ cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+ end;
+cpc_recv(Tag, NoReq, NoGcReq,
+ #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) ->
+ receive
+ {'DOWN', R, process, _, _} when R == R0;
+ R == R1;
+ R == R2;
+ R == R3;
+ R == R4 ->
+ cpc_handle_down(NoReq, NoGcReq, R, KillState);
+ {check_process_code, {Tag, Pid, GC}, Res} ->
+ cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+ end;
+cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) ->
+ receive
+ {'DOWN', R, process, _, _} ->
+ cpc_handle_down(NoReq, NoGcReq, R, KillState);
+ {check_process_code, {Tag, Pid, GC}, Res} ->
+ cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState)
+ end.
+
+cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs,
+ no_outstanding = N} = KillState) ->
+ {NoReq, NoGcReq, undefined, 'DOWN',
+ cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs),
+ no_outstanding = N-1})}.
+
+cpc_list_rm(R, [R|Rs]) ->
+ Rs;
+cpc_list_rm(R0, [R1|Rs]) ->
+ [R1|cpc_list_rm(R0, Rs)].
+
+cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) ->
+ {NoReq-1, NoGcReq, Pid, Res, KillState};
+cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) ->
+ {NoReq, NoGcReq-1, Pid, Res, KillState}.
+
+cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) ->
+ KillState;
+cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs,
+ no_outstanding = N,
+ waiting = [P|Ps]} = KillState) ->
+ R = erlang:monitor(process, P),
+ exit(P, kill),
+ KillState#cpc_kill{outstanding = [R|Rs],
+ no_outstanding = N+1,
+ waiting = Ps,
+ killed = true}.
+
+cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState)
+ when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS ->
+ KillState#cpc_kill{waiting = [Pid|Pids]};
+cpc_sched_kill(Pid,
+ #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) ->
+ R = erlang:monitor(process, Pid),
+ exit(Pid, kill),
+ KillState#cpc_kill{outstanding = [R|Rs],
+ no_outstanding = N+1,
+ killed = true}.
+
+cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) ->
+ erts_internal:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}},
+ {allow_gc, AllowGc},
+ {copy_literals, true}]).
+
+cpc_request_gc(CpcS, [Pid|Pids]) ->
+ cpc_request(CpcS, Pid, true),
+ Pids.
+
+cpc_init(_CpcS, [], NoReqs) ->
+ NoReqs;
+cpc_init(CpcS, [Pid|Pids], NoReqs) ->
+ cpc_request(CpcS, Pid, false),
+ cpc_init(CpcS, Pids, NoReqs+1).
+
+% end of check_proc_code() implementation.
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 7ed4efea4b..330fcc4a9c 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -31,22 +31,33 @@
-export([await_port_send_result/3]).
-export([cmp_term/2]).
--export([map_to_tuple_keys/1, map_type/1, map_hashmap_children/1]).
--export([port_command/3, port_connect/2, port_close/1,
+-export([map_to_tuple_keys/1, term_type/1, map_hashmap_children/1]).
+-export([open_port/2, port_command/3, port_connect/2, port_close/1,
port_control/3, port_call/3, port_info/1, port_info/2]).
+-export([system_check/1,
+ gather_system_check_result/1]).
+
-export([request_system_task/3]).
--export([check_process_code/2]).
+-export([check_process_code/3]).
+-export([copy_literals/2]).
+-export([purge_module/1]).
-export([flush_monitor_messages/3]).
-export([await_result/1, gather_io_bytes/2]).
--export([time_unit/0]).
+-export([time_unit/0, perf_counter_unit/0]).
-export([is_system_process/1]).
+-export([await_microstate_accounting_modifications/3,
+ gather_microstate_accounting_result/2]).
+
+%% Auto-import name clash
+-export([check_process_code/2]).
+
%%
%% Await result of send to port
%%
@@ -88,6 +99,13 @@ gather_io_bytes(Ref, No, InAcc, OutAcc) ->
%% Statically linked port NIFs
%%
+-spec erts_internal:open_port(PortName, PortSettings) -> Result when
+ PortName :: tuple(),
+ PortSettings :: term(),
+ Result :: port() | reference() | atom().
+open_port(_PortName, _PortSettings) ->
+ erlang:nif_error(undefined).
+
-spec erts_internal:port_command(Port, Data, OptionList) -> Result when
Port :: port() | atom(),
Data :: iodata(),
@@ -184,19 +202,105 @@ port_info(_Result, _Item) ->
-spec request_system_task(Pid, Prio, Request) -> 'ok' when
Prio :: 'max' | 'high' | 'normal' | 'low',
Request :: {'garbage_collect', term()}
- | {'check_process_code', term(), module(), boolean()},
+ | {'check_process_code', term(), module(), non_neg_integer()},
Pid :: pid().
request_system_task(_Pid, _Prio, _Request) ->
erlang:nif_error(undefined).
--spec check_process_code(Module, OptionList) -> boolean() when
+-define(ERTS_CPC_ALLOW_GC, (1 bsl 0)).
+-define(ERTS_CPC_COPY_LITERALS, (1 bsl 1)).
+
+-spec check_process_code(Module, Flags) -> boolean() when
Module :: module(),
- Option :: {allow_gc, boolean()},
- OptionList :: [Option].
-check_process_code(_Module, _OptionList) ->
+ Flags :: non_neg_integer().
+check_process_code(_Module, _Flags) ->
erlang:nif_error(undefined).
+-spec check_process_code(Pid, Module, OptionList) -> CheckResult | async when
+ Pid :: pid(),
+ Module :: module(),
+ RequestId :: term(),
+ Option :: {async, RequestId} | {allow_gc, boolean()} | {copy_literals, boolean()},
+ OptionList :: [Option],
+ CheckResult :: boolean() | aborted.
+check_process_code(Pid, Module, OptionList) ->
+ {Async, Flags} = get_cpc_opts(OptionList, sync, ?ERTS_CPC_ALLOW_GC),
+ case Async of
+ {async, ReqId} ->
+ {priority, Prio} = erlang:process_info(erlang:self(),
+ priority),
+ erts_internal:request_system_task(Pid,
+ Prio,
+ {check_process_code,
+ ReqId,
+ Module,
+ Flags}),
+ async;
+ sync ->
+ case Pid == erlang:self() of
+ true ->
+ erts_internal:check_process_code(Module, Flags);
+ false ->
+ {priority, Prio} = erlang:process_info(erlang:self(),
+ priority),
+ ReqId = erlang:make_ref(),
+ erts_internal:request_system_task(Pid,
+ Prio,
+ {check_process_code,
+ ReqId,
+ Module,
+ Flags}),
+ receive
+ {check_process_code, ReqId, CheckResult} ->
+ CheckResult
+ end
+ end
+ end.
+
+% gets async and flag opts and verify valid option list
+get_cpc_opts([{async, _ReqId} = AsyncTuple | Options], _OldAsync, Flags) ->
+ get_cpc_opts(Options, AsyncTuple, Flags);
+get_cpc_opts([{allow_gc, AllowGC} | Options], Async, Flags) ->
+ get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_ALLOW_GC, AllowGC));
+get_cpc_opts([{copy_literals, CopyLit} | Options], Async, Flags) ->
+ get_cpc_opts(Options, Async, cpc_flags(Flags, ?ERTS_CPC_COPY_LITERALS, CopyLit));
+get_cpc_opts([], Async, Flags) ->
+ {Async, Flags}.
+
+cpc_flags(OldFlags, Bit, true) ->
+ OldFlags bor Bit;
+cpc_flags(OldFlags, Bit, false) ->
+ OldFlags band (bnot Bit).
+
+-spec copy_literals(Module,Bool) -> 'true' | 'false' | 'aborted' when
+ Module :: module(),
+ Bool :: boolean().
+copy_literals(_Mod, _Bool) ->
+ erlang:nif_error(undefined).
+
+-spec purge_module(Module) -> boolean() when
+ Module :: module().
+purge_module(_Module) ->
+ erlang:nif_error(undefined).
+
+-spec system_check(Type) -> 'ok' when
+ Type :: 'schedulers'.
+
+system_check(_Type) ->
+ erlang:nif_error(undefined).
+
+gather_system_check_result(Ref) when is_reference(Ref) ->
+ gather_system_check_result(Ref, erlang:system_info(schedulers)).
+
+gather_system_check_result(_Ref, 0) ->
+ ok;
+gather_system_check_result(Ref, N) ->
+ receive
+ Ref ->
+ gather_system_check_result(Ref, N - 1)
+ end.
+
%% term compare where integer() < float() = true
-spec cmp_term(A,B) -> Result when
@@ -215,12 +319,18 @@ cmp_term(_A,_B) ->
map_to_tuple_keys(_M) ->
erlang:nif_error(undefined).
-%% return the internal map type
--spec map_type(M) -> Type when
- M :: map(),
- Type :: 'flatmap' | 'hashmap' | 'hashmap_node'.
-
-map_type(_M) ->
+%% return the internal term type
+-spec term_type(T) -> Type when
+ T :: term(),
+ Type :: 'flatmap' | 'hashmap' | 'hashmap_node'
+ | 'fixnum' | 'bignum' | 'hfloat'
+ | 'list' | 'tuple' | 'export' | 'fun'
+ | 'refc_binary' | 'heap_binary' | 'sub_binary'
+ | 'reference' | 'external_reference'
+ | 'pid' | 'external_pid' | 'port' | 'external_port'
+ | 'atom' | 'catch' | 'nil'.
+
+term_type(_T) ->
erlang:nif_error(undefined).
%% return the internal hashmap sub-nodes from
@@ -258,8 +368,38 @@ flush_monitor_messages(Ref, Multi, Res) when is_reference(Ref) ->
time_unit() ->
erlang:nif_error(undefined).
+-spec erts_internal:perf_counter_unit() -> pos_integer().
+
+perf_counter_unit() ->
+ erlang:nif_error(undefined).
+
-spec erts_internal:is_system_process(Pid) -> boolean() when
Pid :: pid().
is_system_process(_Pid) ->
erlang:nif_error(undefined).
+
+-spec await_microstate_accounting_modifications(Ref, Result, Threads) -> boolean() when
+ Ref :: reference(),
+ Result :: boolean(),
+ Threads :: pos_integer().
+
+await_microstate_accounting_modifications(Ref, Result, Threads) ->
+ _ = microstate_accounting(Ref,Threads),
+ Result.
+
+-spec gather_microstate_accounting_result(Ref, Threads) -> [#{}] when
+ Ref :: reference(),
+ Threads :: pos_integer().
+
+gather_microstate_accounting_result(Ref, Threads) ->
+ microstate_accounting(Ref, Threads).
+
+microstate_accounting(_Ref, 0) ->
+ [];
+microstate_accounting(Ref, Threads) ->
+ receive
+ Ref -> microstate_accounting(Ref, Threads - 1);
+ {Ref, Res} ->
+ [Res | microstate_accounting(Ref, Threads - 1)]
+ end.
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index c4e37b76f1..5de3732c20 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -23,7 +23,6 @@
%% a local file or distributed from another erlang node.
%%
%% Flags:
-%% -id Identity : identity of the system.
%% -boot File : Absolute file name of the boot script.
%% -boot_var Var Value
%% : $Var in the boot script is expanded to
@@ -75,6 +74,19 @@
subscribed = []}).
-type state() :: #state{}.
+%% Data for eval_script/2.
+-record(es,
+ {init,
+ debug,
+ path,
+ pa,
+ pz,
+ path_choice,
+ prim_load,
+ load_mode,
+ vars
+ }).
+
-define(ON_LOAD_HANDLER, init__boot__on_load_handler).
debug(false, _) -> ok;
@@ -117,7 +129,7 @@ bs2ss(L) ->
get_status() ->
request(get_status).
--spec fetch_loaded() -> [atom()].
+-spec fetch_loaded() -> [{module(),file:filename()}].
fetch_loaded() ->
request(fetch_loaded).
@@ -167,11 +179,9 @@ stop(Status) -> init ! {stop,{stop,Status}}, ok.
boot(BootArgs) ->
register(init, self()),
process_flag(trap_exit, true),
- start_on_load_handler_process(),
{Start0,Flags,Args} = parse_boot_args(BootArgs),
Start = map(fun prepare_run_args/1, Start0),
- Flags0 = flags_to_atoms_again(Flags),
- boot(Start,Flags0,Args).
+ boot(Start, Flags, Args).
prepare_run_args({eval, [Expr]}) ->
{eval,Expr};
@@ -203,16 +213,6 @@ map(_F, []) ->
map(F, [X|Rest]) ->
[F(X) | map(F, Rest)].
-flags_to_atoms_again([]) ->
- [];
-flags_to_atoms_again([{F0,L0}|Rest]) ->
- L = L0,
- F = b2a(F0),
- [{F,L}|flags_to_atoms_again(Rest)];
-flags_to_atoms_again([{F0}|Rest]) ->
- F = b2a(F0),
- [{F}|flags_to_atoms_again(Rest)].
-
-spec code_path_choice() -> 'relaxed' | 'strict'.
code_path_choice() ->
case get_argument(code_path_choice) of
@@ -225,6 +225,7 @@ code_path_choice() ->
end.
boot(Start,Flags,Args) ->
+ start_on_load_handler_process(),
BootPid = do_boot(Flags,Start),
State = #state{flags = Flags,
args = Args,
@@ -337,7 +338,7 @@ boot_loop(BootPid, State) ->
end.
ensure_loaded(Module, Loaded) ->
- File = concat([Module,objfile_extension()]),
+ File = atom_to_list(Module) ++ objfile_extension(),
case catch load_mod(Module,File) of
{ok, FullName} ->
{{module, Module}, [{Module, FullName}|Loaded]};
@@ -451,9 +452,9 @@ do_handle_msg(Msg,State) ->
%%% -------------------------------------------------
make_permanent(Boot,Config,Flags0,State) ->
- case set_flag('-boot',Boot,Flags0) of
+ case set_flag(boot, Boot, Flags0) of
{ok,Flags1} ->
- case set_flag('-config',Config,Flags1) of
+ case set_flag(config, Config, Flags1) of
{ok,Flags} ->
{ok,State#state{flags = Flags}};
Error ->
@@ -635,9 +636,9 @@ unload(_) ->
do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())).
do_unload([M|Mods]) ->
- catch erlang:purge_module(M),
+ catch erts_internal:purge_module(M),
catch erlang:delete_module(M),
- catch erlang:purge_module(M),
+ catch erts_internal:purge_module(M),
do_unload(Mods);
do_unload([]) ->
purge_all_hipe_refs(),
@@ -691,17 +692,15 @@ sleep(T) -> receive after T -> ok end.
%%% The loader shall run for ever!
%%% -------------------------------------------------
-start_prim_loader(Init,Id,Pgm,Nodes,Path,{Pa,Pz}) ->
- case erl_prim_loader:start(Id,Pgm,Nodes) of
- {ok,Pid} when Path =:= false ->
- InitPath = append(Pa,["."|Pz]),
- erl_prim_loader:set_path(InitPath),
- add_to_kernel(Init,Pid),
- Pid;
+start_prim_loader(Init, Path0, {Pa,Pz}) ->
+ Path = case Path0 of
+ false -> Pa ++ ["."|Pz];
+ _ -> Path0
+ end,
+ case erl_prim_loader:start() of
{ok,Pid} ->
erl_prim_loader:set_path(Path),
- add_to_kernel(Init,Pid),
- Pid;
+ add_to_kernel(Init, Pid);
{error,Reason} ->
erlang:display({"cannot start loader",Reason}),
exit(Reason)
@@ -715,13 +714,6 @@ add_to_kernel(Init,Pid) ->
ok
end.
-prim_load_flags(Flags) ->
- PortPgm = get_flag('-loader',Flags,<<"efile">>),
- Hosts = get_flag_list('-hosts', Flags, []),
- Id = get_flag('-id',Flags,none),
- Path = get_flag_list('-path',Flags,false),
- {PortPgm, Hosts, Id, Path}.
-
%%% -------------------------------------------------
%%% The boot process fetches a boot script and loads
%%% all modules specified and starts spec. processes.
@@ -734,24 +726,23 @@ do_boot(Flags,Start) ->
do_boot(Init,Flags,Start) ->
process_flag(trap_exit,true),
- {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags),
- Root = b2s(get_flag('-root',Flags)),
- PathFls = path_flags(Flags),
- Pgm = b2s(Pgm0),
- _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes),
- bs2ss(Path),PathFls),
+ Root = get_root(Flags),
+ Path = get_flag_list(path, Flags, false),
+ {Pa,Pz} = PathFls = path_flags(Flags),
+ start_prim_loader(Init, bs2ss(Path), PathFls),
BootFile = bootfile(Flags,Root),
BootList = get_boot(BootFile,Root),
- LoadMode = b2a(get_flag('-mode',Flags,false)),
- Deb = b2a(get_flag('-init_debug',Flags,false)),
+ LoadMode = b2a(get_flag(mode, Flags, false)),
+ Deb = b2a(get_flag(init_debug, Flags, false)),
catch ?ON_LOAD_HANDLER ! {init_debug_flag,Deb},
- BootVars = get_flag_args('-boot_var',Flags),
- ParallelLoad =
- (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0),
+ BootVars = get_boot_vars(Root, Flags),
PathChoice = code_path_choice(),
- eval_script(BootList,Init,PathFls,{Root,BootVars},Path,
- {true,LoadMode,ParallelLoad},Deb,PathChoice),
+ Es = #es{init=Init,debug=Deb,path=Path,pa=Pa,pz=Pz,
+ path_choice=PathChoice,
+ prim_load=true,load_mode=LoadMode,
+ vars=BootVars},
+ eval_script(BootList, Es),
%% To help identifying Purify windows that pop up,
%% print the node name into the Purify log.
@@ -759,21 +750,43 @@ do_boot(Init,Flags,Start) ->
start_em(Start).
+get_root(Flags) ->
+ case get_argument(root, Flags) of
+ {ok,[[Root]]} ->
+ Root;
+ _ ->
+ exit(no_or_multiple_root_variables)
+ end.
+
+get_boot_vars(Root, Flags) ->
+ BootVars = get_boot_vars_1(#{}, Flags),
+ RootKey = <<"ROOT">>,
+ BootVars#{RootKey=>Root}.
+
+get_boot_vars_1(Vars, [{boot_var,[Key,Value]}|T]) ->
+ get_boot_vars_1(Vars#{Key=>Value}, T);
+get_boot_vars_1(_, [{boot_var,_}|_]) ->
+ exit(invalid_boot_var_argument);
+get_boot_vars_1(Vars, [_|T]) ->
+ get_boot_vars_1(Vars, T);
+get_boot_vars_1(Vars, []) ->
+ Vars.
+
bootfile(Flags,Root) ->
- b2s(get_flag('-boot',Flags,concat([Root,"/bin/start"]))).
+ b2s(get_flag(boot, Flags, Root++"/bin/start")).
path_flags(Flags) ->
- Pa = append(reverse(get_flag_args('-pa',Flags))),
- Pz = append(get_flag_args('-pz',Flags)),
+ Pa = append(reverse(get_flag_args(pa, Flags))),
+ Pz = append(get_flag_args(pz, Flags)),
{bs2ss(Pa),bs2ss(Pz)}.
get_boot(BootFile0,Root) ->
- BootFile = concat([BootFile0,".boot"]),
+ BootFile = BootFile0 ++ ".boot",
case get_boot(BootFile) of
{ok, CmdList} ->
CmdList;
not_found -> %% Check for default.
- BootF = concat([Root,"/bin/",BootFile]),
+ BootF = Root ++ "/bin/" ++ BootFile,
case get_boot(BootF) of
{ok, CmdList} ->
CmdList;
@@ -807,93 +820,67 @@ get_boot(BootFile) ->
%% boot process hangs (we want to ensure syncronicity).
%%
-eval_script([{progress,Info}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
- debug(Deb,{progress,Info}),
+eval_script([{progress,Info}=Progress|T], #es{debug=Deb}=Es) ->
+ debug(Deb, Progress),
init ! {self(),progress,Info},
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([{preLoaded,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([{path,Path}|CfgL],Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice) ->
+ eval_script(T, Es);
+eval_script([{preLoaded,_}|T], #es{}=Es) ->
+ eval_script(T, Es);
+eval_script([{path,Path}|T], #es{path=false,pa=Pa,pz=Pz,
+ path_choice=PathChoice,
+ vars=Vars}=Es) ->
RealPath0 = make_path(Pa, Pz, Path, Vars),
RealPath = patch_path(RealPath0, PathChoice),
erl_prim_loader:set_path(RealPath),
- eval_script(CfgL,Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice);
-eval_script([{path,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
+ eval_script(T, Es);
+eval_script([{path,_}|T], #es{}=Es) ->
%% Ignore, use the command line -path flag.
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,embedded,Par},Deb,PathChoice) ->
- eval_script(CfgL,Init,PathFs,Vars,P,{true,embedded,Par},Deb,PathChoice);
-eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,E,Par},Deb,PathChoice) ->
- eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice);
-eval_script([{primLoad,Mods}|CfgL],Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice)
+ eval_script(T, Es);
+eval_script([{kernel_load_completed}|T], #es{load_mode=Mode}=Es0) ->
+ Es = case Mode of
+ embedded -> Es0;
+ _ -> Es0#es{prim_load=false}
+ end,
+ eval_script(T, Es);
+eval_script([{primLoad,[Mod]}|T], #es{prim_load=true}=Es) ->
+ %% Common special case (loading of error_handler). Nothing
+ %% to gain by parallel loading.
+ File = atom_to_list(Mod) ++ objfile_extension(),
+ {ok,Full} = load_mod(Mod, File),
+ init ! {self(),loaded,{Mod,Full}}, % Tell init about loaded module
+ eval_script(T, Es);
+eval_script([{primLoad,Mods}|T], #es{init=Init,prim_load=PrimLoad}=Es)
when is_list(Mods) ->
- if
- Par =:= true ->
- par_load_modules(Mods,Init);
+ case PrimLoad of
true ->
- load_modules(Mods)
+ load_modules(Mods, Init);
+ false ->
+ %% Do not load now, code_server does that dynamically!
+ ok
end,
- eval_script(CfgL,Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice);
-eval_script([{primLoad,_Mods}|CfgL],Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice) ->
- %% Do not load now, code_server does that dynamically!
- eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice);
-eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|CfgL],Init,
- PathFs,Vars,P,Ph,Deb,PathChoice) ->
- debug(Deb,{start,Server}),
- start_in_kernel(Server,Mod,Fun,Args,Init),
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([{apply,{Mod,Fun,Args}}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
- debug(Deb,{apply,{Mod,Fun,Args}}),
- apply(Mod,Fun,Args),
- eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
-eval_script([],_,_,_,_,_,_,_) ->
+ eval_script(T, Es);
+eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|T],
+ #es{init=Init,debug=Deb}=Es) ->
+ debug(Deb, {start,Server}),
+ start_in_kernel(Server, Mod, Fun, Args, Init),
+ eval_script(T, Es);
+eval_script([{apply,{Mod,Fun,Args}}=Apply|T], #es{debug=Deb}=Es) ->
+ debug(Deb, Apply),
+ apply(Mod, Fun, Args),
+ eval_script(T, Es);
+eval_script([], #es{}) ->
ok;
-eval_script(What,_,_,_,_,_,_,_) ->
+eval_script(What, #es{}) ->
exit({'unexpected command in bootfile',What}).
-load_modules([Mod|Mods]) ->
- File = concat([Mod,objfile_extension()]),
+load_modules([Mod|Mods], Init) ->
+ File = atom_to_list(Mod) ++ objfile_extension(),
{ok,Full} = load_mod(Mod,File),
- init ! {self(),loaded,{Mod,Full}}, %% Tell init about loaded module
- load_modules(Mods);
-load_modules([]) ->
+ Init ! {self(),loaded,{Mod,Full}}, %Tell init about loaded module
+ load_modules(Mods, Init);
+load_modules([], _) ->
ok.
-%%% An optimization: erl_prim_loader gets the chance of loading many
-%%% files in parallel, using threads. This will reduce the seek times,
-%%% and loaded code can be processed while other threads are waiting
-%%% for the disk. The optimization is not tried unless the loader is
-%%% "efile" and there is a non-empty pool of threads.
-%%%
-%%% Many threads are needed to get a good result, so it would be
-%%% beneficial to load several applications in parallel. However,
-%%% measurements show that the file system handles one directory at a
-%%% time, regardless if parallel threads are created for files on
-%%% several directories (a guess: writing the meta information when
-%%% the file was last read ('mtime'), forces the file system to sync
-%%% between directories).
-
-par_load_modules(Mods,Init) ->
- Ext = objfile_extension(),
- ModFiles = [{Mod,concat([Mod,Ext])} || Mod <- Mods,
- not erlang:module_loaded(Mod)],
- Self = self(),
- Fun = fun(Mod, BinCode, FullName) ->
- case catch load_mod_code(Mod, BinCode, FullName) of
- {ok, _} ->
- Init ! {Self,loaded,{Mod,FullName}},
- ok;
- _EXIT ->
- {error, Mod}
- end
- end,
- case erl_prim_loader:get_files(ModFiles, Fun) of
- ok ->
- ok;
- {error,Mod} ->
- exit({'cannot load',Mod,get_files})
- end.
-
make_path(Pa, Pz, Path, Vars) ->
append([Pa,append([fix_path(Path,Vars),Pz])]).
@@ -908,34 +895,25 @@ fix_path([Path|Ps], Vars) ->
fix_path(_, _) ->
[].
-add_var("$ROOT/" ++ Path, {Root,_}) ->
- concat([Root, "/", Path]);
-add_var([$$|Path0], {_,VarList}) ->
- {Var,Path} = extract_var(Path0,[]),
- Value = b2s(get_var_value(list_to_binary(Var),VarList)),
- concat([Value, "/", Path]);
-add_var(Path, _) ->
+add_var("$"++Path0, Vars) ->
+ {Var,Path} = extract_var(Path0, []),
+ Key = list_to_binary(Var),
+ case Vars of
+ #{Key:=Value0} ->
+ Value = b2s(Value0),
+ Value ++ "/" ++ Path;
+ _ ->
+ Error0 = "cannot expand $" ++ Var ++ " in bootfile",
+ Error = list_to_atom(Error0),
+ exit(Error)
+ end;
+add_var(Path, _) ->
Path.
extract_var([$/|Path],Var) -> {reverse(Var),Path};
extract_var([H|T],Var) -> extract_var(T,[H|Var]);
extract_var([],Var) -> {reverse(Var),[]}.
-%% get_var_value(Var, [Vars]) where Vars == [atom()]
-get_var_value(Var,[Vars|VarList]) ->
- case get_var_val(Var,Vars) of
- {ok, Value} ->
- Value;
- _ ->
- get_var_value(Var,VarList)
- end;
-get_var_value(Var,[]) ->
- exit(list_to_atom(concat(["cannot expand \$", Var, " in bootfile"]))).
-
-get_var_val(Var,[Var,Value|_]) -> {ok, Value};
-get_var_val(Var,[_,_|Vars]) -> get_var_val(Var,Vars);
-get_var_val(_,_) -> false.
-
patch_path(Dirs, strict) ->
Dirs;
patch_path(Dirs, relaxed) ->
@@ -1049,18 +1027,10 @@ start_it({eval,Bin}) ->
{value, _Value, _Bs} = erl_eval:exprs(Expr, erl_eval:new_bindings()),
ok;
start_it([_|_]=MFA) ->
- Ref = make_ref(),
- case catch {Ref,case MFA of
- [M] -> M:start();
- [M,F] -> M:F();
- [M,F|Args] -> M:F(Args) % Args is a list
- end} of
- {Ref,R} ->
- R;
- {'EXIT',Reason} ->
- exit(Reason);
- Other ->
- throw(Other)
+ case MFA of
+ [M] -> M:start();
+ [M,F] -> M:F();
+ [M,F|Args] -> M:F(Args) % Args is a list
end.
%%
@@ -1102,7 +1072,7 @@ load_mod_code(Mod, BinCode, FullName) ->
%% --------------------------------------------------------
shutdown_timer(Flags) ->
- case get_flag('-shutdown_time',Flags,infinity) of
+ case get_flag(shutdown_time, Flags, infinity) of
infinity ->
self();
Time ->
@@ -1152,14 +1122,10 @@ parse_boot_args([B|Bs], Ss, Fs, As) ->
eval_arg ->
{Expr,Rest} = get_args(Bs, []),
parse_boot_args(Rest, [{eval, Expr}|Ss], Fs, As);
- flag ->
+ {flag,A} ->
{F,Rest} = get_args(Bs, []),
- Fl = case F of
- [] -> [B];
- FF -> [B,FF]
- end,
- parse_boot_args(Rest, Ss,
- [list_to_tuple(Fl)|Fs], As);
+ Fl = {A,F},
+ parse_boot_args(Rest, Ss, [Fl|Fs], As);
arg ->
parse_boot_args(Bs, Ss, Fs, [B|As]);
end_args ->
@@ -1173,12 +1139,8 @@ check(<<"-s">>) -> start_arg;
check(<<"-run">>) -> start_arg2;
check(<<"-eval">>) -> eval_arg;
check(<<"--">>) -> end_args;
-check(X) when is_binary(X) ->
- case binary_to_list(X) of
- [$-|_Rest] -> flag;
- _Chars -> arg %Even empty atoms
- end;
-check(_X) -> arg. %This should never occur
+check(<<"-",Flag/binary>>) -> {flag,b2a(Flag)};
+check(_) -> arg.
get_args([B|Bs], As) ->
case check(B) of
@@ -1187,7 +1149,7 @@ get_args([B|Bs], As) ->
start_arg2 -> {reverse(As), [B|Bs]};
eval_arg -> {reverse(As), [B|Bs]};
end_args -> {reverse(As), Bs};
- flag -> {reverse(As), [B|Bs]};
+ {flag,_} -> {reverse(As), [B|Bs]};
arg ->
get_args(Bs, [B|As])
end;
@@ -1199,44 +1161,28 @@ get_args([], As) -> {reverse(As),[]}.
%% atom() if a single arg was given.
%% list(atom()) if several args were given.
%%
-get_flag(F,Flags,Default) ->
- case catch get_flag(F,Flags) of
- {'EXIT',_} ->
- Default;
- Value ->
- Value
- end.
-
-get_flag(F,Flags) ->
- case search(F,Flags) of
- {value,{F,[V]}} ->
+get_flag(F, Flags, Default) ->
+ case lists:keyfind(F, 1, Flags) of
+ {F,[]} ->
+ true;
+ {F,[V]} ->
V;
- {value,{F,V}} ->
+ {F,V} ->
V;
- {value,{F}} -> % Flag given!
- true;
_ ->
- exit(list_to_atom(concat(["no ",F," flag"])))
+ Default
end.
%%
%% Internal get_flag function, with default value.
%% Return: list(atom())
%%
-get_flag_list(F,Flags,Default) ->
- case catch get_flag_list(F,Flags) of
- {'EXIT',_} ->
- Default;
- Value ->
- Value
- end.
-
-get_flag_list(F,Flags) ->
- case search(F,Flags) of
- {value,{F,V}} ->
+get_flag_list(F, Flags, Default) ->
+ case lists:keyfind(F, 1, Flags) of
+ {F,[_|_]=V} ->
V;
_ ->
- exit(list_to_atom(concat(["no ",F," flag"])))
+ Default
end.
%%
@@ -1246,21 +1192,15 @@ get_flag_list(F,Flags) ->
%%
get_flag_args(F,Flags) -> get_flag_args(F,Flags,[]).
-get_flag_args(F,[{F,V}|Flags],Acc) when is_list(V) ->
- get_flag_args(F,Flags,[V|Acc]);
get_flag_args(F,[{F,V}|Flags],Acc) ->
- get_flag_args(F,Flags,[[V]|Acc]);
+ get_flag_args(F,Flags,[V|Acc]);
get_flag_args(F,[_|Flags],Acc) ->
get_flag_args(F,Flags,Acc);
get_flag_args(_,[],Acc) ->
reverse(Acc).
get_arguments([{F,V}|Flags]) ->
- [$-|Fl] = atom_to_list(F),
- [{list_to_atom(Fl),to_strings(V)}|get_arguments(Flags)];
-get_arguments([{F}|Flags]) ->
- [$-|Fl] = atom_to_list(F),
- [{list_to_atom(Fl),[]}|get_arguments(Flags)];
+ [{F,to_strings(V)}|get_arguments(Flags)];
get_arguments([]) ->
[].
@@ -1268,44 +1208,26 @@ to_strings([H|T]) when is_atom(H) -> [atom_to_list(H)|to_strings(T)];
to_strings([H|T]) when is_binary(H) -> [b2s(H)|to_strings(T)];
to_strings([]) -> [].
-get_argument(Arg,Flags) ->
- Args = get_arguments(Flags),
- case get_argument1(Arg,Args) of
- [] ->
- error;
- Value ->
- {ok,Value}
+get_argument(Arg, Flags) ->
+ case get_argument1(Arg, Flags) of
+ [] -> error;
+ Value -> {ok,Value}
end.
-get_argument1(Arg,[{Arg,V}|Args]) ->
- [V|get_argument1(Arg,Args)];
-get_argument1(Arg,[_|Args]) ->
- get_argument1(Arg,Args);
-get_argument1(_,[]) ->
+get_argument1(Arg, [{Arg,V}|Args]) ->
+ [to_strings(V)|get_argument1(Arg, Args)];
+get_argument1(Arg, [_|Args]) ->
+ get_argument1(Arg, Args);
+get_argument1(_, []) ->
[].
set_argument([{Flag,_}|Flags],Flag,Value) ->
[{Flag,[Value]}|Flags];
-set_argument([{Flag}|Flags],Flag,Value) ->
- [{Flag,[Value]}|Flags];
set_argument([Item|Flags],Flag,Value) ->
[Item|set_argument(Flags,Flag,Value)];
set_argument([],Flag,Value) ->
[{Flag,[Value]}].
-concat([A|T]) when is_atom(A) ->
- atom_to_list(A) ++ concat(T);
-concat([C|T]) when is_integer(C), 0 =< C, C =< 255 ->
- [C|concat(T)];
-concat([Bin|T]) when is_binary(Bin) ->
- binary_to_list(Bin) ++ concat(T);
-concat([S|T]) ->
- S ++ concat(T);
-concat([]) ->
- [].
-
-append(L, Z) -> L ++ Z.
-
append([E]) -> E;
append([H|T]) ->
H ++ append(T);
@@ -1320,13 +1242,6 @@ reverse([A, B]) ->
reverse([A, B | L]) ->
lists:reverse(L, [B, A]). % BIF
-search(Key, [H|_T]) when is_tuple(H), element(1, H) =:= Key ->
- {value, H};
-search(Key, [_|T]) ->
- search(Key, T);
-search(_Key, []) ->
- false.
-
-spec objfile_extension() -> nonempty_string().
objfile_extension() ->
".beam".
diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl
index c87b2645ec..ab5359ebbc 100644
--- a/erts/preloaded/src/prim_file.erl
+++ b/erts/preloaded/src/prim_file.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1276,6 +1276,7 @@ lseek_position(_) ->
%% Translates the response from the driver into
%% {ok, Result} or {error, Reason}.
+-dialyzer({no_improper_lists, translate_response/2}).
translate_response(?FILE_RESP_OK, []) ->
ok;
translate_response(?FILE_RESP_ERROR, List) when is_list(List) ->
diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl
index d5c8fd4268..bd74831bb7 100644
--- a/erts/preloaded/src/prim_inet.erl
+++ b/erts/preloaded/src/prim_inet.erl
@@ -232,7 +232,7 @@ bindx(S, AddFlag, Addrs) ->
%% if timeout is given:
%% timeout < 0 -> infinity
%% 0 -> immediate connect (mostly works for loopback)
-%% > 0 -> wait for timout ms if not connected then
+%% > 0 -> wait for timeout ms if not connected then
%% return {error, timeout}
%%
%% ASYNC_CONNECT(insock(), IP, Port, Timeout) -> {ok, S, Ref} | {error, Reason}
@@ -273,7 +273,7 @@ async_connect(S, IP, Port, Time) ->
%% if timeout is given:
%% timeout < 0 -> infinity
%% 0 -> immediate accept (poll)
-%% > 0 -> wait for timout ms for accept if no accept then
+%% > 0 -> wait for timeout ms for accept if no accept then
%% return {error, timeout}
%%
%% ASYNC_ACCEPT(insock(), Timeout)
diff --git a/erts/test/Makefile b/erts/test/Makefile
index 5263d8cd4f..a01d67e34f 100644
--- a/erts/test/Makefile
+++ b/erts/test/Makefile
@@ -54,7 +54,7 @@ RELSYSDIR = $(RELEASE_PATH)/system_test
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS +=
# ----------------------------------------------------
# Targets
diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl
index 3b0c083702..f0fee49024 100644
--- a/erts/test/erl_print_SUITE.erl
+++ b/erts/test/erl_print_SUITE.erl
@@ -40,7 +40,7 @@
-export([erlang_display/1, integer/1, float/1,
string/1, character/1, snprintf/1, quote/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl
index c21064fd3f..7e44be1fe0 100644
--- a/erts/test/erlc_SUITE.erl
+++ b/erts/test/erlc_SUITE.erl
@@ -27,7 +27,7 @@
compile_mib/1, good_citizen/1, deep_cwd/1, arg_overflow/1,
make_dep_options/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl
index 9279872d25..6440cbf0d7 100644
--- a/erts/test/erlexec_SUITE.erl
+++ b/erts/test/erlexec_SUITE.erl
@@ -38,7 +38,7 @@
-export([args_file/1, evil_args_file/1, env/1, args_file_env/1, otp_7461/1, otp_7461_remote/1, otp_8209/1, zdbbl_dist_buf_busy_limit/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(Case, Config) ->
diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl
index 4a40dbb11e..8ad2a32278 100644
--- a/erts/test/ethread_SUITE.erl
+++ b/erts/test/ethread_SUITE.erl
@@ -51,7 +51,7 @@
atomic/1,
dw_atomic_massage/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
tests() ->
[create_join_thread,
@@ -123,38 +123,6 @@ try_lock_mutex(suite) ->
try_lock_mutex(Config) ->
run_case(Config, "try_lock_mutex", "").
-%% Remove dead code?
-
-% wd_dispatch(P) ->
-% receive
-% bye ->
-% ?line true = port_command(P, "-1 "),
-% ?line bye;
-% L when is_list(L) ->
-% ?line true = port_command(P, L),
-% ?line wd_dispatch(P)
-% end.
-%
-% watchdog(Port) ->
-% ?line process_flag(priority, max),
-% ?line receive after 500 -> ok end,
-%
-% ?line random:seed(),
-% ?line true = port_command(Port, "0 "),
-% ?line lists:foreach(fun (T) ->
-% erlang:send_after(T,
-% self(),
-% integer_to_list(T)
-% ++ " ")
-% end,
-% lists:usort(lists:map(fun (_) ->
-% random:uniform(4500)+500
-% end,
-% lists:duplicate(50,0)))),
-% ?line erlang:send_after(5100, self(), bye),
-%
-% wd_dispatch(Port).
-
cond_wait(doc) ->
["Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast."];
cond_wait(suite) ->
diff --git a/erts/test/ethread_SUITE_data/ethread_tests.c b/erts/test/ethread_SUITE_data/ethread_tests.c
index 12f7f3db7a..b51771c736 100644
--- a/erts/test/ethread_SUITE_data/ethread_tests.c
+++ b/erts/test/ethread_SUITE_data/ethread_tests.c
@@ -1457,6 +1457,9 @@ do { \
ASSERT(ethr_ ## A ## _read ## B(&A) == 0x33333333); \
} while (0)
+ethr_atomic32_t atomic32;
+ethr_atomic_t atomic;
+ethr_dw_atomic_t dw_atomic;
static void
atomic_basic_test(void)
@@ -1465,8 +1468,6 @@ atomic_basic_test(void)
* Verify that each op does what it is expected
* to do for at least one input.
*/
- ethr_atomic32_t atomic32;
- ethr_atomic_t atomic;
print_line("AT_AINT32_MAX=%d",AT_AINT32_MAX);
print_line("AT_AINT32_MIN=%d",AT_AINT32_MIN);
@@ -1629,7 +1630,6 @@ atomic_basic_test(void)
/* Double word */
{
- ethr_dw_atomic_t dw_atomic;
ethr_dw_sint_t dw0, dw1;
dw0.sint[0] = 4711;
dw0.sint[1] = 4712;
diff --git a/erts/test/ignore_cores.erl b/erts/test/ignore_cores.erl
index 13f34cd10f..e40b91392c 100644
--- a/erts/test/ignore_cores.erl
+++ b/erts/test/ignore_cores.erl
@@ -28,7 +28,7 @@
-module(ignore_cores).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]).
diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl
index b380b064bd..d6df1aab6b 100644
--- a/erts/test/install_SUITE.erl
+++ b/erts/test/install_SUITE.erl
@@ -52,7 +52,7 @@
-define(DEFAULT_TIMEOUT, ?t:minutes(1)).
-define(JOIN(A,B,C), filename:join(A, B, C)).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-record(inst, {mkdirs = true,
symlinks = true,
diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl
index dbae8df7fe..1ddaaaaeb5 100644
--- a/erts/test/nt_SUITE.erl
+++ b/erts/test/nt_SUITE.erl
@@ -20,7 +20,7 @@
%%% Purpose: Test NT specific utilities
-module(nt_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl
index 69a0d19719..2efb5ae200 100644
--- a/erts/test/otp_SUITE.erl
+++ b/erts/test/otp_SUITE.erl
@@ -27,7 +27,7 @@
call_to_size_1/1,call_to_now_0/1,strong_components/1,
erl_file_encoding/1,xml_file_encoding/1,runtime_dependencies/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-import(lists, [filter/2,foldl/3,foreach/2]).
@@ -290,7 +290,7 @@ call_to_deprecated(Config) when is_list(Config) ->
call_to_size_1(Config) when is_list(Config) ->
%% Applications that do not call erlang:size/1:
Apps = [asn1,compiler,debugger,kernel,observer,parsetools,
- runtime_tools,stdlib,tools,webtool],
+ runtime_tools,stdlib,tools],
not_recommended_calls(Config, Apps, {erlang,size,1}).
call_to_now_0(Config) when is_list(Config) ->
@@ -298,12 +298,14 @@ call_to_now_0(Config) when is_list(Config) ->
Apps = [asn1,common_test,compiler,debugger,dialyzer,
gs,kernel,mnesia,observer,parsetools,reltool,
runtime_tools,sasl,stdlib,syntax_tools,
- test_server,tools,webtool],
+ tools],
not_recommended_calls(Config, Apps, {erlang,now,0}).
-not_recommended_calls(Config, Apps, MFA) ->
+not_recommended_calls(Config, Apps0, MFA) ->
Server = ?config(xref_server, Config),
+ Apps = [App || App <- Apps0, is_present_application(App, Server)],
+
Fs = [MFA],
Q1 = io_lib:format("E || ~p : Fun", [Fs]),
@@ -337,11 +339,28 @@ not_recommended_calls(Config, Apps, MFA) ->
end,
case CallsToMFA of
[] ->
- ok;
+ SkippedApps = ordsets:subtract(ordsets:from_list(Apps0),
+ ordsets:from_list(Apps)),
+ case SkippedApps of
+ [] ->
+ ok;
+ _ ->
+ AppStrings = [atom_to_list(A) || A <- SkippedApps],
+ Mess = io_lib:format("Application(s) not present: ~s\n",
+ [string:join(AppStrings, ", ")]),
+ {comment, Mess}
+ end;
_ ->
?t:fail({length(CallsToMFA),calls_to_size_1})
end.
+is_present_application(Name, Server) ->
+ Q = io_lib:format("~w : App", [Name]),
+ case xref:q(Server, lists:flatten(Q)) of
+ {ok,[Name]} -> true;
+ {error,_,_} -> false
+ end.
+
strong_components(Config) when is_list(Config) ->
Server = ?config(xref_server, Config),
?line {ok,Cs} = xref:q(Server, "components AE"),
@@ -440,24 +459,7 @@ runtime_dependencies(Config) ->
end,
{undefined, []},
SAE),
- [] = lists:filter(fun ({missing_runtime_dependency,
- AppFile,
- common_test}) ->
- %% The test_server app is contaminated by
- %% common_test when run in a source tree. It
- %% should however *not* be contaminated
- %% when run in an installation.
- case {filename:basename(AppFile),
- is_run_in_src_tree()} of
- {"test_server.app", true} ->
- false;
- _ ->
- true
- end;
- (_) ->
- true
- end,
- check_apps_deps([AppDep|AppDeps], IgnoreApps)),
+ check_apps_deps([AppDep|AppDeps], IgnoreApps),
case IgnoreApps of
[] ->
ok;
@@ -469,17 +471,6 @@ runtime_dependencies(Config) ->
{comment, Comment}
end.
-is_run_in_src_tree() ->
- %% At least currently run_erl is not present in <code-root>/bin
- %% in the source tree, but present in <code-root>/bin of an
- %% ordinary installation.
- case file:read_file_info(filename:join([code:root_dir(),
- "bin",
- "run_erl"])) of
- {ok, _} -> false;
- {error, _} -> true
- end.
-
have_rdep(_App, [], _Dep) ->
false;
have_rdep(App, [RDep | RDeps], Dep) ->
diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl
index 328477d870..e3c563d3d9 100644
--- a/erts/test/run_erl_SUITE.erl
+++ b/erts/test/run_erl_SUITE.erl
@@ -26,7 +26,7 @@
basic/1,heavy/1,heavier/1,defunct/1]).
-export([ping_me_back/1]).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
init_per_testcase(_Case, Config) ->
Dog = ?t:timetrap(?t:minutes(2)),
@@ -141,12 +141,10 @@ heavier_1(Config) ->
?line ToErl = open_port({spawn,"to_erl "++Pipe}, []),
io:format("ToErl = ~p\n", [ToErl]),
- X = 1,
- Y = 555,
- Z = 42,
- ?line random:seed(X, Y, Z),
- SeedCmd = lists:flatten(io_lib:format("random:seed(~p, ~p, ~p). \r\n",
- [X,Y,Z])),
+ Seed = {1,555,42},
+ rand:seed(exsplus, Seed),
+ SeedCmd = lists:flatten(io_lib:format("rand:seed(exsplus, ~p). \r\n",
+ [Seed])),
?line io:format("~p\n", [SeedCmd]),
?line erlang:port_command(ToErl, SeedCmd),
@@ -157,9 +155,9 @@ heavier_1(Config) ->
"F = fun(F,0) -> ok; "++
"(F,N) -> " ++
"io:format(\"\\\"~s\\\"~n\","++
- "[[35|[random:uniform(25)+65 || " ++
+ "[[35|[rand:uniform(25)+65 || " ++
"_ <- lists:seq(1, "++
- "random:uniform("++
+ "rand:uniform("++
integer_to_list(MaxLen)++
"))]]]), "++
"F(F,N-1) "++
@@ -189,8 +187,8 @@ receive_all(Iter, ToErl, MaxLen) ->
receive_all_1(0, _, _, _) -> ok;
receive_all_1(Iter, Line, ToErl, MaxLen) ->
- NumChars = random:uniform(MaxLen),
- Pattern = [random:uniform(25)+65 || _ <- lists:seq(1, NumChars)],
+ NumChars = rand:uniform(MaxLen),
+ Pattern = [rand:uniform(25)+65 || _ <- lists:seq(1, NumChars)],
receive_all_2(Iter, {NumChars,Pattern}, Line, ToErl, MaxLen).
diff --git a/erts/vsn.mk b/erts/vsn.mk
index 140baeb846..6ad3680213 100644
--- a/erts/vsn.mk
+++ b/erts/vsn.mk
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2013. All Rights Reserved.
+# Copyright Ericsson AB 1997-2016. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -18,7 +18,7 @@
# %CopyrightEnd%
#
-VSN = 7.1
+VSN = 8.0
# Port number 4365 in 4.2
# Port number 4366 in 4.3